diff --git a/vendors/tezos-modded/.dockerignore b/vendors/tezos-modded/.dockerignore new file mode 100644 index 000000000..cf0c58e24 --- /dev/null +++ b/vendors/tezos-modded/.dockerignore @@ -0,0 +1,50 @@ + +## /!\ /!\ Update .gitignore accordingly /!\ /!\ + +.DS_Store +__pycache__ +**/*.pyc + +_build +_opam +_docker_build +docs/_build +docs/api/tezos-client.html +docs/api/tezos-admin-client.html + +tezos-node +tezos-protocol-compiler +tezos-client +tezos-admin-client +tezos-baker-* +tezos-endorser-* +tezos-accuser-* +tezos-signer + +scripts/opam-test-all.sh.DONE +scripts/create_genesis/src + +docs/introduction/readme.rst +docs/api/errors.rst +docs/api/rpc.rst +docs/api/p2p.rst + +src/bin_client/test/LOG.* + +**/dune-project + +**/*.install +**/.merlin + +**/*~ +**/\#*\# + +**/*.rej +**/*.orig + +## Not in .gitignore + +.git +.gitignore +.gitlab-ci.yml + diff --git a/vendors/tezos-modded/.gitattributes b/vendors/tezos-modded/.gitattributes new file mode 100644 index 000000000..b702860fe --- /dev/null +++ b/vendors/tezos-modded/.gitattributes @@ -0,0 +1,4 @@ +.gitignore export-ignore +.gitattributes export-ignore +.gitlab-ci.yml export-ignore +src/lib_base/current_git_info.ml export-subst diff --git a/vendors/tezos-modded/.github/ISSUE_TEMPLATE.md b/vendors/tezos-modded/.github/ISSUE_TEMPLATE.md new file mode 120000 index 000000000..bd93fccdf --- /dev/null +++ b/vendors/tezos-modded/.github/ISSUE_TEMPLATE.md @@ -0,0 +1 @@ +../.gitlab/issue_templates/issues.md \ No newline at end of file diff --git a/vendors/tezos-modded/.gitignore b/vendors/tezos-modded/.gitignore new file mode 100644 index 000000000..0bdd47e8a --- /dev/null +++ b/vendors/tezos-modded/.gitignore @@ -0,0 +1,48 @@ + +## /!\ /!\ Update .dockerignore accordingly /!\ /!\ + +.DS_Store +__pycache__ +*.pyc + +/_build +**/_build +/_opam +/_docker_build +/docs/_build +/docs/api/tezos-client.html +/docs/api/tezos-admin-client.html + +/tezos-node +/tezos-protocol-compiler +/tezos-client +/tezos-admin-client +/tezos-baker-* +/tezos-endorser-* +/tezos-accuser-* +/tezos-signer + +/scripts/opam-test-all.sh.DONE +/scripts/create_genesis/src + +/docs/introduction/readme.rst +/docs/api/errors.rst +/docs/api/rpc.rst +/docs/api/p2p.rst + +/src/bin_client/test/LOG.* + +dune-project +*.install +.merlin + +*~ +\#*\# +[._]*.s[a-v][a-z] +[._]*.sw[a-p] +[._]s[a-rt-v][a-z] +[._]ss[a-gi-z] +[._]sw[a-p] + +*.rej +*.orig diff --git a/vendors/tezos-modded/.gitlab-ci.yml b/vendors/tezos-modded/.gitlab-ci.yml new file mode 100644 index 000000000..09fbdb914 --- /dev/null +++ b/vendors/tezos-modded/.gitlab-ci.yml @@ -0,0 +1,38 @@ +before_script: + - apt-get update -qq + # rsync is needed by opam to sync a package installed from a local directory with the copy in ~/.opam + - apt-get -y -qq install rsync libhidapi-dev libcap-dev libev-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) + - printf '' | opam switch create toto ocaml-base-compiler.4.06.1 + - eval $(opam config env) + - opam repository add new-tezos-opam-repository https://gitlab.com/ligolang/new-tezos-opam-repository.git + - eval $(opam config env) + # Show versions and current switch + - opam --version + - printf '' | ocaml + - opam switch + +default-job: + script: + - (cd src/lib_utils && opam install -y --build-test --working-dir .) + - (cd src/ligo && opam install -y --build-test --working-dir .) + - (cd src/ligo && dune build && dune build -p ligo && dune build @ligo-test) + artifacts: + paths: + - src/ligo/bin/cli.ml + + +install-from-repo-job: + script: + - opam install -y ligo + # Used in the IDE + #- opam install -y user-setup + #- opam install -y merlin + #- opam install -y ocp-indent + #- opam user-setup install diff --git a/vendors/tezos-modded/.gitlab/issue_templates/issues.md b/vendors/tezos-modded/.gitlab/issue_templates/issues.md new file mode 100644 index 000000000..da9637879 --- /dev/null +++ b/vendors/tezos-modded/.gitlab/issue_templates/issues.md @@ -0,0 +1,56 @@ +Before submitting your issue, ask this question: is this a bug in the Tezos codebase or a personal problem for which you need support? Here are a few examples of each: + +Personal problem: +* Lost or compromised key +* Fundraiser issues +* Questions about how to use Tezos +* Feature requests +* Questions about the state of development + +These sorts of questions should be asked on the [riot chat](https://riot.im/app/#/room/#tezos:matrix.org). People there will be happy to assist you. + +Bugs: +* Crashes or exceptions in the node +* Defaults that cause failures +* Missing documentation +* Build failures + +Make sure to give your issue a descriptive title. We should get the general idea of the problem just from reading the title. Avoid words like "weird", "strange", and "unexpected". Instead, spell out the strange behavior in as much detail as possible. As an example, "Michelson: lists are reversed" is significantly better than "List handling is weird". Unless your investigations have revealed the source of the bug, do not speculate on its cause or severity. The easier it is for us to understand your bug the easier it is for us to fix. + +### Environment (Alphanet, build from source, or both) + +Please specify the version of the code you were running when the bug appeared. + +If you've built the program from source, you can find the commit hash via the following command: + +`git log -1 --format=format:%H` + +If you're running the alphanet, the status output is extremely useful: + +`./alphanet.sh status` + +### Expected behavior +What you expected to happen. + +### Actual behavior + +What actually happened. + +### Steps to reproduce + +Please provide the command that led to the issue. Copy and paste the command line and the output into the issue and attach any files we'll need to reproduce the bug. Screenshots are much harder to deal with because we cannot rerun your commands or see the entire setup. + +Whenever possible, provide the smallest amount of code needed to produce the bug dependably. If you cannot reproduce the bug, we likely will not be able to either. + +If you had a problem while trying to build Tezos from source, please include the output of `opam list -i` and any error messages that you saw while building. If you ran a second command which fixed the problem, provide us with the error you saw initially in addition to telling us how you fixed the bug. + +### Logs +Please include logs with your bug report whenever possible. + + +On the alphanet, you can access the log from the node, baker, and endorser using the following commands: +* `./alphanet.sh node log` +* `./alphanet.sh baker log` +* `./alphanet.sh endorser log` + +If you've encountered the bug when using the sandboxed node initialization scripts, there should be a file in the directory called `LOG.N`, where `N` is the number with which you started the node. Please attach that log to the bug report. diff --git a/vendors/tezos-modded/.ocp-indent b/vendors/tezos-modded/.ocp-indent new file mode 100644 index 000000000..ef83851c8 --- /dev/null +++ b/vendors/tezos-modded/.ocp-indent @@ -0,0 +1 @@ +match_clause = 4 diff --git a/vendors/tezos-modded/LICENSE b/vendors/tezos-modded/LICENSE new file mode 100644 index 000000000..d2dac454e --- /dev/null +++ b/vendors/tezos-modded/LICENSE @@ -0,0 +1,20 @@ +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. diff --git a/vendors/tezos-modded/Makefile b/vendors/tezos-modded/Makefile new file mode 100644 index 000000000..30dbda58a --- /dev/null +++ b/vendors/tezos-modded/Makefile @@ -0,0 +1,119 @@ + +PACKAGES:=$(patsubst %.opam,%,$(notdir $(shell find src vendors -name \*.opam -print))) + +active_protocol_versions := $(shell cat active_protocol_versions) +active_protocol_directories := $(shell tr -- - _ < active_protocol_versions) + +current_opam_version := $(shell opam --version) +include scripts/version.sh + +ifeq ($(filter ${opam_version}.%,${current_opam_version}),) +$(error Unexpected opam version (found: ${current_opam_version}, expected: ${opam_version}.*)) +endif + +current_ocaml_version := $(shell opam exec -- ocamlc -version) + +all: generate_dune +ifneq (${current_ocaml_version},${ocaml_version}) + $(error Unexpected ocaml version (found: ${current_ocaml_version}, expected: ${ocaml_version})) +endif + @dune build \ + src/bin_node/main.exe \ + src/bin_client/main_client.exe \ + src/bin_client/main_admin.exe \ + src/bin_signer/main_signer.exe \ + src/lib_protocol_compiler/main_native.exe \ + $(foreach p, $(active_protocol_directories), src/proto_$(p)/bin_baker/main_baker_$(p).exe) \ + $(foreach p, $(active_protocol_directories), src/proto_$(p)/bin_endorser/main_endorser_$(p).exe) \ + $(foreach p, $(active_protocol_directories), src/proto_$(p)/bin_accuser/main_accuser_$(p).exe) + @cp _build/default/src/bin_node/main.exe tezos-node + @cp _build/default/src/bin_client/main_client.exe tezos-client + @cp _build/default/src/bin_client/main_admin.exe tezos-admin-client + @cp _build/default/src/bin_signer/main_signer.exe tezos-signer + @cp _build/default/src/lib_protocol_compiler/main_native.exe tezos-protocol-compiler + @for p in $(active_protocol_directories) ; do \ + cp _build/default/src/proto_$$p/bin_baker/main_baker_$$p.exe tezos-baker-`echo $$p | tr -- _ -` ; \ + cp _build/default/src/proto_$$p/bin_endorser/main_endorser_$$p.exe tezos-endorser-`echo $$p | tr -- _ -` ; \ + cp _build/default/src/proto_$$p/bin_accuser/main_accuser_$$p.exe tezos-accuser-`echo $$p | tr -- _ -` ; \ + done + +PROTOCOLS := genesis alpha demo +DUNE_INCS=$(patsubst %,src/proto_%/lib_protocol/dune.inc, ${PROTOCOLS}) + +generate_dune: ${DUNE_INCS} + +${DUNE_INCS}:: src/proto_%/lib_protocol/dune.inc: \ + src/proto_%/lib_protocol/TEZOS_PROTOCOL + dune build @$(dir $@)/runtest_dune_template --auto-promote + touch $@ + +all.pkg: generate_dune + @dune build \ + $(patsubst %.opam,%.install, $(shell find src vendors -name \*.opam -print)) + +$(addsuffix .pkg,${PACKAGES}): %.pkg: + @dune build \ + $(patsubst %.opam,%.install, $(shell find src vendors -name $*.opam -print)) + +$(addsuffix .test,${PACKAGES}): %.test: + @dune build \ + @$(patsubst %/$*.opam,%,$(shell find src vendors -name $*.opam))/runtest + +doc-html: all + @dune build @doc + @./tezos-client -protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-client.html + @./tezos-admin-client man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-admin-client.html + @./tezos-signer man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-signer.html + @./tezos-baker-alpha man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-baker-alpha.html + @./tezos-endorser-alpha man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-endorser-alpha.html + @./tezos-accuser-alpha man -verbosity 3 -format html | sed "s#${HOME}#\$$HOME#g" > docs/api/tezos-accuser-alpha.html + @mkdir -p $$(pwd)/docs/_build/api/odoc + @rm -rf $$(pwd)/docs/_build/api/odoc/* + @cp -r $$(pwd)/_build/default/_doc/* $$(pwd)/docs/_build/api/odoc/ + @${MAKE} -C docs html + +doc-html-and-linkcheck: doc-html + @${MAKE} -C docs all + +build-test: + @dune build @buildtest + +test: + @dune runtest + @./scripts/check_opam_test.sh + +test-indent: + @dune build @runtest_indent + +fix-indent: + @src/lib_stdlib/test-ocp-indent.sh fix + +build-deps: + @./scripts/install_build_deps.sh + +build-dev-deps: + @./scripts/install_build_deps.sh --dev + +docker-image: + @./scripts/create_docker_image.sh + +install: + @dune build @install + @dune install + +uninstall: + @dune uninstall + +clean: + @-dune clean + @-rm -f \ + tezos-node \ + tezos-client \ + tezos-signer \ + tezos-admin-client \ + tezos-protocol-compiler \ + $(foreach p, $(active_protocol_versions), tezos-baker-$(p) tezos-endorser-$(p) tezos-accuser-$(p)) + @-${MAKE} -C docs clean + @-rm -f docs/api/tezos-{baker,endorser,accuser}-alpha.html docs/api/tezos-{admin-,}client.html docs/api/tezos-signer.html + +.PHONY: all test build-deps docker-image clean diff --git a/vendors/tezos-modded/README.md b/vendors/tezos-modded/README.md new file mode 100644 index 000000000..dd6b2a123 --- /dev/null +++ b/vendors/tezos-modded/README.md @@ -0,0 +1,47 @@ +Tezos +===== + +The Project +----------- + +Tezos is a distributed consensus platform with meta-consensus +capability. Tezos not only comes to consensus about the state of its ledger, +like Bitcoin or Ethereum. It also attempts to come to consensus about how the +protocol and the nodes should adapt and upgrade. + + - Developer documentation is available online at http://tezos.gitlab.io/master + always in sync with the master branch (which may be desynchronized with + the code running on the live networks, replace `master` in the URL by the + branch of your choice: mainnet, alphanet, zeronet, to make sure you are + consulting the right API version) + - The website https://tezos.com/ contains more information about the project. + - All development happens on GitLab at https://gitlab.com/tezos/tezos + +The source code of Tezos is placed under the MIT Open Source License. + +The Community +------------- + + - Several community built block explorers are available: + + - http://tzscan.io + - https://tezos.id + - https://tezex.info + +- A few community run websites collect useful Tezos links: + + - https://www.tezos.help + - https://tezos.rocks + + - There is a matrix channel *Tezos* that you can join `here `_. + - There is a sub-reddit at https://www.reddit.com/r/tezos/ + - There is also a community FAQ at https://github.com/tezoscommunity/faq/wiki/Tezos-Technical-FAQ + - There is a *#tezos* IRC channel on *freenode* that is reserved for technical discussions + + +The Networks +------------ + +The Tezos Alpha (test) network has been live and open since February 2017. + +The Tezos Beta (experimental) network has been live and open since June 2018. diff --git a/vendors/tezos-modded/active_protocol_versions b/vendors/tezos-modded/active_protocol_versions new file mode 100644 index 000000000..4a5800705 --- /dev/null +++ b/vendors/tezos-modded/active_protocol_versions @@ -0,0 +1 @@ +alpha diff --git a/vendors/tezos-modded/docs/Makefile b/vendors/tezos-modded/docs/Makefile new file mode 100644 index 000000000..5309877c7 --- /dev/null +++ b/vendors/tezos-modded/docs/Makefile @@ -0,0 +1,42 @@ +# You can set these variables from the command line. +SPHINXOPTS = -aE -n +SPHINXBUILD = sphinx-build +SPHINXPROJ = Tezos +SOURCEDIR = . +BUILDDIR = _build + +DOCGENDIR = doc_gen +DOCERRORDIR = $(DOCGENDIR)/errors +DOCRPCDIR = $(DOCGENDIR)/rpcs + +all: html linkcheck + +linkcheck: + $(SPHINXBUILD) -b linkcheck "$(SOURCEDIR)" "$(BUILDDIR)" + +api/errors.rst: $(DOCERRORDIR)/error_doc.ml + @cd .. && dune build docs/$(DOCERRORDIR)/error_doc.exe + ../_build/default/docs/$(DOCERRORDIR)/error_doc.exe > api/errors.rst + +$(DOCGENDIR)/rpc_doc.exe: + @cd .. && dune build docs/$(DOCGENDIR)/rpc_doc.exe + +api/rpc.rst: $(DOCGENDIR)/rpc_doc.exe + @dune exec $(DOCGENDIR)/rpc_doc.exe > api/rpc.rst + +$(DOCGENDIR)/p2p_doc.exe: + @cd .. && dune build docs/$(DOCGENDIR)/p2p_doc.exe + +api/p2p.rst: $(DOCGENDIR)/p2p_doc.exe api/p2p_usage.rst.inc + @dune exec $(DOCGENDIR)/p2p_doc.exe < api/p2p_usage.rst.inc > api/p2p.rst + +.PHONY: help Makefile + +# Catch-all target: route all unknown targets to Sphinx using the new +# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). +html: Makefile api/errors.rst api/rpc.rst api/p2p.rst + @$(SPHINXBUILD) -b html "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) + +clean: + @-rm -Rf "$(BUILDDIR)" + @-rm -Rf api/errors.rst api/rpc.rst diff --git a/vendors/tezos-modded/docs/README.rst b/vendors/tezos-modded/docs/README.rst new file mode 100644 index 000000000..8c1463d42 --- /dev/null +++ b/vendors/tezos-modded/docs/README.rst @@ -0,0 +1,64 @@ +****************************** +Building documentation locally +****************************** + +The documentation is available online at `tezos.gitlab.io `_, +always up to date with master on `GitLab `_. + +Building instructions +--------------------- + +To build the documentation, you can use the main Makefile target ``doc-html`` + +.. code:: bash + + make doc-html + +The documentation is built by Sphinx, and uses the Read The Docs theme. + +On a debian system, you can install the needed dependencies with: + +.. code:: bash + + sudo apt install \ + python3-recommonmark \ + python3-sphinx \ + python3-sphinx-rtd-theme + +Sphinx extensions +----------------- + +Some ad-hoc reference kinds are supported. + +- ``:package-src:`name``` or ``:package-src:`text``` points + to the gitlab source tree viewer where the `.opam` for the package + is located +- ``:package:`name``` or ``:package:`text``` now points + either to the `odoc` page, or if it doesn't exist, to the gitlab + source tree viewer +- ``:package-name:`name``` or ``:package-name:`text``` just + displays the package name (no link), checking that the package + exists +- ``:src:`/path/to/file/or/dir``` or + ``:src:`text``` points to the gitlab source + tree viewer +- ``:opam:`package``` or ``:opam:`text``` points to the + package page on ``opam.ocaml.org``, version number is supported + (``package.version``) + +OCaml documentation +------------------- + +Odoc is used for OCaml API generation, that you can install with: + +.. code:: bash + + opam install odoc + +Tezos generates the API documentation for all libraries in HTML format. The +generated HTML pages in ``_build//_doc``. It creates one sub-directory +per public library and generates an ``index.html`` file in each sub-directory. + +The documentation is not installed on the system by Tezos. It is meant to be +read locally while developing and then published on the www when releasing +packages. diff --git a/vendors/tezos-modded/docs/_extensions/tezos_custom_roles.py b/vendors/tezos-modded/docs/_extensions/tezos_custom_roles.py new file mode 100644 index 000000000..c7ab05b5e --- /dev/null +++ b/vendors/tezos-modded/docs/_extensions/tezos_custom_roles.py @@ -0,0 +1,77 @@ +from docutils import nodes +import os +import os.path +import re + +def setup(app): + app.add_role('package', package_role) + app.add_role('package-name', package_role) + app.add_role('package-src', package_role) + app.add_role('opam', opam_role) + app.add_role('src', src_role) + +def find_dot_opam(name): + for path, dirs, files in os.walk('..'): + for file in files: + if file == name + '.opam': + return path.lstrip('../') + raise ValueError('opam file ' + name + '.opam does not exist in the odoc') + +def package_role(name, rawtext, text, lineno, inliner, options={}, content=[]): + rel_lvl = inliner.document.current_source.replace(os.getcwd(),'').count('/') + parts = re.match("^([^<>]*)<([^<>]*)>$", text) + if parts: + text = parts.group(2) + lib = parts.group(1) + else: + lib = text + src = find_dot_opam(lib) + branch = os.environ.get('CI_COMMIT_REF_NAME', 'master') + project_url = os.environ.get('CI_PROJECT_URL', 'https://gitlab.com/tezos/tezos') + src_url = project_url + "/tree/" + branch + "/" + src + if os.path.isdir('_build/api/odoc/_html/'+lib): + if os.path.isdir(os.path.join('_build','api','odoc','_html',lib,lib.replace('-','_').capitalize())): + lib = lib + '/' + lib.replace('-','_').capitalize() + url = "api/api-inline.html#" + lib + '/index.html' + for i in range(1,rel_lvl): + url = '../' + url + else: + url = src_url + if name == 'package': + node = nodes.reference(rawtext, text, refuri=url, **options) + elif name == 'package-name': + node = nodes.literal(text, text) + elif name == 'package-src': + node = nodes.reference(rawtext, src, refuri=src_url, **options) + return [node], [] + +def opam_role(name, rawtext, text, lineno, inliner, options={}, content=[]): + rel_lvl = inliner.document.current_source.replace(os.getcwd(),'').count('/') + parts = re.match("^([^<>]*)<([^<>]*)>$", text) + if parts: + text = parts.group(2) + lib = parts.group(1) + else: + lib = text + tagged = re.match('([^.]+)[.].*', lib) + if tagged: + url = "https://opam.ocaml.org/packages/" + tagged.group(1) + "/" + lib + else: + url = "https://opam.ocaml.org/packages/" + lib + node = nodes.reference(rawtext, text, refuri=url, **options) + return [node], [] + +def src_role(name, rawtext, text, lineno, inliner, options={}, content=[]): + rel_lvl = inliner.document.current_source.replace(os.getcwd(),'').count('/') + parts = re.match("^([^<>]*)<([^<>]*)>$", text) + if parts: + text = parts.group(2) + src = parts.group(1) + else: + src = text + text = text + branch = os.environ.get('CI_COMMIT_REF_NAME', 'master') + project_url = os.environ.get('CI_PROJECT_URL', 'https://gitlab.com/tezos/tezos') + url = project_url + "/tree/" + branch + "/" + src + node = nodes.reference(rawtext, text, refuri=url, **options) + return [node], [] diff --git a/vendors/tezos-modded/docs/api/api-inline.rst b/vendors/tezos-modded/docs/api/api-inline.rst new file mode 100644 index 000000000..146aaa732 --- /dev/null +++ b/vendors/tezos-modded/docs/api/api-inline.rst @@ -0,0 +1,19 @@ +************************** +Online OCaml Documentation +************************** + +.. raw:: html + + + + diff --git a/vendors/tezos-modded/docs/api/cli-commands.rst b/vendors/tezos-modded/docs/api/cli-commands.rst new file mode 100644 index 000000000..a98f4f5dd --- /dev/null +++ b/vendors/tezos-modded/docs/api/cli-commands.rst @@ -0,0 +1,66 @@ +********************** +Command Line Interface +********************** + +This document is a prettier output of the documentation produced by +the command line client's ``man`` command. You can obtain similar pages +using the following shell commands. + +:: + + tezos-client -protocol ProtoALphaALph man -verbosity 3 + tezos-admin-client man -verbosity 3 + + +.. _client_manual: + +Client manual +============= + +.. raw:: html + :file: tezos-client.html + + +.. _admin_client_manual: + +Admin-client manual +=================== + +.. raw:: html + :file: tezos-admin-client.html + + +.. _signer_manual: + +Signer manual +============= + +.. raw:: html + :file: tezos-signer.html + + +.. _baker_manual: + +Baker manual +============ + +.. raw:: html + :file: tezos-baker-alpha.html + + +.. _endorser_manual: + +Endorser manual +=============== + +.. raw:: html + :file: tezos-endorser-alpha.html + + +.. _accuser_manual: + +Accuser manual +============== + +.. raw:: html + :file: tezos-accuser-alpha.html diff --git a/vendors/tezos-modded/docs/api/p2p_usage.rst.inc b/vendors/tezos-modded/docs/api/p2p_usage.rst.inc new file mode 100644 index 000000000..8b1378917 --- /dev/null +++ b/vendors/tezos-modded/docs/api/p2p_usage.rst.inc @@ -0,0 +1 @@ + diff --git a/vendors/tezos-modded/docs/conf.py b/vendors/tezos-modded/docs/conf.py new file mode 100644 index 000000000..4b1d43f68 --- /dev/null +++ b/vendors/tezos-modded/docs/conf.py @@ -0,0 +1,181 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- +# +# Tezos documentation build configuration file, created by +# sphinx-quickstart on Wed Jan 17 18:04:32 2018. +# +# This file is execfile()d with the current directory set to its +# containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +# sys.path.insert(0, os.path.abspath('.')) + +import os +import sys +import datetime +from os import environ +sys.path.insert(0, os.path.abspath('.') + '/_extensions') + +# -- General configuration ------------------------------------------------ + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = ['sphinx.ext.extlinks', 'tezos_custom_roles'] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = 'Tezos' +copyright = '2018, Nomadic Labs ' +author = 'Nomadic Labs ' + +# The version info for the project you're documenting, acts as replacement for +# |version| and |release|, also used in various other places throughout the +# built documents. +# +# The short X.Y version. + +version = os.environ.get('CI_COMMIT_REF_NAME', 'local') +# The full version, including alpha/beta/rc tags. +release = '(' + version + ' branch, ' + datetime.datetime.now().strftime(" %Y/%m/%d %H:%M)") +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This patterns also effect to html_static_path and html_extra_path +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store', 'doc_gen'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + +# Deactivate syntax highlighting +# - http://www.sphinx-doc.org/en/stable/markup/code.html#code-examples +# - http://www.sphinx-doc.org/en/stable/config.html#confval-highlight_language +highlight_language = 'none' +# TODO write a Pygments lexer for Michelson +# cf. http://pygments.org/docs/lexerdevelopment/ and http://pygments.org/docs/lexers/ + + +# If true, `todo` and `todoList` produce output, else they produce nothing. +todo_include_todos = False + + +# -- Options for HTML output ---------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = "sphinx_rtd_theme" + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +html_theme_options = {'logo_only': True} +html_logo = "logo.svg" +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# This is required for the alabaster theme +# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars +# html_sidebars = { +# '**': [ +# 'relations.html', # needs 'show_related': True theme option to display +# 'searchbox.html', +# ] +# } + + +# -- Options for HTMLHelp output ------------------------------------------ + +# Output file base name for HTML help builder. +htmlhelp_basename = 'Tezosdoc' + + +# -- Options for LaTeX output --------------------------------------------- + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'Tezos.tex', 'Tezos Documentation', + 'Nomadic Labs \\textless{}contact@nomadic-labs.com\\textgreater{}', 'manual'), +] + + +# -- Options for manual page output --------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'tezos', 'Tezos Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'Tezos', 'Tezos Documentation', + author, 'Tezos', 'One line description of project.', + 'Miscellaneous'), +] + +# -- Ignore fragments in linkcheck + +linkcheck_anchors = False diff --git a/vendors/tezos-modded/docs/doc_gen/dune b/vendors/tezos-modded/docs/doc_gen/dune new file mode 100644 index 000000000..9470d9692 --- /dev/null +++ b/vendors/tezos-modded/docs/doc_gen/dune @@ -0,0 +1,26 @@ +(executables + (names rpc_doc + p2p_doc) + (libraries tezos-base + tezos-stdlib-unix + tezos-shell + tezos-protocol-updater + tezos-embedded-protocol-alpha + re) + (flags (:standard -w -9+27-30-32-40@8 + -safe-string + -open Tezos_base__TzPervasives + -open Tezos_stdlib_unix + -open Tezos_shell + -open Tezos_protocol_updater + -linkall))) + +(alias + (name buildtest) + (deps rpc_doc.exe + p2p_doc.exe)) + +(alias + (name runtest_indent) + (deps (glob_files *.ml{,i})) + (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps}))) diff --git a/vendors/tezos-modded/docs/doc_gen/errors/dune b/vendors/tezos-modded/docs/doc_gen/errors/dune new file mode 100644 index 000000000..e7e0d5fdf --- /dev/null +++ b/vendors/tezos-modded/docs/doc_gen/errors/dune @@ -0,0 +1,16 @@ +(executable + (name error_doc) + (libraries tezos-shell + tezos-client-alpha) + (flags (:standard -w -9+27-30-32-40@8 + -open Tezos_base + -open Tezos_error_monad + -open Tezos_data_encoding + -open Tezos_client_alpha + -safe-string + -linkall))) + +(alias + (name runtest_indent) + (deps (glob_files *.ml{,i})) + (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps}))) diff --git a/vendors/tezos-modded/docs/doc_gen/errors/error_doc.ml b/vendors/tezos-modded/docs/doc_gen/errors/error_doc.ml new file mode 100644 index 000000000..9cf5c8d9e --- /dev/null +++ b/vendors/tezos-modded/docs/doc_gen/errors/error_doc.ml @@ -0,0 +1,263 @@ +(*****************************************************************************) +(* *) +(* 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 + +(* TODO: add section descriptions *) + +let default_section_id = "default" +let default_section_title = "Miscellaneous" + +(* Association list where keys are set of identifier's prefixes that + maps to a section title. The ordering of sections in the rst output + depends on their position in this list. + + e.g. : an error which id is 'utils.Timeout' will be documented + under the `Miscellaneous` section which will be displayed at the + bottom of the document. Unprefixed ids or unreferenced prefixes + will default to `Miscellaneous` *) +let section_titles = + [ [ "proto.alpha" ], "Protocol Alpha"; + [ "distributed_db" ; "node" ; "raw_store" ; "validator" ; "worker" ], "Shell" ; + [ "micheline" ; "michelson" ], "Michelson parsing/macros" ; + [ "rpc_client" ], "Client" ; + [ "cli"; "utils"; default_section_id ], default_section_title ; + ] +let pp_rst_title ~char ppf title = + let sub = String.map (fun _ -> char) title in + fprintf ppf "@[%s@\n@]@[%s@\n@\n@]" title sub + +let pp_rst_h1 = pp_rst_title ~char:'#' +let pp_rst_h2 = pp_rst_title ~char:'*' +(* let pp_rst_h3 = pp_rst_title ~char:'=' + * let pp_rst_h4 = pp_rst_title ~char:'`' *) + +let string_of_err_category = function + | `Branch -> "branch" + | `Temporary -> "temporary" + | `Permanent -> "permanent" + +let make_counter () = + let i = ref 1 in + fun () -> incr i; !i + +let count = make_counter () + +let unique_label () = + let label = sprintf "ref%d" (count ()) in + label + +let pp_print_html_tab_button fmt ?(default=false) ~shortlabel ~content idref = + fprintf fmt "@ " + (if default then " defaultOpen" else "") + (idref ^ shortlabel) idref content + +let pp_print_html_tabs fmt { Error_monad.id ; category ; description ; schema ; _ } = + let idref = unique_label () in + let descr_label = "descr" in + let schema_label = "schema" in + + fprintf fmt "@[.. raw:: html@ @ "; + fprintf fmt "@[
@ "; + + fprintf fmt "%a" (pp_print_html_tab_button ~default:true ~shortlabel:descr_label ~content:"Description") idref; + fprintf fmt "%a" (pp_print_html_tab_button ~default:false ~shortlabel:schema_label ~content:"JSON Schema") idref; + fprintf fmt "@
@ @]"; + + let description_content = + asprintf "

%s

Id : %s
Category : %s

" description id (string_of_err_category category) + in + + open_vbox 2; + + (* Print description *) + begin + fprintf fmt "
@ " + (idref ^ descr_label) idref; + fprintf fmt "%s@ " description_content; + fprintf fmt "
@]"; + end; + + (* Print schema *) + begin + (* Hack: negative offset in order to reduce the 
's content left-margin *)
+    (* TODO: pretty-(html)-print the schema *)
+    open_vbox (-8);
+    fprintf fmt "
@ "
+      (idref ^ schema_label) idref;
+    fprintf fmt "<%s>@ %a@ " "pre" Json_schema.pp schema "pre";
+    fprintf fmt "
";
+    close_box ();
+  end;
+
+  close_box ()
+
+let pp_info_to_rst
+    ppf
+    (Error_monad.{ title ; _ } as error_info) =
+  let open Format in
+
+  fprintf ppf "**%s**@\n@\n" (if title = "" then "" else title);
+  fprintf ppf "@[%a@ @ @]" pp_print_html_tabs error_info;
+
+module ErrorSet = Set.Make(struct
+    type t = Error_monad.error_info
+    let compare { Error_monad.id ; _ } { Error_monad.id = id' ; _ } =
+      String.compare id id'
+  end)
+
+module ErrorPartition = struct
+  include Map.Make(struct
+      include String
+      let titles = List.map snd section_titles
+
+      let compare s s' =
+        let idx s =
+          let rec loop acc = function
+            | [] -> assert false
+            | h::_ when h = s -> acc
+            | _::t -> loop (acc + 1) t
+          in loop 0 titles
+        in
+        Pervasives.compare (idx s) (idx s')
+    end)
+
+  let add_error (id : key) (error : Error_monad.error_info) (map : 'a t) =
+    let title =
+      try
+        snd
+          (List.find
+             (fun (id_set, _) ->
+                List.exists (fun pattern -> Stringext.find_from id ~pattern = Some 0) id_set)
+             section_titles)
+      with
+      | Not_found -> default_section_title
+    in
+    let set =
+      try find title map with Not_found -> ErrorSet.empty
+    in
+    add title (ErrorSet.add error set) map
+end
+
+let pp_error_map ppf (map : ErrorSet.t ErrorPartition.t) : unit =
+  let open Format in
+  ErrorPartition.iter (fun section_title set ->
+      fprintf ppf "%a" pp_rst_h2 section_title ;
+
+      ErrorSet.iter
+        (fun error_repr ->
+           fprintf ppf "@[%a@]@\n@\n" pp_info_to_rst error_repr
+        ) set
+    ) map
+
+let script =
+  ""
+
+let style =
+  ""
+
+let print_script ppf =
+  (* HACK : show/hide JSON schemas + style *)
+  fprintf ppf "@[.. raw:: html@\n@\n" ;
+  fprintf ppf "@[%s%s@]@\n@\n@]@]@." script style
+
+(* Main *)
+let () =
+  let open Format in
+  let ppf = std_formatter in
+
+  (* Header *)
+  let title = "RPC Errors" in
+  fprintf ppf "%a" pp_rst_h1 title ;
+
+  print_script ppf ;
+
+  fprintf ppf
+    "This document references possible errors that can come \
+     from RPC calls. It is generated from the OCaml source \
+     code (master branch).@\n@\n" ;
+
+  (* Body *)
+  let map =
+    let all_errors =
+      Error_monad.get_registered_errors () in
+    List.fold_left
+      (fun acc ( Error_monad.{ id ; _ } as error ) ->
+         ErrorPartition.add_error id error acc
+      ) ErrorPartition.empty all_errors
+  in
+
+  fprintf ppf "%a" pp_error_map map
diff --git a/vendors/tezos-modded/docs/doc_gen/node_helpers.ml b/vendors/tezos-modded/docs/doc_gen/node_helpers.ml
new file mode 100644
index 000000000..213a58d50
--- /dev/null
+++ b/vendors/tezos-modded/docs/doc_gen/node_helpers.ml
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 genesis : State.Chain.genesis = {
+  time =
+    Time.of_notation_exn "2018-04-17T11:46:23Z" ;
+  block =
+    Block_hash.of_b58check_exn
+      "BLockGenesisGenesisGenesisGenesisGenesisa52f8bUWPcg" ;
+  protocol =
+    Protocol_hash.of_b58check_exn
+      "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im" ;
+}
+
+let with_node f =
+  let run dir =
+    let (/) = Filename.concat in
+    let node_config : Node.config = {
+      genesis ;
+      patch_context = None ;
+      store_root = dir / "store" ;
+      context_root = dir / "context" ;
+      p2p = None ;
+      test_chain_max_tll = None ;
+      checkpoint = None ;
+    } in
+    Node.create
+      node_config
+      Node.default_peer_validator_limits
+      Node.default_block_validator_limits
+      Node.default_prevalidator_limits
+      Node.default_chain_validator_limits >>=? fun node ->
+    f node >>=? fun () ->
+    return () in
+  Lwt_utils_unix.with_tempdir "tezos_rpcdoc_" run >>= function
+  | Ok () ->
+      Lwt.return_unit
+  | Error err ->
+      Format.eprintf "%a@." pp_print_error err ;
+      Pervasives.exit 1
diff --git a/vendors/tezos-modded/docs/doc_gen/p2p_doc.ml b/vendors/tezos-modded/docs/doc_gen/p2p_doc.ml
new file mode 100644
index 000000000..8925b2e71
--- /dev/null
+++ b/vendors/tezos-modded/docs/doc_gen/p2p_doc.ml
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 protocols = [
+  "Alpha", "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" ;
+]
+
+let main _node =
+  (* Style : hack *)
+  Format.printf "%a@." Rst.pp_raw_html Rst.style ;
+  (* Script : hack *)
+  Format.printf "%a@." Rst.pp_raw_html Rst.script ;
+  (* Page title *)
+  Format.printf "%a" Rst.pp_h1 "P2P message format" ;
+  (* include/copy usage.rst from input  *)
+  let rec loop () =
+    let s = read_line () in
+    Format.printf "%s@\n" s ;
+    loop () in
+  begin try loop () with End_of_file -> () end ;
+  Format.printf "@\n" ;
+  (* Data *)
+  Format.printf "%a@\n@\n%a@\n@."
+    Rst.pp_h2 "Block header (shell)"
+    Data_encoding.Binary_schema.pp
+    (Data_encoding.Binary.describe Block_header.encoding) ;
+  Format.printf "%a@\n@\n%a@\n@."
+    Rst.pp_h2 "Operation (shell)"
+    Data_encoding.Binary_schema.pp
+    (Data_encoding.Binary.describe Operation.encoding) ;
+  List.iter
+    (fun (_name, hash) ->
+       let hash = Protocol_hash.of_b58check_exn hash in
+       let (module Proto) = Registered_protocol.get_exn hash in
+       Format.printf "%a@\n@\n%a@\n@."
+         Rst.pp_h2 "Block_header (alpha-specific)"
+         Data_encoding.Binary_schema.pp
+         (Data_encoding.Binary.describe Proto.block_header_data_encoding) ;
+       Format.printf "%a@\n@\n%a@\n@."
+         Rst.pp_h2 "Operation (alpha-specific)"
+         Data_encoding.Binary_schema.pp
+         (Data_encoding.Binary.describe Proto.operation_data_encoding) ;
+    )
+    protocols ;
+  return ()
+
+let () =
+  Lwt_main.run (Node_helpers.with_node main)
diff --git a/vendors/tezos-modded/docs/doc_gen/rpc_doc.ml b/vendors/tezos-modded/docs/doc_gen/rpc_doc.ml
new file mode 100644
index 000000000..81e6b8b2d
--- /dev/null
+++ b/vendors/tezos-modded/docs/doc_gen/rpc_doc.ml
@@ -0,0 +1,314 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 protocols = [
+  "Alpha", "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK" ;
+]
+
+let pp_name ppf = function
+  | [] | [""] -> Format.pp_print_string ppf "/"
+  | prefix -> Format.pp_print_string ppf (String.concat "/" prefix)
+
+let ref_of_service (prefix, meth) =
+  Format.asprintf "%s_%s"
+    (Resto.string_of_meth meth)
+    (Re.Str.global_replace
+       (Re.Str.regexp "<\\([^>]*\\)>")
+       "\\1"
+       (String.concat "--" prefix))
+
+module Index = struct
+
+  let rec pp prefix ppf dir =
+    let open Resto.Description in
+    match dir with
+    | Empty -> Format.fprintf ppf "Empty"
+    | Static { services ; subdirs = None } ->
+        pp_services prefix ppf services
+    | Static { services ; subdirs = Some (Suffixes map) } ->
+        Format.fprintf ppf "@[%a@ @ %a@]"
+          (pp_services prefix) services
+          (Format.pp_print_list
+             ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ @ ")
+             (pp_suffixes prefix))
+          (Resto.StringMap.bindings map)
+    | Static { services ; subdirs = Some (Arg (arg, dir)) } ->
+        let name = Format.asprintf "<%s>" arg.name in
+        Format.fprintf ppf "@[%a@ @ %a@]"
+          (pp_services prefix) services
+          (pp_suffixes prefix) (name, dir)
+    | Dynamic _ ->
+        Format.fprintf ppf "* %a ()" pp_name prefix
+
+  and pp_suffixes prefix ppf (name, dir) =
+    pp (prefix @ [name]) ppf dir
+
+  and pp_services prefix ppf services =
+    match (Resto.MethMap.bindings services) with
+    | [] ->
+        Format.fprintf ppf "* %a" pp_name prefix
+    | _ :: _ as services ->
+        Format.fprintf ppf "* %a (@[%a@])"
+          pp_name prefix
+          (Format.pp_print_list
+             ~pp_sep:Format.pp_print_space
+             (pp_service_method prefix)) services
+
+  and pp_service_method prefix ppf (meth, _service) =
+    Format.fprintf ppf "`%s <%s_>`_"
+      (Resto.string_of_meth meth)
+      (ref_of_service (prefix, meth))
+
+end
+
+module Description = struct
+
+  module Query = struct
+
+    let pp_arg fmt =
+      let open RPC_arg in
+      function { name ; _ } ->
+        Format.fprintf fmt "<%s>" name
+
+    let pp_title_item ppf =
+      let open RPC_description in
+      function {name ; kind ; _ } ->
+      match kind with
+      | Single arg | Optional arg ->
+          Format.fprintf ppf "[%s=%a]" name pp_arg arg
+      | Flag ->
+          Format.fprintf ppf "[%s]" name
+      | Multi arg ->
+          Format.fprintf ppf "(%s=%a)\\*" name pp_arg arg
+
+    let pp_title ppf query =
+      Format.fprintf ppf "%s%a"
+        (if query = [] then "" else "?")
+        (Format.pp_print_list
+           ~pp_sep:(fun ppf () -> Format.fprintf ppf "&")
+           pp_title_item) query
+
+    let pp_html_arg fmt =
+      let open RPC_arg in
+      function { name ; _ } ->
+        Format.fprintf fmt "<%s>" name
+
+    let pp_item ppf =
+      let open RPC_description in
+      function { name ; description ; kind } ->
+        begin match kind with
+          | Single arg
+          | Optional arg
+          | Multi arg ->
+              Format.fprintf ppf
+                "%s = %a"
+                name pp_html_arg arg
+          | Flag ->
+              Format.fprintf ppf
+                "%s"
+                name
+        end ;
+        begin match description with
+          | None -> ()
+          | Some descr -> Format.fprintf ppf " : %s" descr
+        end
+
+    let pp ppf query =
+      match query with
+      | [] -> ()
+      | _ :: _ as query ->
+          Format.fprintf ppf
+            "
 
Optional query arguments :
  • %a
"
+            (Format.pp_print_list
+               ~pp_sep:(fun ppf () -> Format.fprintf ppf "
  • ")
+               pp_item)
+            query
+
+  end
+
+  module Tabs = struct
+
+    let pp_tab_div ppf f =
+      Format.fprintf ppf
+        "@[
    %a
    @]"
+        (fun ppf () -> f ppf) ()
+
+    let pp_tabcontent_div ~id ~class_ ppf f =
+      Format.fprintf ppf
+        "@[
    @ \
+         %a@ \
+         @]
    @ "
+        id class_ (fun ppf () -> f ppf) ()
+
+    let pp_button ppf ?(default=false) ~shortlabel ~content target_ref =
+      Format.fprintf ppf
+        "@ "
+        (if default then " defaultOpen" else "")
+        (target_ref ^ shortlabel)
+        target_ref
+        content
+
+    let pp_content ppf ~tag ~shortlabel target_ref pp_content content =
+      pp_tabcontent_div
+        ~id:(target_ref ^ shortlabel) ~class_:target_ref ppf
+        begin fun ppf ->
+          Format.fprintf ppf "<%s>@ %a" tag pp_content content tag
+        end
+
+    let pp_description ppf (service : _ RPC_description.service) =
+      let open RPC_description in
+      (* TODO collect and display arg description (in path and in query) *)
+      Format.fprintf ppf "@[%a@]%a"
+        Format.pp_print_text (Option.unopt ~default:"" service.description)
+        Query.pp service.query
+
+    let pp ppf prefix service =
+      let open RPC_description in
+      let target_ref = ref_of_service (prefix, service.meth) in
+      Rst.pp_html ppf begin fun ppf ->
+        pp_tab_div ppf begin fun ppf ->
+          pp_button ppf
+            ~default:true ~shortlabel:"descr" ~content:"Description"
+            target_ref ;
+          Option.iter service.input ~f: begin fun _ ->
+            pp_button ppf
+              ~default:false ~shortlabel:"input.json" ~content:"Json input"
+              target_ref ;
+            pp_button ppf
+              ~default:false ~shortlabel:"input.bin" ~content:"Binary input"
+              target_ref
+          end ;
+          pp_button ppf
+            ~default:false ~shortlabel:"output.json" ~content:"Json output"
+            target_ref ;
+          pp_button ppf
+            ~default:false ~shortlabel:"output.bin" ~content:"Binary output"
+            target_ref ;
+        end ;
+        pp_content ppf
+          ~tag:"p" ~shortlabel:"descr" target_ref
+          pp_description service ;
+        Option.iter service.input ~f: begin fun (schema, bin_schema) ->
+          pp_content ppf
+            ~tag:"pre" ~shortlabel:"input.json" target_ref
+            Json_schema.pp schema ;
+          pp_content ppf
+            ~tag:"pre" ~shortlabel:"input.bin" target_ref
+            Data_encoding.Binary_schema.pp bin_schema ;
+        end ;
+        pp_content ppf
+          ~tag:"pre" ~shortlabel:"output.json" target_ref
+          Json_schema.pp (fst service.output) ;
+        pp_content ppf
+          ~tag:"pre" ~shortlabel:"output.bin" target_ref
+          Data_encoding.Binary_schema.pp (snd service.output) ;
+      end
+
+  end
+
+  let rec pp prefix ppf dir =
+    let open Resto.Description in
+    match dir with
+    | Empty -> ()
+    | Static { services ; subdirs = None } ->
+        pp_services prefix ppf services
+    | Static { services ; subdirs = Some (Suffixes map) } ->
+        pp_services prefix ppf services ;
+        Format.pp_print_list (pp_suffixes prefix)
+          ppf (Resto.StringMap.bindings map)
+    | Static { services ; subdirs = Some (Arg (arg, dir)) } ->
+        let name = Format.asprintf "<%s>" arg.name in
+        pp_services prefix ppf services ;
+        pp_suffixes prefix ppf (name, dir)
+    | Dynamic _ -> ()
+
+  and pp_suffixes prefix ppf (name, dir) =
+    pp (prefix @ [name]) ppf dir
+
+  and pp_services prefix ppf services =
+    List.iter
+      (pp_service prefix ppf)
+      (Resto.MethMap.bindings services)
+
+  and pp_service prefix ppf (meth, service) =
+    Rst.pp_ref ppf (ref_of_service (prefix, meth)) ;
+    Format.fprintf ppf "**%s %a%a**@\n@\n"
+      (Resto.string_of_meth meth)
+      pp_name prefix
+      Query.pp_title service.query ;
+    Tabs.pp ppf prefix service
+
+end
+
+let pp_document ppf descriptions =
+  (* Style : hack *)
+  Format.fprintf ppf "%a@." Rst.pp_raw_html Rst.style ;
+  (* Script : hack *)
+  Format.fprintf ppf "%a@." Rst.pp_raw_html Rst.script ;
+  (* Index *)
+  Format.pp_set_margin ppf 10000 ;
+  Format.pp_set_max_indent ppf 9000 ;
+  Format.fprintf ppf "%a" Rst.pp_ref "rpc_index" ;
+  Rst.pp_h2 ppf "RPCs - Index" ;
+  List.iter
+    (fun (name, prefix, rpc_dir) ->
+       Rst.pp_h3 ppf name ;
+       Format.fprintf ppf "%a@\n@\n" (Index.pp prefix) rpc_dir)
+    descriptions ;
+  (* Full description *)
+  Rst.pp_h2 ppf "RPCs - Full description" ;
+  Format.pp_print_flush ppf () ;
+  Format.pp_set_margin ppf 80 ;
+  Format.pp_set_max_indent ppf 76 ;
+  List.iter
+    (fun (name, prefix, rpc_dir) ->
+       Rst.pp_h3 ppf name ;
+       Format.fprintf ppf "%a@\n@\n" (Description.pp prefix) rpc_dir)
+    descriptions
+
+let main node =
+  let shell_dir = Node.build_rpc_directory node in
+  let protocol_dirs =
+    List.map
+      (fun (name, hash) ->
+         let hash = Protocol_hash.of_b58check_exn hash in
+         let (module Proto) = Registered_protocol.get_exn hash in
+         "Protocol " ^ name,
+         [".." ; ""] ,
+         RPC_directory.map (fun () -> assert false) @@
+         Block_directory.build_raw_rpc_directory (module Proto) (module Proto))
+      protocols in
+  let dirs = ("Shell", [""], shell_dir) :: protocol_dirs in
+  Lwt_list.map_p
+    (fun (name, path, dir) ->
+       RPC_directory.describe_directory ~recurse:true ~arg:() dir >>= fun dir ->
+       Lwt.return (name, path, dir))
+    dirs >>= fun descriptions ->
+  let ppf = Format.std_formatter in
+  pp_document ppf descriptions ;
+  return ()
+
+let () =
+  Lwt_main.run (Node_helpers.with_node main)
diff --git a/vendors/tezos-modded/docs/doc_gen/rst.ml b/vendors/tezos-modded/docs/doc_gen/rst.ml
new file mode 100644
index 000000000..232a5397a
--- /dev/null
+++ b/vendors/tezos-modded/docs/doc_gen/rst.ml
@@ -0,0 +1,120 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 pp_title ~char ppf title =
+  let sub = String.map (fun _ -> char) title in
+  Format.fprintf ppf "@[%s@ %s@ @ @]" title sub
+
+let pp_h1 = pp_title ~char:'#'
+let pp_h2 = pp_title ~char:'*'
+let pp_h3 = pp_title ~char:'='
+let pp_h4 = pp_title ~char:'`'
+
+let pp_raw_html ppf str =
+  Format.fprintf ppf "@[.. raw:: html@   @   %s@ @ @]"
+    (Re.Str.global_replace (Re.Str.regexp "\n") "\n  " str)
+
+let pp_html ppf f =
+  Format.fprintf ppf
+    "@[.. raw:: html@ @ %a@]@\n@\n"
+    (fun ppf () -> f ppf) ()
+
+let pp_ref ppf name = Format.fprintf ppf ".. _%s :@\n@\n" name
+
+
+
+let style = {css|
+
+|css}
+
+let script = {script|
+
+|script}
diff --git a/vendors/tezos-modded/docs/index.rst b/vendors/tezos-modded/docs/index.rst
new file mode 100644
index 000000000..595fd5670
--- /dev/null
+++ b/vendors/tezos-modded/docs/index.rst
@@ -0,0 +1,160 @@
+.. Tezos documentation master file, created by
+   sphinx-quickstart on Sat Nov 11 11:08:48 2017.
+   You can adapt this file completely to your liking, but it should at least
+   contain the root `toctree` directive.
+
+
+Welcome to the Tezos Developer Documentation!
+=============================================
+
+The Project
+-----------
+
+Tezos is a distributed consensus platform with meta-consensus
+capability. Tezos not only comes to consensus about the state of its ledger,
+like Bitcoin or Ethereum. It also attempts to come to consensus about how the
+protocol and the nodes should adapt and upgrade.
+
+ - Developer documentation is available online at
+   https://tezos.gitlab.io/master . The documentation is automatically
+   generated for the master branch, the main network `mainnet
+   `_ and the test network `alphanet
+   `_.
+   Make sure you are consulting the right version.
+ - The website https://tezos.com/ contains more information about the project.
+ - All development happens on GitLab at https://gitlab.com/tezos/tezos
+
+The source code of Tezos is placed under the MIT Open Source License.
+
+The Community
+-------------
+
+- The website of the `Tezos Foundation `_.
+- `Tezos sub-reddit `_ is an
+  important meeting point of the community.
+- Several community-built block explorers are available:
+
+    - https://tzscan.io
+    - https://tezex.info
+
+- A few community-run websites collect useful Tezos links:
+
+    - https://www.tezos.help
+    - https://tezos.rocks
+
+- More resources can be found in the :ref:`support` page.
+
+The Networks
+------------
+
+.. _mainnet:
+
+Mainnet
+~~~~~~~
+
+The Tezos network is the current incarnation of the Tezos blockchain.
+It runs with real tez that have been allocated to the
+donors of July 2017 ICO (see :ref:`activate_fundraiser_account`).
+
+The Tezos network has been live and open since June 30th 2018.
+
+All the instructions in this documentation are valid for Mainnet
+however we **strongly** encourage users to first try all the
+introduction tutorials on Alphanet to familiarize themselves without
+risks.
+
+.. _alphanet:
+
+Alphanet
+~~~~~~~~
+
+Tezos Alphanet is a test network for the Tezos blockchain with a
+faucet to obtain free tez (see :ref:`faucet`).
+It is updated and rebooted rarely and it is running the same code as
+the Mainnet.
+It is the reference network for developers wanting to test their
+software before going to beta and for users who want to familiarize
+themselves with Tezos before using their real tez.
+
+We offer support for Alphanet on IRC.
+
+The Tezos Alpha (test) network has been live and open since February 2017.
+
+
+.. _zeronet:
+
+Zeronet
+~~~~~~~
+
+Zeronet is the most cutting-edge development network of Tezos. It is
+restarted without notice, possibly several times a day.
+This network is mostly used internally by the Tezos developers and may
+have *different constants* from Alphanet or Mainnet, for example it
+has shorter cycles and a shorter interval between blocks.
+We offer no support for the Zeronet.
+
+
+Getting started
+---------------
+
+The best place to start exploring the project is following the How Tos
+in the :ref:`introduction `.
+
+
+.. toctree::
+   :maxdepth: 2
+   :caption: Introduction:
+
+   introduction/howtoget
+   introduction/howtouse
+   introduction/howtorun
+   introduction/various
+   introduction/support
+   introduction/contributing
+
+.. toctree::
+   :maxdepth: 2
+   :caption: White doc:
+
+   whitedoc/the_big_picture
+   whitedoc/p2p
+   whitedoc/validation
+   whitedoc/michelson
+   whitedoc/proof_of_stake
+   whitedoc/voting
+
+.. toctree::
+   :maxdepth: 2
+   :caption: Protocols:
+
+   protocols/003_PsddFKi3
+
+.. toctree::
+   :maxdepth: 2
+   :caption: Developer Tutorials:
+
+   tutorials/rpc
+   tutorials/data_encoding
+   tutorials/error_monad
+   tutorials/michelson_anti_patterns
+   tutorials/entering_alpha
+   tutorials/protocol_environment
+   tutorials/profiling
+
+.. toctree::
+   :maxdepth: 2
+   :caption: APIs:
+
+   README
+   api/api-inline
+   api/cli-commands
+   api/rpc
+   api/errors
+   api/p2p
+
+Indices and tables
+==================
+
+* :ref:`genindex`
+* :ref:`modindex`
+* :ref:`search`
diff --git a/vendors/tezos-modded/docs/introduction/contributing.rst b/vendors/tezos-modded/docs/introduction/contributing.rst
new file mode 100644
index 000000000..483dfd36b
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/contributing.rst
@@ -0,0 +1,100 @@
+How to contribute
+=================
+
+Introduction
+------------
+
+The purpose of this document is to help contributors get started with
+the Tezos OCaml codebase.
+
+
+Reporting issues
+----------------
+
+The simplest way to contribute to Tezos is to report issues that you may
+find with the software on `gitlab `__.
+If you are unsure about an issue ask on IRC first and always make sure
+to search the existing issues before reporting a new one.
+Some info that are probably important to include in the description:
+the architecture (e.g. *ARM64*), the operating system (e.g. *Debian
+Stretch*), the network you are connected to (e.g. *Alphanet*), the
+binary or component (e.g. *tezos-node crashes* or *rpc X returns Y
+while Z was expected*).
+
+
+First steps
+-----------
+
+First, make sure that you are proficient enough in OCaml. The community
+Website http://www.ocaml.org below gives a few pointer for that. In
+particular, we use a lot of functors, and a few GADTs in the codebase,
+so you may want to make sure that you master these advanced concepts.
+
+Then, if you don’t know well about the Lwt library, that’s what you want
+to learn. This library is used extensively throughout the code base, as
+that’s the one we use to handle concurrency, and Tezos is a very
+concurrent system. You can use the `online documentation `__. The chapter on concurrency of `Real World
+OCaml `__ has also been ported to Lwt.
+
+After that, it is a good idea to read the tutorials for
+:ref:`error_monad` and
+:ref:`data_encoding `, two homegrown
+libraries that we use pervasively.
+
+Where to start
+--------------
+
+While you familiarize yourself with the basics as suggested above, you
+can have a look at the :ref:`software architecture
+` of Tezos. It will
+give you the main components and their interactions, and links to the
+documentations for the various parts.
+
+Our git workflow
+----------------
+
+First, the repository is https://gitlab.com/tezos/tezos, the github one
+is just a clone that exists for historical reasons. So if you want to
+contribute, simply create an account there.
+
+Then, there are many ways to use Git, here is ours.
+
+We use almost only merge requests to push into master. Meaning, nobody
+should push directly into master. Once a merge request is ready, it is
+reviewed and approved, we merge it using the ``--fast-forward`` option
+of Git, in order to maintain a linear history without merge patches.
+
+For that to work, it means that merge requests must be direct suffixes
+of the master branch. So whenever ``origin/master`` changes, you have to
+rebase your branch on it, so that you patches always sit on top of
+master. When that happens, you may have to edit your patches during the
+rebase, and then use ``push -f`` in your branch to rewrite the history.
+
+We also enforce a few hygiene rules, so make sure your MR respects them:
+
+-  Prefer small atomic commits over a large one that do many things.
+-  Don’t mix refactoring and new features.
+-  Never mix reindentation, whitespace deletion, or other style changes
+   with actual code changes.
+-  Try as much as possible to make every patch compile, not only the
+   last.
+-  If you add new functions into a documented interface, don’t forget to
+   extend the documentation for your addition.
+-  For parts whose specification is in the repository (e.g. Michelson),
+   make sure to keep it in sync with the implementation.
+-  Try and mimic the style of commit messages, and for non trivial
+   commits, add an extended commit message.
+
+As per the hygiene of MRs themselves:
+
+-  Give appropriate titles to the MRs, and when non trivial add a
+   detailed motivated explanation.
+-  Give meaningful and consistent names to branches.
+-  Don’t forget to put a ``WIP:`` flag when it is a work in progress
+
+Some extra CI tests are only done on demand for branches other that
+master. You can (should) activate these tests by including keywords in
+the branch name.
+
+-  If your MR impacts OPAM packaging, use ``opam`` in the branch name.
+-  If your MR updates documentation, use ``doc`` in the branch name.
diff --git a/vendors/tezos-modded/docs/introduction/howtoget.rst b/vendors/tezos-modded/docs/introduction/howtoget.rst
new file mode 100644
index 000000000..2200af25c
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/howtoget.rst
@@ -0,0 +1,184 @@
+.. _howtoget:
+
+How to get Tezos
+================
+
+In this How To we explain how to get up-to-date binaries to run Tezos
+for each network.
+You can either use the docker images, which is easier, or build from
+sources.
+
+
+Docker images
+-------------
+
+The recommended way for running an up-to-date Tezos node is to use the
+docker images that are automatically generated from the GitLab
+repository and published on `DockerHub
+`_.
+The script ``alphanet.sh`` is provided to help download the right
+image for each network and run a simple node.
+Its only requirement is a working installation of `Docker
+`__ and docker compose on a machine with
+architecture **x86_64**.
+Although we only officially support Linux, the script has been tested
+with success in the past on windows/mac/linux.
+
+The same script can be used to run Mainnet, Alphanet or Zeronet, it
+suffices to rename it as it downloads a different image based on its
+name.
+For example, to run Alphanet:
+
+::
+
+    wget https://gitlab.com/tezos/tezos/raw/master/scripts/alphanet.sh
+    chmod +x alphanet.sh
+
+Alternatively, to run Mainnet:
+
+::
+
+    wget -O mainnet.sh https://gitlab.com/tezos/tezos/raw/master/scripts/alphanet.sh
+    chmod +x mainnet.sh
+
+In the following we assume you are running Alphanet.
+You are now one step away from a working node:
+
+::
+
+    ./alphanet.sh start
+
+This will download the right docker image for your chosen network,
+launch 3 docker containers running the node, the baker and the
+endorser.
+The first launch might take a few minutes to download the
+docker images and synchronize the chain.
+
+Every call to ``alphanet.sh`` will check for updates of the node and
+will fail if your node is not up-to-date. For updating the node, simply
+run:
+
+::
+
+    ./alphanet.sh restart
+
+If you prefer to temporarily disable automatic updates, you just have to
+set an environment variable:
+
+::
+
+    export TEZOS_ALPHANET_DO_NOT_PULL=yes
+
+See ``./alphanet.sh --help`` for more informations about the
+script. In particular see ``./alphanet.sh client --help`` or the
+:ref:`online manual` for more information about
+the client. Every command to the ``tezos-client`` can be
+equivalently executed using ``./alphanet.sh client``.
+
+
+Build from sources
+------------------
+
+**TL;DR**: Typically you want to do:
+
+::
+
+   sudo apt install -y rsync git m4 build-essential patch unzip bubblewrap wget
+   wget https://github.com/ocaml/opam/releases/download/2.0.1/opam-2.0.1-x86_64-linux
+   sudo cp opam-2.0.1-x86_64-linux /usr/local/bin/opam
+   sudo chmod a+x /usr/local/bin/opam
+   git clone https://gitlab.com/tezos/tezos.git
+   cd tezos
+   git checkout alphanet
+   opam init --bare
+   make build-deps
+   eval $(opam env)
+   make
+   export PATH=~/tezos:$PATH
+   source ./src/bin_client/bash-completion.sh
+   export TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER=Y
+
+
+Environment
+~~~~~~~~~~~
+
+Currently Tezos is being developed for Linux x86_64, mostly for
+Debian/Ubuntu and Archlinux.
+
+The following OSes are reported to work:
+
+- macOS/x86_64
+- Linux/armv7h (32 bits) (Raspberry Pi3, etc.)
+- Linux/aarch64 (64 bits) (Raspberry Pi3, etc.)
+
+A Windows port is feasible and might be developed in the future.
+
+If ``bubblewrap`` is not available in your distribution you can also
+skip it and init opam with ``--disable-sandbox``.
+
+Get the sources
+~~~~~~~~~~~~~~~
+
+Tezos *git* repository is hosted at `GitLab
+`_. All development happens here. Do
+**not** use our `GitHub mirror `_
+which we don't use anymore and only mirrors what happens on GitLab.
+
+You also need to **choose the branch** of the network you want to connect
+to: *alphanet*, *zeronet* or *mainnet*.
+
+The *master* branch is where code is merged, but there is no test
+network using the master branch directly.
+
+
+Install OPAM
+~~~~~~~~~~~~
+
+To compile Tezos, you need the `OPAM `__
+package manager, version *2.0*. The build script will take
+care of setting-up OPAM, download the right version of the OCaml
+compiler, and so on.
+
+Use ``opam init --bare`` to avoid compiling the OCaml compiler now: it
+will be done in the next step.
+
+
+Install Tezos dependencies with OPAM
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Install the OCaml compiler and the libraries which Tezos depends on:
+
+::
+
+   make build-deps
+
+Alternatively, if you want to be able to install extra packages
+(development packages such as `merlin`), you may use the following
+command instead:
+
+::
+
+   make build-dev-deps
+
+This command creates a local opam switch ``_opam`` where the right
+version of OCaml is compiled and installed (this takes a while but
+it's only done once).
+
+After OCaml it will start with Tezos dependencies, OPAM is able to
+handle correctly the OCaml libraries but it is not always able to
+handle all external C libraries we depend on. On most system, it is
+able to suggest a call to the system package manager but it currently
+does not handle version check.
+
+Once the dependencies are done we can update opam's environment to
+refer to the new switch and compile the project:
+
+::
+
+   eval $(opam env)
+   make
+
+Lastly you can also add Tezos binaries to your ``PATH`` variable,
+activate bash autocompletion and after reading the Disclaimer a few
+hundred times you are allowed to disable it with
+``TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER=Y``.
diff --git a/vendors/tezos-modded/docs/introduction/howtorun.rst b/vendors/tezos-modded/docs/introduction/howtorun.rst
new file mode 100644
index 000000000..7322826c4
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/howtorun.rst
@@ -0,0 +1,302 @@
+.. _howtorun:
+
+How to run Tezos
+================
+
+In this section we discuss how to take part in the protocol that runs
+the network.
+There are two main ways to participate in the consensus, delegating
+your coins and running a delegate.
+To learn more about the protocol refer to :ref:`this section `.
+
+
+Delegating your coins
+---------------------
+
+If you don't want to deal with the complexity of running your own
+delegate, you can always take part in the protocol by delegating your
+coins to one.
+
+Implicit accounts cannot have a delegate, so the first step is to
+originate an account, transfer your tez there and set a delegate.
+Notice that an originated account is a special case of a contract
+without code, so it is still necessary to pay for its small storage
+(see `originated_account`).
+
+::
+
+   tezos-client originate account alice_del for alice \
+                                  transferring 1000 from alice \
+                                  --delegate bob
+
+As done before, we originate a contract *alice_del* with manager
+*alice* and we fund it with 1kꜩ.
+The interesting part is setting the delegate to *bob*, when
+originating a contract the delegate is not set by default.
+If you already own contracts that are delegatable you can change
+the delegate with the command ``set delegate``.
+
+
+Notice that, by default, an originated account is not *delegatable*,
+which means that you can't change the delegate once the contract is
+originated, even if you initially set a delegate.
+To be able to change the delegate latter, add the
+``--delegatable`` flag.
+
+Notice that only implicit accounts can be delegates, so your delegate
+must be a *tz1* address.
+
+Funds in implicit accounts which are not registered as delegates
+do not participate in baking.
+
+
+Running a delegate
+------------------
+
+A delegate is responsible for baking blocks, endorsing blocks and
+accusing other delegates in case they try to double bake or double
+endorse.
+
+In the network, rights for baking and endorsing are randomly assigned
+to delegates proportionally to the number of rolls they have been
+delegated.
+A roll is just a block of 10kꜩ and all computations with rolls are
+rounded to the nearest lower integer e.g. if you have 16kꜩ it amounts
+to 1 roll.
+
+When you obtain coins from :ref:`the faucet`, if you
+are lucky to obtain more than one roll, you can register a delegate
+using this identity.
+Otherwise, you need to ask the faucet for more accounts, originate an
+account for each one and delegate them to the first.
+
+Deposits and over-delegation
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+When baking or endorsing a block, a *security deposit* (or *bond*) is
+frozen for ``preserved_cycles`` cycles from the account of the
+delegate.
+Hence a delegate must have enough funds to be able to pay security
+deposits for all the blocks it can potentially bake/endorse during
+``preserved_cycles``.
+The current deposits are *512ꜩ* for baked block and *64ꜩ* for
+endorsement.
+Note that being delegated coins doesn't mean that a delegate can spend
+them, they only add up to its rolls count while all the deposits must
+come from the delegate's account.
+
+If a delegate runs out of funds to deposit it won't be able to bake or
+endorse, other than being a missed opportunity for them this has also
+negative consequences on the network.
+Missing baking slots slows the network, as it is necessary to wait one
+minute for the baker at priority 2 to bake, while missing endorsements
+reduce the fitness of the chain, making it more susceptible to forks.
+Running out of funds can happen if a delegate is *over-delegated*,
+that is if the amount of rolls it was delegate is disproportionate
+with respect to its available funds.
+It is the responsibility of every delegator to make sure a delegate is
+not already over-delegated (a delegate cannot refuse a delegation) and
+each delegate should plan carefully its deposits.
+
+.. _expected_rights:
+
+Expected rights, deposits and rewards
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Let's assume we have 1 roll, we want to estimate our chances to bake
+or endorse in order to prepare the funds for our deposits.
+Our chances depend on how many rolls are currently active in the
+network, once we know that we can estimate how many blocks and
+endorsements we could be assigned in a cycle.
+The number of active rolls can be computed with two RPCs, first we
+list all the active delegates with ``delegates?active``, then we sum
+all their ``stacking_balance`` and we simply divide by the size of a
+roll, 10kꜩ.
+At the time of writing, on Betanet the number of active rolls is ~30k
+so for each block we know that the chance that we get selected for
+baking is ``1/30k`` while for endorsing is 32 times that.
+Given that every draw is with replacement, the distribution that
+describes our chances of being selected is the binomial with
+probability of success ``p=1/30k``.
+The distribution has another parameter ``n`` for the number of times
+we draw, in our case in a cycle the draws for baking are ``n_b =
+4096`` while for endorsing are ``n_e = 4096 * 32``.
+Moreover we could extend ``n`` to cover ``preserved_cycles = 5``.
+Once we have ``p`` and ``n``, the expected number of times that we
+might get selected is ``p * n`` (the mean of the distribution).
+Over many cycles our chances will fall around the mean, in some cycles
+we might get unlucky and be assigned fewer rights, but in some cycles we might
+get lucky and be assigned more rights!
+Clearly we would like to plan ahead and have enough deposits to cover
+also the "lucky" cycles so we need to compute a sort of "maximum"
+number of rights that is safe for `most cases`.
+We can compute this maximum using the inverse of Cumulative
+Distribution Function of the Binomial where `most cases` is a value of
+confidence that we can put to 95%.
+There a simple `Python
+script `_
+that does the computation for us and returns the deposits and rewards,
+expected and maximum, for a cycle and for `preserved_cycles`.
+
+::
+
+   prob success 3.333333e-05
+   confidence   0.95
+   ----------one-cycle--------------------
+   blocks
+    mean 0.14
+    max  1.00
+   endorsements
+    mean 4.37
+    max  8.00
+   deposits
+    mean 69.91 + 279.62
+    max  512.00 + 512.00
+   rewards
+    mean 2.18 + 8.74
+    max  16.00 + 16.00
+   ----------preserved-cycles-------------
+   blocks
+    mean 0.68
+    max  2.00
+   endorsements
+    mean 21.85
+    max  30.00
+   deposits
+    mean 349.53 + 1398.10
+    max  1024.00 + 1920.00
+   rewards
+    mean 10.92 + 43.69
+    max  32.00 + 60.00
+
+As a rule of thumb if we want to have a very high confidence that we
+won't miss any opportunity we should have around ~3kꜩ for deposits,
+on the other hand the expected returns will probably be around ~10ꜩ per cycle.
+
+After ``preserved_cycles``, not only the delegate takes back control of
+its frozen deposits but it also receives the rewards for its hard work
+which amount to 16ꜩ to bake a block and ``ꜩ2 / `` for
+endorsing a block.
+Additionally a baker also receives the fees of the operations it
+included in its blocks.
+While fees are unfrozen after ``preserved_cycles`` like deposits and
+rewards, they participate in the staking balance of the delegate
+immediately after the block has been baked.
+
+
+Register and check your rights
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In order to run a delegate you first need to register as one using
+your implicit account:
+
+::
+
+   tezos-client register key bob as delegate
+
+Once registered, you need to wait ``preserved_cycles + 2 = 7`` cycles
+for your rights to be considered.
+
+There is a simple rpc that can be used to check your rights for every
+cycle, up to 5 cycles in the future.
+
+::
+
+   tezos-client rpc get /chains/main/blocks/head/helpers/baking_rights\?cycle=300\&delegate=tz1_xxxxxxxxxxx\&max_priority=2
+
+Sometimes a delegate skips its turn so it is worth considering also
+baking rights at priority 2 like in the example above.
+There is no priority for endorsements, every missed endorsement is
+lost.
+
+Inactive delegates
+~~~~~~~~~~~~~~~~~~
+
+If a delegate doesn't show any sign of activity for `preserved_cycles`
+it is marked **inactive** and its rights are removed.
+This mechanism is important to remove inactive delegates and reallocate
+their rights to the active ones so that the network is always working
+smoothly.
+Normally even a baker with one single roll should perform enough
+operations during 5 cycles to remain active.
+If for some reason you delegate is marked inactive you can reactivate
+it simply by re-registering again like above.
+
+Baker
+~~~~~
+
+The baker is a daemon that once connected to an account, computes the
+baking rights for that account, collects transactions from the mempool
+and bakes a block.
+Note that the baker is the only program that needs direct access to
+the node data directory for performance reasons.
+
+Let's launch the daemon pointing to the standard node directory and
+baking for user *bob*:
+
+::
+
+   tezos-baker-alpha run with local node ~/.tezos-node bob
+
+Endorser
+~~~~~~~~
+
+The endorser is a daemon that once connected to an account, computes
+the endorsing rights for that account and, upon reception of a new
+block, verifies the validity of the block and emits an endorsement
+operation.
+It can endorse for a specific account or if omitted it endorses for
+all accounts.
+
+::
+
+   tezos-endorser-alpha run
+
+Accuser
+~~~~~~~
+
+The accuser is a daemon that monitors all blocks received on all
+chains and looks for:
+
+* bakers who signed two blocks at the same level
+* endorsers who injected more than one endorsement operation for the
+  same baking slot (more details :ref:`here`)
+
+Upon finding such irregularity, it will emit respectively a
+double-baking or double-endorsing denunciation operation, which will
+cause the offender to loose its security deposit.
+
+::
+
+   tezos-accuser-alpha run
+
+Remember that having two bakers or endorsers running connected to the
+same account could lead to double baking/endorsing and the loss of all
+your bonds.
+If you are worried about availability of your node when is its turn to
+bake/endorse there are other ways than duplicating your credentials.
+**Never** use the same account on two daemons.
+
+
+Docker
+~~~~~~
+
+The docker image runs the daemons by default for all your keys.
+To know if you baked, just run:
+
+::
+
+    ./alphanet.sh baker log
+    ./alphanet.sh endorser log
+
+You should see lines such as:
+
+::
+
+    Injected block BLxzbB7PBW1axq for bootstrap5 after BLSrg4dXzL2aqq  (level 1381, slot 0, fitness 00::0000000000005441, operations 21)
+
+Or:
+
+::
+
+    Injected endorsement for block 'BLSrg4dXzL2aqq'  (level 1381, slot 3, contract bootstrap5) 'oo524wKiEWBoPD'
diff --git a/vendors/tezos-modded/docs/introduction/howtouse.rst b/vendors/tezos-modded/docs/introduction/howtouse.rst
new file mode 100644
index 000000000..870450c40
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/howtouse.rst
@@ -0,0 +1,481 @@
+.. _howtouse:
+
+How to use Tezos
+================
+
+This How To illustrates the use of the various Tezos binaries as well
+as some concepts about the network.
+
+The binaries
+------------
+
+After a successful compilation, you should have the following binaries:
+
+- ``tezos-node``: the tezos daemon itself;
+- ``tezos-client``: a command-line client and basic wallet;
+- ``tezos-admin-client``: administration tool for the node;
+- ``tezos-{baker,endorser,accuser}-alpha``: daemons to bake, endorse
+  and accuse on the Tezos network (see :ref:`howtorun`);
+- ``tezos-signer``: a client to remotely sign operations or blocks
+  (see :ref:`signer`);
+
+Note that Alphanet and Zeronet only support the last version of the
+protocol which is always called `alpha` while Betanet must also
+support all past protocols.
+For this reason the name of the 3 daemons in Betanet contains the
+incremental number and the partial hash of the protocol they are bound
+to, such as ``tezos-{baker,endorser,accuser}-002-PsYLVpVv``.
+
+
+Read The Friendly Manual
+------------------------
+
+The manual of each binary can be obtained with the command ``man`` and
+the verbosity can be increased with ``-v``.
+To use one specific command, type the command without arguments to see
+possible completions and options.
+It is also possible to search a keyword in the manual with ``man
+keyword``.
+The full documentation is also available online :ref:`client_manual`.
+
+::
+
+   tezos-client man -v 3
+   tezos-client transfer
+   tezos-client man set
+
+
+Node
+----
+
+The node is effectively the Tezos blockchain and it has two main
+functions: running the gossip network and the updating the context.
+The gossip network is where all Tezos nodes exchange blocks and
+operations with each other (see :ref:`tezos-admin-client` to monitor
+p2p connections).
+Using this peer-to-peer network an operation originated by a user, can
+hop several times through other nodes until it finds its way in a
+block baked by a baker.
+Using the blocks it receives on the gossip network the shell also
+keeps up to date the current `context`, that is the full state of
+the blockchain shared by all peers.
+Approximately every minute a new block is created and, when the shell
+receives it, it applies each operation in the block to its current
+context and computes a new context.
+The last block received on a chain is also called the `head` of that
+chain.
+Each new head is then advertised by the node to its peers,
+disseminating this information to build a consensus across the
+network.
+
+Other than passively observing the network, your node can also inject
+its own new operations when instructed by the ``tezos-client`` and even
+send new blocks when guided by the ``tezos-baker-alpha``.
+The node has also a view of the multiple chains that may exist
+concurrently and selects the best one based on its fitness (see
+:ref:`proof-of-stake`).
+
+
+Node identity
+~~~~~~~~~~~~~
+
+First we need to generate a new identity in order for the node to
+connect to the network:
+
+::
+
+    tezos-node identity generate
+
+The identity comprises a pair of cryptographic
+keys that nodes use to encrypt messages sent to each other, and an
+antispam-PoW stamp proving that enough computing power has been
+dedicated to creating this identity.
+Note that this is merely a network identity and it is not related in
+any way to a Tezos address on the blockchain.
+
+
+Storage
+~~~~~~~
+
+All blockchain data is stored under ``$HOME/.tezos-node/``.
+If for some reason your node is misbehaving or there has been an
+upgrade of the network, it is safe to remove this directory, it just
+means that your node will take some time to resync the chain.
+You can keep ``identity.json`` if it takes a long time for you to
+compute it and only remove the ``store`` and ``context`` directories.
+
+If you are also running a baker make sure that it has access to the
+``.tezos-node`` directory of the node.
+
+
+RPC interface
+~~~~~~~~~~~~~
+
+The only interface to the node is through Json RPC calls and it is disabled by
+default.  A more detailed documentation can be found in the :ref:`RPC index.
+` The RPC interface must be enabled in order for the clients
+to communicate with the node, but is should not be publicly accessible on the
+internet. With the following command it is available uniquely on the
+`localhost` address of your machine, on the default port ``8732``.
+
+::
+
+   tezos-node run --rpc-addr 127.0.0.1
+
+The node listens by default on port ``19732`` so it is advisable to
+open incoming connections to that port.
+You can read more about the :ref:`node configuration ` and
+its :ref:`private mode `.
+
+
+Client
+------
+
+Tezos client can be used to interact with the node, it can query its
+status or ask the node to perform some actions.
+For example after starting your node you can check if it has finished
+synchronizing using
+
+::
+
+   tezos-client bootstrapped
+
+This call will hang and return only when the node is synchronized.
+We can now check what is the current timestamp of the head of the
+chain (time is in UTC so it may differ from your local):
+
+::
+
+   tezos-client get timestamp
+
+
+A simple wallet
+~~~~~~~~~~~~~~~
+
+The client is also a basic wallet and after the activation above you
+will notice that the directory ``.tezos-client`` has been populated with
+3 files ``public_key_hashs``, ``public_keys`` and ``secret_keys``.
+The content of each file is in json and keeps the mapping between
+aliases (``alice`` in our case) and what you would expect from the name
+of the file.
+Secret keys are stored on disk encrypted with a password except when
+using a hardware wallet (see :ref:`ledger`).
+An additional file ``contracts`` contains the addresses of `originated
+contracts`, which have the form *KT1…*.
+
+We can for example generate a new pair of keys, which can used locally
+with the alias *bob*:
+
+::
+
+      $ tezos-client gen keys bob
+
+Tezos support three different ECC schemes: *Ed25519*, *secp256k1* (the
+one used in Bitcoin), and *P-256* (also called *secp256r1*). The two
+latter curves have been added for interoperability with Bitcoin and
+Hardware Security Modules (*HSMs*) mostly. Unless your use case
+require those, you should probably use *Ed25519*. We use a verified
+library for Ed25519, and it is generally recommended over other curves
+by the crypto community, for performance and security reasons.
+
+Make sure to make a back-up of this directory and that the password
+protecting your secret keys is properly managed.
+
+For more advanced key management we offer :ref:`ledger support
+` and a :ref:`remote signer`.
+
+
+.. _faucet:
+
+Get free tez
+~~~~~~~~~~~~
+
+In order to test the networks and help users get familiar with the
+system, on Zeronet and Alphanet you can obtain free tez from a
+`faucet `__.
+
+This will provide a wallet in the form of a JSON file
+``tz1__xxxxxxxxx__.json``, that can be activated with the following
+command:
+
+::
+
+    tezos-client activate account alice with "tz1__xxxxxxxxx__.json"
+
+If you use the ``alphanet.sh`` script, you should prefix the file
+with ``container:`` in order to copy it into the docker image:
+``./alphanet.sh client activate account alice with "container:tz1__xxxxxxxxx__.json"``
+
+Let's check the balance of the new account with:
+
+::
+
+    tezos-client get balance for alice
+
+Please preserve the JSON file, after each reset of Zeronet or
+Alphanet, you will have to reactivate the wallet.
+
+Please drink carefully and don't abuse the faucet: it only contains
+30,000 wallets for a total amount of ꜩ760,000,000.
+
+
+Transactions
+~~~~~~~~~~~~
+
+Let's transfer some tez to the new account:
+
+::
+
+   tezos-client transfer 1 from alice to bob --fee 0.05
+
+The ``transfer`` command returns a receipt with all the details of the
+transaction, including its hash, and then waits for the operation to
+be included in one block.
+If you want to simulate a transaction without actually sending it to
+the network you can use the ``--dry-run`` option.
+As in any blockchain it is advisable to wait several blocks to
+consider the transaction as final, for an important operation we
+advice to wait 60 blocks.
+We can do that with:
+
+::
+
+   tezos-client wait for  to be included
+
+In the rare case when an operation is lost, how can we be sure that it
+will not be included in any future block and re-emit it?
+After 60 blocks a transaction is considered invalid and can't be
+included anymore in a block.
+Furthermore each operation has a counter (explained in more detail
+later) that prevents replays so it is usually safe to re-emit an
+operation that seems lost.
+
+
+Receipts for operations and blocks
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+After an operation the client prints a `receipt` that recapitulates
+the effects of the operation on the blockchain.
+It is possible to review the receipt of a transaction with:
+
+::
+
+   tezos-client rpc get /chains/main/blocks/head/operations
+
+A manager operation, such as a transaction, has 3 important
+parameters: counter, gas and storage limit.
+The counter belongs to each account, it increases at each operation
+signed by that account and enforces some good intuitive properties:
+
+- each operation is unique: for example if we perform twice the same
+  transfer from *alice* to *bob*, even if all the data are the
+  same the counter will be different.
+- each operation is applied once: for example if the transfer above
+  reaches two peers and they both send it to a third peer, it will not
+  apply the transaction twice.
+- operations are applied in order.
+- all previous operations have been applied: if we emit operation *n*
+  and *n+1*, and *n* gets lost then *n+1* cannot be applied.
+
+Additionally each operation needs to declare a gas and storage limit,
+if an operation consumes more than these limits it will fail.
+Later we'll learn more about the gas and storage model.
+
+Another interesting field of the receipts are the `balance updates`
+showing which account was credited or debited.
+For the transaction above the updates are symmetrical, *alice* is
+debited 1ꜩ and *bob* is credited the same amount.
+The same is true for the fees with the difference that the baker is
+credited and, more importantly, it is not credited immediately on its
+main account but on its frozen fees account, hence the category
+`freezer`.
+Each delegate has 3 frozen accounts: `deposits`, `fees` and `rewards`.
+They are frozen because the delegate can't use them for now, but only
+after a number cycles.
+
+It is also possible to review the receipt of the whole block:
+
+::
+
+   tezos-client rpc get /chains/main/blocks/head/metadata
+
+Here we always see the deposit that the baker had to put down to bake
+the block, which is again a debit on its main account paired with a
+credit on its `deposits` account, and the creation of a reward, which
+is a single credit to its `rewards` account.
+
+An interesting block receipt is the one produced at the end of a
+cycle as many delegates receive back part of their unfrozen accounts.
+
+
+.. _originated_accounts:
+
+Originated accounts and Contracts
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In Tezos there are two kinds of accounts: *implicit* and *originated*.
+The implicit accounts are the *tz1* we have used up to now and to
+create them if suffices to have a pair of keys and to transfer some
+funds to the public key hash.
+Originated accounts have addresses *KT1* and are created through an
+origination operation.
+One reason to originate an account is to delegate your tokens
+(see more :ref:`here. `).
+The other main reason is that an originated account can also have
+Michelson code, in which case it is called a *contract*.
+
+Let's originate our first contract and call it *id*:
+
+::
+
+   tezos-client originate contract id for alice \
+                                   transferring 1 from alice \
+                                   running ./src/bin_client/test/contracts/id.tz \
+                                   --init '"hello"'
+
+We set *alice* as manager, a 1ꜩ starting balance generously provided
+by *alice* and the code from the ``id.tz`` Michelson program which
+is just the identity.
+Every program declares in its first 2 lines the type of its parameter
+and storage, for *id* they are both strings so we initialize the
+contract with the string ``"hello"`` (the extra quotes are to avoid
+the shell expansion).
+
+Gas and storage cost model
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A quick look at the balance updates on the receipt shows that on top of
+funding the contract with 1ꜩ, *alice* was also charged an extra cost
+that is burnt.
+This cost comes from the *storage* and is shown in the line
+``Paid storage size diff: 46 bytes``, 41 for the contract and 5 for
+the string ``"hello"``.
+Given that a contract saves its data on the public blockchain that
+every node stores, it is necessary to charge a fee per byte to avoid
+abuse and encourage lean programs.
+
+Let's see what calling a program with a new argument would look like
+with the ``--dry-run`` option:
+
+::
+
+   tezos-client transfer 0 from alice to id --arg '"world"' --dry-run
+
+The transaction would successfully update the storage but this time it
+wouldn't cost us anything more than the fee, the reason is that the
+storage for ``"world"`` is the same as for ``"hello"``, which has
+already been paid for.
+To store more we'll need to pay more, you can try by passing a longer
+string.
+
+The other cost associated with running contracts is the *gas*, which
+measures *how long* does a program take to compute.
+Contrary to storage there is no cost per gas unit, a transfer can
+require as much gas as it wants, however a baker that has to choose
+among several transactions is much more likely to include a low gas
+one because it's cheaper to run and validate.
+At the same time bakers also give priority to high fee transactions.
+This means that there is an implicit cost for gas that is related to
+the fee offered versus the gas and fees of other transactions.
+
+If you are happy with the gas and storage of your transaction you can
+run it for real, however it is always a good idea to set explicit
+limit for both. The transaction fails if the limits are passed.
+
+::
+
+   tezos-client transfer 0 from alice to id --arg '"world"' \
+                                            --gas-limit 1475 \
+                                            --storage-limit 46
+
+A baker is more likely to include an operation with lower gas and
+storage limits because it takes less resources to execute so it is in
+the best interest of the user to pick limits that are as close as
+possible to the actual use.
+
+More test contracts can be found in directory
+:src:`src/bin_client/test/contracts/`.
+An advanced documentation of the smart contract language is available
+:ref:`here`.
+For details and examples, see also https://www.michelson-lang.com/
+
+
+Validation
+~~~~~~~~~~
+
+The node allows to validate an operation before submitting it to the
+network by simply simulating the application of the operation to the
+current context.
+In general if you just send an invalid operation e.g. sending more
+tokens that what you own, the node will broadcast it and when it is
+included in a block you'll have to pay the usual fee even if it won't
+have an affect on the context.
+To avoid this case the client first asks the node to validate the
+transaction and then sends it.
+
+The same validation is used when you pass the option ``--dry-run``,
+the receipt that you see is actually a simulated one.
+
+Another important use of validation is to determine gas and storage
+limits.
+The node first simulates the execution of a Michelson program and
+takes trace of the amount of gas and storage.
+Then the client sends the transaction with the right limits for gas
+and storage based on that indicated by the node.
+This is why we were able to submit transactions without specifying
+this limits, they were computed for us.
+
+More information on validation can be found :ref:`here. `
+
+It's RPCs all the way down
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The client communicates with the node uniquely through RPC calls so
+make sure that the node is listening and that the ports are
+correct.
+For example the ``get timestamp`` command above is a shortcut for:
+
+::
+
+   tezos-client rpc get /chains/main/blocks/head/header/shell
+
+The client tries to simplify common tasks as much as possible, however
+if you want to query the node for more specific informations you'll
+have to resort to RPCs.
+For example to check the value of important constants in Tezos, which
+may differ between Betanet, Alphanet and Zeronet, you can use:
+
+::
+
+   tezos-client rpc get /chains/main/blocks/head/context/constants | jq
+   {
+     "proof_of_work_nonce_size": 8,
+     "nonce_length": 32,
+     "max_revelations_per_block": 32,
+     "max_operation_data_length": 16384,
+     "preserved_cycles": 5,
+     "blocks_per_cycle": 4096,
+     "blocks_per_commitment": 32,
+     "blocks_per_roll_snapshot": 256,
+     "blocks_per_voting_period": 32768,
+     "time_between_blocks": [
+       "60",
+       "75"
+     ],
+     "endorsers_per_block": 32,
+     "hard_gas_limit_per_operation": "400000",
+     "hard_gas_limit_per_block": "4000000",
+     "proof_of_work_threshold": "70368744177663",
+     "tokens_per_roll": "10000000000",
+     "michelson_maximum_type_size": 1000,
+     "seed_nonce_revelation_tip": "125000",
+     "origination_burn": "257000",
+     "block_security_deposit": "48000000",
+     "endorsement_security_deposit": "6000000",
+     "block_reward": "0",
+     "endorsement_reward": "0",
+     "cost_per_byte": "1000",
+     "hard_storage_limit_per_operation": "60000"
+   }
+
+You can find more info in the :ref:`RPCs' page. `
diff --git a/vendors/tezos-modded/docs/introduction/support.rst b/vendors/tezos-modded/docs/introduction/support.rst
new file mode 100644
index 000000000..517467915
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/support.rst
@@ -0,0 +1,25 @@
+.. _support:
+
+Technical Support
+=================
+
+If you need help understanding how the Tezos protocol works or if you
+have technical questions about the software, here are a few resources
+to find answers.
+
+- `This documentation! `_
+  Make sure to go through this technical documentation before asking
+  elsewhere, there is also a searchbox on the top left corner.
+- Tezos `Stack Exchange `_ is live
+  (still in beta). If you don't find the answers you are looking for,
+  feel free to ask questions!
+- There is a sub-reddit at https://www.reddit.com/r/tezos/ that is the
+  main meeting point for the Tezos community, for technical,
+  economical and just random questions. They also have a nicely
+  curated list of resources.
+- For anything baking related `Obsidian Systems
+  `_ is running a dedicated Slack channel,
+  contact them to get access.
+- There is a *#tezos* IRC channel on *freenode* that is reserved for
+  technical discussions and is always very active.
+- There is a matrix channel *Tezos* that you can join `here `_.
diff --git a/vendors/tezos-modded/docs/introduction/various.rst b/vendors/tezos-modded/docs/introduction/various.rst
new file mode 100644
index 000000000..12e5a24a5
--- /dev/null
+++ b/vendors/tezos-modded/docs/introduction/various.rst
@@ -0,0 +1,613 @@
+Various
+=======
+
+.. _activate_fundraiser_account:
+
+Activate fundraiser account - Mainnet
+-------------------------------------
+
+If you took part in the fundraiser you can activate your account for
+the Mainnet on https://check.tezos.com/.
+This feature is also included in some wallets.
+If you have any question or issue refer to that page or to the `Tezos
+foundation `_ for support.
+
+You may also use ``tezos-client`` to activate your account, **be
+warned that you should have a very good understanding of key
+management in Tezos and be familiar with the command-line.**
+The first step is to recover your private key using the following
+command which will ask for:
+
+- the email address used during the fundraiser
+- the 14 words mnemonic of your paper wallet
+- the password used to protect the paper wallet
+
+::
+
+   tezos-client import fundraiser key alice
+
+Once you insert all the required information, the client computes
+your secret key and it asks to create a new password to store your
+secret key on disk encrypted.
+
+If you haven't already activated your account on the website, you can
+use this command with the activation code obtained from the Tezos
+foundation.
+
+::
+
+   tezos-client activate fundraiser account alice with 
+
+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
new file mode 100644
index 000000000..99da1d27a
--- /dev/null
+++ b/vendors/tezos-modded/docs/logo.svg
@@ -0,0 +1,129 @@
+
+
+
+
+  
+  
+  
+    
+      
+        image/svg+xml
+        
+        
+      
+    
+  
+  
+    
+    
+    ꜩ
+    
+    Developer
+    Resources
+    Tezos
+  
+
diff --git a/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst b/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst
new file mode 100644
index 000000000..b3fa704a9
--- /dev/null
+++ b/vendors/tezos-modded/docs/protocols/003_PsddFKi3.rst
@@ -0,0 +1,236 @@
+.. _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
new file mode 100644
index 000000000..0ed1e808e
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/data_encoding.rst
@@ -0,0 +1,207 @@
+.. _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
new file mode 100644
index 000000000..fed1ea359
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/entering_alpha.rst
@@ -0,0 +1,199 @@
+.. _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
new file mode 100644
index 000000000..ddac11f6f
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/error_monad.rst
@@ -0,0 +1,366 @@
+.. _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
new file mode 100644
index 000000000..bf6ad897e
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/michelson_anti_patterns.rst
@@ -0,0 +1,203 @@
+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
new file mode 100644
index 000000000..4508e1635
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/profiling.rst
@@ -0,0 +1,79 @@
+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
new file mode 100644
index 000000000..31be8eeda
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/protocol_environment.rst
@@ -0,0 +1,48 @@
+.. _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
new file mode 100644
index 000000000..686d03f51
--- /dev/null
+++ b/vendors/tezos-modded/docs/tutorials/rpc.rst
@@ -0,0 +1,73 @@
+.. _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
new file mode 100644
index 000000000..a309def41
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/michelson.rst
@@ -0,0 +1,3115 @@
+.. _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
new file mode 100644
index 000000000..39085da7e
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/octopus.svg
@@ -0,0 +1,1558 @@
+
+
+
+image/svg+xml
\ No newline at end of file
diff --git a/vendors/tezos-modded/docs/whitedoc/p2p.rst b/vendors/tezos-modded/docs/whitedoc/p2p.rst
new file mode 100644
index 000000000..36b347952
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/p2p.rst
@@ -0,0 +1,127 @@
+.. _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
new file mode 100644
index 000000000..bed597efd
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/packages.svg
@@ -0,0 +1,3030 @@
+
+
+
+image/svg+xml
\ 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
new file mode 100644
index 000000000..d6c9e0427
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/proof_of_stake.rst
@@ -0,0 +1,324 @@
+.. _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
new file mode 100644
index 000000000..2d6168b7c
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/the_big_picture.rst
@@ -0,0 +1,327 @@
+.. _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
new file mode 100644
index 000000000..ab8d1f80e
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/validation.rst
@@ -0,0 +1,120 @@
+.. _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
new file mode 100644
index 000000000..7878b165f
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/validation.svg
@@ -0,0 +1,1578 @@
+
+
+
+image/svg+xml
\ No newline at end of file
diff --git a/vendors/tezos-modded/docs/whitedoc/voting.rst b/vendors/tezos-modded/docs/whitedoc/voting.rst
new file mode 100644
index 000000000..f6061a763
--- /dev/null
+++ b/vendors/tezos-modded/docs/whitedoc/voting.rst
@@ -0,0 +1,181 @@
+.. _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
new file mode 100644
index 000000000..c8ef27903
--- /dev/null
+++ b/vendors/tezos-modded/dune
@@ -0,0 +1,13 @@
+(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
new file mode 100644
index 000000000..de4fc2092
--- /dev/null
+++ b/vendors/tezos-modded/dune-workspace
@@ -0,0 +1 @@
+(lang dune 1.0)
diff --git a/vendors/tezos-modded/emacs/README.md b/vendors/tezos-modded/emacs/README.md
new file mode 100644
index 000000000..df817a2bd
--- /dev/null
+++ b/vendors/tezos-modded/emacs/README.md
@@ -0,0 +1,65 @@
+# 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
new file mode 100644
index 000000000..20ce905dc
--- /dev/null
+++ b/vendors/tezos-modded/emacs/michelson-mode.el
@@ -0,0 +1,913 @@
+;; 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
new file mode 100755
index 000000000..f72b2e5cd
--- /dev/null
+++ b/vendors/tezos-modded/scripts/activate_protocol.sh
@@ -0,0 +1,89 @@
+#! /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
new file mode 100755
index 000000000..515b9519e
--- /dev/null
+++ b/vendors/tezos-modded/scripts/alphanet.sh
@@ -0,0 +1,829 @@
+#! /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
new file mode 100644
index 000000000..a5b662c3e
--- /dev/null
+++ b/vendors/tezos-modded/scripts/alphanet_constants.patch
@@ -0,0 +1,20 @@
+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
new file mode 100644
index 000000000..de461c2e1
--- /dev/null
+++ b/vendors/tezos-modded/scripts/alphanet_version
@@ -0,0 +1 @@
+2018-06-30T16:07:32Z
diff --git a/vendors/tezos-modded/scripts/apply_patch.sh b/vendors/tezos-modded/scripts/apply_patch.sh
new file mode 100755
index 000000000..437fc4957
--- /dev/null
+++ b/vendors/tezos-modded/scripts/apply_patch.sh
@@ -0,0 +1,35 @@
+#! /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
new file mode 100755
index 000000000..39870e986
--- /dev/null
+++ b/vendors/tezos-modded/scripts/b58_prefix.py
@@ -0,0 +1,44 @@
+#! /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
new file mode 120000
index 000000000..34a626507
--- /dev/null
+++ b/vendors/tezos-modded/scripts/betanet.sh
@@ -0,0 +1 @@
+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
new file mode 100755
index 000000000..d4540c3eb
--- /dev/null
+++ b/vendors/tezos-modded/scripts/check_opam_test.sh
@@ -0,0 +1,36 @@
+#! /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
new file mode 100755
index 000000000..c8ca53209
--- /dev/null
+++ b/vendors/tezos-modded/scripts/check_patch.sh
@@ -0,0 +1,22 @@
+#! /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
new file mode 100755
index 000000000..652a782da
--- /dev/null
+++ b/vendors/tezos-modded/scripts/ci/create_docker_image.minimal.sh
@@ -0,0 +1,65 @@
+#! /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
new file mode 100644
index 000000000..d3da7afb8
--- /dev/null
+++ b/vendors/tezos-modded/scripts/create_genesis/requirements.txt
@@ -0,0 +1,3 @@
+-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
new file mode 100644
index 000000000..32d09755a
--- /dev/null
+++ b/vendors/tezos-modded/scripts/docker/docker-compose-generic.yml
@@ -0,0 +1,57 @@
+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
new file mode 100644
index 000000000..92fdb7c87
--- /dev/null
+++ b/vendors/tezos-modded/scripts/docker/entrypoint.inc.sh
@@ -0,0 +1,134 @@
+#!/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
new file mode 100755
index 000000000..e19f828e7
--- /dev/null
+++ b/vendors/tezos-modded/scripts/docker/entrypoint.sh
@@ -0,0 +1,66 @@
+#!/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
new file mode 100755
index 000000000..79e443b61
--- /dev/null
+++ b/vendors/tezos-modded/scripts/install_build_deps.raw.sh
@@ -0,0 +1,16 @@
+#! /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
new file mode 100755
index 000000000..e4803c887
--- /dev/null
+++ b/vendors/tezos-modded/scripts/install_build_deps.sh
@@ -0,0 +1,45 @@
+#! /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
new file mode 120000
index 000000000..34a626507
--- /dev/null
+++ b/vendors/tezos-modded/scripts/localnet.sh
@@ -0,0 +1 @@
+alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/scripts/mainnet.sh b/vendors/tezos-modded/scripts/mainnet.sh
new file mode 120000
index 000000000..34a626507
--- /dev/null
+++ b/vendors/tezos-modded/scripts/mainnet.sh
@@ -0,0 +1 @@
+alphanet.sh
\ No newline at end of file
diff --git a/vendors/tezos-modded/scripts/nginx.conf b/vendors/tezos-modded/scripts/nginx.conf
new file mode 100644
index 000000000..2db9fae21
--- /dev/null
+++ b/vendors/tezos-modded/scripts/nginx.conf
@@ -0,0 +1,31 @@
+# /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
new file mode 100755
index 000000000..1f44d0f0e
--- /dev/null
+++ b/vendors/tezos-modded/scripts/ocamldot.py
@@ -0,0 +1,85 @@
+#!/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
new file mode 100755
index 000000000..e83977faa
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-check.sh
@@ -0,0 +1,39 @@
+#! /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
new file mode 100755
index 000000000..ff4509f2f
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-pin.sh
@@ -0,0 +1,30 @@
+#! /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
new file mode 100755
index 000000000..0de2cd8f2
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-remove.sh
@@ -0,0 +1,20 @@
+#! /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
new file mode 100755
index 000000000..812db7b6a
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-test-all.sh
@@ -0,0 +1,74 @@
+#! /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
new file mode 100755
index 000000000..e22c0f72d
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-unpin.sh
@@ -0,0 +1,13 @@
+#! /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
new file mode 100755
index 000000000..292214d74
--- /dev/null
+++ b/vendors/tezos-modded/scripts/opam-upgrade.sh
@@ -0,0 +1,35 @@
+#! /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
new file mode 100644
index 000000000..92922ca2c
--- /dev/null
+++ b/vendors/tezos-modded/scripts/protocol_parameters.json
@@ -0,0 +1,48 @@
+{ "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
new file mode 100755
index 000000000..dd815e874
--- /dev/null
+++ b/vendors/tezos-modded/scripts/reset_chain.sh
@@ -0,0 +1,23 @@
+#! /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
new file mode 100644
index 000000000..007ba123e
--- /dev/null
+++ b/vendors/tezos-modded/scripts/sandbox.json
@@ -0,0 +1,4 @@
+{
+    "genesis_pubkey":
+      "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2"
+}
diff --git a/vendors/tezos-modded/scripts/snapshot_alpha.sh b/vendors/tezos-modded/scripts/snapshot_alpha.sh
new file mode 100755
index 000000000..99235cfd5
--- /dev/null
+++ b/vendors/tezos-modded/scripts/snapshot_alpha.sh
@@ -0,0 +1,124 @@
+#! /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
new file mode 100755
index 000000000..42f2f7da9
--- /dev/null
+++ b/vendors/tezos-modded/scripts/update_hashes.sh
@@ -0,0 +1,49 @@
+#! /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
new file mode 100755
index 000000000..f5b046305
--- /dev/null
+++ b/vendors/tezos-modded/scripts/update_opam_repo.sh
@@ -0,0 +1,117 @@
+#! /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
new file mode 100755
index 000000000..09499b8ae
--- /dev/null
+++ b/vendors/tezos-modded/scripts/update_opam_test.sh
@@ -0,0 +1,30 @@
+#! /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
new file mode 100644
index 000000000..03230dc7d
--- /dev/null
+++ b/vendors/tezos-modded/scripts/version.sh
@@ -0,0 +1,13 @@
+#! /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
new file mode 100644
index 000000000..121dc04ff
--- /dev/null
+++ b/vendors/tezos-modded/scripts/zeronet.patch
@@ -0,0 +1,21 @@
+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
new file mode 120000
index 000000000..34a626507
--- /dev/null
+++ b/vendors/tezos-modded/scripts/zeronet.sh
@@ -0,0 +1 @@
+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
new file mode 100644
index 000000000..842e19e75
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_attacker/attacker_main.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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
new file mode 100644
index 000000000..4c852e41c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_attacker/attacker_minimal.ml
@@ -0,0 +1,336 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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
new file mode 100644
index 000000000..69783195e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_attacker/attacker_minimal.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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
new file mode 100755
index 000000000..6546573a3
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/bash-completion.sh
@@ -0,0 +1,54 @@
+_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
new file mode 100644
index 000000000..8d5f8f036
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/client_protocols_commands.ml
@@ -0,0 +1,83 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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
new file mode 100644
index 000000000..d50cc7538
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/client_protocols_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 commands: unit -> Client_commands.command list
diff --git a/vendors/tezos-modded/src/bin_client/client_rpc_commands.ml b/vendors/tezos-modded/src/bin_client/client_rpc_commands.ml
new file mode 100644
index 000000000..5e75c741f
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/client_rpc_commands.ml
@@ -0,0 +1,531 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Command line interface - Generic JSON RPC interface *)
+
+open Lwt.Infix
+open Clic
+open Json_schema
+
+(*-- Assisted, schema directed input fill in --------------------------------*)
+
+exception Unsupported_construct
+
+type input = {
+  int : int -> int -> string option -> string list -> int Lwt.t ;
+  float : string option -> string list -> float Lwt.t ;
+  string : string option -> string list -> string Lwt.t ;
+  bool : string option -> string list -> bool Lwt.t ;
+  continue : string option -> string list -> bool Lwt.t ;
+  display : string -> unit Lwt.t ;
+}
+
+(* generic JSON generation from a schema with callback for random or
+   interactive filling *)
+let fill_in ?(show_optionals=true) input schema =
+  let rec element path { title ; kind }=
+    match kind with
+    | Integer { minimum ; maximum } ->
+        let minimum =
+          match minimum with
+          | None -> min_int
+          | Some (m, `Inclusive) -> int_of_float m
+          | Some (m, `Exclusive) -> int_of_float m + 1 in
+        let maximum =
+          match maximum with
+          | None -> max_int
+          | Some (m, `Inclusive) -> int_of_float m
+          | Some (m, `Exclusive) -> int_of_float m - 1 in
+        input.int minimum maximum title path >>= fun i ->
+        Lwt.return (`Float (float i))
+    | Number _ ->
+        input.float title path >>= fun f ->
+        Lwt.return (`Float f)
+    | Boolean ->
+        input.bool title path >>= fun f ->
+        Lwt.return (`Bool f)
+    | String _ ->
+        input.string title path >>= fun f ->
+        Lwt.return (`String f)
+    | Combine ((One_of | Any_of), elts) ->
+        let nb = List.length elts in
+        input.int 0 (nb - 1) (Some "Select the schema to follow") path >>= fun n ->
+        element path (List.nth elts n)
+    | Combine ((All_of | Not), _) ->  Lwt.fail Unsupported_construct
+    | Def_ref name ->
+        Lwt.return (`String (Json_query.json_pointer_of_path name))
+    | Id_ref _ | Ext_ref _ ->
+        Lwt.fail Unsupported_construct
+    | Array (elts, _) ->
+        let rec fill_loop acc n ls =
+          match ls with
+          | [] -> Lwt.return acc
+          | elt :: elts ->
+              element (string_of_int n :: path) elt >>= fun json ->
+              fill_loop (json :: acc) (succ n) elts
+        in
+        fill_loop [] 0 elts >>= fun acc ->
+        Lwt.return (`A (List.rev acc))
+    | Object { properties } ->
+        let properties =
+          if show_optionals
+          then properties
+          else (List.filter (fun (_, _, b, _) -> b) properties) in
+        let rec fill_loop acc ls =
+          match ls with
+          | [] -> Lwt.return acc
+          | (n, elt, _, _) :: elts ->
+              element (n :: path) elt >>= fun json ->
+              fill_loop ((n, json) :: acc) elts
+        in
+        fill_loop [] properties >>= fun acc ->
+        Lwt.return (`O (List.rev acc))
+    | Monomorphic_array (elt, specs) ->
+        let rec fill_loop acc min n max =
+          if n > max then
+            Lwt.return acc
+          else
+            element (string_of_int n :: path) elt >>= fun json ->
+            (if n < min then Lwt.return_true else input.continue title path) >>= function
+            | true -> fill_loop (json :: acc) min (succ n) max
+            | false -> Lwt.return (json :: acc)
+        in
+        let max = match specs.max_items with None -> max_int | Some m -> m in
+        fill_loop [] specs.min_items 0 max >>= fun acc ->
+        Lwt.return (`A (List.rev acc))
+    | Any -> Lwt.fail Unsupported_construct
+    | Dummy -> Lwt.fail Unsupported_construct
+    | Null -> Lwt.return `Null
+  in
+  element [] (Json_schema.root schema)
+
+let random_fill_in ?(show_optionals=true) schema =
+  let display _ = Lwt.return_unit in
+  let int min max _ _ =
+    let max = Int64.of_int max
+    and min = Int64.of_int min in
+    let range = Int64.sub max min in
+    let random_int64 = Int64.add (Random.int64 range) min in
+    Lwt.return (Int64.to_int random_int64) in
+  let string _title _ = Lwt.return "" in
+  let float _ _ = Lwt.return (Random.float infinity) in
+  let bool _ _ = Lwt.return (Random.int 2 = 0) in
+  let continue _ _ = Lwt.return (Random.int 4 = 0) in
+  Lwt.catch
+    (fun () ->
+       fill_in ~show_optionals
+         { int ; float ; string ; bool ; display ; continue }
+         schema >>= fun json ->
+       Lwt.return (Ok json))
+    (fun e ->
+       let msg = Printf.sprintf "Fill-in failed %s\n%!" (Printexc.to_string e) in
+       Lwt.return (Error msg))
+
+let editor_fill_in ?(show_optionals=true) schema =
+  let tmp = Filename.temp_file "tezos_rpc_call_" ".json" in
+  let rec init () =
+    (* write a temp file with instructions *)
+    random_fill_in ~show_optionals schema >>= function
+    | Error msg -> Lwt.return (Error msg)
+    | Ok json ->
+        Lwt_io.(with_file ~mode:Output tmp (fun fp ->
+            write_line fp (Data_encoding.Json.to_string json))) >>= fun () ->
+        edit ()
+  and edit () =
+    (* launch the user's editor on it *)
+    let editor_cmd =
+      let ed =
+        match Sys.getenv_opt "EDITOR", Sys.getenv_opt "VISUAL" with
+        | Some ed, _ -> ed
+        | None, Some ed -> ed
+        | None, None when Sys.win32 ->
+            (* TODO: I have no idea what I'm doing here *)
+            "notepad.exe"
+        | _ ->
+            (* TODO: vi on MacOSX ? *)
+            "nano" in
+      Lwt_process.shell (ed ^ " " ^ tmp) in
+    (Lwt_process.open_process_none editor_cmd) # status >>= function
+    | Unix.WEXITED 0 ->
+        reread () >>= fun json ->
+        delete () >>= fun () ->
+        Lwt.return json
+    | Unix.WSIGNALED x | Unix.WSTOPPED x | Unix.WEXITED x ->
+        let msg = Printf.sprintf "FAILED %d \n%!" x in
+        delete () >>= fun () ->
+        Lwt.return (Error msg)
+  and reread () =
+    (* finally reread the file *)
+    Lwt_io.(with_file ~mode:Input tmp (fun fp -> read fp)) >>= fun text ->
+    match Data_encoding.Json.from_string text with
+    | Ok r -> Lwt.return (Ok r)
+    | Error msg -> Lwt.return (Error (Printf.sprintf "bad input: %s" msg))
+  and delete () =
+    (* and delete the temp file *)
+    Lwt_unix.unlink tmp
+  in
+  init ()
+
+(*-- Nice list display ------------------------------------------------------*)
+
+let rec count =
+  let open RPC_description in
+  function
+  | Empty -> 0
+  | Dynamic _ -> 1
+  | Static { services ; subdirs } ->
+      let service = RPC_service.MethMap.cardinal services in
+      let subdirs =
+        match subdirs with
+        | None -> 0
+        | Some (Suffixes subdirs) ->
+            Resto.StringMap.fold (fun _ t r -> r + count t) subdirs 0
+        | Some (Arg (_, subdir)) -> count subdir in
+      service + subdirs
+
+(*-- Commands ---------------------------------------------------------------*)
+
+let list url (cctxt : #Client_context.full) =
+  let args = String.split '/' url in
+  RPC_description.describe cctxt
+    ~recurse:true args >>=? fun tree ->
+  let open RPC_description in
+  let collected_args = ref [] in
+  let collect arg =
+    if not (arg.RPC_arg.descr <> None && List.mem arg !collected_args) then
+      collected_args := arg :: !collected_args in
+  let display_paragraph ppf description =
+    Format.fprintf ppf "@,    @[%a@]"
+      (fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words)
+      (String.split ' ' description)
+  in
+  let display_arg ppf arg =
+    match arg.RPC_arg.descr with
+    | None -> Format.fprintf ppf "%s" arg.RPC_arg.name
+    | Some descr ->
+        Format.fprintf ppf "<%s>%a" arg.RPC_arg.name display_paragraph descr
+  in
+  let display_service ppf (_path, tpath, service) =
+    Format.fprintf ppf "- %s /%s"
+      (RPC_service.string_of_meth service.meth)
+      (String.concat "/" tpath) ;
+    match service.description with
+    | None | Some "" -> ()
+    | Some description -> display_paragraph ppf description
+  in
+  let display_services ppf (_path, tpath, services) =
+    Format.pp_print_list
+      (fun ppf (_,s) -> display_service ppf (_path, tpath, s))
+      ppf
+      (RPC_service.MethMap.bindings services)
+  in
+  let rec display ppf (path, tpath, tree) =
+    match tree with
+    | Dynamic description -> begin
+        Format.fprintf ppf "- /%s " (String.concat "/" tpath) ;
+        match description with
+        | None | Some "" -> ()
+        | Some description -> display_paragraph ppf description
+      end
+    | Empty -> ()
+    | Static { services ; subdirs = None } ->
+        display_services ppf (path, tpath, services)
+    | Static { services ; subdirs = Some (Suffixes subdirs) } -> begin
+        match RPC_service.MethMap.cardinal services, Resto.StringMap.bindings subdirs with
+        | 0, [] -> ()
+        | 0, [ n, solo ] ->
+            display ppf (path @ [ n ], tpath @ [ n ], solo)
+        | _, items when count tree >= 3 && path <> [] ->
+            Format.fprintf ppf "@[+ %s/@,%a@]"
+              (String.concat "/" path) (display_list tpath) items
+        | _, items when count tree >= 3 && path <> [] ->
+            Format.fprintf ppf "@[+ %s@,%a@,%a@]"
+              (String.concat "/" path)
+              display_services (path, tpath, services)
+              (display_list tpath) items
+        | 0, (n, t) :: items ->
+            Format.fprintf ppf "%a"
+              display (path @ [ n ], tpath @ [ n ], t) ;
+            List.iter
+              (fun (n, t) ->
+                 Format.fprintf ppf "@,%a"
+                   display (path @ [ n ], tpath @ [ n ], t))
+              items
+        | _, items ->
+            display_services ppf (path, tpath, services) ;
+            List.iter
+              (fun (n, t) ->
+                 Format.fprintf ppf "@,%a"
+                   display (path @ [ n ], tpath @ [ n ], t))
+              items
+      end
+    | Static { services ; subdirs = Some (Arg (arg, solo)) }
+      when RPC_service.MethMap.cardinal services = 0 ->
+        collect arg ;
+        let name = Printf.sprintf "<%s>" arg.RPC_arg.name in
+        display ppf (path @ [ name ], tpath @ [ name ], solo)
+    | Static { services;
+               subdirs = Some (Arg (arg, solo)) } ->
+        collect arg ;
+        display_services ppf (path, tpath, services) ;
+        Format.fprintf ppf "@," ;
+        let name = Printf.sprintf "<%s>" arg.RPC_arg.name in
+        display ppf (path @ [ name ], tpath @ [ name ], solo)
+  and display_list tpath =
+    Format.pp_print_list
+      (fun ppf (n,t) -> display ppf ([ n ], tpath @ [ n ], t))
+  in
+  cctxt#message "@ @[Available services:@ @ %a@]@."
+    display (args, args, tree) >>= fun () ->
+  if !collected_args <> [] then begin
+    cctxt#message "@,@[Dynamic parameter description:@ @ %a@]@."
+      (Format.pp_print_list display_arg) !collected_args >>= fun () ->
+    return_unit
+  end else return_unit
+
+
+let schema meth url (cctxt : #Client_context.full) =
+  let args = String.split '/' url in
+  let open RPC_description in
+  RPC_description.describe cctxt ~recurse:false args >>=? function
+  | Static { services } -> begin
+      match RPC_service.MethMap.find_opt meth services with
+      | None ->
+          cctxt#message
+            "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+          return_unit
+      | Some ({ input = Some input ; output }) ->
+          let json = `O [ "input", Json_schema.to_json (fst input) ;
+                          "output", Json_schema.to_json (fst output) ] in
+          cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
+          return_unit
+      | Some ({ input = None ; output }) ->
+          let json = `O [ "output", Json_schema.to_json (fst output) ] in
+          cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
+          return_unit
+    end
+  | _ ->
+      cctxt#message
+        "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+      return_unit
+
+let format binary meth url (cctxt : #Client_context.io_rpcs) =
+  let args = String.split '/' url in
+  let open RPC_description in
+  let pp =
+    if binary then
+      (fun ppf (_, schema) -> Data_encoding.Binary_schema.pp ppf schema)
+    else
+      (fun ppf (schema, _) -> Json_schema.pp ppf schema) in
+  RPC_description.describe cctxt ~recurse:false args >>=? function
+  | Static { services } -> begin
+      match RPC_service.MethMap.find_opt meth services with
+      | None ->
+          cctxt#message
+            "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+          return_unit
+      | Some ({ input = Some input ; output }) ->
+          cctxt#message
+            "@[\
+             @[Input format:@,%a@]@,\
+             @[Output format:@,%a@]@,\
+             @]"
+            pp input
+            pp output >>= fun () ->
+          return_unit
+      | Some ({ input = None ; output }) ->
+          cctxt#message
+            "@[\
+             @[Output format:@,%a@]@,\
+             @]"
+            pp output >>= fun () ->
+          return_unit
+    end
+  | _ ->
+      cctxt#message
+        "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
+      return_unit
+
+let fill_in ?(show_optionals=true) schema =
+  let open Json_schema in
+  match (root schema).kind with
+  | Null -> Lwt.return (Ok `Null)
+  | Any | Object { properties = [] } -> Lwt.return (Ok (`O []))
+  | _ -> editor_fill_in ~show_optionals schema
+
+let display_answer (cctxt : #Client_context.full) = function
+  | `Ok json ->
+      cctxt#message "%a"
+        Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
+      return_unit
+  | `Not_found _ ->
+      cctxt#message "No service found at this URL\n%!" >>= fun () ->
+      return_unit
+  | `Unauthorized _ | `Error _ | `Forbidden _ | `Conflict _ ->
+      cctxt#message "Unexpected server answer\n%!" >>= fun () ->
+      return_unit
+
+let call meth raw_url (cctxt : #Client_context.full) =
+  let uri = Uri.of_string raw_url in
+  let args = String.split_path (Uri.path uri) in
+  RPC_description.describe cctxt ~recurse:false args >>=? function
+  | Static { services } -> begin
+      match RPC_service.MethMap.find_opt meth services with
+      | None ->
+          cctxt#message
+            "No service found at this URL with this method \
+             (but this is a valid prefix)\n%!" >>= fun () ->
+          return_unit
+      | Some ({ input = None }) ->
+          cctxt#generic_json_call meth uri >>=?
+          display_answer cctxt
+      | Some ({ input = Some input }) ->
+          fill_in ~show_optionals:false (fst input) >>= function
+          | Error msg ->
+              cctxt#error "%s" msg >>= fun () ->
+              return_unit
+          | Ok json ->
+              cctxt#generic_json_call meth ~body:json uri >>=?
+              display_answer cctxt
+    end
+  | _ ->
+      cctxt#message "No service found at this URL\n%!" >>= fun () ->
+      return_unit
+
+let call_with_json meth raw_url json (cctxt: #Client_context.full) =
+  let uri = Uri.of_string raw_url in
+  match Data_encoding.Json.from_string json with
+  | exception Assert_failure _ ->
+      (* Ref : https://github.com/mirage/ezjsonm/issues/31 *)
+      cctxt#error
+        "Failed to parse the provided json: unwrapped JSON value.\n%!"
+  | Error err ->
+      cctxt#error
+        "Failed to parse the provided json: %s\n%!"
+        err
+  | Ok body ->
+      cctxt#generic_json_call meth ~body uri >>=?
+      display_answer cctxt
+
+let call_with_file_or_json meth url maybe_file (cctxt: #Client_context.full) =
+  begin
+    match TzString.split ':' ~limit:1 maybe_file with
+    | [ "file" ; filename] ->
+        (* Mostly copied from src/client/client_aliases.ml *)
+        Lwt.catch
+          (fun () ->
+             Lwt_io.(with_file ~mode:Input filename read) >>= fun content ->
+             return content)
+          (fun exn ->
+             failwith
+               "cannot read file (%s)" (Printexc.to_string exn))
+    | _ -> return maybe_file
+  end >>=? fun json ->
+  call_with_json meth url json cctxt
+
+let meth_params ?(name = "HTTP method") ?(desc = "") params =
+  param ~name ~desc
+    (parameter ~autocomplete:(fun _ ->
+         return @@
+         List.map String.lowercase_ascii @@
+         List.map Resto.string_of_meth @@
+         [ `GET ; `POST ; `DELETE ; `PUT ; `PATCH ])
+        (fun _ name ->
+           match Resto.meth_of_string (String.uppercase_ascii name) with
+           | None -> failwith "Unknown HTTP method: %s" name
+           | Some meth -> return meth))
+    params
+
+let group =
+  { Clic.name = "rpc" ;
+    title = "Commands for the low level RPC layer" }
+
+let commands = [
+
+  command ~group
+    ~desc: "List RPCs under a given URL prefix.\n\
+            Some parts of the RPC service hierarchy depend on parameters,\n\
+            they are marked by a suffix ``.\n\
+            You can list these sub-hierarchies by providing a concrete URL prefix \
+            whose arguments are set to a valid value."
+    no_options
+    (prefixes [ "rpc" ; "list" ] @@ string ~name:"url" ~desc: "the URL prefix" @@ stop)
+    (fun () -> list) ;
+
+  command ~group
+    ~desc: "Alias to `rpc list /`."
+    no_options
+    (prefixes [ "rpc" ; "list" ] @@ stop)
+    (fun () -> (list "/"));
+
+  command ~group
+    ~desc: "Get the input and output JSON schemas of an RPC."
+    no_options
+    (prefixes [ "rpc" ; "schema" ] @@
+     meth_params @@
+     string ~name: "url" ~desc: "the RPC url" @@
+     stop)
+    (fun () -> schema) ;
+
+  command ~group
+    ~desc: "Get the humanoid readable input and output formats of an RPC."
+    (args1
+       (switch
+          ~doc:"Binary format"
+          ~short:'b'
+          ~long:"binary" ()))
+    (prefixes [ "rpc" ; "format"] @@
+     meth_params @@
+     string ~name: "url" ~desc: "the RPC URL" @@
+     stop)
+    format ;
+
+  command ~group
+    ~desc: "Call an RPC with the GET method."
+    no_options
+    (prefixes [ "rpc" ; "get" ] @@ string ~name: "url" ~desc: "the RPC URL" @@ stop)
+    (fun () -> call `GET) ;
+
+  command ~group
+    ~desc: "Call an RPC with the POST method.\n\
+            If input data is needed, a text editor will be popped up."
+    no_options
+    (prefixes [ "rpc" ; "post" ] @@ string ~name: "url" ~desc: "the RPC URL" @@ stop)
+    (fun () -> call `POST) ;
+
+  command ~group
+    ~desc: "Call an RPC with the POST method, \
+           \ providing input data via the command line."
+    no_options
+    (prefixes [ "rpc" ; "post" ] @@ string ~name: "url" ~desc: "the RPC URL"
+     @@ prefix "with"
+     @@ string ~name:"input"
+       ~desc:"the raw JSON input to the RPC\n\
+              For instance, use `{}` to send the empty document.\n\
+              Alternatively, use `file:path` to read the JSON data from a file."
+     @@ stop)
+    (fun () -> call_with_file_or_json `POST)
+
+]
diff --git a/vendors/tezos-modded/src/bin_client/client_rpc_commands.mli b/vendors/tezos-modded/src/bin_client/client_rpc_commands.mli
new file mode 100644
index 000000000..1aa7d5a9c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/client_rpc_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 commands: Client_commands.command list
diff --git a/vendors/tezos-modded/src/bin_client/dune b/vendors/tezos-modded/src/bin_client/dune
new file mode 100644
index 000000000..a36e187ea
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/dune
@@ -0,0 +1,34 @@
+(executables
+ (names main_client main_admin)
+ (public_names tezos-client tezos-admin-client)
+ (libraries tezos-base
+            tezos-rpc-http
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-commands
+            tezos-client-genesis
+            tezos-client-demo
+            tezos-client-alpha
+            tezos-stdlib-unix
+            tezos-client-base-unix
+            tezos-client-alpha-commands.registration
+            tezos-baking-alpha-commands.registration
+            tezos-signer-backends)
+  (flags (:standard -w -9+27-30-32-40@8
+                    -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_rpc_http
+                    -open Tezos_stdlib_unix
+                    -open Tezos_shell_services
+                    -open Tezos_client_base
+                    -open Tezos_client_commands
+                    -open Tezos_client_base_unix)))
+
+(install
+ (section bin)
+ (files (tezos-init-sandboxed-client.sh as tezos-init-sandboxed-client.sh)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/bin_client/main_admin.ml b/vendors/tezos-modded/src/bin_client/main_admin.ml
new file mode 100644
index 000000000..84160bf62
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/main_admin.ml
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 select_commands _ _ =
+  return
+    (List.flatten
+       [ Client_report_commands.commands () ;
+         Client_admin_commands.commands () ;
+         Client_p2p_commands.commands () ;
+         Client_protocols_commands.commands () ;
+         Client_rpc_commands.commands ])
+
+let () = Client_main_run.run select_commands
diff --git a/vendors/tezos-modded/src/bin_client/main_client.ml b/vendors/tezos-modded/src/bin_client/main_client.ml
new file mode 100644
index 000000000..e4d687962
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/main_client.ml
@@ -0,0 +1,138 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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 Client_config
+
+let disable_disclaimer =
+  match Sys.getenv_opt "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" with
+  | Some ("yes" | "y" | "YES" | "Y") -> true
+  | _ -> false
+
+let zeronet () =
+  if not disable_disclaimer then
+    Format.eprintf
+      "@[@{@{Warning@}@}@,@,\
+      \               This is @{<warning>NOT@} the Tezos Mainnet.@,\
+       @,\
+      \    The node you are connecting to claims to be running on the@,\
+      \               @{<warning>Tezos Zeronet DEVELOPMENT NETWORK@}.@,\
+      \         Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
+       Zeronet is a testing network, with free tokens and frequent resets.@]@\n@."
+
+let alphanet () =
+  if not disable_disclaimer then
+    Format.eprintf
+      "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
+      \               This is @{<warning>NOT@} the Tezos Mainnet.@,\
+       @,\
+      \   The node you are connecting to claims to be running on the@,\
+      \             @{<warning>Tezos Alphanet DEVELOPMENT NETWORK.@}@,\
+      \        Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
+      \        Alphanet is a testing network, with free tokens.@]@\n@."
+
+let mainnet () =
+  if not disable_disclaimer then
+    Format.eprintf
+      "@[<v 2>@{<warning>@{<title>Disclaimer@}@}@,\
+       The  Tezos  network  is  a  new  blockchain technology.@,\
+       Users are  solely responsible  for any risks associated@,\
+       with usage of the Tezos network.  Users should do their@,\
+       own  research to determine  if Tezos is the appropriate@,\
+       platform for their needs and should apply judgement and@,\
+       care in their network interactions.@]@\n@."
+
+let sandbox () =
+  if not disable_disclaimer then
+    Format.eprintf
+      "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
+      \ The node you are connecting to claims to be running in a@,\
+      \                  @{<warning>Tezos TEST SANDBOX@}.@,\
+      \    Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
+       You should not see this message if you are not a developer.@]@\n@."
+
+let check_network ctxt =
+  Shell_services.P2p.versions ctxt >>= function
+  | Error _ ->
+      Lwt.return_none
+  | Ok versions ->
+      match String.split_on_char '_' (P2p_version.best versions).name with
+      | "SANDBOXED" :: _ ->
+          sandbox () ;
+          Lwt.return_some `Sandbox
+      | "TEZOS" :: "ZERONET" :: _date :: [] ->
+          zeronet () ;
+          Lwt.return_some `Zeronet
+      | "TEZOS" :: "ALPHANET" :: _date :: [] ->
+          alphanet () ;
+          Lwt.return_some `Alphanet
+      | "TEZOS" :: "BETANET" :: _date :: [] ->
+          mainnet () ;
+          Lwt.return_some `Mainnet
+      | _ ->
+          Lwt.return_none
+
+let get_commands_for_version ctxt network block protocol =
+  Shell_services.Blocks.protocols ctxt ~block () >>= function
+  | Ok { next_protocol = version } -> begin
+      match protocol with
+      | None ->
+          return (Some version, Client_commands.commands_for_version version network)
+      | Some given_version -> begin
+          if not (Protocol_hash.equal version given_version) then
+            Format.eprintf
+              "@[<v 2>@{<warning>@{<title>Warning@}@}@,\
+               The protocol provided via `--protocol` (%a)@,\
+               is not the one retrieved from the node (%a).@]@\n@."
+              Protocol_hash.pp_short given_version
+              Protocol_hash.pp_short version ;
+          return (Some version, Client_commands.commands_for_version given_version network)
+        end
+    end
+  | Error errs -> begin
+      match protocol with
+      | None -> begin
+          Format.eprintf
+            "@[<v 2>@{<warning>@{<title>Warning@}@}@,\
+             Failed to acquire the protocol version from the node@,%a@]@\n@."
+            (Format.pp_print_list pp) errs ;
+          return (None, [])
+        end
+      | Some version ->
+          return (Some version, Client_commands.commands_for_version version network)
+    end
+
+let select_commands ctxt { block ; protocol } =
+  check_network ctxt >>= fun network ->
+  get_commands_for_version ctxt network block protocol >>|? fun (_, commands_for_version)  ->
+  Client_rpc_commands.commands @
+  Tezos_signer_backends.Ledger.commands () @
+  List.map
+    (Clic.map_command
+       (fun (o : Client_context.full) -> (o :> Client_context.io_wallet)))
+    (Client_keys_commands.commands network) @
+  Client_helpers_commands.commands () @
+  commands_for_version
+
+let () = Client_main_run.run select_commands
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/accounts.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/accounts.tz
new file mode 100644
index 000000000..c327692ca
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/accounts.tz
@@ -0,0 +1,54 @@
+# This is a very simple accounts system.
+# (Left key) initializes or deposits into an account
+# (Right key (pair mutez (signed mutez))) withdraws mutez amount to a
+# IMPLICIT_ACCOUNT created from the key if the balance is available
+# and the key is correctly signed
+parameter (or (key_hash %Initialize)
+              (pair     %Withdraw
+                 (key %from)
+                 (pair
+                    (mutez     %withdraw_amount)
+                    (signature %sig))));
+# Maps the key to the balance they have stored
+storage (map :stored_balance key_hash mutez);
+code { DUP; CAR;
+       # Deposit into account
+       IF_LEFT { DUP; DIIP{ CDR %stored_balance; DUP };
+                 DIP{ SWAP }; GET @opt_prev_balance;
+                 # Create the account
+                 IF_SOME # Add to an existing account
+                   { RENAME @previous_balance;
+                     AMOUNT; ADD; SOME; SWAP; UPDATE; NIL operation; PAIR }
+                   { DIP{ AMOUNT; SOME }; UPDATE; NIL operation; PAIR }}
+               # Withdrawl
+               { DUP; DUP; DUP; DUP;
+                 # Check signature on data
+                 CAR %from;
+                 DIIP{ CDAR %withdraw_amount; PACK ; BLAKE2B @signed_amount };
+                 DIP{ CDDR %sig }; CHECK_SIGNATURE;
+                 IF {} { PUSH string "Bad signature"; FAILWITH };
+                 # Get user account information
+                 DIIP{ CDR %stored_balance; DUP };
+                 CAR %from; HASH_KEY @from_hash; DUP; DIP{ DIP { SWAP }; SWAP}; GET;
+                 # Account does not exist
+                 IF_NONE { PUSH string "Account does not exist"; PAIR; FAILWITH }
+                         # Account exists
+                         { RENAME @previous_balance;
+                           DIP { DROP };
+                           DUP; DIIP{ DUP; CDAR %withdraw_amount; DUP };
+                           # Ensure funds are available
+                           DIP{ CMPLT @not_enough }; SWAP;
+                           IF { PUSH string "Not enough funds"; FAILWITH }
+                              { SUB @new_balance; DIP{ DUP; DIP{ SWAP }}; DUP;
+                                # Delete account if balance is 0
+                                PUSH @zero mutez 0; CMPEQ @null_balance;
+                                IF { DROP; NONE @new_balance mutez }
+                                   # Otherwise update storage with new balance
+                                   { SOME @new_balance };
+                                SWAP; CAR %from; HASH_KEY @from_hash; UPDATE;
+                                SWAP; DUP; CDAR %withdraw_amount;
+                                # Execute the transfer
+                                DIP{ CAR %from; HASH_KEY @from_hash; IMPLICIT_ACCOUNT @from_account}; UNIT;
+                                TRANSFER_TOKENS @widthdraw_transfer_op;
+                                NIL operation; SWAP; CONS;
+                                PAIR }}}}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1.tz
new file mode 100644
index 000000000..78d4f9d1c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1.tz
@@ -0,0 +1,7 @@
+parameter int;
+storage int;
+code {CAR;                      # Get the parameter
+      PUSH int 1;               # We're adding 1, so we need to put 1 on the stack
+      ADD;                      # Add the two numbers
+      NIL operation;            # We put an empty list of operations on the stack
+      PAIR}                     # Create the end value
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1_list.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1_list.tz
new file mode 100644
index 000000000..084868c5e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/add1_list.tz
@@ -0,0 +1,6 @@
+parameter (list int);
+storage (list int);
+code { CAR;                                # Get the parameter
+       MAP { PUSH int 1; ADD };            # Map over the list adding one
+       NIL operation;                      # No internal op
+       PAIR }                              # Match the calling convetion
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/after_strategy.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/after_strategy.tz
new file mode 100644
index 000000000..70812e52b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/after_strategy.tz
@@ -0,0 +1,3 @@
+parameter nat;
+storage (pair (pair nat bool) timestamp);
+code {DUP; CAR; DIP{CDDR; DUP; NOW; CMPGT}; PAIR; PAIR ; NIL operation ; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/always.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/always.tz
new file mode 100644
index 000000000..a7802fec9
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/always.tz
@@ -0,0 +1,4 @@
+parameter nat;
+storage (pair nat bool);
+code { CAR; PUSH bool True; SWAP;
+       PAIR; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/append.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/append.tz
new file mode 100644
index 000000000..3b8335455
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/append.tz
@@ -0,0 +1,8 @@
+parameter (pair (list int) (list int));
+storage (list int);
+code { CAR; UNPAIR  ; # Unpack lists
+       NIL int; SWAP; # Setup reverse accumulator
+       ITER {CONS};   # Reverse list
+       ITER {CONS};   # Append reversed list
+       NIL operation;
+       PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/at_least.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/at_least.tz
new file mode 100644
index 000000000..6c6d2968c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/at_least.tz
@@ -0,0 +1,6 @@
+parameter unit;
+storage mutez;                    # How much you have to send me
+code {CDR; DUP;                 # Get the amount required (once for comparison, once to save back in storage)
+      AMOUNT; CMPLT;            # Check to make sure no one is wasting my time
+      IF {FAIL}                 # Reject the person
+         {NIL operation;PAIR}}  # Finish the transaction
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/auction.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/auction.tz
new file mode 100644
index 000000000..af8aedfb7
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/auction.tz
@@ -0,0 +1,8 @@
+parameter key_hash;
+storage (pair timestamp (pair mutez key_hash));
+code { DUP; CDAR; DUP; NOW; CMPGT; IF {FAIL} {}; SWAP; # Check if auction has ended
+       DUP; CAR; DIP{CDDR}; AMOUNT; PAIR; SWAP; DIP{SWAP; PAIR}; # Setup replacement storage
+       DUP; CAR; AMOUNT; CMPLE; IF {FAIL} {};  # Check to make sure that the new amount is greater
+       DUP; CAR;                               # Get amount of refund
+       DIP{CDR; IMPLICIT_ACCOUNT}; UNIT; TRANSFER_TOKENS; # Make refund
+       NIL operation; SWAP; CONS; PAIR} # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/bad_lockup.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/bad_lockup.tz
new file mode 100644
index 000000000..aeb3ec7fe
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/bad_lockup.tz
@@ -0,0 +1,6 @@
+parameter unit;
+storage (pair timestamp (pair (contract unit) (contract unit)));
+code { CDR; DUP; CAR; NOW; CMPLT; IF {FAIL} {};
+       DUP; CDAR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; SWAP;
+       DUP; CDDR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; DIP {SWAP} ;
+       NIL operation ; SWAP ; CONS ; SWAP ; CONS ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/big_map_union.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/big_map_union.tz
new file mode 100644
index 000000000..0c971ff11
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/big_map_union.tz
@@ -0,0 +1,8 @@
+parameter (list (pair string int)) ;
+storage (pair (big_map string int) unit) ;
+code { UNPAPAIR ;
+       ITER { UNPAIR ; DUUUP ; DUUP; GET ;
+              IF_NONE { PUSH int 0 } {} ;
+              SWAP ; DIP { ADD ; SOME } ;
+              UPDATE } ;
+       PAIR ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/cadr_annotation.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cadr_annotation.tz
new file mode 100644
index 000000000..3f4978aeb
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cadr_annotation.tz
@@ -0,0 +1,3 @@
+parameter (pair (pair %p1 unit (string %no_name)) bool);
+storage unit;
+code { CAR @param; CADR @name %no_name; DROP; UNIT; NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/concat.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/concat.tz
new file mode 100644
index 000000000..26814afca
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/concat.tz
@@ -0,0 +1,7 @@
+parameter string;
+storage string;
+code { DUP;
+       DIP { CDR ; NIL string ; SWAP ; CONS } ;
+       CAR ; CONS ;
+       CONCAT;
+       NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/conditionals.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/conditionals.tz
new file mode 100644
index 000000000..16bf8e916
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/conditionals.tz
@@ -0,0 +1,9 @@
+parameter (or string (option int));
+storage string;
+code { CAR;                      # Access the storage
+       IF_LEFT {}                # The string is on top of the stack, nothing to do
+               { IF_NONE { FAIL}  # Fail if None
+                         { PUSH int 0; CMPGT; # Check for negative number
+                           IF {FAIL}          # Fail if negative
+                              {PUSH string ""}}}; # Push the empty string
+       NIL operation; PAIR}                       # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/cons_twice.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cons_twice.tz
new file mode 100644
index 000000000..4761b23f7
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cons_twice.tz
@@ -0,0 +1,9 @@
+parameter nat;
+storage (list nat);
+code { DUP;                     # Duplicate the storage and parameter
+       CAR;                     # Extract the parameter
+       DIP{CDR};                # Extract the storage
+       DUP;                     # Duplicate the parameter
+       DIP{CONS};               # Add the first instance of the parameter to the list
+       CONS;                    # Add the second instance of the parameter to the list
+       NIL operation; PAIR}     # Finish the calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/cps_fact.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cps_fact.tz
new file mode 100644
index 000000000..6c8ee7146
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/cps_fact.tz
@@ -0,0 +1,16 @@
+storage nat ;
+parameter nat ;
+code { UNPAIR ;
+       DIP { SELF ; ADDRESS ; SENDER;
+             IFCMPEQ {} { DROP ; PUSH @storage nat 1 } };
+       DUP ;
+       PUSH nat 1 ;
+       IFCMPGE
+         { DROP ; NIL operation ; PAIR }
+         { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ;
+           IF_NONE
+             { NIL operation ; PAIR }
+             { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; SWAP;
+               DIP { DIP { SELF; PUSH mutez 0 } ;
+                     TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ;
+               SWAP ; PAIR } } }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/create_add1_lists.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/create_add1_lists.tz
new file mode 100644
index 000000000..c183ad1e2
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/create_add1_lists.tz
@@ -0,0 +1,17 @@
+parameter unit;
+storage address;
+code { DROP; NIL int; # starting storage for contract
+       AMOUNT;                   # Push the starting balance
+       PUSH bool False;          # Not spendable
+       DUP;                      # Or delegatable
+       NONE key_hash;                 # No delegate
+       PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
+       CREATE_CONTRACT          # Create the contract
+         { parameter (list int) ;
+           storage (list int) ;
+           code
+             { CAR;
+               MAP {PUSH int 1; ADD};
+               NIL operation;
+               PAIR } };
+       NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/data_publisher.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/data_publisher.tz
new file mode 100644
index 000000000..9240d6302
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/data_publisher.tz
@@ -0,0 +1,8 @@
+parameter (pair signature (pair string nat));
+storage (pair (pair key nat) string);
+code { DUP; CAR; DIP{CDR; DUP};
+       SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; PACK ; BLAKE2B}};
+       CHECK_SIGNATURE;
+       IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD;
+            DIP{SWAP}; SWAP; PAIR; PAIR; NIL operation; PAIR}
+          {FAIL}}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/dispatch.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/dispatch.tz
new file mode 100644
index 000000000..9c185133a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/dispatch.tz
@@ -0,0 +1,9 @@
+parameter (or string (pair string (lambda unit string)));
+storage (pair string (map string (lambda unit string)));
+code { DUP; DIP{CDDR}; CAR;      # Unpack stack
+       IF_LEFT { DIP{DUP}; GET; # Get lambda if it exists
+                 IF_NONE {FAIL} {}; # Fail if it doesn't
+                 UNIT; EXEC }        # Execute the lambda
+               { DUP; CAR; DIP {CDR; SOME}; UPDATE; PUSH string ""}; # Update the storage
+       PAIR;
+       NIL operation; PAIR} # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/empty.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/empty.tz
new file mode 100644
index 000000000..d3aecdb25
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/empty.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage unit;
+code {CDR; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/fail_amount.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/fail_amount.tz
new file mode 100644
index 000000000..95b71c4f0
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/fail_amount.tz
@@ -0,0 +1,6 @@
+# Fail if the amount transferred is less than 10
+parameter unit;
+storage unit;
+code { DROP;
+       AMOUNT; PUSH mutez 10000000; CMPGT; IF {FAIL} {};
+       UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/faucet.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/faucet.tz
new file mode 100644
index 000000000..0c92a0744
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/faucet.tz
@@ -0,0 +1,7 @@
+parameter key_hash ;
+storage timestamp ;
+code { UNPAIR ; SWAP ;
+       PUSH int 300 ; ADD @FIVE_MINUTES_LATER ;
+       NOW ; ASSERT_CMPGE ;
+       IMPLICIT_ACCOUNT ; PUSH mutez 1000000 ; UNIT ; TRANSFER_TOKENS ;
+       NIL operation ; SWAP ; CONS ; DIP { NOW } ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/forward.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/forward.tz
new file mode 100644
index 000000000..9894dae20
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/forward.tz
@@ -0,0 +1,144 @@
+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} } } } } } }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/id.tz
new file mode 100644
index 000000000..4eee565ca
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/id.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage string;
+code {CAR; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/infinite_loop.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/infinite_loop.tz
new file mode 100644
index 000000000..77cdbc48c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/infinite_loop.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage unit;
+code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/insertion_sort.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/insertion_sort.tz
new file mode 100644
index 000000000..34eca64d0
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/insertion_sort.tz
@@ -0,0 +1,16 @@
+parameter (list int) ;
+storage (list int) ;
+code { CAR ;
+       NIL int ; SWAP ;
+       ITER { SWAP; DIIP{NIL int} ; PUSH bool True ;
+              LOOP
+                { IF_CONS
+                    { SWAP ;
+                      DIP{DUP ; DIIP{DUP} ; DIP{CMPLT} ; SWAP} ;
+                      SWAP ;
+                      IF { DIP{SWAP ; DIP{CONS}} ; PUSH bool True}
+                         { SWAP ; CONS ; PUSH bool False}}
+                    { NIL int ; PUSH bool False}} ;
+              SWAP ; CONS ; SWAP ;
+              ITER {CONS}} ;
+       NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/int_publisher.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/int_publisher.tz
new file mode 100644
index 000000000..6ee49b979
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/int_publisher.tz
@@ -0,0 +1,17 @@
+# (signed hash of the string, string)
+parameter (option (pair signature int));
+storage (pair key int);
+code {DUP; DUP; CAR;
+      IF_NONE {PUSH mutez 1000000; # Fee pattern from July 26
+               AMOUNT; CMPLE; IF {FAIL} {};
+               # Provide the data
+               CDR; DIP {CDDR}}
+              {DUP; DIP{SWAP}; SWAP; CDAR; # Move key to the top
+               DIP {DUP; CAR; DIP {CDR; PACK ; BLAKE2B}}; # Arrange the new piece of data
+               CHECK_SIGNATURE;                    # Check to ensure the data is authentic
+               # Update data
+               IF {CDR; SWAP; DIP{DUP}; CDAR; PAIR}
+                  # Revert the update. This could be replaced with FAIL
+                  {DROP; DUP; CDR; DIP{CDDR}}};
+      # Cleanup
+      DIP{DROP}; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/king_of_tez.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/king_of_tez.tz
new file mode 100644
index 000000000..033ead7f1
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/king_of_tez.tz
@@ -0,0 +1,19 @@
+parameter key_hash;
+storage (pair timestamp (pair mutez key_hash));
+code { DUP; CDAR;
+       # If the time is more than 2 weeks, any amount makes you king
+       NOW; CMPGT;
+       # User becomes king of mutez
+       IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR;
+            NIL operation }
+          # Check balance to see if user has paid enough to become the new king
+          { DUP; CDDAR; AMOUNT; CMPLT;
+            IF { FAIL }             # user has not paid out
+               { CAR; DUP;
+                 # New storage
+                 DIP{ AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR };
+                 # Pay funds to old king
+                 IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS;
+                 NIL operation; SWAP; CONS}};
+       # Cleanup
+       PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/list_of_transactions.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/list_of_transactions.tz
new file mode 100644
index 000000000..412112aad
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/list_of_transactions.tz
@@ -0,0 +1,8 @@
+parameter unit;
+storage (list (contract unit));
+code { CDR; DUP;
+       DIP {NIL operation}; PUSH bool True;     # Setup loop
+       LOOP {IF_CONS { PUSH mutez 1000000; UNIT; TRANSFER_TOKENS; # Make transfer
+                       SWAP; DIP {CONS}; PUSH bool True}                   # Setup for next round of loop
+                     { NIL (contract unit); PUSH bool False}}; # Data to satisfy types and end loop
+       DROP; PAIR};                                                 # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/queue.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/queue.tz
new file mode 100644
index 000000000..a074906dd
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/queue.tz
@@ -0,0 +1,24 @@
+parameter (option string);
+storage (pair (option string) (pair (pair nat nat) (map nat string)));
+code { DUP; CAR;
+       # Retrieving an element
+       IF_NONE { CDDR; DUP; CAR; DIP{CDR; DUP}; DUP;
+                 CAR; SWAP; DIP{GET}; # Check if an element is available
+                 SWAP;
+                 # Put NONE on stack and finish
+                 IF_NONE { NONE string; DIP{PAIR}; PAIR}
+                         # Reoption the element and remove the entry from the map
+                         { SOME;
+                           DIP{ DUP; DIP{ CAR; DIP{ NONE string }; UPDATE };
+                                # Increment the counter and cleanup
+                                DUP; CAR; PUSH nat 1; ADD; DIP{ CDR }; PAIR; PAIR};
+                           PAIR }}
+               # Arrange the stack
+               { DIP{DUP; CDDAR; DIP{CDDDR}; DUP}; SWAP; CAR;
+                 # Add the element to the map
+                 DIP{ SOME; SWAP; CDR; DUP; DIP{UPDATE};
+                      # Increment the second number
+                      PUSH nat 1; ADD};
+                 # Cleanup and finish
+                 PAIR; PAIR; NONE string; PAIR };
+       NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/reduce_map.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/reduce_map.tz
new file mode 100644
index 000000000..aab8ea60d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/reduce_map.tz
@@ -0,0 +1,16 @@
+
+parameter (pair (lambda int int) (list int));
+storage (list int);
+code { DIP{NIL int};
+       CAR;
+       DUP;
+       DIP{CAR; PAIR};          # Unpack data and setup accumulator
+       CDR;
+       ITER {PAIR;
+             DUP; CDAR;
+             DIP{ DUP; DIP{CDAR}; DUP;
+                  CAR; DIP{CDDR; SWAP}; EXEC; CONS};
+             PAIR};
+       CDR; DIP{NIL int}; # First reduce
+       ITER {CONS}; # Reverse
+       NIL operation; PAIR}     # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/reentrancy.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/reentrancy.tz
new file mode 100644
index 000000000..2e5d92060
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/reentrancy.tz
@@ -0,0 +1,7 @@
+parameter unit;
+storage (pair (contract unit) (contract unit));
+code { CDR; DUP; CAR; PUSH mutez 5000000; UNIT;
+       TRANSFER_TOKENS;
+       DIP {DUP; CDR;
+            PUSH mutez 5000000; UNIT; TRANSFER_TOKENS};
+       DIIP{NIL operation};DIP{CONS};CONS;PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/attic/spawn_identities.tz b/vendors/tezos-modded/src/bin_client/test/contracts/attic/spawn_identities.tz
new file mode 100644
index 000000000..91b062aff
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/attic/spawn_identities.tz
@@ -0,0 +1,22 @@
+parameter nat;
+storage (list address);
+code { DUP;
+       CAR;                     # Get the number
+       DIP{CDR; NIL operation}; # Put the accumulators on the stack
+       PUSH bool True;          # Push true so we have a do while loop
+       LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0
+              IF { PUSH bool False}   # End the loop
+                 { PUSH nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat
+                   PUSH string "init"; # Storage type
+                   PUSH mutez 5000000; # Strating balance
+                   PUSH bool False; DUP; # Not spendable or delegatable
+                   NONE key_hash;
+                   PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
+                   CREATE_CONTRACT
+                     { parameter string ;
+                       storage string ;
+                       code { CAR ; NIL operation ; PAIR } } ; # Make the contract
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list
+                   PUSH bool True}}; # Continue the loop
+       DROP; PAIR}    # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert.tz
new file mode 100644
index 000000000..6c5ce503b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert.tz
@@ -0,0 +1,3 @@
+parameter bool;
+storage unit;
+code {CAR; ASSERT; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpeq.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpeq.tz
new file mode 100644
index 000000000..55621bac8
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpeq.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpge.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpge.tz
new file mode 100644
index 000000000..e98b17044
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpge.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpgt.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpgt.tz
new file mode 100644
index 000000000..7a44174b7
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpgt.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmple.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmple.tz
new file mode 100644
index 000000000..e4b61cfc4
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmple.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmplt.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmplt.tz
new file mode 100644
index 000000000..290b49537
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmplt.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpneq.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpneq.tz
new file mode 100644
index 000000000..86b601393
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_cmpneq.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_eq.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_eq.tz
new file mode 100644
index 000000000..338096a62
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_eq.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_ge.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_ge.tz
new file mode 100644
index 000000000..06bb3cec9
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_ge.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_gt.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_gt.tz
new file mode 100644
index 000000000..d041093b0
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_gt.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_le.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_le.tz
new file mode 100644
index 000000000..8250f3f3b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_le.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_lt.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_lt.tz
new file mode 100644
index 000000000..e387e9d74
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_lt.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_neq.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_neq.tz
new file mode 100644
index 000000000..83f19559e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/assert_neq.tz
@@ -0,0 +1,3 @@
+parameter (pair int int);
+storage unit;
+code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_get_add.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_get_add.tz
new file mode 100644
index 000000000..2dcf1ce69
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_get_add.tz
@@ -0,0 +1,7 @@
+parameter (pair (pair %set_pair int (option int)) (pair %check_pair int (option int))) ;
+storage (pair (big_map int int) unit) ;
+code { DUP ; DIP { CDAR } ;
+       DUP ; DIP { CADR; DUP ; CAR ; DIP { CDR } ; UPDATE ; DUP } ;
+       CADR ; DUP ; CDR ; DIP { CAR ; GET } ;
+       IF_SOME { SWAP ; IF_SOME { ASSERT_CMPEQ } {FAIL}} { ASSERT_NONE } ;
+       UNIT ; SWAP ; PAIR ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_mem.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_mem.tz
new file mode 100644
index 000000000..55736ab89
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/big_map_mem.tz
@@ -0,0 +1,5 @@
+# Fails if the boolean does not match the membership criteria
+parameter (pair int bool) ;
+storage (pair (big_map int unit) unit) ;
+code { DUP ; DUP ; CADR ; DIP { CAAR ; DIP { CDAR ; DUP } ; MEM } ;
+       ASSERT_CMPEQ ; UNIT ; SWAP ; PAIR ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/build_list.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/build_list.tz
new file mode 100644
index 000000000..842056d91
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/build_list.tz
@@ -0,0 +1,6 @@
+parameter nat;
+storage (list nat);
+code { CAR @counter; NIL @acc nat; SWAP; DUP @cmp_num; PUSH nat 0; CMPNEQ;
+       LOOP { DUP; DIP {SWAP}; CONS @acc; SWAP; PUSH nat 1; SWAP; SUB @counter;
+              DUP; DIP{ABS}; PUSH int 0; CMPNEQ};
+       CONS; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare.tz
new file mode 100644
index 000000000..698ef3e69
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare.tz
@@ -0,0 +1,9 @@
+parameter (pair mutez mutez);
+storage (list bool);
+code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool};
+      DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS};
+      DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS};
+      DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS};
+      DIP {DUP; CAR; DIP {CDR}; COMPARE; GT; CONS};
+      DUP; CAR; DIP {CDR}; COMPARE; EQ; CONS;
+      NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare_bytes.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare_bytes.tz
new file mode 100644
index 000000000..3b5e5a9c4
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/compare_bytes.tz
@@ -0,0 +1,9 @@
+parameter (pair bytes bytes);
+storage (list bool);
+code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool};
+      DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS};
+      DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS};
+      DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS};
+      DIP {DUP; CAR; DIP {CDR}; COMPARE; GT; CONS};
+      DUP; CAR; DIP {CDR}; COMPARE; EQ; CONS;
+      NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/fail.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/fail.tz
new file mode 100644
index 000000000..7f8bde252
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/fail.tz
@@ -0,0 +1,5 @@
+parameter unit;
+storage unit;
+code
+  { # This contract will never accept a incoming transaction
+    FAIL};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/guestbook.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/guestbook.tz
new file mode 100644
index 000000000..b362f94b9
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/guestbook.tz
@@ -0,0 +1,10 @@
+parameter string;
+storage (map address (option string));
+
+code { UNPAIR @message @guestbook; SWAP;
+       DUP; SENDER; GET @previous_message;
+       ASSERT_SOME;
+       ASSERT_NONE;
+       SWAP; SOME; SOME; SENDER; UPDATE;
+       NIL operation;
+       PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/macro_annotations.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/macro_annotations.tz
new file mode 100644
index 000000000..f48f18e3d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/macro_annotations.tz
@@ -0,0 +1,6 @@
+parameter unit;
+storage (pair (unit %truc) unit);
+code { DROP; UNIT ; UNIT ; PAIR %truc ; UNIT ;
+       DUUP @new_storage ;
+       DIP { DROP ; DROP } ;
+       NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/map_caddaadr.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/map_caddaadr.tz
new file mode 100644
index 000000000..45509839c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/map_caddaadr.tz
@@ -0,0 +1,4 @@
+parameter unit;
+storage (pair (pair nat (pair nat (pair (pair (pair (nat %p) (mutez %value)) nat) nat))) nat);
+code { MAP_CDADDAADR @new_storage %value { PUSH mutez 1000000 ; ADD } ;
+       NIL operation ; SWAP; SET_CAR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/max_in_list.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/max_in_list.tz
new file mode 100644
index 000000000..89c4955e9
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/max_in_list.tz
@@ -0,0 +1,9 @@
+parameter (list int);
+storage (option int);
+code {CAR; DIP{NONE int};
+      ITER {SWAP;
+            IF_NONE {SOME}
+                    {DIP {DUP}; DUP; DIP{SWAP};
+                     CMPLE; IF {DROP} {DIP {DROP}};
+                     SOME}};
+      NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/min.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/min.tz
new file mode 100644
index 000000000..cedd835bb
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/min.tz
@@ -0,0 +1,11 @@
+
+parameter (pair int int);
+storage int;
+code { CAR;                     # Ignore the storage
+       DUP;                     # Duplicate so we can get both the numbers passed as parameters
+       DUP;                     # Second dup so we can access the lesser number
+       CAR; DIP{CDR};           # Unpack the numbers on top of the stack
+       CMPLT;                   # Compare the two numbers, placing a boolean on top of the stack
+       IF {CAR} {CDR};          # Access the first number if the boolean was true
+       NIL operation;           # Return no op
+       PAIR}                    # Pair the numbers satisfying the calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/pair_macro.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/pair_macro.tz
new file mode 100644
index 000000000..55c70a3be
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/pair_macro.tz
@@ -0,0 +1,6 @@
+parameter unit;
+storage unit;
+code { UNIT; UNIT; UNIT; UNIT; UNIT;
+       PAPAPAPAIR @name %x1 %x2 %x3 %x4 %x5;
+       CDDDAR %x4 @fourth;
+       DROP; CDR; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/set_caddaadr.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/set_caddaadr.tz
new file mode 100644
index 000000000..e98671e40
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/set_caddaadr.tz
@@ -0,0 +1,5 @@
+parameter mutez;
+storage (pair (pair nat (pair nat (pair (pair (pair (nat %p) (mutez %value)) nat) nat))) nat);
+code { DUP ; CAR ; SWAP ; CDR ;
+       SET_CADDAADR @toplevel_pair_name %value ;
+       NIL operation ; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/take_my_money.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/take_my_money.tz
new file mode 100644
index 000000000..bb502d041
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/take_my_money.tz
@@ -0,0 +1,9 @@
+parameter key_hash;
+storage unit;
+code { CAR; IMPLICIT_ACCOUNT; # Create an account for the recipient of the funds
+       DIP{UNIT};             # Push a value of the storage type below the contract
+       PUSH mutez 1000000;       # The person can have a ꜩ
+       UNIT;                 # Push the contract's argument type
+       TRANSFER_TOKENS;      # Run the transfer
+       NIL operation; SWAP; CONS;
+       PAIR };                # Cleanup and put the return values
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/macros/unpair_macro.tz b/vendors/tezos-modded/src/bin_client/test/contracts/macros/unpair_macro.tz
new file mode 100644
index 000000000..384b6839d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/macros/unpair_macro.tz
@@ -0,0 +1,9 @@
+parameter (unit :param_unit);
+storage (unit :u1);
+code { DROP ;
+       UNIT :u4 @a4; UNIT :u3 @a3; UNIT :u2 @a2; UNIT :u1 @a1;
+       PAIR; UNPAIR @x1 @x2;
+       PPAIPAIR @p1 %x1 %x2 %x3 %x4; UNPPAIPAIR %x1 % %x3 %x4 @uno @due @tre @quattro;
+       PAPAPAIR @p2 %x1 %x2 %x3 %x4; UNPAPAPAIR @un @deux @trois @quatre;
+       PAPPAIIR @p3 %x1 %x2 %x3 %x4; UNPAPPAIIR @one @two @three @four;
+       DIP { DROP; DROP; DROP }; NIL operation; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_account.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_account.tz
new file mode 100644
index 000000000..6d0d261ec
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_account.tz
@@ -0,0 +1,12 @@
+parameter (or key_hash address) ;
+storage (option (contract unit)) ;
+code { CAR;
+       IF_LEFT
+         { DIP { PUSH mutez 100000000 ; PUSH bool False ; NONE key_hash };
+           CREATE_ACCOUNT ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; NONE (contract unit) ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ;
+           NIL operation ; PAIR } } ;
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_contract.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_contract.tz
new file mode 100644
index 000000000..a162044ac
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/create_contract.tz
@@ -0,0 +1,18 @@
+parameter (or key_hash address);
+storage unit;
+code { CAR;
+       IF_LEFT
+         { DIP { PUSH string "dummy";
+                 PUSH mutez 100000000 ; PUSH bool False ;
+                 PUSH bool False ; NONE key_hash } ;
+           CREATE_CONTRACT
+             { parameter string ;
+               storage string ;
+               code { CAR ; NIL operation ; PAIR } } ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SENDER ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH mutez 0 ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/default_account.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/default_account.tz
new file mode 100644
index 000000000..db9f01156
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/default_account.tz
@@ -0,0 +1,5 @@
+parameter key_hash;
+storage unit;
+code {DIP{UNIT}; CAR; IMPLICIT_ACCOUNT;
+      PUSH mutez 100000000; UNIT; TRANSFER_TOKENS;
+      NIL operation; SWAP; CONS; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/hardlimit.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/hardlimit.tz
new file mode 100644
index 000000000..464062a52
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/hardlimit.tz
@@ -0,0 +1,5 @@
+parameter unit ;
+storage int ;
+code { # This contract stops accepting transactions after N incoming transactions
+       CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL};
+       NIL operation ; PAIR} ;
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/lockup.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/lockup.tz
new file mode 100644
index 000000000..a68a8628f
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/lockup.tz
@@ -0,0 +1,18 @@
+parameter unit;
+storage (pair timestamp (pair mutez (contract unit)));
+code { CDR;                      # Ignore the parameter
+       DUP;                      # Duplicate the storage
+       CAR;                      # Get the timestamp
+       NOW;                      # Push the current timestamp
+       CMPLT;                    # Compare to the current time
+       IF {FAIL} {};             # Fail if it is too soon
+       DUP;                      # Duplicate the storage value
+       # this must be on the bottom of the stack for us to call transfer tokens
+       CDR;                      # Ignore the timestamp, focussing in on the tranfser data
+       DUP;                      # Duplicate the transfer information
+       CAR;                      # Get the amount of the transfer on top of the stack
+       DIP{CDR};                 # Put the contract underneath it
+       UNIT;                     # Put the contract's argument type on top of the stack
+       TRANSFER_TOKENS;          # Emit the transfer
+       NIL operation; SWAP; CONS;# Make a singleton list of internal operations
+       PAIR}                     # Pair up to meet the calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/originator.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/originator.tz
new file mode 100644
index 000000000..c454e230d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/originator.tz
@@ -0,0 +1,16 @@
+parameter nat ;
+storage (list address) ;
+code
+  { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ;
+    DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ;
+    LOOP
+      { PUSH mutez 5000000 ;
+        PUSH bool True ; # delegatable
+        NONE key_hash ; # delegate
+        PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
+        CREATE_ACCOUNT ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
+        PUSH nat 1 ; SWAP ; SUB ; ABS ;
+        DUP ; PUSH nat 0 ; CMPNEQ } ;
+    DROP ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/parameterized_multisig.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/parameterized_multisig.tz
new file mode 100644
index 000000000..17d301b78
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/parameterized_multisig.tz
@@ -0,0 +1,24 @@
+storage (pair bool (pair (map nat (pair bool bool)) (pair key key)));
+parameter (or nat (pair signature nat));
+code { DUP; CAR; DIP{CDDR};       # Stack rangling
+       IF_LEFT { DIP{DUP; CAR}; GET; # Get the value stored for that index
+                 IF_NONE { PUSH bool False} # If not referenced, reject
+                         { DUP; CAR; DIP{CDR}; AND};
+                 PAIR}
+               { DUP; CAR; DIP{CDR; DUP; PACK ; BLAKE2B}; PAIR; SWAP; # Create the signature pair
+                 DIP{ DIP{DUP; CDR; DIP{CAR}; DUP};
+                      SWAP; CAR; DIP{DUP; UNPAIR}; CHECK_SIGNATURE }; # Check the first signature
+                 SWAP;
+                 # If the signature typechecked, get and update the first element of the pair
+                 IF { DIP{DROP; SWAP; DUP}; DUP;
+                      DIP{ GET; IF_NONE{PUSH (pair bool bool) (Pair False False)} {};
+                           CDR; PUSH bool True; PAIR; SOME }}
+                    # Check the second signature
+                    { DIP{DIP{DUP; CDR}; SWAP; DIP {UNPAIR}; CHECK_SIGNATURE}; SWAP;
+                      IF { DUP; DIP{DIP{SWAP; DUP}; GET}; SWAP;
+                           IF_NONE {PUSH (pair bool bool) (Pair False False)} {};
+                           CAR; PUSH bool True; SWAP; PAIR; SOME; SWAP}
+                         {FAIL}};
+                 # Update the stored value and finish off
+                 UPDATE; PAIR; PUSH bool False; PAIR};
+       NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/replay.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/replay.tz
new file mode 100644
index 000000000..d00e368d9
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/replay.tz
@@ -0,0 +1,6 @@
+parameter unit ;
+storage unit ;
+code { CDR ; NIL operation ;
+       SELF ; PUSH mutez 0 ; UNIT ; TRANSFER_TOKENS ;
+       DUP ; DIP { CONS } ; CONS ;
+       PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reservoir.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reservoir.tz
new file mode 100644
index 000000000..4e693c9ba
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reservoir.tz
@@ -0,0 +1,23 @@
+parameter unit ;
+storage
+  (pair
+     (pair (timestamp %T) (mutez %N))
+     (pair (contract %A unit) (contract %B unit))) ;
+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 } }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reveal_signed_preimage.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reveal_signed_preimage.tz
new file mode 100644
index 000000000..520707c60
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/reveal_signed_preimage.tz
@@ -0,0 +1,7 @@
+parameter (pair bytes signature) ;
+storage (pair bytes key) ;
+code { DUP ; UNPAIR ; CAR ; SHA256 ; DIP { CAR } ; ASSERT_CMPEQ ;
+       DUP ; UNPAIR ; SWAP ; DIP { UNPAIR ; SWAP } ; CDR ; CHECK_SIGNATURE ; ASSERT ;
+       CDR ; DUP ; CDR ; HASH_KEY ; IMPLICIT_ACCOUNT ;
+       BALANCE ; UNIT ; TRANSFER_TOKENS ;
+       NIL operation ; SWAP ; CONS ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/scrutable_reservoir.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/scrutable_reservoir.tz
new file mode 100644
index 000000000..9e30a1a72
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/scrutable_reservoir.tz
@@ -0,0 +1,62 @@
+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 } } }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/vote_for_delegate.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/vote_for_delegate.tz
new file mode 100644
index 000000000..1155c073f
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/vote_for_delegate.tz
@@ -0,0 +1,30 @@
+parameter (option key_hash) ;
+storage (pair
+           (pair %mgr1 (address %addr) (option %key key_hash))
+           (pair %mgr2 (address %addr) (option %key key_hash))) ;
+code { # Update the storage
+       DUP ; CDAAR %addr @%; SENDER ; PAIR %@ %@; UNPAIR;
+       IFCMPEQ
+         { UNPAIR ; SWAP ; SET_CADR %key @changed_mgr1_key }
+         { DUP ; CDDAR ; SENDER ;
+           IFCMPEQ
+             { UNPAIR ; SWAP ; SET_CDDR %key }
+             { FAIL } } ;
+       # Now compare the proposals
+       DUP ; CADR ;
+       DIP { DUP ; CDDR } ;
+       IF_NONE
+         { IF_NONE
+             { NONE key_hash ;
+               SET_DELEGATE ; NIL operation ; SWAP ; CONS }
+             { DROP ; NIL operation } }
+         { SWAP ;
+           IF_SOME
+             { DIP { DUP } ;
+               IFCMPEQ
+                 { SOME ;
+                   SET_DELEGATE ; NIL operation ; SWAP ; CONS }
+                 { DROP ;
+                   NIL operation }}
+             { DROP ; NIL operation }} ;
+       PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/weather_insurance.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/weather_insurance.tz
new file mode 100644
index 000000000..858fe918f
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/weather_insurance.tz
@@ -0,0 +1,18 @@
+parameter (pair (signature %signed_weather_data) (nat :rain %actual_level));
+# (pair (under_key over_key) (pair weather_service_key (pair rain_level days_in_future)))
+storage (pair (pair (contract %under_key unit)
+                    (contract %over_key unit))
+              (pair (nat :rain %rain_level) (key %weather_service_key)));
+code { DUP; DUP;
+       CAR; MAP_CDR{PACK ; BLAKE2B};
+       SWAP; CDDDR %weather_service_key;
+       DIP {UNPAIR} ; CHECK_SIGNATURE @sigok; # Check if the data has been correctly signed
+       ASSERT; # If signature is not correct, end the execution
+       DUP; DUP; DUP; DIIIP{CDR %storage}; # Place storage type on bottom of stack
+       DIIP{CDAR};                # Place contracts below numbers
+       DIP{CADR %actual_level};   # Get actual rain
+       CDDAR %rain_level;         # Get rain threshold
+       CMPLT; IF {CAR %under_key} {CDR %over_key};     # Select contract to receive tokens
+       BALANCE; UNIT ; TRANSFER_TOKENS @trans.op; # Setup and execute transfer
+       NIL operation ; SWAP ; CONS ;
+       PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat.tz
new file mode 100644
index 000000000..254f4d825
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat.tz
@@ -0,0 +1,46 @@
+parameter (bytes);
+storage (unit);
+code {
+       # Extract parameter from initial stack.
+       CAR @preimage;
+       DIP {
+             # Push contract constants to the stack.
+             #
+             # There's a temptation to use @storage to parametrize
+             # a contract but, in general, there's no reason to encumber
+             # @storage with immutable values.
+             PUSH @from (contract unit) "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"; #changeme
+             PUSH @to   (contract unit) "tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN"; #changeme
+             PUSH @target_hash bytes 0x123456; #changeme
+             PUSH @deadline timestamp "2018-08-08 00:00:00Z"; #changeme
+           };
+       # Test if the deadline has passed.
+       SWAP; NOW;
+       IFCMPLT
+         # In case the deadline did pass:
+         {
+           # Ignore parameter, just transfer xtz balance back to @from
+           DROP; DROP; DROP; BALANCE; UNIT; TRANSFER_TOKENS;
+         }
+         # In case the deadline hasn't passed yet:
+         {
+           # Test length of parameter.
+           DUP; SIZE;
+           PUSH @max_length nat 32;
+           IFCMPLT
+             { PUSH string "preimage too long"; FAILWITH; }
+             {
+               # Test if it's a preimage of @target_hash.
+               SHA256 @candidate_hash;
+               IFCMPNEQ
+                 { PUSH string "invalid preimage"; FAILWITH; }
+                 {
+                   # Transfer xtz balance to @to.
+                   BALANCE; UNIT; TRANSFER_TOKENS; DIP { DROP };
+                 };
+             };
+         };
+       # Transform single operation into a list.
+       NIL operation; SWAP; CONS;
+       UNIT; SWAP; PAIR
+     }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat_dapp.tz b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat_dapp.tz
new file mode 100644
index 000000000..86ca62c5a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/mini_scenarios/xcat_dapp.tz
@@ -0,0 +1,79 @@
+parameter (or
+             # First possible action is funding, to create an xcat
+             (pair %fund
+                (address %dest)
+                (pair %settings (bytes %target_hash) (timestamp %deadline)))
+
+             # Other possible action is to claim the tokens (or ask a refund)
+             (or %claim_refund
+                (bytes %preimage_claim)
+                (bytes %refund_hash)));
+
+storage (pair
+           (big_map
+              bytes # The target hash is used as a key
+              (pair
+                 # We store in %from the person who funded the xcat
+                 (pair %recipients (address %from) (address %dest))
+                 (pair %settings (mutez %amount) (timestamp %deadline)))
+           )
+           unit);
+
+code {
+       NIL @operations operation; SWAP;
+       UNPAPAIR @% @% @%; DIP {DUP};
+       IF_LEFT  # Let's fund a new xcat!
+         {
+           # Unpack the parameters
+           UNPAIR @% @%;
+           # Assert that the destination address is of type unit.
+           # This costs a bit more gas but limits foot-shooting.
+           DUP; CONTRACT @dest unit; ASSERT_SOME; DROP;
+           SWAP; UNPAIR @% @%;
+           DIP
+             {
+               AMOUNT @amount;
+               SENDER;
+               DUP; CONTRACT @from unit; ASSERT_SOME; DROP;
+               DIP { PAIR; SWAP; }; PAIR; PAIR; SOME @xcat;
+               SWAP;
+             };
+           DUP; DIP { MEM; NOT; ASSERT }; # Assert that this target hash isn't already in the map
+           UPDATE; PAIR @new_storage; SWAP; PAIR;
+         }
+         {
+           # Let's process a claim or a refund
+           IF_LEFT
+             { # It's a claim!
+               DUP; SIZE; PUSH nat 32; ASSERT_CMPGE;
+               SHA256 @hash; DUP; DIP {SWAP};
+               DIIP {
+                      GET; ASSERT_SOME;
+                      # Check deadline and prepare transaction.
+                      DUP; CADR @%; CONTRACT @dest unit; ASSERT_SOME;
+                      SWAP; CDR @%;
+                      UNPAIR @% @%; SWAP;
+                      # The deadline must not have passed
+                      NOW; ASSERT_CMPLT;
+                      # prepare transaction
+                      UNIT; TRANSFER_TOKENS;
+                    };
+             }
+             { # It's a refund!
+               DUP;
+               DIP
+                 {
+                   GET; ASSERT_SOME;
+                   DUP; CAAR @%; CONTRACT @from unit; ASSERT_SOME; SWAP; CDR;
+                   UNPAIR @% @%; SWAP;
+                   # The deadline must not HAVE passed
+                   NOW; ASSERT_CMPGE;
+                   UNIT; TRANSFER_TOKENS; SWAP;
+                 };
+             };
+           # Clear the big map
+           NONE @none (pair (pair address address) (pair mutez timestamp));
+           SWAP; UPDATE @cleared_map; SWAP; DIP { PAIR; SWAP };
+           CONS; PAIR;
+         }
+     }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_delta_timestamp.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_delta_timestamp.tz
new file mode 100644
index 000000000..b9ed86901
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_delta_timestamp.tz
@@ -0,0 +1,3 @@
+parameter (pair int timestamp);
+storage (option timestamp);
+code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_timestamp_delta.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_timestamp_delta.tz
new file mode 100644
index 000000000..766bf9f91
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/add_timestamp_delta.tz
@@ -0,0 +1,3 @@
+parameter (pair timestamp int);
+storage (option timestamp);
+code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/and.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/and.tz
new file mode 100644
index 000000000..48e346ca0
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/and.tz
@@ -0,0 +1,3 @@
+parameter (pair :param (bool %first) (bool %second));
+storage (option bool);
+code { CAR ; UNPAIR; AND @and; SOME @res; NIL @noop operation; PAIR; UNPAIR @x @y; PAIR %a %b };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/balance.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/balance.tz
new file mode 100644
index 000000000..0a9bfc614
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/balance.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage mutez;
+code {DROP; BALANCE; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/check_signature.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/check_signature.tz
new file mode 100644
index 000000000..1d0569cb8
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/check_signature.tz
@@ -0,0 +1,8 @@
+parameter key;
+storage (pair signature string);
+code { DUP; DUP;
+       DIP{ CDR; DUP; CAR;
+            DIP{CDR; PACK ; BLAKE2B}; PAIR};
+       CAR; DIP {UNPAIR}; CHECK_SIGNATURE;
+       IF {} {FAIL} ;
+       CDR; NIL operation ; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_hello.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_hello.tz
new file mode 100644
index 000000000..e290b90fb
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_hello.tz
@@ -0,0 +1,4 @@
+parameter (list string);
+storage (list string);
+code{ CAR;
+      MAP { PUSH @hello string "Hello "; CONCAT }; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_list.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_list.tz
new file mode 100644
index 000000000..b570027ff
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/concat_list.tz
@@ -0,0 +1,5 @@
+parameter (list string);
+storage string;
+code {CAR; PUSH string ""; SWAP;
+      ITER {SWAP; DIP{NIL string; SWAP; CONS}; CONS; CONCAT};
+      NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/contains_all.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/contains_all.tz
new file mode 100644
index 000000000..fe4160f87
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/contains_all.tz
@@ -0,0 +1,7 @@
+parameter (pair (list string) (list string));
+storage (option bool);
+code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP;
+      ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE};
+      PUSH bool True; SWAP; PAIR; SWAP;
+      ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR};
+      CDR; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/diff_timestamps.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/diff_timestamps.tz
new file mode 100644
index 000000000..f1991a37a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/diff_timestamps.tz
@@ -0,0 +1,3 @@
+parameter (pair timestamp timestamp);
+storage int;
+code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/empty_map.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/empty_map.tz
new file mode 100644
index 000000000..9023fe847
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/empty_map.tz
@@ -0,0 +1,6 @@
+storage (map string string);
+parameter unit;
+code {DROP;
+      EMPTY_MAP string string;
+      PUSH string "world"; SOME; PUSH string "hello"; UPDATE;
+      NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/exec_concat.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/exec_concat.tz
new file mode 100644
index 000000000..0265f1557
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/exec_concat.tz
@@ -0,0 +1,7 @@
+parameter string;
+storage string;
+code {CAR;
+      LAMBDA string string
+             {PUSH string "_abc"; NIL string ;
+              SWAP ; CONS ; SWAP ; CONS ; CONCAT};
+      SWAP; EXEC; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/first.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/first.tz
new file mode 100644
index 000000000..6e47b4c00
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/first.tz
@@ -0,0 +1,3 @@
+parameter (list nat);
+storage nat;
+code{CAR; IF_CONS {DIP{DROP}} {FAIL}; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/get_map_value.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/get_map_value.tz
new file mode 100644
index 000000000..f46639649
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/get_map_value.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage (pair (option string) (map string string));
+code {DUP; CAR; DIP{CDDR; DUP}; GET; PAIR; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_consistency_checker.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_consistency_checker.tz
new file mode 100644
index 000000000..fb98a39da
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_consistency_checker.tz
@@ -0,0 +1,3 @@
+parameter (pair mutez (pair timestamp int)) ;
+storage bytes ;
+code { CAR ; PACK ; BLAKE2B ; NIL operation ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_key.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_key.tz
new file mode 100644
index 000000000..6c7f78b4a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_key.tz
@@ -0,0 +1,3 @@
+parameter key;
+storage (option key_hash);
+code {CAR; HASH_KEY; SOME ;NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_string.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_string.tz
new file mode 100644
index 000000000..b0b8ddea6
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/hash_string.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage bytes;
+code {CAR; PACK ; BLAKE2B; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if.tz
new file mode 100644
index 000000000..4bc0e353d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if.tz
@@ -0,0 +1,3 @@
+parameter bool;
+storage (option bool);
+code {CAR; IF {PUSH bool True} {PUSH bool False}; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if_some.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if_some.tz
new file mode 100644
index 000000000..5c3138b22
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/if_some.tz
@@ -0,0 +1,3 @@
+parameter (option string);
+storage string;
+code { CAR; IF_SOME {} {PUSH string ""}; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/left_right.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/left_right.tz
new file mode 100644
index 000000000..d5650c034
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/left_right.tz
@@ -0,0 +1,3 @@
+parameter (or bool string);
+storage (or string bool);
+code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat.tz
new file mode 100644
index 000000000..d7bfb7d13
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat.tz
@@ -0,0 +1,3 @@
+parameter (list string);
+storage string;
+code { UNPAIR ; SWAP ; CONS ; CONCAT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat_bytes.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat_bytes.tz
new file mode 100644
index 000000000..0fc8e1620
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_concat_bytes.tz
@@ -0,0 +1,3 @@
+parameter (list bytes);
+storage bytes;
+code { UNPAIR ; SWAP ; CONS ; CONCAT; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id.tz
new file mode 100644
index 000000000..6cd3693a1
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id.tz
@@ -0,0 +1,3 @@
+parameter (list string);
+storage (list string);
+code {CAR; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id_map.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id_map.tz
new file mode 100644
index 000000000..38b4493e8
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_id_map.tz
@@ -0,0 +1,3 @@
+parameter (list string);
+storage (list string);
+code {CAR; MAP {}; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_iter.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_iter.tz
new file mode 100644
index 000000000..df904d882
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_iter.tz
@@ -0,0 +1,5 @@
+parameter (list int);
+storage int;
+code { CAR; PUSH int 1; SWAP;
+       ITER { MUL };
+       NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_map_block.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_map_block.tz
new file mode 100644
index 000000000..b5202dd9b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/list_map_block.tz
@@ -0,0 +1,5 @@
+parameter (list int);
+storage (list int);
+code { CAR; PUSH int 0; SWAP;
+       MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}};
+       NIL operation; PAIR; DIP{DROP}}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/loop_left.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/loop_left.tz
new file mode 100644
index 000000000..64bcc76c8
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/loop_left.tz
@@ -0,0 +1,7 @@
+parameter (list string);
+storage (list string);
+code { CAR; NIL string; SWAP; PAIR; LEFT (list string);
+       LOOP_LEFT { DUP; CAR; DIP{CDR};
+                   IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) }
+                           { RIGHT (pair (list string) (list string)) }; };
+       NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_car.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_car.tz
new file mode 100644
index 000000000..b763590ec
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_car.tz
@@ -0,0 +1,5 @@
+parameter bool;
+storage (pair (bool %b) (nat %n));
+code { DUP; CAR; DIP{CDR}; SWAP;
+       MAP_CAR @new_storage %b { AND };
+       NIL operation; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_id.tz
new file mode 100644
index 000000000..ff0a3bbbf
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_id.tz
@@ -0,0 +1,3 @@
+parameter (map nat nat);
+storage (map nat nat);
+code { CAR ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_iter.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_iter.tz
new file mode 100644
index 000000000..3ab5c35c7
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_iter.tz
@@ -0,0 +1,7 @@
+parameter (map (int :k) (int :e));
+storage (pair (int :k) (int :e));
+code { CAR; PUSH @acc_e (int :e) 0; PUSH @acc_k (int :k) 0; PAIR % %r; SWAP;
+       ITER
+         { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr
+           DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR % %r };
+       NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_size.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_size.tz
new file mode 100644
index 000000000..4bd6417e6
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/map_size.tz
@@ -0,0 +1,3 @@
+parameter (map string nat);
+storage nat;
+code {CAR; SIZE; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/noop.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/noop.tz
new file mode 100644
index 000000000..bd19da15c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/noop.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage unit;
+code {CDR; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/not.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/not.tz
new file mode 100644
index 000000000..f89394072
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/not.tz
@@ -0,0 +1,3 @@
+parameter bool;
+storage (option bool);
+code {CAR; NOT; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/or.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/or.tz
new file mode 100644
index 000000000..89d533c44
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/or.tz
@@ -0,0 +1,3 @@
+parameter (pair bool bool);
+storage (option bool);
+code {CAR; DUP; CAR; SWAP; CDR; OR; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/packunpack.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/packunpack.tz
new file mode 100644
index 000000000..ad313fa8a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/packunpack.tz
@@ -0,0 +1,6 @@
+parameter (pair (pair (pair string (list int)) (set nat)) bytes) ;
+storage unit ;
+code { CAR ; UNPAIR ; DIP { DUP } ;
+       PACK ; ASSERT_CMPEQ ;
+       UNPACK (pair (pair string (list int)) (set nat)) ; ASSERT_SOME ; DROP ;
+       UNIT ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/pair_id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/pair_id.tz
new file mode 100644
index 000000000..3bfedf2d8
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/pair_id.tz
@@ -0,0 +1,3 @@
+parameter (pair bool bool);
+storage (option (pair bool bool));
+code {CAR; SOME; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/ret_int.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/ret_int.tz
new file mode 100644
index 000000000..720a99568
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/ret_int.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage (option nat);
+code {DROP; PUSH nat 300; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse.tz
new file mode 100644
index 000000000..5a851f3e2
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse.tz
@@ -0,0 +1,5 @@
+parameter (list string);
+storage (list string);
+code { CAR; NIL string; SWAP;
+       ITER {CONS};
+       NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse_loop.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse_loop.tz
new file mode 100644
index 000000000..d8117135c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/reverse_loop.tz
@@ -0,0 +1,5 @@
+parameter (list string);
+storage (list string);
+code { CAR; NIL string; SWAP; PUSH bool True;
+       LOOP { IF_CONS {SWAP; DIP{CONS}; PUSH bool True} {NIL string; PUSH bool False}};
+       DROP; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/self.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/self.tz
new file mode 100644
index 000000000..728cd5f1d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/self.tz
@@ -0,0 +1,3 @@
+parameter unit ;
+storage (contract unit) ;
+code { DROP ; SELF ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_car.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_car.tz
new file mode 100644
index 000000000..460b33856
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_car.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage (pair (string %s) (nat %n));
+code { DUP; CDR; DIP{CAR}; SET_CAR %s; NIL operation; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_cdr.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_cdr.tz
new file mode 100644
index 000000000..d725756bb
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_cdr.tz
@@ -0,0 +1,3 @@
+parameter nat;
+storage (pair (string %s) (nat %n));
+code { DUP; CDR; DIP{CAR}; SET_CDR %n; NIL operation; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_id.tz
new file mode 100644
index 000000000..ede301b0e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_id.tz
@@ -0,0 +1,3 @@
+parameter (set string);
+storage (set string);
+code { CAR ; NIL operation ; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_iter.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_iter.tz
new file mode 100644
index 000000000..55d8ae34a
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_iter.tz
@@ -0,0 +1,3 @@
+parameter (set int);
+storage int;
+code { CAR; PUSH int 0; SWAP; ITER { ADD }; NIL operation; PAIR }
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_member.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_member.tz
new file mode 100644
index 000000000..ae97cce14
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_member.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage (pair (set string) (option bool));
+code {DUP; DUP; CAR; DIP{CDAR}; MEM; SOME; DIP {CDAR}; SWAP; PAIR ; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_size.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_size.tz
new file mode 100644
index 000000000..aa055cb02
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/set_size.tz
@@ -0,0 +1,3 @@
+parameter (set int);
+storage nat;
+code {CAR; SIZE; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/slices.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/slices.tz
new file mode 100644
index 000000000..fa7682726
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/slices.tz
@@ -0,0 +1,11 @@
+parameter (pair bytes signature) ;
+storage key ;
+code { DUP ;
+       CAAR ; DUP ; SIZE ; PUSH nat 128 ; SWAP ; SUB ; ISNAT ; IF_SOME {} { FAIL } ;
+       PUSH nat 128 ; SLICE @payload ; ASSERT_SOME ;
+       DUP ; DIP { DIP { DUP ; CAAR ; PUSH nat 32 ; PUSH nat 0 ; SLICE ; ASSERT_SOME } ; SHA256 ; ASSERT_CMPEQ } ;
+       DUP ; DIP { DIP { DUP ; CAAR ; PUSH nat 32 ; PUSH nat 32 ; SLICE ; ASSERT_SOME } ; BLAKE2B ; ASSERT_CMPEQ } ;
+       DUP ; DIP { DIP { DUP ; CAAR ; PUSH nat 64 ; PUSH nat 64 ; SLICE ; ASSERT_SOME } ; SHA512 ; ASSERT_CMPEQ } ;
+       DIP { DUP ; CDR ; DIP { DUP ; CADR }} ; SWAP ; DIP { SWAP } ; CHECK_SIGNATURE ; ASSERT ;
+       CDR ; DUP ; HASH_KEY ; IMPLICIT_ACCOUNT ; BALANCE ; UNIT ; TRANSFER_TOKENS ;
+       NIL operation ; SWAP ; CONS ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_bytes.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_bytes.tz
new file mode 100644
index 000000000..f3b623b3c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_bytes.tz
@@ -0,0 +1,16 @@
+parameter bytes ;
+storage (list bytes) ;
+code { UNPAIR ;
+       DIP { NIL bytes ; SWAP ; ITER { CONS } } ;
+       DUP ; SIZE ; PUSH nat 0 ; CMPNEQ ;
+       DIP { PUSH @index nat 0 } ;
+       LOOP
+         { PAIR ; DUP ;
+           DIP { UNPAIR ; DIP { PUSH nat 1 } ; SLICE ; ASSERT_SOME ; CONS @storage } ;
+           UNPAIR ;
+           PUSH nat 1 ; ADD @index ;
+           DUP ; DIP { DIP { DUP } ; SWAP ; SIZE ; CMPNEQ } ; SWAP ;
+         } ;
+       DROP ; DROP ;
+       NIL bytes ; SWAP ; ITER { CONS } ;
+       NIL operation ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_string.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_string.tz
new file mode 100644
index 000000000..909ba6047
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/split_string.tz
@@ -0,0 +1,16 @@
+parameter string ;
+storage (list string) ;
+code { UNPAIR ;
+       DIP { NIL string ; SWAP ; ITER { CONS } } ;
+       DUP ; SIZE ; PUSH nat 0 ; CMPNEQ ;
+       DIP { PUSH @index nat 0 } ;
+       LOOP
+         { PAIR ; DUP ;
+           DIP { UNPAIR ; DIP { PUSH nat 1 } ; SLICE ; ASSERT_SOME ; CONS @storage } ;
+           UNPAIR ;
+           PUSH nat 1 ; ADD @index ;
+           DUP ; DIP { DIP { DUP } ; SWAP ; SIZE ; CMPNEQ } ; SWAP ;
+         } ;
+       DROP ; DROP ;
+       NIL string ; SWAP ; ITER { CONS } ;
+       NIL operation ; PAIR }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/steps_to_quota.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/steps_to_quota.tz
new file mode 100644
index 000000000..4981864be
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/steps_to_quota.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage nat;
+code {DROP; STEPS_TO_QUOTA; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_input.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_input.tz
new file mode 100644
index 000000000..4eee565ca
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_input.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage string;
+code {CAR; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_now.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_now.tz
new file mode 100644
index 000000000..1a868ac06
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/store_now.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage timestamp;
+code {DROP; NOW; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/str_id.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/str_id.tz
new file mode 100644
index 000000000..f9e0710c3
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/str_id.tz
@@ -0,0 +1,3 @@
+parameter string;
+storage (option string);
+code { CAR ; SOME ; NIL operation ; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/sub_timestamp_delta.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/sub_timestamp_delta.tz
new file mode 100644
index 000000000..f154e9524
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/sub_timestamp_delta.tz
@@ -0,0 +1,3 @@
+parameter (pair timestamp int);
+storage timestamp;
+code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR}
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/subset.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/subset.tz
new file mode 100644
index 000000000..a16ef1695
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/subset.tz
@@ -0,0 +1,12 @@
+parameter (pair (set string) (set string));
+storage bool;
+code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists
+       PUSH bool True;
+       PAIR; SWAP;              # Setup accumulator
+       ITER { DIP{ DUP; DUP; CDR;
+                   DIP{CAR; DIP{CDR}}};
+              MEM;            # Check membership
+              AND;            # Combine accumulator and input
+              PAIR};
+       CAR;                     # Get the accumulator value
+       NIL operation; PAIR}     # Calling convention
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/tez_add_sub.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/tez_add_sub.tz
new file mode 100644
index 000000000..39eba1d16
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/tez_add_sub.tz
@@ -0,0 +1,5 @@
+parameter (pair mutez mutez);
+storage (option (pair mutez mutez));
+code {CAR; DUP; DUP; CAR; DIP{CDR}; ADD;
+      DIP{DUP; CAR; DIP{CDR}; SUB};
+      PAIR; SOME; NIL operation; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_amount.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_amount.tz
new file mode 100644
index 000000000..973c64f04
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_amount.tz
@@ -0,0 +1,3 @@
+parameter unit;
+storage mutez;
+code { DROP; AMOUNT; NIL operation; PAIR };
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_tokens.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_tokens.tz
new file mode 100644
index 000000000..599b4dae1
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/transfer_tokens.tz
@@ -0,0 +1,5 @@
+parameter (contract unit);
+storage unit;
+code { CAR; DIP{UNIT}; PUSH mutez 100000000; UNIT;
+       TRANSFER_TOKENS;
+       NIL operation; SWAP; CONS; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/xor.tz b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/xor.tz
new file mode 100644
index 000000000..ab8dcf57d
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/contracts/opcodes/xor.tz
@@ -0,0 +1,3 @@
+parameter (pair bool bool);
+storage (option bool);
+code {CAR; DUP; CAR; DIP{CDR}; XOR; SOME; NIL operation ; PAIR};
diff --git a/vendors/tezos-modded/src/bin_client/test/demo/TEZOS_PROTOCOL b/vendors/tezos-modded/src/bin_client/test/demo/TEZOS_PROTOCOL
new file mode 100644
index 000000000..9d31dc91c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/demo/TEZOS_PROTOCOL
@@ -0,0 +1,3 @@
+{
+    "modules": ["Main"]
+}
diff --git a/vendors/tezos-modded/src/bin_client/test/demo/main.ml b/vendors/tezos-modded/src/bin_client/test/demo/main.ml
new file mode 100644
index 000000000..f8a11fd7f
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/demo/main.ml
@@ -0,0 +1,150 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type block_header_data = MBytes.t
+type block_header = {
+  shell : Block_header.shell_header ;
+  protocol_data : block_header_data ;
+}
+let block_header_data_encoding =
+  Data_encoding.(obj1 (req "random_data" Variable.bytes))
+
+type block_header_metadata = unit
+let block_header_metadata_encoding = Data_encoding.unit
+
+type operation_data = unit
+let operation_data_encoding = Data_encoding.unit
+
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
+type operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+let max_block_length = 42
+let max_operation_data_length = 42
+let validation_passes = []
+let acceptable_passes _op = []
+
+let compare_operations _ _ = 0
+
+type validation_state = {
+  context : Context.t ;
+  fitness : Int64.t ;
+}
+
+let current_context { context } =
+  return context
+
+module Fitness = struct
+
+  type error += Invalid_fitness
+  type error += Invalid_fitness2
+
+  let int64_to_bytes i =
+    let b = MBytes.create 8 in
+    MBytes.set_int64 b 0 i;
+    b
+
+  let int64_of_bytes b =
+    if Compare.Int.(MBytes.length b <> 8) then
+      fail Invalid_fitness2
+    else
+      return (MBytes.get_int64 b 0)
+
+  let from_int64 fitness =
+    [ int64_to_bytes fitness ]
+
+  let to_int64 = function
+    | [ fitness ] -> int64_of_bytes fitness
+    | [] -> return 0L
+    | _ -> fail Invalid_fitness
+
+  let get { fitness } = fitness
+
+end
+
+let begin_application
+    ~chain_id:_
+    ~predecessor_context:context
+    ~predecessor_timestamp:_
+    ~predecessor_fitness:_
+    (raw_block : block_header) =
+  Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness ->
+  return { context ; fitness }
+
+let begin_partial_application
+    ~chain_id
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    raw_block =
+  begin_application
+    ~chain_id
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    raw_block
+
+let begin_construction
+    ~chain_id:_
+    ~predecessor_context:context
+    ~predecessor_timestamp:_
+    ~predecessor_level:_
+    ~predecessor_fitness:pred_fitness
+    ~predecessor:_
+    ~timestamp:_
+    ?protocol_data:_ () =
+  Fitness.to_int64 pred_fitness >>=? fun pred_fitness ->
+  let fitness = Int64.succ pred_fitness in
+  return { context ; fitness }
+
+let apply_operation ctxt _ =
+  return (ctxt, ())
+
+let finalize_block ctxt =
+  let fitness = Fitness.get ctxt in
+  let message = Some (Format.asprintf "fitness <- %Ld" fitness) in
+  let fitness = Fitness.from_int64 fitness in
+  return ({ Updater.message ; context = ctxt.context ; fitness ;
+            max_operations_ttl = 0 ; last_allowed_fork_level = 0l ;
+          }, ())
+
+let rpc_services = RPC_directory.empty
+
+let init ctxt block_header =
+  let fitness = block_header.Block_header.fitness in
+  let message = None in
+  return { Updater.message ; context = ctxt ; fitness ;
+           max_operations_ttl = 0 ; last_allowed_fork_level = 0l ;
+         }
diff --git a/vendors/tezos-modded/src/bin_client/test/demo/main.mli b/vendors/tezos-modded/src/bin_client/test/demo/main.mli
new file mode 100644
index 000000000..eec87d090
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/demo/main.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Updater.PROTOCOL
diff --git a/vendors/tezos-modded/src/bin_client/test/dune b/vendors/tezos-modded/src/bin_client/test/dune
new file mode 100644
index 000000000..54b7b12b1
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/dune
@@ -0,0 +1,170 @@
+(alias
+ (name runtest_basic.sh)
+ (deps sandbox.json
+       protocol_parameters.json
+       king_commitment.json
+       queen_commitment.json
+       test_lib.inc.sh
+       (glob_files contracts/opcodes/*)
+       (glob_files contracts/mini_scenarios/*))
+  (locks /tcp-port/18731
+         /tcp-port/19731)
+  (action
+   (run bash %{dep:test_basic.sh}
+             %{bin:tezos-sandboxed-node.sh}
+             %{bin:tezos-node}
+             %{bin:tezos-init-sandboxed-client.sh}
+             %{bin:tezos-client}
+             %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_contracts.sh)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files contracts/attic/*))
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (action
+  (run bash %{dep:test_contracts.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_contracts_opcode.sh)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files contracts/opcodes/*))
+  (locks /tcp-port/18731
+         /tcp-port/19731)
+  (action
+  (run bash %{dep:test_contracts_opcode.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_contracts_macros.sh)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files contracts/macros/*))
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (action
+ (run bash %{dep:test_contracts_macros.sh}
+           %{bin:tezos-sandboxed-node.sh}
+           %{bin:tezos-node}
+           %{bin:tezos-init-sandboxed-client.sh}
+           %{bin:tezos-client}
+           %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_contracts_mini_scenarios.sh)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files contracts/mini_scenarios/*))
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (action
+ (run bash %{dep:test_contracts_mini_scenarios.sh}
+           %{bin:tezos-sandboxed-node.sh}
+           %{bin:tezos-node}
+           %{bin:tezos-init-sandboxed-client.sh}
+           %{bin:tezos-client}
+           %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_multinode.sh)
+ (deps sandbox.json
+       test_lib.inc.sh)
+ (locks  /tcp-port/18731 /tcp-port/18732 /tcp-port/18733 /tcp-port/18734
+         /tcp-port/18735 /tcp-port/18736 /tcp-port/18737 /tcp-port/18738
+         /tcp-port/19731 /tcp-port/19732 /tcp-port/19733 /tcp-port/19734
+         /tcp-port/19735 /tcp-port/19736 /tcp-port/19737 /tcp-port/19738)
+ (action
+  (run bash %{dep:test_multinode.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_injection.sh)
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (deps sandbox.json
+       protocol_parameters.json
+       test_lib.inc.sh
+       (glob_files demo/*))
+ (action
+  (run bash %{dep:test_injection.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client}
+            %{bin:tezos-protocol-compiler})))
+
+(alias
+ (name runtest_tls.sh)
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files demo/*))
+ (action
+  (run bash %{dep:test_tls.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_cors.sh)
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (deps sandbox.json
+       test_lib.inc.sh
+       (glob_files demo/*))
+ (action
+  (run bash %{dep:test_cors.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest_voting.sh)
+ (locks /tcp-port/18731
+        /tcp-port/19731)
+ (deps sandbox.json
+       protocol_parameters.json
+       test_lib.inc.sh
+       (glob_files demo/*))
+ (action
+  (run bash %{dep:test_voting.sh}
+            %{bin:tezos-sandboxed-node.sh}
+            %{bin:tezos-node}
+            %{bin:tezos-init-sandboxed-client.sh}
+            %{bin:tezos-client}
+            %{bin:tezos-admin-client})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_basic.sh)
+       (alias runtest_contracts.sh)
+       (alias runtest_contracts_opcode.sh)
+       (alias runtest_contracts_macros.sh)
+       (alias runtest_contracts_mini_scenarios.sh)
+       (alias runtest_multinode.sh)
+       (alias runtest_injection.sh)
+       (alias runtest_tls.sh)
+       (alias runtest_cors.sh)
+       (alias runtest_voting.sh)))
diff --git a/vendors/tezos-modded/src/bin_client/test/king_commitment.json b/vendors/tezos-modded/src/bin_client/test/king_commitment.json
new file mode 100644
index 000000000..af963b3c6
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/king_commitment.json
@@ -0,0 +1,8 @@
+ {
+  "mnemonic": ["envelope", "hospital", "mind", "sunset", "cancel", "muscle", "leisure", "thumb", "wine", "market", "exit", "lucky", "style", "picnic", "success"],
+  "secret": "0f39ed0b656509c2ecec4771712d9cddefe2afac",
+  "amount": "23932454669343",
+  "pkh": "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF",
+  "password": "z0eZHQQGKt",
+  "email": "cjgfoqmk.wpxnvnup@tezos.example.org"
+}
diff --git a/vendors/tezos-modded/src/bin_client/test/protocol_parameters.json b/vendors/tezos-modded/src/bin_client/test/protocol_parameters.json
new file mode 100644
index 000000000..fb8c64e35
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/protocol_parameters.json
@@ -0,0 +1,27 @@
+{ "bootstrap_accounts":
+  [
+      [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", "4000000000000" ],
+      [ "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", "4000000000000" ],
+      [ "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", "4000000000000" ],
+      [ "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", "4000000000000" ],
+      [ "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n", "4000000000000" ]
+  ],
+  "commitments": [
+    [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
+    [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
+    [ "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428348" ],
+    [ "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ],
+    [ "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ],
+    [ "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ],
+    [ "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ],
+    [ "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ],
+    [ "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ],
+    [ "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ]
+  ],
+  "time_between_blocks" : [ "1", "0" ],
+  "blocks_per_cycle" : 128,
+  "blocks_per_roll_snapshot" : 32,
+  "blocks_per_voting_period" : 256,
+  "preserved_cycles" : 1,
+  "proof_of_work_threshold": "-1"
+}
diff --git a/vendors/tezos-modded/src/bin_client/test/queen_commitment.json b/vendors/tezos-modded/src/bin_client/test/queen_commitment.json
new file mode 100644
index 000000000..7928579d6
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/queen_commitment.json
@@ -0,0 +1,8 @@
+ {
+  "mnemonic": ["flag", "quote", "will", "valley", "mouse", "chat", "hold", "prosper", "silk", "tent", "cruel", "cause", "demise", "bottom", "practice"],
+  "activation_code": "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4",
+  "amount": "72954577464032",
+  "pkh": "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX",
+  "password": "MHErskWPE6",
+  "email": "oklmcktr.ztljnpzc@tezos.example.org"
+ }
diff --git a/vendors/tezos-modded/src/bin_client/test/sandbox.json b/vendors/tezos-modded/src/bin_client/test/sandbox.json
new file mode 100644
index 000000000..007ba123e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/sandbox.json
@@ -0,0 +1,4 @@
+{
+    "genesis_pubkey":
+      "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2"
+}
diff --git a/vendors/tezos-modded/src/bin_client/test/test_basic.sh b/vendors/tezos-modded/src/bin_client/test/test_basic.sh
new file mode 100755
index 000000000..eaf6342da
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_basic.sh
@@ -0,0 +1,102 @@
+#! /usr/bin/env bash
+
+set -e
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+sleep 2
+
+#tests for the rpc service raw_context
+$client rpc get '/chains/main/blocks/head/context/raw/bytes/non-existent' | assert 'No service found at this URL'
+$client rpc get '/chains/main/blocks/head/context/raw/bytes/delegates/?depth=3' | assert '{ "ed25519":
+    { "02": { "29": null }, "a9": { "ce": null }, "c5": { "5c": null },
+      "da": { "c9": null }, "e7": { "67": null } } }'
+$client rpc get '/chains/main/blocks/head/context/raw/bytes/non-existent?depth=-1' | assert 'Unexpected server answer'
+$client rpc get '/chains/main/blocks/head/context/raw/bytes/non-existent?depth=0' | assert 'No service found at this URL'
+
+bake
+
+key1=foo
+key2=bar
+key3=boo
+key4=king
+key5=queen
+# key6=p256
+
+$client gen keys $key1
+$client gen keys $key2 --sig secp256k1
+$client gen keys $key3 --sig ed25519
+# $client gen keys $key6 --sig p256
+
+$client list known addresses
+$client get balance for bootstrap1
+
+bake_after $client transfer 1,000 from bootstrap1 to $key1 --burn-cap 0.257
+bake_after $client transfer 2,000 from bootstrap1 to $key2 --burn-cap 0.257
+bake_after $client transfer 3,000 from bootstrap1 to $key3 --burn-cap 0.257
+# bake_after $client transfer 4,000 from bootstrap1 to $key6
+
+$client get balance for $key1 | assert "1000 ꜩ"
+$client get balance for $key2 | assert "2000 ꜩ"
+$client get balance for $key3 | assert "3000 ꜩ"
+
+bake_after $client transfer 1,000 from $key2 to $key1 --fee 0 --force-low-fee
+$client get balance for $key1 | assert "2000 ꜩ"
+$client get balance for $key2 | assert "1000 ꜩ"
+
+bake_after $client transfer 1,000 from $key1 to $key2 --fee 0.05
+$client get balance for $key1 | assert "999.95 ꜩ"
+$client get balance for $key2 | assert "2000 ꜩ"
+
+# Should fail
+# $client transfer 999.95 from $key2 to $key1
+
+bake
+
+$client remember script noop file:contracts/opcodes/noop.tz
+$client typecheck script file:contracts/opcodes/noop.tz
+bake_after $client originate contract noop \
+        for $key1 transferring 1,000 from bootstrap1 \
+        running file:contracts/opcodes/noop.tz --burn-cap 0.295
+
+bake_after $client transfer 10 from bootstrap1 to noop --arg "Unit"
+
+
+bake_after $client originate contract hardlimit \
+        for $key1 transferring 1,000 from bootstrap1 \
+        running file:contracts/mini_scenarios/hardlimit.tz --init "3" --burn-cap 0.341
+bake_after $client transfer 10 from bootstrap1 to hardlimit --arg "Unit"
+bake_after $client transfer 10 from bootstrap1 to hardlimit --arg "Unit"
+
+bake_after $client originate account free_account for $key1 \
+        transferring 1,000 from bootstrap1 --delegatable --burn-cap 0.257
+$client get delegate for free_account
+
+bake_after $client register key $key2 as delegate
+bake_after $client set delegate for free_account to $key2
+$client get delegate for free_account
+
+$client get balance for bootstrap5 | assert "4000000 ꜩ"
+bake_after $client transfer 400,000 from bootstrap5 to bootstrap1 --fee 0 --force-low-fee
+bake_after $client transfer 400,000 from bootstrap1 to bootstrap5 --fee 0 --force-low-fee
+$client get balance for bootstrap5 | assert "4000000 ꜩ"
+
+bake_after $client activate account $key4 with king_commitment.json
+bake_after $client activate account $key5 with queen_commitment.json
+
+$client get balance for $key4 | assert "23932454.669343 ꜩ"
+$client get balance for $key5 | assert "72954577.464032 ꜩ"
+
+bake_after $client transfer 10 from $key4 to $key5
+
+echo
+echo End of test
+echo
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_contracts.sh b/vendors/tezos-modded/src/bin_client/test/test_contracts.sh
new file mode 100755
index 000000000..28ce61827
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_contracts.sh
@@ -0,0 +1,87 @@
+#!/bin/bash
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+bake
+
+key1=foo
+key2=bar
+
+$client gen keys $key1
+$client gen keys $key2
+
+printf "\n\n"
+
+# Assert all contracts typecheck
+if [ ! $NO_TYPECHECK ] ; then
+    for contract in `ls $contract_attic_dir/*.tz`; do
+        printf "[Typechecking %s]\n" "$contract";
+        ${client} typecheck script "$contract";
+    done
+    printf "All contracts are well typed\n\n"
+fi
+
+# Typing gas bounds checks
+tee /tmp/first_explosion.tz <<EOF
+{ parameter unit;
+  storage unit;
+  code{ DROP; PUSH nat 0 ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR ;
+        DUP ; PAIR } }'
+EOF
+assert_fails $client originate contract first_explosion for bootstrap1 \
+             transferring 0 from bootstrap1 \
+             running /tmp/first_explosion.tz -G 8000 --burn-cap 10
+
+# Serialization gas bounds checks
+tee /tmp/second_explosion.tz <<EOF
+{ parameter (list int) ;
+  storage (list (list (list int))) ;
+  code { CAR ; DIP { NIL (list int) } ;
+         DUP ; ITER { DROP ; DUP ; DIP { CONS } } ;
+         DROP ; DIP { NIL (list (list int)) } ;
+         DUP ; ITER { DROP ; DUP ; DIP { CONS } } ;
+         DROP ; NIL operation ; PAIR } }
+EOF
+assert_success $client run script /tmp/second_explosion.tz \
+               on storage '{}' \
+               and input '{1;2;3;4;5;6;7;8;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1}'
+#assert_fails $client run script /tmp/second_explosion.tz \
+#               on storage '{}' \
+#               and input '{1;2;3;4;5;6;7;8;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1}'
+
+# Test sets and map literals
+assert_fails $client typecheck data '{ Elt 0 1 ; Elt 0 1 }' against type '(map nat nat)'
+assert_fails $client typecheck data '{ Elt 0 1 ; Elt 10 1 ; Elt 5 1 }' against type '(map nat nat)'
+assert_fails $client typecheck data '{ "A" ; "C" ; "B" }' against type '(set string)'
+assert_fails $client typecheck data '{ "A" ; "B" ; "B" }' against type '(set string)'
+
+# Test for issue #262 (bad serialization of 3+ arity primitives)
+tee /tmp/bug_262.tz <<EOF
+{ parameter unit ;
+  storage unit ;
+  code { DROP ;
+         LAMBDA unit unit {} ; UNIT ; EXEC ;
+         NIL operation ; PAIR } }
+EOF
+init_with_transfer /tmp/bug_262.tz $key1 'Unit' 1 bootstrap1
+assert_balance bug_262 "1 ꜩ"
+
+printf "\nEnd of test\n"
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_contracts_attic.sh b/vendors/tezos-modded/src/bin_client/test/test_contracts_attic.sh
new file mode 100644
index 000000000..2b1c889ac
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_contracts_attic.sh
@@ -0,0 +1,35 @@
+#!/bin/bash
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+bake
+
+key1=foo
+key2=bar
+
+$client gen keys $key1
+$client gen keys $key2
+
+printf "\n\n"
+
+# Assert all contracts typecheck
+if [ ! $NO_TYPECHECK ] ; then
+    for contract in `ls $contract_attic_dir/*.tz`; do
+        printf "[Typechecking %s]\n" "$contract";
+        ${client} typecheck script "$contract";
+    done
+    printf "All contracts are well typed\n\n"
+fi
+
+printf "\nEnd of test\n"
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_contracts_macros.sh b/vendors/tezos-modded/src/bin_client/test/test_contracts_macros.sh
new file mode 100644
index 000000000..b24073612
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_contracts_macros.sh
@@ -0,0 +1,173 @@
+#!/bin/bash
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+bake
+
+key1=foo
+key2=bar
+
+$client gen keys $key1
+$client gen keys $key2
+
+printf "\n\n"
+
+# Assert all contracts typecheck
+if [ ! $NO_TYPECHECK ] ; then
+    for contract in `ls $contract_macros_dir/*.tz`; do
+        printf "[Typechecking %s]\n" "$contract";
+        ${client} typecheck script "$contract";
+    done
+    printf "All contracts are well typed\n\n"
+fi
+
+# TODO add tests for fail.tz, macro_annotations.tz, min.tz, pair_macro.tz, take_my_money.tz, unpair_macro.tz
+
+# FORMAT: assert_output contract_file storage input expected_result
+
+# Build list
+assert_storage $contract_macros_dir/build_list.tz '{}' 0 "{ 0 }"
+assert_storage $contract_macros_dir/build_list.tz '{}' 3 "{ 0 ; 1 ; 2 ; 3 }"
+assert_storage $contract_macros_dir/build_list.tz '{}' 10 \
+			  "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }"
+
+# Find maximum int in list -- returns None if not found
+assert_storage $contract_macros_dir/max_in_list.tz None '{}' 'None'
+assert_storage $contract_macros_dir/max_in_list.tz None '{ 1 }' '(Some 1)'
+assert_storage $contract_macros_dir/max_in_list.tz None '{ -1 }' '(Some -1)'
+assert_storage $contract_macros_dir/max_in_list.tz None \
+			  '{ 10 ; -1 ; -20 ; 100 ; 0 }' '(Some 100)'
+assert_storage $contract_macros_dir/max_in_list.tz None \
+			  '{ 10 ; -1 ; -20 ; 100 ; 0 }' '(Some 100)'
+assert_storage $contract_macros_dir/max_in_list.tz None \
+			  '{ -10 ; -1 ; -20 ; -100 }' '(Some -1)'
+
+# Test comparisons on tez { EQ ; GT ; LT ; GE ; LE }
+assert_storage $contract_macros_dir/compare.tz '{}' '(Pair 1000000 2000000)' '{ False ; False ; True ; False ; True }'
+assert_storage $contract_macros_dir/compare.tz '{}' '(Pair 2000000 1000000)' '{ False ; True ; False ; True ; False }'
+assert_storage $contract_macros_dir/compare.tz '{}' '(Pair 2370000 2370000)' '{ True ; False ; False ; True ; True }'
+
+# Test ASSERT
+assert_storage $contract_macros_dir/assert.tz Unit True Unit
+assert_fails $client run script $contract_macros_dir/assert.tz on storage Unit and input False
+
+# ASSERT_{OP}
+assert_storage $contract_macros_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)'
+assert_storage $contract_macros_dir/assert_eq.tz Unit '(Pair -1 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_eq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_storage $contract_macros_dir/assert_neq.tz Unit '(Pair 0 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_neq.tz on storage Unit and input '(Pair -1 -1)'
+
+assert_storage $contract_macros_dir/assert_lt.tz Unit '(Pair -1 0)' Unit
+assert_fails $client run script $contract_macros_dir/assert_lt.tz on storage Unit and input '(Pair 0 -1)'
+assert_fails $client run script $contract_macros_dir/assert_lt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_storage $contract_macros_dir/assert_le.tz Unit '(Pair 0 0)' Unit
+assert_storage $contract_macros_dir/assert_le.tz Unit '(Pair -1 0)' Unit
+assert_fails $client run script $contract_macros_dir/assert_le.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_storage $contract_macros_dir/assert_gt.tz Unit '(Pair 0 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_gt.tz on storage Unit and input '(Pair -1 0)'
+assert_fails $client run script $contract_macros_dir/assert_gt.tz on storage Unit and input '(Pair 0 0)'
+
+assert_storage $contract_macros_dir/assert_ge.tz Unit '(Pair 0 0)' Unit
+assert_storage $contract_macros_dir/assert_ge.tz Unit '(Pair 0 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_ge.tz on storage Unit and input '(Pair -1 0)'
+
+# ASSERT_CMP{OP}
+assert_storage $contract_macros_dir/assert_cmpeq.tz Unit '(Pair -1 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmpeq.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_storage $contract_macros_dir/assert_cmpneq.tz Unit '(Pair 0 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmpneq.tz on storage Unit and input '(Pair -1 -1)'
+
+assert_storage $contract_macros_dir/assert_cmplt.tz Unit '(Pair -1 0)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 0)'
+assert_fails $client run script $contract_macros_dir/assert_cmplt.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_storage $contract_macros_dir/assert_cmple.tz Unit '(Pair -1 0)' Unit
+assert_storage $contract_macros_dir/assert_cmple.tz Unit '(Pair 0 0)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmple.tz on storage Unit and input '(Pair 0 -1)'
+
+assert_storage $contract_macros_dir/assert_cmpgt.tz Unit '(Pair 0 -1)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmpgt.tz on storage Unit and input '(Pair 0 0)'
+assert_fails $client run script $contract_macros_dir/assert_cmpgt.tz on storage Unit and input '(Pair -1 0)'
+
+
+assert_storage $contract_macros_dir/assert_cmpge.tz Unit '(Pair 0 -1)' Unit
+assert_storage $contract_macros_dir/assert_cmpge.tz Unit '(Pair 0 0)' Unit
+assert_fails $client run script $contract_macros_dir/assert_cmpge.tz on storage Unit and input '(Pair -1 0)'
+
+# Tests the SET_CAR and SET_CDR instructions
+assert_storage  $contract_macros_dir/set_caddaadr.tz \
+'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 0) 4) 5))) 6)' \
+'3000000' \
+'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 3000000) 4) 5))) 6)'
+
+assert_storage  $contract_macros_dir/map_caddaadr.tz \
+'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 0) 4) 5))) 6)' \
+'Unit' \
+'(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 1000000) 4) 5))) 6)'
+
+# Test comparisons on bytes { EQ ; GT ; LT ; GE ; LE }
+assert_storage $contract_macros_dir/compare_bytes.tz '{}' '(Pair 0x33 0x34)' '{ False ; False ; True ; False ; True }'
+assert_storage $contract_macros_dir/compare_bytes.tz '{}' '(Pair 0x33 0x33aa)' '{ False ; False ; True ; False ; True }'
+assert_storage $contract_macros_dir/compare_bytes.tz '{}' '(Pair 0x33 0x33)' '{ True ; False ; False ; True ; True }'
+assert_storage $contract_macros_dir/compare_bytes.tz '{}' '(Pair 0x34 0x33)' '{ False ; True ; False ; True ; False }'
+
+# Test goldenbook
+
+init_with_transfer $contract_macros_dir/guestbook.tz $key1\
+                   '{ Elt "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" None }' \
+                   100 bootstrap1
+assert_fails $client transfer 0 from bootstrap2 to guestbook -arg '"Pas moi"' --burn-cap 10
+bake_after $client transfer 0 from bootstrap1 to guestbook -arg '"Coucou"' --burn-cap 10
+assert_storage_contains guestbook '{ Elt "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" (Some "Coucou") }'
+assert_fails $client transfer 0 from bootstrap3 to guestbook -arg '"Pas moi non plus"' --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to guestbook -arg '"Recoucou ?"' --burn-cap 10
+
+# Test for big maps
+init_with_transfer $contract_macros_dir/big_map_mem.tz $key1\
+                   '(Pair { Elt 1 Unit ; Elt 2 Unit ; Elt 3 Unit } Unit)' \
+                   100 bootstrap1
+bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 0 False)' --burn-cap 10
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 0 True)' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 1 True)' --burn-cap 10
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 1 False)' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 2 True)' --burn-cap 10
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 2 False)' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 True)' --burn-cap 10
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 False)' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 False)' --burn-cap 10
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 True)' --burn-cap 10
+assert_fails $client typecheck data '3' against type \
+             '(int :aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)'
+$client typecheck data '3' against type \
+        '(int :aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)'
+
+init_with_transfer $contract_macros_dir/big_map_get_add.tz $key1\
+                   '(Pair { Elt 0 1 ; Elt 1 2 ; Elt 2 3 } Unit)' \
+                   100 bootstrap1
+
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 (Some 2)) (Pair 200 (Some 2)))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 None) (Pair 200 None))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 None) (Pair 300 None))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 1 None) (Pair 200 None))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 1 (Some 2)) (Pair 0 (Some 1)))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 400 (Some 1232)) (Pair 400 (Some 1232)))' --burn-cap 10
+bake_after $client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 401 (Some 0)) (Pair 400 (Some 1232)))' --burn-cap 10
+
+printf "\nEnd of test\n"
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_contracts_mini_scenarios.sh b/vendors/tezos-modded/src/bin_client/test/test_contracts_mini_scenarios.sh
new file mode 100644
index 000000000..ed381a93c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_contracts_mini_scenarios.sh
@@ -0,0 +1,112 @@
+#!/bin/bash
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+bake
+
+key1=foo
+key2=bar
+
+$client gen keys $key1
+$client gen keys $key2
+
+printf "\n\n"
+
+# Assert all contracts typecheck
+if [ ! $NO_TYPECHECK ] ; then
+    for contract in `ls $contract_scenarios_dir/*.tz`; do
+        printf "[Typechecking %s]\n" "$contract";
+        ${client} typecheck script "$contract";
+    done
+    printf "All contracts are well typed\n\n"
+fi
+
+# FORMAT: assert_output contract_file storage input expected_result
+
+# TODO add tests for the following contracts
+# lockup, originator, parameterized_multisig, reservoir, scrutable_reservoir,
+# weather_insurance, xcat_dapp, xcat
+# NB: hardlimit.tz is tested in test_basic.sh
+
+# Test replay prevention
+init_with_transfer $contract_scenarios_dir/replay.tz $key2 Unit 0 bootstrap1
+assert_fails $client transfer 0 from bootstrap1 to replay --burn-cap 10
+
+# Tests create_account
+init_with_transfer $contract_scenarios_dir/create_account.tz $key2 None 1,000 bootstrap1
+assert_balance create_account "1000 ꜩ"
+created_account=\
+`$client transfer 100 from bootstrap1 to create_account -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' --burn-cap 10 \
+ | grep 'New contract' \
+ | sed -E 's/.*(KT1[a-zA-Z0-9]+).*/\1/' \
+ | head -1`
+bake
+assert_balance $created_account "100 ꜩ"
+assert_balance create_account "1000 ꜩ"
+
+# Creates a contract, transfers data to it and stores the data
+init_with_transfer $contract_scenarios_dir/create_contract.tz $key2 Unit 1,000 bootstrap1
+assert_balance create_contract "1000 ꜩ"
+created_contract=\
+`$client transfer 0 from bootstrap1 to create_contract -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' --burn-cap 10 \
+| grep 'New contract' \
+| sed -E 's/.*(KT1[a-zA-Z0-9]+).*/\1/' \
+| head -1`
+bake
+assert_storage_contains $created_contract '"abcdefg"'
+assert_balance $created_contract "100 ꜩ"
+assert_balance create_contract "900 ꜩ"
+
+# Test IMPLICIT_ACCOUNT
+init_with_transfer $contract_scenarios_dir/default_account.tz $key1 \
+				   Unit 1,000 bootstrap1
+bake_after $client transfer 0 from bootstrap1 to default_account  -arg "\"$BOOTSTRAP4_IDENTITY\"" --burn-cap 10
+assert_balance $BOOTSTRAP4_IDENTITY "4000100 ꜩ"
+account=tz1SuakBpFdG9b4twyfrSMqZzruxhpMeSrE5
+bake_after $client transfer 0 from bootstrap1 to default_account  -arg "\"$account\"" --burn-cap 10
+assert_balance $account "100 ꜩ"
+
+# Test bytes, SHA256, CHECK_SIGNATURE
+init_with_transfer $contract_scenarios_dir/reveal_signed_preimage.tz bootstrap1 \
+				   '(Pair 0x9995c2ef7bcc7ae3bd15bdd9b02dc6e877c27b26732340d641a4cbc6524813bb "p2pk66uq221795tFxT7jfNmXtBMdjMf6RAaxRTwv1dbuSHbH6yfqGwz")' 1,000 bootstrap1
+assert_fails $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
+             '(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972 "p2sigvgDSBnN1bUsfwyMvqpJA1cFhE5s5oi7SetJVQ6LJsbFrU2idPvnvwJhf5v9DhM9ZTX1euS9DgWozVw6BTHiK9VcQVpAU8")'  --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
+             '(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972203f "p2sigvgDSBnN1bUsfwyMvqpJA1cFhE5s5oi7SetJVQ6LJsbFrU2idPvnvwJhf5v9DhM9ZTX1euS9DgWozVw6BTHiK9VcQVpAU8")'  --burn-cap 10
+assert_success $client transfer 0 from bootstrap1 to reveal_signed_preimage -arg \
+               '(Pair 0x050100000027566f756c657a2d766f757320636f75636865722061766563206d6f692c20636520736f6972203f "p2sigsceCzcDw2AeYDzUonj4JT341WC9Px4wdhHBxbZcG1FhfqFVuG7f2fGCzrEHSAZgrsrQWpxduDPk9qZRgrpzwJnSHC3gZJ")'  --burn-cap 10
+bake
+
+# Test SET_DELEGATE
+b2='tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN'
+b3='tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU'
+b4='tz1b7tUupMgCNw2cCLpKTkSD1NZzB5TkP2sv'
+b5='tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv'
+init_with_transfer $contract_scenarios_dir/vote_for_delegate.tz bootstrap1 \
+				   "(Pair (Pair \"$b3\" None) (Pair \"$b4\" None))" 1,000 bootstrap1
+$client get delegate for vote_for_delegate | assert_in_output none
+
+assert_fails $client transfer 0 from bootstrap1 to vote_for_delegate -arg None --burn-cap 10
+assert_fails $client transfer 0 from bootstrap2 to vote_for_delegate -arg None --burn-cap 10
+bake_after $client transfer 0 from bootstrap3 to vote_for_delegate -arg "(Some \"$b5\")" --burn-cap 10
+assert_storage_contains vote_for_delegate "\"$b5\""
+$client get delegate for vote_for_delegate | assert_in_output none
+bake_after $client transfer 0 from bootstrap4 to vote_for_delegate -arg "(Some \"$b2\")" --burn-cap 10
+assert_storage_contains vote_for_delegate "\"$b2\""
+$client get delegate for vote_for_delegate | assert_in_output none
+bake_after $client transfer 0 from bootstrap4 to vote_for_delegate -arg "(Some \"$b5\")" --burn-cap 10
+$client get delegate for vote_for_delegate | assert_in_output "$b5"
+
+
+printf "\nEnd of test\n"
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_contracts_opcode.sh b/vendors/tezos-modded/src/bin_client/test/test_contracts_opcode.sh
new file mode 100644
index 000000000..be5d66335
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_contracts_opcode.sh
@@ -0,0 +1,367 @@
+#!/bin/bash
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+activate_alpha
+
+$client -w none config update
+
+bake
+
+key1=foo
+key2=bar
+
+$client gen keys $key1
+$client gen keys $key2
+
+printf "\n\n"
+
+# Assert all contracts typecheck
+if [ ! $NO_TYPECHECK ] ; then
+    for contract in `ls $contract_op_dir/*.tz`; do
+        printf "[Typechecking %s]\n" "$contract";
+        ${client} typecheck script "$contract";
+    done
+    printf "All contracts are well typed\n\n"
+fi
+
+# FORMAT: assert_output contract_file storage input expected_result
+
+# TODO add tests for map_car.tz, subset.tz
+# NB: noop.tz is tested in test_basic.sh
+
+assert_storage $contract_op_dir/ret_int.tz None Unit '(Some 300)'
+
+# Map block on lists
+assert_storage $contract_op_dir/list_map_block.tz '{0}' '{}' '{}'
+assert_storage $contract_op_dir/list_map_block.tz '{0}' '{ 1 ; 1 ; 1 ; 1 }' '{ 1 ; 2 ; 3 ; 4 }'
+assert_storage $contract_op_dir/list_map_block.tz '{0}' '{ 1 ; 2 ; 3 ; 0 }' '{ 1 ; 3 ; 5 ; 3 }'
+
+# Reverse a list
+assert_storage $contract_op_dir/reverse.tz '{""}' '{}' '{}'
+assert_storage $contract_op_dir/reverse.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }'
+
+# Reverse using LOOP_LEFT
+assert_storage $contract_op_dir/loop_left.tz '{""}' '{}' '{}'
+assert_storage $contract_op_dir/loop_left.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }'
+
+# Identity on strings
+assert_storage $contract_op_dir/str_id.tz None '"Hello"' '(Some "Hello")'
+assert_storage $contract_op_dir/str_id.tz None '"abcd"' '(Some "abcd")'
+
+# Identity on pairs
+assert_storage $contract_op_dir/pair_id.tz None '(Pair True False)' '(Some (Pair True False))'
+assert_storage $contract_op_dir/pair_id.tz None '(Pair False True)' '(Some (Pair False True))'
+assert_storage $contract_op_dir/pair_id.tz None '(Pair True True)' '(Some (Pair True True))'
+assert_storage $contract_op_dir/pair_id.tz None '(Pair False False)' '(Some (Pair False False))'
+
+# Logical not
+assert_storage $contract_op_dir/not.tz None True '(Some False)'
+assert_storage $contract_op_dir/not.tz None False '(Some True)'
+
+# Logical and
+assert_storage $contract_op_dir/and.tz None "(Pair False False)" '(Some False)'
+assert_storage $contract_op_dir/and.tz None "(Pair False True)" '(Some False)'
+assert_storage $contract_op_dir/and.tz None "(Pair True False)" '(Some False)'
+assert_storage $contract_op_dir/and.tz None "(Pair True True)" '(Some True)'
+
+# Logical or
+assert_storage $contract_op_dir/or.tz None "(Pair False False)" '(Some False)'
+assert_storage $contract_op_dir/or.tz None "(Pair False True)" '(Some True)'
+assert_storage $contract_op_dir/or.tz None "(Pair True False)" '(Some True)'
+assert_storage $contract_op_dir/or.tz None "(Pair True True)" '(Some True)'
+
+# XOR
+assert_storage $contract_op_dir/xor.tz None "(Pair False False)" '(Some False)'
+assert_storage $contract_op_dir/xor.tz None "(Pair False True)" '(Some True)'
+assert_storage $contract_op_dir/xor.tz None "(Pair True False)" '(Some True)'
+assert_storage $contract_op_dir/xor.tz None "(Pair True True)" '(Some False)'
+
+
+# Concatenate all strings of a list into one string
+assert_storage $contract_op_dir/concat_list.tz '""' '{ "a" ; "b" ; "c" }' '"abc"'
+assert_storage $contract_op_dir/concat_list.tz '""' '{}' '""'
+assert_storage $contract_op_dir/concat_list.tz \
+			  '""' '{ "Hello" ; " " ; "World" ; "!" }' '"Hello World!"'
+
+# Identity on lists
+assert_storage $contract_op_dir/list_id.tz '{""}' '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }'
+assert_storage $contract_op_dir/list_id.tz '{""}' '{}' '{}'
+assert_storage $contract_op_dir/list_id.tz '{""}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }'
+
+assert_storage $contract_op_dir/list_id_map.tz '{""}' '{ "1" ; "2" ; "3" }' '{ "1" ; "2" ; "3" }'
+assert_storage $contract_op_dir/list_id_map.tz '{""}' '{}' '{}'
+assert_storage $contract_op_dir/list_id_map.tz '{""}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }'
+
+
+# Identity on maps
+assert_storage $contract_op_dir/map_id.tz '{}' '{ Elt 0 1 }' '{ Elt 0 1 }'
+assert_storage $contract_op_dir/map_id.tz '{}' '{ Elt 0 0 }' '{ Elt 0 0 }'
+assert_storage $contract_op_dir/map_id.tz '{}' '{ Elt 0 0 ; Elt 3 4 }' '{ Elt 0 0 ; Elt 3 4 }'
+
+# Identity on sets
+assert_storage $contract_op_dir/set_id.tz '{}' '{ "a" ; "b" ; "c" }' '{ "a" ; "b" ; "c" }'
+assert_storage $contract_op_dir/set_id.tz '{}' '{}' '{}'
+assert_storage $contract_op_dir/set_id.tz '{}' '{ "asdf" ; "bcde" }' '{ "asdf" ; "bcde" }'
+
+# List concat
+assert_storage $contract_op_dir/list_concat.tz '"abc"' '{ "d" ; "e" ; "f" }' '"abcdef"'
+assert_storage $contract_op_dir/list_concat.tz '"abc"' '{}' '"abc"'
+
+assert_storage $contract_op_dir/list_concat_bytes.tz '0x00ab' '{ 0xcd ; 0xef ; 0x00 }' '0x00abcdef00'
+assert_storage $contract_op_dir/list_concat_bytes.tz '0x' '{ 0x00 ; 0x11 ; 0x00 }' '0x001100'
+assert_storage $contract_op_dir/list_concat_bytes.tz '0xabcd' '{}' '0xabcd'
+assert_storage $contract_op_dir/list_concat_bytes.tz '0x' '{}' '0x'
+
+# List iter
+assert_storage $contract_op_dir/list_iter.tz 0 '{ 10 ; 2 ; 1 }' 20
+assert_storage $contract_op_dir/list_iter.tz 0 '{ 3 ; 6 ; 9 }' 162
+
+# Set member -- set is in storage
+assert_storage $contract_op_dir/set_member.tz '(Pair {} None)' '"Hi"' '(Pair {} (Some False))'
+assert_storage $contract_op_dir/set_member.tz '(Pair { "Hi" } None)' '"Hi"' '(Pair { "Hi" } (Some True))'
+assert_storage $contract_op_dir/set_member.tz '(Pair { "Hello" ; "World" } None)' '""' '(Pair { "Hello" ; "World" } (Some False))'
+
+# Set size
+assert_storage $contract_op_dir/set_size.tz 111 '{}' 0
+assert_storage $contract_op_dir/set_size.tz 111 '{ 1 }' 1
+assert_storage $contract_op_dir/set_size.tz 111 '{ 1 ; 2 ; 3 }' 3
+assert_storage $contract_op_dir/set_size.tz 111 '{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }' 6
+
+# Set iter
+assert_storage $contract_op_dir/set_iter.tz 111 '{}' 0
+assert_storage $contract_op_dir/set_iter.tz 111 '{ 1 }' 1
+assert_storage $contract_op_dir/set_iter.tz 111 '{ -100 ; 1 ; 2 ; 3 }' '-94'
+
+# Map size
+assert_storage $contract_op_dir/map_size.tz 111 '{}' 0
+assert_storage $contract_op_dir/map_size.tz 111 '{ Elt "a" 1 }' 1
+assert_storage $contract_op_dir/map_size.tz 111 \
+              '{ Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 }' 3
+assert_storage $contract_op_dir/map_size.tz 111 \
+              '{ Elt "a" 1 ; Elt "b" 2 ; Elt "c" 3 ; Elt "d" 4 ; Elt "e" 5 ; Elt "f" 6 }' 6
+
+# Contains all elements -- does the second list contain all of the same elements
+# as the first one? I'm ignoring element multiplicity
+assert_storage $contract_op_dir/contains_all.tz \
+			  None '(Pair {} {})' '(Some True)'
+assert_storage $contract_op_dir/contains_all.tz \
+			  None '(Pair { "a" } { "B" })' '(Some False)'
+assert_storage $contract_op_dir/contains_all.tz \
+			  None '(Pair { "A" } { "B" })' '(Some False)'
+assert_storage $contract_op_dir/contains_all.tz \
+			  None '(Pair { "B" } { "B" })' '(Some True)'
+assert_storage $contract_op_dir/contains_all.tz None \
+			  '(Pair { "B" ; "C" ; "asdf" } { "B" ; "B" ; "asdf" ; "C" })' '(Some True)'
+assert_storage $contract_op_dir/contains_all.tz None \
+			  '(Pair { "B" ; "B" ; "asdf" ; "C" } { "B" ; "C" ; "asdf" })' '(Some True)'
+
+# Concatenate the string in storage with all strings in the given list
+assert_storage $contract_op_dir/concat_hello.tz '{}' \
+			  '{ "World!" }' '{ "Hello World!" }'
+assert_storage $contract_op_dir/concat_hello.tz '{}' \
+			  '{}' '{}'
+assert_storage $contract_op_dir/concat_hello.tz '{}' \
+			  '{ "test1" ; "test2" }' '{ "Hello test1" ; "Hello test2" }'
+
+# Create an empty map and add a string to it
+assert_storage $contract_op_dir/empty_map.tz '{}' Unit \
+			  '{ Elt "hello" "world" }'
+
+# Get the value stored at the given key in the map
+assert_storage $contract_op_dir/get_map_value.tz '(Pair None { Elt "hello" "hi" })' \
+			  '"hello"' '(Pair (Some "hi") { Elt "hello" "hi" })'
+assert_storage $contract_op_dir/get_map_value.tz '(Pair None { Elt "hello" "hi" })' \
+			  '""' '(Pair None { Elt "hello" "hi" })'
+assert_storage $contract_op_dir/get_map_value.tz \
+			  '(Pair None { Elt "1" "one" ; Elt "2" "two" })' \
+			  '"1"' '(Pair (Some "one") { Elt "1" "one" ; Elt "2" "two" })'
+
+# Map iter
+assert_storage $contract_op_dir/map_iter.tz '(Pair 0 0)' '{ Elt 0 100 ; Elt 2 100 }' '(Pair 2 200)'
+assert_storage $contract_op_dir/map_iter.tz '(Pair 0 0)' '{ Elt 1 1 ; Elt 2 100 }' '(Pair 3 101)'
+
+# Return True if True branch of if was taken and False otherwise
+assert_storage $contract_op_dir/if.tz None True '(Some True)'
+assert_storage $contract_op_dir/if.tz None False '(Some False)'
+
+# Generate a pair of or types
+assert_storage $contract_op_dir/left_right.tz '(Left "X")' '(Left True)' '(Right True)'
+assert_storage $contract_op_dir/left_right.tz '(Left "X")' '(Right "a")' '(Left "a")'
+
+# Reverse a list
+assert_storage $contract_op_dir/reverse_loop.tz '{""}' '{}' '{}'
+assert_storage $contract_op_dir/reverse_loop.tz '{""}' '{ "c" ; "b" ; "a" }' '{ "a" ; "b" ; "c" }'
+
+# Exec concat contract
+assert_storage $contract_op_dir/exec_concat.tz '"?"' '""' '"_abc"'
+assert_storage $contract_op_dir/exec_concat.tz '"?"' '"test"' '"test_abc"'
+
+# Test PACK/UNPACK and binary format
+assert_success $client run script $contract_op_dir/packunpack.tz on storage Unit and input \
+               '(Pair (Pair (Pair "toto" {3;7;9;1}) {1;2;3}) 0x05070707070100000004746f746f020000000800030007000900010200000006000100020003)'
+
+assert_fails $client run script $contract_op_dir/packunpack.tz on storage Unit and input \
+               '(Pair (Pair (Pair "toto" {3;7;9;1}) {1;2;3}) 0x05070707070100000004746f746f0200000008000300070009000102000000060001000200030004)'
+
+# Get current steps to quota
+assert_storage $contract_op_dir/steps_to_quota.tz 111 Unit 399813
+
+# Get the current balance of the contract
+assert_storage $contract_op_dir/balance.tz '111' Unit '4000000000000'
+
+# Test addition and subtraction on tez
+assert_storage $contract_op_dir/tez_add_sub.tz None '(Pair 2000000 1000000)' '(Some (Pair 3000000 1000000))'
+assert_storage $contract_op_dir/tez_add_sub.tz None '(Pair 2310000 1010000)' '(Some (Pair 3320000 1300000))'
+
+# Test get first element of list
+assert_storage $contract_op_dir/first.tz '111' '{ 1 ; 2 ; 3 ; 4 }' '1'
+assert_storage $contract_op_dir/first.tz '111' '{ 4 }' '4'
+
+# Hash input string
+# Test assumed to be correct -- hash is based on encoding of AST
+assert_storage $contract_op_dir/hash_string.tz '0x00' '"abcdefg"' '0x46fdbcb4ea4eadad5615cdaa17d67f783e01e21149ce2b27de497600b4cd8f4e'
+assert_storage $contract_op_dir/hash_string.tz '0x00' '"12345"' '0xb4c26c20de52a4eaf0d8a340db47ad8cb1e74049570859c9a9a3952b204c772f'
+
+# IF_SOME
+assert_storage $contract_op_dir/if_some.tz '"?"' '(Some "hello")' '"hello"'
+assert_storage $contract_op_dir/if_some.tz '"?"' 'None' '""'
+
+# Tests the SET_CAR and SET_CDR instructions
+assert_storage  $contract_op_dir/set_car.tz '(Pair "hello" 0)' '"world"' '(Pair "world" 0)'
+assert_storage  $contract_op_dir/set_car.tz '(Pair "hello" 0)' '"abc"' '(Pair "abc" 0)'
+assert_storage  $contract_op_dir/set_car.tz '(Pair "hello" 0)' '""' '(Pair "" 0)'
+assert_fails $client run script $contract_op_dir/set_car.tz on storage '(Pair %wrong %field "hello" 0)' Unit and input '""'
+
+assert_storage  $contract_op_dir/set_cdr.tz '(Pair "hello" 0)' '1' '(Pair "hello" 1)'
+assert_storage  $contract_op_dir/set_cdr.tz '(Pair "hello" 500)' '3' '(Pair "hello" 3)'
+assert_storage  $contract_op_dir/set_cdr.tz '(Pair "hello" 7)' '100' '(Pair "hello" 100)'
+
+# Did the given key sign the string? (key is bootstrap1)
+assert_success $client run script $contract_op_dir/check_signature.tz \
+               on storage '(Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" "hello")' \
+               and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
+
+assert_fails $client run script $contract_op_dir/check_signature.tz \
+             on storage '(Pair "edsigthTzJ8X7MPmNeEwybRAvdxS1pupqcM5Mk4uCuyZAe7uEk68YpuGDeViW8wSXMrCi5CwoNgqs8V2w8ayB5dMJzrYCHhD8C7" "abcd")' \
+             and input '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"'
+
+
+# Convert a public key to a public key hash
+assert_storage $contract_op_dir/hash_key.tz None '"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"' \
+               '(Some "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")'
+assert_storage $contract_op_dir/hash_key.tz None '"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES"' \
+               '(Some "tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k")'
+
+bake_after $client transfer 1,000 from bootstrap1 to $key1 --burn-cap 0.257
+bake_after $client transfer 2,000 from bootstrap1 to $key2 --burn-cap 0.257
+
+assert_balance $key1 "1000 ꜩ"
+assert_balance $key2 "2000 ꜩ"
+
+# Create a contract and transfer 100 ꜩ to it
+init_with_transfer $contract_op_dir/store_input.tz $key1 '""' 100 bootstrap1
+bake_after $client transfer 100 from bootstrap1 to store_input -arg '"abcdefg"' --burn-cap 10
+assert_balance store_input "200 ꜩ"
+assert_storage_contains store_input '"abcdefg"'
+bake_after $client transfer 100 from bootstrap1 to store_input -arg '"xyz"' --burn-cap 10
+assert_storage_contains store_input '"xyz"'
+
+init_with_transfer $contract_op_dir/transfer_amount.tz $key1 '0' "100" bootstrap1
+bake_after $client transfer 500 from bootstrap1 to transfer_amount -arg Unit --burn-cap 10
+assert_storage_contains transfer_amount 500
+
+
+# This tests the `NOW` instruction.
+# This test may fail if timings are marginal, though I have not yet seen this happen
+init_with_transfer $contract_op_dir/store_now.tz $key1 '"2017-07-13T09:19:01Z"' "100" bootstrap1
+bake_after $client transfer 500 from bootstrap1 to store_now -arg Unit --burn-cap 10
+assert_storage_contains store_now "$($client get timestamp)"
+
+# Test timestamp operations
+assert_storage $contract_op_dir/add_timestamp_delta.tz None '(Pair 100 100)' '(Some "1970-01-01T00:03:20Z")'
+assert_storage $contract_op_dir/add_timestamp_delta.tz None '(Pair 100 -100)' '(Some "1970-01-01T00:00:00Z")'
+assert_storage $contract_op_dir/add_timestamp_delta.tz None '(Pair "1970-01-01T00:00:00Z" 0)' '(Some "1970-01-01T00:00:00Z")'
+
+assert_storage $contract_op_dir/add_delta_timestamp.tz None '(Pair 100 100)' '(Some "1970-01-01T00:03:20Z")'
+assert_storage $contract_op_dir/add_delta_timestamp.tz None '(Pair -100 100)' '(Some "1970-01-01T00:00:00Z")'
+assert_storage $contract_op_dir/add_delta_timestamp.tz None '(Pair 0 "1970-01-01T00:00:00Z")' '(Some "1970-01-01T00:00:00Z")'
+
+assert_storage $contract_op_dir/sub_timestamp_delta.tz 111 '(Pair 100 100)' '"1970-01-01T00:00:00Z"'
+assert_storage $contract_op_dir/sub_timestamp_delta.tz 111 '(Pair 100 -100)' '"1970-01-01T00:03:20Z"'
+assert_storage $contract_op_dir/sub_timestamp_delta.tz 111 '(Pair 100 2000000000000000000)' -1999999999999999900
+
+assert_storage $contract_op_dir/diff_timestamps.tz 111 '(Pair 0 0)' 0
+assert_storage $contract_op_dir/diff_timestamps.tz 111 '(Pair 0 1)' -1
+assert_storage $contract_op_dir/diff_timestamps.tz 111 '(Pair 1 0)' 1
+assert_storage $contract_op_dir/diff_timestamps.tz 111 '(Pair "1970-01-01T00:03:20Z" "1970-01-01T00:00:00Z")' 200
+
+# Tests TRANSFER_TOKENS
+bake_after $client originate account "test_transfer_account1" for $key1 transferring 100 from bootstrap1 --burn-cap 10
+bake_after $client originate account "test_transfer_account2" for $key1 transferring 20 from bootstrap1 --burn-cap 10
+init_with_transfer $contract_op_dir/transfer_tokens.tz $key2 Unit 1,000 bootstrap1
+assert_balance test_transfer_account1 "100 ꜩ"
+bake_after $client transfer 100 from bootstrap1 to transfer_tokens \
+           -arg "\"$(get_contract_addr test_transfer_account1)\"" --burn-cap 10
+assert_balance test_transfer_account1 "200 ꜩ" # Why isn't this 200 ꜩ? Baking fee?
+bake_after $client transfer 100 from bootstrap1 to transfer_tokens \
+            -arg "\"$(get_contract_addr test_transfer_account2)\"" --burn-cap 10
+assert_balance test_transfer_account2 "120 ꜩ" # Why isn't this 120 ꜩ? Baking fee?
+
+# Test SELF
+init_with_transfer $contract_op_dir/self.tz $key1 \
+				   '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' 1,000 bootstrap1
+bake_after $client transfer 0 from bootstrap1 to self --burn-cap 10
+assert_storage_contains self "\"$(get_contract_addr self)\""
+
+# Test SLICE and SIZE on bytes
+init_with_transfer $contract_op_dir/slices.tz bootstrap1 \
+				   '"sppk7dBPqMPjDjXgKbb5f7V3PuKUrA4Zuwc3c3H7XqQerqPUWbK7Hna"' 1,000 bootstrap1
+
+assert_fails $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda254970f9fcd92c6228c178e1a923e5600758eb83f2a05edd0be7625657901f2ba81eaf145d003dbef78e33f43a32a3788bdf0501000000085341554349535345 "p2sigsceCzcDw2AeYDzUonj4JT341WC9Px4wdhHBxbZcG1FhfqFVuG7f2fGCzrEHSAZgrsrQWpxduDPk9qZRgrpzwJnSHC3gZJ")' --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xeaa9ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda254970f9fcd92c6228c178e1a923e5600758eb83f2a05edd0be7625657901f2ba81eaf145d003dbef78e33f43a32a3788bdf0501000000085341554349535345 "spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm")' --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2deaad01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda254970f9fcd92c6228c178e1a923e5600758eb83f2a05edd0be7625657901f2ba81eaf145d003dbef78e33f43a32a3788bdf0501000000085341554349535345 "spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm")' --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150733eefdbeda254970f9fcd92c6228c178e1a923e5600758eb83f2a05edd0be7625657901f2ba81eaf145d003dbef78e33f43a32a3788bdf0501000000085341554349535345 "spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm")' --burn-cap 10
+assert_fails $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xe009ab79e8b84ef0 "spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm")' --burn-cap 10
+assert_success $client transfer 0 from bootstrap1 to slices -arg \
+        '(Pair 0xe009ab79e8b84ef0e55c43a9a857214d8761e67b75ba63500a5694fb2ffe174acc2de22d01ccb7259342437f05e1987949f0ad82e9f32e9a0b79cb252d7f7b8236ad728893f4e7150742eefdbeda254970f9fcd92c6228c178e1a923e5600758eb83f2a05edd0be7625657901f2ba81eaf145d003dbef78e33f43a32a3788bdf0501000000085341554349535345 "spsig1PPUFZucuAQybs5wsqsNQ68QNgFaBnVKMFaoZZfi1BtNnuCAWnmL9wVy5HfHkR6AeodjVGxpBVVSYcJKyMURn6K1yknYLm")' --burn-cap 10
+bake
+
+init_with_transfer $contract_op_dir/split_string.tz bootstrap1 '{}' 1,000 bootstrap1
+
+bake_after $client transfer 0 from bootstrap1 to split_string -arg '"abc"' --burn-cap 10
+assert_storage_contains split_string '{ "a" ; "b" ; "c" }'
+bake_after $client transfer 0 from bootstrap1 to split_string -arg '"def"' --burn-cap 10
+assert_storage_contains split_string '{ "a" ; "b" ; "c" ; "d" ; "e" ; "f" }'
+
+init_with_transfer $contract_op_dir/split_bytes.tz bootstrap1 '{}' 1,000 bootstrap1
+
+bake_after $client transfer 0 from bootstrap1 to split_bytes -arg '0xaabbcc' --burn-cap 10
+assert_storage_contains split_bytes '{ 0xaa ; 0xbb ; 0xcc }'
+bake_after $client transfer 0 from bootstrap1 to split_bytes -arg '0xddeeff' --burn-cap 10
+assert_storage_contains split_bytes '{ 0xaa ; 0xbb ; 0xcc ; 0xdd ; 0xee ; 0xff }'
+
+# Test hash consistency between Michelson and the CLI
+hash_result=`$client hash data '(Pair 22220000000 (Pair "2017-12-13T04:49:00Z" 034))' \
+                     of type '(pair mutez (pair timestamp int))' | grep Blake2b | sed 's/.*: *//'`
+
+assert_storage $contract_op_dir/hash_consistency_checker.tz '0x00' \
+              '(Pair 22220000000 (Pair "2017-12-13T04:49:00Z" 034))' "$hash_result"
+
+assert_storage $contract_op_dir/hash_consistency_checker.tz '0x00' \
+              '(Pair 22220000000 (Pair "2017-12-13T04:49:00+00:00" 34))' "$hash_result"
+
+
+printf "\nEnd of test\n"
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_cors.sh b/vendors/tezos-modded/src/bin_client/test/test_cors.sh
new file mode 100755
index 000000000..add9f67b7
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_cors.sh
@@ -0,0 +1,50 @@
+#! /usr/bin/env bash
+
+## from genesis to demo
+
+set -e
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1 --cors-origin "*"
+
+show_logs="no"
+
+sleep 2
+
+run_preflight() {
+    local origin="$1"
+    local method="$2"
+    local cors_method="$3"
+    local header="$4"
+    curl -H "Origin: $origin" \
+         -H "Access-Control-Request-Method: $cors_method" \
+         -H "Access-Control-Request-Headers: $header" \
+         -X $method \
+         -I -s http://localhost:18731/chains/main/blocks/head/header/shell > CURL.$id 2>&1
+}
+
+run_request() {
+    local origin="$1"
+    curl -H "Origin: $origin" \
+         -H "Content-Type: application/json" \
+         -D CURL.$id \
+         -s http://localhost:18731/chains/main/blocks/head/header/shell 2>&1 > /dev/null
+}
+
+# Preflight
+run_preflight "localhost" "OPTIONS" "GET" "Content-Type"
+cat CURL.$id
+grep -q "access-control-allow-origin" CURL.$id
+grep -q "access-control-allow-methods" CURL.$id
+grep -q "access-control-allow-headers" CURL.$id
+
+# Request
+run_request "localhost"
+cat CURL.$id
+grep -q "access-control-allow-origin" CURL.$id
+
+echo
+echo End of test
+echo
diff --git a/vendors/tezos-modded/src/bin_client/test/test_injection.sh b/vendors/tezos-modded/src/bin_client/test/test_injection.sh
new file mode 100755
index 000000000..d9ddc0f60
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_injection.sh
@@ -0,0 +1,49 @@
+#! /usr/bin/env bash
+
+## from genesis to demo
+
+set -e
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+expected_connections=2
+max_peer_id=3
+for i in $(seq 1 $max_peer_id); do
+    echo
+    echo "## Starting node $i."
+    echo
+    start_node $i
+    echo
+done
+
+## waiting for the node to establish connections
+
+for client in "${client_instances[@]}"; do
+    echo
+    echo "### $client bootstrapped"
+    echo
+    $client -w none config update
+    $client bootstrapped
+    echo
+done
+
+sleep 2
+
+protocol_version=`$compiler -hash-only "$test_dir/demo"`
+
+$admin_client inject protocol "$test_dir/demo"
+$admin_client list protocols
+
+$client activate protocol $protocol_version \
+        with fitness 1 \
+        and key activator \
+        and parameters $parameters_file
+
+retry 2 15 assert_protocol "$protocol_version"
+
+echo
+echo End of test
+echo
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_lib.inc.sh b/vendors/tezos-modded/src/bin_client/test/test_lib.inc.sh
new file mode 100755
index 000000000..7ba2b8616
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_lib.inc.sh
@@ -0,0 +1,272 @@
+#! /usr/bin/env bash
+
+test_dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && echo "$(pwd -P)")"
+src_dir="$(dirname "$test_dir")"
+cd "$test_dir"
+
+sandbox_file="$test_dir/sandbox.json"
+parameters_file="$test_dir/protocol_parameters.json"
+
+export TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER=Y
+
+tezos_sandboxed_node="${1:-$test_dir/../../bin_node/tezos-sandboxed-node.sh}"
+local_node="${2:-$test_dir/../../../_build/default/src/bin_node/main.exe}"
+tezos_init_sandboxed_client="${3:-$test_dir/../../bin_client/tezos-init-sandboxed-client.sh}"
+local_client="${4:-$test_dir/../../../_build/default/src/bin_client/main_client.exe}"
+local_admin_client="${5:-$test_dir/../../../_build/default/src/bin_client/main_admin.exe}"
+local_compiler="${6:-$test_dir/../../../_build/default/src/lib_protocol_compiler/main_native.exe}"
+
+contract_op_dir="contracts/opcodes"
+contract_macros_dir="contracts/macros"
+contract_scenarios_dir="contracts/mini_scenarios"
+contract_attic_dir="contracts/attic"
+
+source $tezos_sandboxed_node
+source $tezos_init_sandboxed_client
+
+### Log files handling
+
+display_file() {
+    echo
+    echo "#################"
+    echo "### $ cat $1"
+    sed -e 's/^/### /' $1
+    echo "#################"
+    echo
+}
+
+log_files=()
+
+register_log() {
+    log_files+=("$1")
+}
+
+show_logs="${show_logs:-yes}"
+
+display_logs() {
+    if [ "$show_logs" = "yes" ]; then
+        for file in "${log_files[@]}"; do
+            display_file $file;
+        done
+        good_run=OK
+    fi
+}
+
+### Node/Client instances control
+
+client_instances=()
+admin_client_instances=()
+
+start_node() {
+    local id=${1:-1}
+    shift
+    start_sandboxed_node $id "$@" > LOG.$id 2>&1
+    register_log LOG.$id
+    init_sandboxed_client $id
+    wait_for_the_node_to_be_ready
+    add_sandboxed_bootstrap_identities
+    client_instances+=("$client")
+    admin_client_instances+=("$admin_client")
+    export "client$id=$client"
+}
+
+cleanup() {
+    set -e
+    display_logs
+    cleanup_nodes
+    cleanup_clients
+}
+trap cleanup EXIT INT
+
+### Various helpers
+
+run_contract_file () {
+    local contract="$1"
+    local storage="$2"
+    local input="$3"
+    local amount_flag=""
+    if [ ! -z "$4" ]; then
+        amount_flag="-amount $4"
+    fi
+    $client run script "$contract" on storage "$storage" and input "$input" $amount_flag
+}
+
+assert_storage () {
+    local contract=$1;
+    local input=$2;
+    local storage=$3;
+    local expected=$4;
+    local amount=$5;
+    echo "Testing [$contract]"
+    local storage=$(run_contract_file "$contract" "$input" "$storage" "$amount"  | awk '/storage/{getline; print}' |
+                        sed -e 's/^[[:space:]]*//' -e 's/[[:space:]]*$//' ||
+                        { printf '\nTest failed with error at line %s\n' "$(caller)" 1>&2;
+                          exit 1; });
+    if [ "$expected" != "$storage" ]; then
+        echo "Test at " `caller` failed 1>&2 ;
+        printf "Expected %s but got %s" "$expected" "$storage" 1>&2 ;
+        exit 1;
+    fi
+}
+
+assert_balance () {
+    local KEY="$1"
+    local EXPECTED_BALANCE="$2"
+    local RESULT=$($client get balance for ${KEY})
+    echo "[Asserting balance for '$KEY']"
+    if [ "${RESULT}" != "${EXPECTED_BALANCE}" ]; then
+        printf "Balance assertion failed for ${KEY} on line '%s'. Expected %s but got %s.\n" \
+               "$(caller)" "${EXPECTED_BALANCE}" "${RESULT}"
+        exit 2
+    fi
+}
+
+contract_name_of_file () {
+    basename "$1" ".tz"
+}
+
+init_contract_from_file () {
+    local FILE="$1"
+    local NAME=$(contract_name_of_file "${FILE}")
+    $client remember script "${NAME}" "file:${FILE}"
+}
+
+bake () {
+    $client bake for bootstrap1 --max-priority 512 --minimal-timestamp  --minimal-fees 0 --minimal-nanotez-per-byte 0 --minimal-nanotez-per-gas-unit 0
+}
+
+bake_after () {
+    "$@"
+    bake
+}
+
+init_with_transfer () {
+    local FILE="$1"
+    local NAME=$(contract_name_of_file "${FILE}")
+    local KEY="$2"
+    local INITIAL_STORAGE="$3"
+    local TRANSFER_AMT="$4"
+    local TRANSFER_SRC=${5-bootstrap1}
+    echo "Originating [$NAME]"
+    $client originate contract ${NAME} \
+            for ${KEY} transferring "${TRANSFER_AMT}" \
+            from ${TRANSFER_SRC} running "${FILE}" -init "${INITIAL_STORAGE}" --burn-cap 10
+    bake
+}
+
+# Takes a grep regexp and fails with an error message if command does not include
+# the regexp
+assert_in_output () {
+    local MATCHING="$1"
+    local INPUT="$2"
+    if ! grep -q "${MATCHING}" ${INPUT}; then
+        printf "\nFailure on line %s. Expected to find %s in output." \
+               "$(caller)"  "${MATCHING}"
+        exit 1
+    else
+        echo "[Assertion succeeded]"
+    fi
+}
+
+get_contract_addr () {
+    local CONTRACT_NAME="$1"
+    $client show known contract "${CONTRACT_NAME}"
+}
+
+contract_storage () {
+    local CONTRACT_NAME="$1"    # Can be either an alias or hash
+    $client get script storage for ${CONTRACT_NAME}
+}
+
+assert_storage_contains () {
+    local CONTRACT_NAME="$1"
+    local EXPECTED_STORAGE="$2"
+    contract_storage ${CONTRACT_NAME} | assert_in_output "${EXPECTED_STORAGE}"
+}
+
+assert() {
+    local expected="$1"
+    local result="$(cat)"
+    if [ "${result}" != "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Expected: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_success() {
+    printf "[Asserting success]\n"
+    if "$@" 2> /dev/null; then
+        return 0
+    else
+        printf "Expected command line to success, but failed:\n"
+        echo "$@"
+        exit 1
+    fi
+}
+
+assert_fails() {
+    printf "[Asserting failure]\n"
+    if "$@" 2> /dev/null; then
+        printf "Expected command line to fail, but succeeded:\n"
+        echo "$@"
+        exit 1
+    else
+        return 0
+    fi
+}
+
+assert_contract_fails() {
+    local contract=$1;
+    local input=$2;
+    local storage=$3;
+    local amount=$4;
+    printf "Testing failure for [$contract]\n"
+    if run_contract_file "$contract" "$input" "$storage" "$amount" 2> /dev/null ; then
+        printf "Expected contract execution to fail, but succeeded:\n"
+        exit 1
+    fi
+}
+
+extract_operation_hash() {
+    grep "Operation hash is" | grep -o "'.*'" | tr -d "'"
+}
+
+assert_propagation_level() {
+    level=$1
+    printf "\n\nAsserting all nodes have reached level %s\n" "$level"
+    for client in "${client_instances[@]}"; do
+        ( $client rpc get /chains/main/blocks/head/header/shell \
+              | assert_in_output "\"level\": $level" ) \
+            || exit 2
+    done
+}
+
+assert_protocol() {
+    proto=$1
+    printf "\n\nAsserting protocol propagation\n"
+    for client in "${client_instances[@]}"; do
+        ( $client -p ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im \
+                  rpc get /chains/main/blocks/head/metadata | assert_in_output "\"next_protocol\": \"$proto\"" ) \
+              || exit 2
+    done
+}
+
+retry() {
+    local timeout=$1
+    local attempts=$2
+    shift 2
+    sleep $timeout
+    while ! ( "$@" ) ; do
+        echo
+        echo "Will retry after $timeout seconds..."
+        echo
+        sleep $timeout
+        attempts=$(($attempts-1))
+        if [ "$attempts" -eq 0 ] ; then
+            echo
+            echo "Failed after too many retries" 1>&2
+            exit 1
+        fi
+    done
+}
diff --git a/vendors/tezos-modded/src/bin_client/test/test_mempool.sh b/vendors/tezos-modded/src/bin_client/test/test_mempool.sh
new file mode 100755
index 000000000..b4225db2e
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_mempool.sh
@@ -0,0 +1,170 @@
+#! /usr/bin/env bash
+
+set -e
+
+#test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source src/bin_client/test/test_lib.inc.sh "$@"
+
+empty_mempool='{ "applied": [], "refused": [], "branch_refused": [], "branch_delayed": [],
+  "unprocessed": [] }'
+
+rpc_not_found='Unregistred error:
+  { "kind": "generic",
+    "error": "Prevalidator is not running, cannot inject the operation" }
+Fatal error: transfer simulation failed.'
+
+prev_not_running='[]'
+
+assert_mempool_not_empty() {
+    local expected=$empty_mempool
+    local result="$(cat)"
+    if [ "${result}" = "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Should be different than: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_mempool_empty() {
+    local expected=$empty_mempool
+    local result="$(cat)"
+    if [ "${result}" != "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Expected: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_rpc_not_exist() {
+    local expected=$rpc_not_found
+    local result="$(cat)"
+    if [ "${result}" != "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Expected: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_rpc_exists() {
+    local expected=$rpc_not_found
+    local result="$(cat)"
+    if [ "${result}" = "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Should be different than: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_prev_not_running() {
+    local expected=$prev_not_running
+    local result="$(cat)"
+    if [ "${result}" != "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Expected: \"${expected}\""
+        exit 2
+    fi
+}
+
+assert_prev_running() {
+    local expected=$prev_not_running
+    local result="$(cat)"
+    if [ "${result}" = "${expected}" ]; then
+        echo "Unexpected result: \"${result}\""
+        echo "Should be different than: \"${expected}\""
+        exit 2
+    fi
+}
+
+echo
+echo Starting 1st node
+echo
+
+start_node 1
+
+echo
+echo Starting 2nd node
+echo
+
+start_node 3
+
+echo
+echo Starting 3rd node
+echo
+
+start_node 9 --disable-mempool
+
+echo
+echo Activating Alpha protocol
+echo
+
+activate_alpha
+
+sleep 1
+
+echo
+$client3 rpc call '/network/peers' with '{}'
+echo
+
+#tests for the prevalidator state
+$client1 rpc call '/workers/prevalidators' | assert_prev_running
+echo 1st node prevalidator is running
+$client3 rpc call '/workers/prevalidators' | assert_prev_running
+echo 2nd node prevalidator is running
+$client9 rpc call '/workers/prevalidators' | assert_prev_not_running
+echo 3dr node prevalidator is not running
+
+#checks that mempools are empty
+$client1 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 1st node mempool is empty
+
+$client3 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 2nd node mempool is empty
+
+$client9 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 3rd node mempool is empty
+
+#inject a transaction through the 1st node
+$client1 transfer 1,000 from bootstrap1 to bootstrap2 &
+
+sleep 3
+
+#checks that mempools are not empty for enable-mempool nodes and
+#empty for the disable-mempool node
+$client1 rpc call '/mempool/pending_operations' | assert_mempool_not_empty
+echo 1st node mempool is not empty
+
+$client3 rpc call '/mempool/pending_operations' | assert_mempool_not_empty
+echo 2nd node mempool is not empty
+
+$client9 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 3rd node mempool is empty
+
+$client1 bake for bootstrap1
+
+sleep 1
+
+#checks that all mempool are empty after baking a block which contains the
+#transaction
+$client1 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 1st node mempool is empty
+
+$client3 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 2nd node mempool is empty
+
+$client9 rpc call '/mempool/pending_operations' | assert_mempool_empty
+echo 3rd node mempool is empty
+
+#checks that trying to inject an operation through a disable-mempool node fails
+{
+    $client9 transfer 2,000 from bootstrap2 to bootstrap3 2> /dev/null &&
+    if [ $? = 0 ]; then
+        echo "This should have failed... exit code:" $?
+        exit 2
+    fi
+} ||
+
+echo
+echo End of test
+echo
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_multinode.sh b/vendors/tezos-modded/src/bin_client/test/test_multinode.sh
new file mode 100755
index 000000000..d79d859c6
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_multinode.sh
@@ -0,0 +1,104 @@
+#!/usr/bin/env bash
+
+set -e
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+expected_connections=4
+max_peer_id=8
+for i in $(seq 1 $max_peer_id); do
+    echo
+    echo "## Starting node $i."
+    echo
+    start_node $i
+    echo
+done
+
+## waiting for the node to establish connections
+
+for client in "${client_instances[@]}"; do
+    echo
+    echo "### $client bootstrapped"
+    echo
+    $client -w none config update
+    $client bootstrapped
+    echo
+done
+
+for admin_client in "${admin_client_instances[@]}"; do
+    echo
+    echo "### $admin_client network stat"
+    echo
+    $admin_client p2p stat
+    echo
+done
+
+activate_alpha
+
+
+printf "\n\n"
+
+retry 2 15 assert_protocol "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK"
+
+$client1 bake for bootstrap1 --max-priority 512 --minimal-timestamp
+retry 2 15 assert_propagation_level 2
+
+$client2 bake for bootstrap2 --max-priority 512 --minimal-timestamp
+retry 2 15 assert_propagation_level 3
+
+$client3 bake for bootstrap3 --max-priority 512 --minimal-timestamp
+retry 2 15 assert_propagation_level 4
+
+$client4 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+retry 2 15 assert_propagation_level 5
+
+endorse_hash=$($client3 endorse for bootstrap3 | extract_operation_hash)
+
+transfer4_hash1=$($client4 transfer 500 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client4 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+transfer4_hash2=$($client4 transfer 400 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client4 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+transfer4_hash3=$($client4 transfer 300 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client4 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+
+sleep 2
+
+transfer3_hash1=$($client3 transfer 500 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client3 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+transfer3_hash2=$($client3 transfer 400 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client3 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+transfer3_hash3=$($client3 transfer 300 from bootstrap1 to bootstrap3 | extract_operation_hash)
+$client3 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+
+# wait for the propagation of operations
+sleep 2
+
+assert_contains_operation() {
+    hash="$1"
+    # hash = '' means that the transfer didn't succeed
+    if [ -z "$hash" ]; then
+      exit 2
+    fi
+    printf "Asserting operations list contains '$hash'\n"
+    for client in "${client_instances[@]}"; do
+        ( $client get receipt for $hash ) || exit 2
+    done
+}
+
+$client4 bake for bootstrap4 --max-priority 512 --minimal-timestamp
+retry 2 15 assert_contains_operation $endorse_hash
+
+retry 2 15 assert_contains_operation $transfer4_hash1
+retry 2 15 assert_contains_operation $transfer4_hash2
+retry 2 15 assert_contains_operation $transfer4_hash3
+
+retry 2 15 assert_contains_operation $transfer3_hash1
+retry 2 15 assert_contains_operation $transfer3_hash2
+retry 2 15 assert_contains_operation $transfer3_hash3
+
+echo
+echo End of test
+echo
+
+show_logs="no"
diff --git a/vendors/tezos-modded/src/bin_client/test/test_tls.sh b/vendors/tezos-modded/src/bin_client/test/test_tls.sh
new file mode 100755
index 000000000..d773e84c2
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_tls.sh
@@ -0,0 +1,23 @@
+#! /usr/bin/env bash
+
+## from genesis to demo
+
+set -e
+
+export USE_TLS=true
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+start_node 1
+
+show_logs="no"
+
+sleep 2
+
+# Dummy command to test connection with node
+$client bootstrapped
+
+echo
+echo End of test
+echo
diff --git a/vendors/tezos-modded/src/bin_client/test/test_voting.sh b/vendors/tezos-modded/src/bin_client/test/test_voting.sh
new file mode 100755
index 000000000..55fe7df9b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/test/test_voting.sh
@@ -0,0 +1,204 @@
+#!/bin/bash
+
+# Requires jq command
+
+set -e
+set -o pipefail
+
+test_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)")"
+source $test_dir/test_lib.inc.sh "$@"
+
+# Prepare a config with a shorter blocks_per_voting_period
+tempdir=`mktemp -d`
+sed -e 's/"blocks_per_voting_period" : [0-9]*/"blocks_per_voting_period" : 4/' $parameters_file > $tempdir/parameters.json
+parameters_file=$tempdir/parameters.json
+echo params=${parameters_file}
+
+# Start a node
+start_node 1
+activate_alpha
+
+echo Alpha activated
+
+function get_ballot_list() {
+    $client rpc get /chains/main/blocks/head/votes/ballot_list
+}
+function get_ballots() {
+    $client rpc get /chains/main/blocks/head/votes/ballots
+}
+function get_current_period_kind() {
+    $client rpc get /chains/main/blocks/head/votes/current_period_kind
+}
+function get_current_proposal() {
+    $client rpc get /chains/main/blocks/head/votes/current_proposal
+}
+function get_current_quorum() {
+    $client rpc get /chains/main/blocks/head/votes/current_quorum
+}
+function get_listings() {
+    $client rpc get /chains/main/blocks/head/votes/listings
+}
+function get_proposals() {
+    $client rpc get /chains/main/blocks/head/votes/proposals
+}
+function get_period_position() {
+    #TODO why offset 1?
+    $client rpc get /chains/main/blocks/head/helpers/current_level?offset=1 | jq .voting_period_position
+}
+
+$client show voting period
+
+[ `get_period_position` = '1' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+echo Checking the bug of the empty listing in the first voting period...
+[ `get_listings` = '[]' ] \
+    || { echo "empty listings bug was fixed?!" ; exit 1 ; }
+
+bake # pos=2
+
+[ `get_period_position` = '2' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+
+bake # pos=3
+bake # new period, pos=0
+
+echo 'Checking the current period = proposal with non empty listings'
+[ `get_period_position` = '0' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+[ "`get_listings`" != '[]' ] \
+    || { echo "strange listings" ; exit 1 ; }
+
+# Prepare 3 different protocol sources
+
+echo 'Injecting protocols...'
+
+cp -r demo $tempdir/proto1
+$admin_client inject protocol $tempdir/proto1
+
+cp -r demo $tempdir/proto2
+echo '(* 2 *)' >> $tempdir/proto2/main.ml
+$admin_client inject protocol $tempdir/proto2
+
+cp -r demo $tempdir/proto3
+echo '(* 3 *)' >> $tempdir/proto3/main.ml
+$admin_client inject protocol $tempdir/proto3
+
+proto_str=`$admin_client list protocols | grep "P" | head -3` # assuming new protocols listed first
+echo New protocols: $proto_str
+proto=($proto_str)
+
+# Proposals
+
+[ `get_proposals` == '[]' ] \
+    || { echo "strange proposals" ; exit 1 ; }
+
+echo 'Proposal voting...'
+
+$client show voting period
+
+$client submit proposals for bootstrap1 ${proto[0]}
+$client submit proposals for bootstrap2 ${proto[0]} ${proto[1]}
+$client submit proposals for bootstrap3 ${proto[1]}
+$client submit proposals for bootstrap4 ${proto[2]}
+
+bake
+
+$client show voting period
+
+[ "`get_proposals`" != '[]' ] \
+    || { echo "strange proposals" ; exit 1 ; }
+
+bake # pos=2
+
+echo 'Breaking the tie'
+
+$client submit proposals for bootstrap4 ${proto[1]} # To make ${proto[1]} win
+$client show voting period
+
+bake # pos=3
+bake # new period! pos=0
+
+echo The phase must be testing_vote...
+
+[ `get_period_position` = '0' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+[ `get_current_period_kind` = '"testing_vote"' ] \
+    || { echo "strange current_period_kind" ; exit 1 ; }
+[ "`get_listings`" != '[]' ] \
+    || { echo "strange listings" ; exit 1 ; }
+[ `get_current_proposal` = '"'${proto[1]}'"' ] \
+    || { echo "strange current_proposal" ; exit 1 ; }
+
+echo Ballots 1
+$client submit ballot for bootstrap1 ${proto[1]} yay
+$client submit ballot for bootstrap2 ${proto[1]} yay
+$client submit ballot for bootstrap3 ${proto[1]} yay
+$client submit ballot for bootstrap4 ${proto[1]} yay
+
+bake # pos=1
+
+# They cannot change their mind.
+echo "Ballots 2 (should fail)"
+$client submit ballot for bootstrap1 ${proto[1]} yay \
+    && { echo "submit ballot cannot be called twice" ; exit 1 ; }
+
+bake # pos=2
+bake # pos=3
+
+$client show voting period
+
+bake # new period pos=0
+
+echo Testing vote should be done
+[ `get_period_position` = '0' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+[ `get_current_period_kind` = '"testing"' ] \
+    || { echo "strange current_period_kind" ; exit 1 ; }
+[ "`get_listings`" = '[]' ] \
+    || { echo "strange listings" ; exit 1 ; }
+[ `get_current_proposal` = '"'${proto[1]}'"' ] \
+    || { echo "strange current_proposal" ; exit 1 ; }
+[ `get_ballot_list` = '[]' ] \
+    || { echo "strange ballot_list" ; exit 1 ; }
+
+bake # pos=1
+bake # pos=2
+bake # pos=3
+bake # new period pos=0
+
+echo Testing should be done
+[ `get_period_position` = '0' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+[ `get_current_period_kind` = '"promotion_vote"' ] \
+    || { echo "strange current_period_kind" ; exit 1 ; }
+[ "`get_listings`" != '[]' ] \
+    || { echo "strange listings" ; exit 1 ; }
+[ `get_current_proposal` = '"'${proto[1]}'"' ] \
+    || { echo "strange current_proposal" ; exit 1 ; }
+[ `get_ballot_list` = '[]' ] \
+    || { echo "strange ballot_list" ; exit 1 ; }
+
+$client submit ballot for bootstrap1 ${proto[1]} yay
+$client submit ballot for bootstrap2 ${proto[1]} yay
+$client submit ballot for bootstrap3 ${proto[1]} yay
+$client submit ballot for bootstrap4 ${proto[1]} nay # not to promote
+
+bake # pos=1
+bake # pos=2
+bake # pos=3
+
+$client show voting period
+
+bake # new period pos=0
+
+echo 'Promotion vote should be over now negatively'
+[ `get_period_position` = '0' ] \
+    || { echo "strange voting_period_position" ; exit 1 ; }
+[ `get_current_period_kind` = '"proposal"' ] \
+    || { echo "strange current_period_kind" ; exit 1 ; }
+[ "`get_listings`" != '[]' ] \
+    || { echo "strange listings" ; exit 1 ; }
+[ `get_current_proposal` = 'null' ] \
+    || { echo "strange current_proposal" ; exit 1 ; }
+[ `get_ballot_list` = '[]' ] \
+    || { echo "strange ballot_list" ; exit 1 ; }
diff --git a/vendors/tezos-modded/src/bin_client/tezos-client.opam b/vendors/tezos-modded/src/bin_client/tezos-client.opam
new file mode 100644
index 000000000..f8cd91aaf
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/tezos-client.opam
@@ -0,0 +1,29 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-base"
+  "tezos-client-genesis"
+  "tezos-client-demo"
+  "tezos-client-alpha"
+  "tezos-client-alpha-commands"
+  "tezos-baking-alpha"
+  "tezos-baking-alpha-commands"
+  "tezos-client-base-unix"
+  "tezos-signer-backends"
+  "tezos-node" { with-test }
+  "tezos-protocol-compiler" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/bin_client/tezos-init-sandboxed-client.sh b/vendors/tezos-modded/src/bin_client/tezos-init-sandboxed-client.sh
new file mode 100755
index 000000000..c34611739
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_client/tezos-init-sandboxed-client.sh
@@ -0,0 +1,284 @@
+#! /usr/bin/env bash
+
+set -e
+
+client_dirs=()
+
+host=localhost
+
+init_sandboxed_client() {
+
+    id="$1"
+    shift 1
+
+    rpc=$((18730 + id))
+    client_dir="$(mktemp -d -t tezos-tmp-client.XXXXXXXX)"
+    client_dirs+=("$client_dir")
+    signer="$local_signer -d $client_dir"
+    if [ -n "$USE_TLS" ]; then
+        client="$local_client -S -base-dir $client_dir -addr $host -port $rpc"
+        admin_client="$local_admin_client -S -base-dir $client_dir -addr $host -port $rpc"
+        alpha_baker="$local_alpha_baker -S -base-dir $client_dir -addr $host -port $rpc"
+	alpha_endorser="$local_alpha_endorser -S -base-dir $client_dir -addr $host -port $rpc"
+	alpha_accuser="$local_alpha_accuser -S -base-dir $client_dir -addr $host -port $rpc"
+        signer="$local_signer -S -base-dir $client_dir -addr $host -port $rpc"
+        compiler="$local_compiler"
+    else
+        client="$local_client -base-dir $client_dir -addr $host -port $rpc"
+        admin_client="$local_admin_client -base-dir $client_dir -addr $host -port $rpc"
+        alpha_baker="$local_alpha_baker -base-dir $client_dir -addr $host -port $rpc"
+	alpha_endorser="$local_alpha_endorser -base-dir $client_dir -addr $host -port $rpc"
+	alpha_accuser="$local_alpha_accuser -base-dir $client_dir -addr $host -port $rpc"
+        signer="$local_signer -base-dir $client_dir -addr $host -port $rpc"
+        compiler="$local_compiler"
+    fi
+    parameters_file="${parameters_file:-$client_dir/protocol_parameters.json}"
+
+    if ! [ -f "$parameters_file" ]; then
+        cat > "$parameters_file" <<EOF
+{ "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,
+  "preserved_cycles" : 2,
+  "proof_of_work_threshold": "-1"
+}
+EOF
+    fi
+
+}
+
+cleanup_clients() {
+    rm -rf "${client_dirs[@]}"
+}
+
+
+## Waiter ##################################################################
+
+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
+}
+
+## Sandboxed client ########################################################
+
+# key pairs from $src_dir/test/sandbox.json
+
+BOOTSTRAP1_IDENTITY="tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"
+BOOTSTRAP1_PUBLIC="edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"
+BOOTSTRAP1_SECRET="unencrypted:edsk3gUfUPyBSfrS9CCgmCiQsTCHGkviBDusMxDJstFtojtc1zcpsh"
+
+BOOTSTRAP2_IDENTITY="tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN"
+BOOTSTRAP2_PUBLIC="edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9"
+BOOTSTRAP2_SECRET="unencrypted:edsk39qAm1fiMjgmPkw1EgQYkMzkJezLNewd7PLNHTkr6w9XA2zdfo"
+
+BOOTSTRAP3_IDENTITY="tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU"
+BOOTSTRAP3_PUBLIC="edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV"
+BOOTSTRAP3_SECRET="unencrypted:edsk4ArLQgBTLWG5FJmnGnT689VKoqhXwmDPBuGx3z4cvwU9MmrPZZ"
+
+BOOTSTRAP4_IDENTITY="tz1b7tUupMgCNw2cCLpKTkSD1NZzB5TkP2sv"
+BOOTSTRAP4_PUBLIC="edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU"
+BOOTSTRAP4_SECRET="unencrypted:edsk2uqQB9AY4FvioK2YMdfmyMrer5R8mGFyuaLLFfSRo8EoyNdht3"
+
+BOOTSTRAP5_IDENTITY="tz1ddb9NMYHZi5UzPdzTZMYQQZoMub195zgv"
+BOOTSTRAP5_PUBLIC="edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n"
+BOOTSTRAP5_SECRET="unencrypted:edsk4QLrcijEffxV31gGdN2HU7UpyJjA8drFoNcmnB28n89YjPNRFm"
+
+ACTIVATOR_SECRET="unencrypted:edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6"
+
+add_sandboxed_bootstrap_identities() {
+
+    ${client} import secret key bootstrap1 ${BOOTSTRAP1_SECRET}
+    ${client} import secret key bootstrap2 ${BOOTSTRAP2_SECRET}
+    ${client} import secret key bootstrap3 ${BOOTSTRAP3_SECRET}
+    ${client} import secret key bootstrap4 ${BOOTSTRAP4_SECRET}
+    ${client} import secret key bootstrap5 ${BOOTSTRAP5_SECRET}
+
+    ${client} import secret key activator ${ACTIVATOR_SECRET}
+}
+
+activate_alpha() {
+
+    ${client} \
+        -block genesis \
+        activate protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK \
+        with fitness 1 \
+        and key activator \
+	and parameters "${parameters_file}" \
+        --timestamp $(TZ='AAA+1' date +%FT%TZ)
+}
+
+usage() {
+    echo "Small script to initialize a client to a local and closed test network with a maximum of 9 nodes."
+    echo
+    echo "Usage: eval \`$0 <id>\`"
+    echo "  where <id> should be an integer between 1 and 9."
+}
+
+main () {
+
+    local bin_dir="$(cd "$(dirname "$0")" && echo "$(pwd -P)/")"
+    if [ $(basename "$bin_dir") = "bin_client" ]; then
+        local_client="${local_client:-$bin_dir/../../_build/default/src/bin_client/main_client.exe}"
+        local_admin_client="${local_admin_client:-$bin_dir/../../_build/default/src/bin_client/main_admin.exe}"
+        local_signer="${local_signer:-$bin_dir/../../_build/default/src/bin_signer/main_signer.exe}"
+        parameters_file="${parameters_file:-$bin_dir/../../scripts/protocol_parameters.json}"
+        local_compiler="${local_compiler:-$bin_dir/../../_build/default/src/lib_protocol_compiler/main_native.exe}"
+    else
+	# we assume a clean install with tezos-(admin-)client in the path
+        local_client="${local_client:-$(which tezos-client)}"
+        local_admin_client="${local_admin_client:-$(which tezos-admin-client)}"
+        local_signer="${local_signer:-$(which tezos-signer)}"
+        local_compiler="${local_compiler:-$(which tezos-protocol-compiler)}"
+    fi
+
+    if [ $# -lt 1 ] || [ "$1" -le 0 ] || [ 10 -le "$1" ]; then
+        usage
+        exit 1
+    fi
+
+    init_sandboxed_client "$1"
+
+    add_sandboxed_bootstrap_identities | sed -e 's/^/## /' 1>&2
+
+    mkdir -p $client_dir/bin
+
+    echo '#!/bin/sh' > $client_dir/bin/tezos-client
+    echo "exec $client \"\$@\"" >> $client_dir/bin/tezos-client
+    chmod +x $client_dir/bin/tezos-client
+
+    echo '#!/bin/sh' > $client_dir/bin/tezos-admin-client
+    echo "exec $admin_client \"\$@\""  >> $client_dir/bin/tezos-admin-client
+    chmod +x $client_dir/bin/tezos-admin-client
+
+    for protocol in $(cat $bin_dir/../../active_protocol_versions); do
+        protocol_underscore=$(echo $protocol | tr -- - _)
+        local_baker="$bin_dir/../../_build/default/src/proto_$protocol_underscore/bin_baker/main_baker_$protocol_underscore.exe"
+        local_endorser="$bin_dir/../../_build/default/src/proto_$protocol_underscore/bin_endorser/main_endorser_$protocol_underscore.exe"
+        local_accuser="$bin_dir/../../_build/default/src/proto_$protocol_underscore/bin_accuser/main_accuser_$protocol_underscore.exe"
+
+        if [ -n "$USE_TLS" ]; then
+            baker="$local_baker -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	    endorser="$local_endorser -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	    accuser="$local_accuser -S -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        else
+            baker="$local_baker -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	    endorser="$local_endorser -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+	    accuser="$local_accuser -base-dir $client_dir -addr 127.0.0.1 -port $rpc"
+        fi
+
+        echo '#!/bin/sh' > $client_dir/bin/tezos-baker-$protocol
+        echo "exec $baker \"\$@\""  >> $client_dir/bin/tezos-baker-$protocol
+        chmod +x $client_dir/bin/tezos-baker-$protocol
+
+        echo '#!/bin/sh' > $client_dir/bin/tezos-endorser-$protocol
+        echo "exec $endorser \"\$@\""  >> $client_dir/bin/tezos-endorser-$protocol
+        chmod +x $client_dir/bin/tezos-endorser-$protocol
+
+        echo '#!/bin/sh' > $client_dir/bin/tezos-accuser-$protocol
+        echo "exec $accuser \"\$@\""  >> $client_dir/bin/tezos-accuser-$protocol
+        chmod +x $client_dir/bin/tezos-accuser-$protocol
+    done
+
+    echo '#!/bin/sh' > $client_dir/bin/tezos-signer
+    echo "exec $signer \"\$@\""  >> $client_dir/bin/tezos-signer
+    chmod +x $client_dir/bin/tezos-signer
+
+    cat <<EOF
+if type tezos-client-reset >/dev/null 2>&1 ; then tezos-client-reset; fi ;
+PATH="$client_dir/bin:\$PATH" ; export PATH ;
+alias tezos-activate-alpha="$client  -block genesis activate protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK with fitness 1 and key activator and parameters $parameters_file --timestamp $(TZ='AAA+1' date +%FT%TZ)" ;
+alias tezos-client-reset="rm -rf \"$client_dir\"; unalias tezos-activate-alpha tezos-client-reset" ;
+alias tezos-autocomplete="if [ \$ZSH_NAME ] ; then autoload bashcompinit ; bashcompinit ; fi ; source \"$bin_dir/bash-completion.sh\"" ;
+trap tezos-client-reset EXIT ;
+
+EOF
+
+    (cat | sed -e 's/^/## /') 1>&2 <<EOF
+
+The client is now properly initialized. In the rest of this shell
+session, you might now run \`tezos-client\` to communicate with a
+tezos node launched with \`launch-sandboxed-node $1\`. For instance:
+
+  tezos-client rpc get /chains/main/blocks/head/metadata
+
+Note: if the current protocol version, as reported by the previous
+command, is "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im", you
+may have to activate in your "sandboxed network" the same economic
+protocol as used by the alphanet by running:
+
+  tezos-activate-alpha
+
+Warning: all the client data will be removed when you close this shell
+or if you run this command a second time.
+
+Activate tab completion by running:
+
+  tezos-autocomplete
+
+EOF
+
+}
+
+if [ "$0" == "$BASH_SOURCE" ]; then
+    main "$@"
+fi
diff --git a/vendors/tezos-modded/src/bin_signer/dune b/vendors/tezos-modded/src/bin_signer/dune
new file mode 100644
index 000000000..3386b8021
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/dune
@@ -0,0 +1,25 @@
+(executables
+ (names main_signer)
+ (public_names tezos-signer)
+ (libraries tezos-base
+            tezos-client-base
+            tezos-client-base-unix
+            tezos-client-commands
+            tezos-signer-services
+            tezos-rpc-http
+            tezos-stdlib-unix
+            tezos-signer-backends)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_client_base
+                   -open Tezos_client_base_unix
+                   -open Tezos_client_commands
+                   -open Tezos_signer_services
+                   -open Tezos_rpc_http
+                   -open Tezos_stdlib_unix)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/bin_signer/handler.ml b/vendors/tezos-modded/src/bin_signer/handler.ml
new file mode 100644
index 000000000..03ac7a386
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/handler.ml
@@ -0,0 +1,229 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Signer_logging
+
+let log = lwt_log_notice
+
+module High_watermark = struct
+  let encoding =
+    let open Data_encoding in
+    let raw_hash =
+      conv Blake2B.to_bytes Blake2B.of_bytes_exn bytes in
+    conv
+      (List.map (fun (chain_id, marks) -> Chain_id.to_b58check chain_id, marks))
+      (List.map (fun (chain_id, marks) -> Chain_id.of_b58check_exn chain_id, marks)) @@
+    assoc @@
+    conv
+      (List.map (fun (pkh, mark) -> Signature.Public_key_hash.to_b58check pkh, mark))
+      (List.map (fun (pkh, mark) -> Signature.Public_key_hash.of_b58check_exn pkh, mark)) @@
+    assoc @@
+    obj3
+      (req "level" int32)
+      (req "hash" raw_hash)
+      (opt "signature" Signature.encoding)
+
+  let mark_if_block_or_endorsement (cctxt : #Client_context.wallet) pkh bytes sign =
+    let mark art name get_level =
+      let file = name ^ "_high_watermark" in
+      cctxt#with_lock @@ fun () ->
+      cctxt#load file ~default:[] encoding >>=? fun all ->
+      if MBytes.length bytes < 9 then
+        failwith "byte sequence too short to be %s %s" art name
+      else
+        let hash = Blake2B.hash_bytes [ bytes ] in
+        let chain_id = Chain_id.of_bytes_exn (MBytes.sub bytes 1 4) in
+        let level = get_level () in
+        begin match List.assoc_opt chain_id all with
+          | None -> return_none
+          | Some marks ->
+              match List.assoc_opt pkh marks with
+              | None -> return_none
+              | Some (previous_level, _, None) ->
+                  if previous_level >= level then
+                    failwith "%s level %ld not above high watermark %ld" name level previous_level
+                  else
+                    return_none
+              | Some (previous_level, previous_hash, Some signature) ->
+                  if previous_level > level then
+                    failwith "%s level %ld below high watermark %ld" name level previous_level
+                  else if previous_level = level then
+                    if previous_hash <> hash then
+                      failwith "%s level %ld already signed with different data" name level
+                    else
+                      return_some signature
+                  else return_none
+        end >>=? function
+        | Some signature -> return signature
+        | None ->
+            sign bytes >>=? fun signature ->
+            let rec update = function
+              | [] -> [ chain_id, [ pkh, (level, hash, Some signature) ] ]
+              | (e_chain_id, marks) :: rest ->
+                  if chain_id = e_chain_id then
+                    let marks = (pkh, (level, hash, Some signature)) :: List.filter (fun (pkh', _) -> pkh <> pkh') marks in
+                    (e_chain_id, marks) :: rest
+                  else
+                    (e_chain_id, marks) :: update rest in
+            cctxt#write file (update all) encoding >>=? fun () ->
+            return signature in
+    if MBytes.length bytes > 0 && MBytes.get_uint8 bytes 0 = 0x01 then
+      mark "a" "block" (fun () -> MBytes.get_int32 bytes 5)
+    else if MBytes.length bytes > 0 && MBytes.get_uint8 bytes 0 = 0x02 then
+      mark "an" "endorsement" (fun () -> MBytes.get_int32 bytes (MBytes.length bytes - 4))
+    else sign bytes
+
+end
+
+module Authorized_key =
+  Client_aliases.Alias (struct
+    include Signature.Public_key
+    let name = "authorized_key"
+    let to_source s = return (to_b58check s)
+    let of_source t = Lwt.return (of_b58check t)
+  end)
+
+let check_magic_byte magic_bytes data =
+  match magic_bytes with
+  | None -> return_unit
+  | Some magic_bytes ->
+      let byte = MBytes.get_uint8 data 0 in
+      if MBytes.length data > 1
+      && (List.mem byte magic_bytes) then
+        return_unit
+      else
+        failwith "magic byte 0x%02X not allowed" byte
+
+
+let check_authorization cctxt pkh data require_auth signature =
+  match require_auth, signature with
+  | false, _ -> return_unit
+  | true, None -> failwith "missing authentication signature field"
+  | true, Some signature ->
+      let to_sign = Signer_messages.Sign.Request.to_sign ~pkh ~data in
+      Authorized_key.load cctxt >>=? fun keys ->
+      if List.fold_left
+          (fun acc (_, key) -> acc || Signature.check key signature to_sign)
+          false keys
+      then
+        return_unit
+      else
+        failwith "invalid authentication signature"
+
+let sign
+    (cctxt : #Client_context.wallet)
+    Signer_messages.Sign.Request.{ pkh ; data ; signature }
+    ?magic_bytes ~check_high_watermark ~require_auth =
+  log Tag.DSL.(fun f ->
+      f "Request for signing %d bytes of data for key %a, magic byte = %02X"
+      -% t event "request_for_signing"
+      -% s num_bytes (MBytes.length data)
+      -% a Signature.Public_key_hash.Logging.tag pkh
+      -% s magic_byte (MBytes.get_uint8 data 0)) >>= fun () ->
+  check_magic_byte magic_bytes data >>=? fun () ->
+  check_authorization cctxt pkh data require_auth signature >>=? fun () ->
+  Client_keys.get_key cctxt pkh >>=? fun (name, _pkh, sk_uri) ->
+  log Tag.DSL.(fun f ->
+      f "Signing data for key %s"
+      -% t event "signing_data"
+      -% s Client_keys.Logging.tag name) >>= fun () ->
+  let sign = Client_keys.sign cctxt sk_uri in
+  if check_high_watermark then
+    High_watermark.mark_if_block_or_endorsement cctxt pkh data sign
+  else
+    sign data
+
+let deterministic_nonce
+    (cctxt : #Client_context.wallet)
+    Signer_messages.Deterministic_nonce.Request.{ pkh ; data ; signature }
+    ~require_auth =
+  log Tag.DSL.(fun f ->
+      f "Request for creating a nonce from %d input bytes for key %a"
+      -% t event "request_for_deterministic_nonce"
+      -% s num_bytes (MBytes.length data)
+      -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+  check_authorization cctxt pkh data require_auth signature >>=? fun () ->
+  Client_keys.get_key cctxt pkh >>=? fun (name, _pkh, sk_uri) ->
+  log Tag.DSL.(fun f ->
+      f "Creating nonce for key %s"
+      -% t event "creating_nonce"
+      -% s Client_keys.Logging.tag name) >>= fun () ->
+  Client_keys.deterministic_nonce sk_uri data
+
+let deterministic_nonce_hash
+    (cctxt : #Client_context.wallet)
+    Signer_messages.Deterministic_nonce_hash.Request.{ pkh ; data ; signature }
+    ~require_auth =
+  log Tag.DSL.(fun f ->
+      f "Request for creating a nonce hash from %d input bytes for key %a"
+      -% t event "request_for_deterministic_nonce_hash"
+      -% s num_bytes (MBytes.length data)
+      -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+  check_authorization cctxt pkh data require_auth signature >>=? fun () ->
+  Client_keys.get_key cctxt pkh >>=? fun (name, _pkh, sk_uri) ->
+  log Tag.DSL.(fun f ->
+      f "Creating nonce hash for key %s"
+      -% t event "creating_nonce_hash"
+      -% s Client_keys.Logging.tag name) >>= fun () ->
+  Client_keys.deterministic_nonce_hash sk_uri data
+
+let supports_deterministic_nonces (cctxt : #Client_context.wallet) pkh =
+  log Tag.DSL.(fun f ->
+      f "Request for checking whether the signer supports deterministic nonces for key %a"
+      -% t event "request_for_supports_deterministic_nonces"
+      -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+  Client_keys.get_key cctxt pkh >>=? fun (name, _pkh, sk_uri) ->
+  log Tag.DSL.(fun f ->
+      f "Returns true if and only if signer can generate determinstic nonces for key %s"
+      -% t event "supports_deterministic_nonces"
+      -% s Client_keys.Logging.tag name) >>= fun () ->
+  Client_keys.supports_deterministic_nonces sk_uri
+
+let public_key (cctxt : #Client_context.wallet) pkh =
+  log Tag.DSL.(fun f ->
+      f "Request for public key %a"
+      -% t event "request_for_public_key"
+      -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+  Client_keys.list_keys cctxt >>=? fun all_keys ->
+  match List.find_opt (fun (_, h, _, _) -> Signature.Public_key_hash.equal h pkh) all_keys with
+  | None ->
+      log Tag.DSL.(fun f ->
+          f "No public key found for hash %a"
+          -% t event "not_found_public_key"
+          -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+      Lwt.fail Not_found
+  | Some (_, _, None, _) ->
+      log Tag.DSL.(fun f ->
+          f "No public key found for hash %a"
+          -% t event "not_found_public_key"
+          -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
+      Lwt.fail Not_found
+  | Some (name, _, Some pk, _) ->
+      log Tag.DSL.(fun f ->
+          f "Found public key for hash %a (name: %s)"
+          -% t event "found_public_key"
+          -% a Signature.Public_key_hash.Logging.tag pkh
+          -% s Client_keys.Logging.tag name) >>= fun () ->
+      return pk
diff --git a/vendors/tezos-modded/src/bin_signer/handler.mli b/vendors/tezos-modded/src/bin_signer/handler.mli
new file mode 100644
index 000000000..69ef13d74
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/handler.mli
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Authorized_key :
+  Client_aliases.Alias with type t := Signature.public_key
+(** Storage for keys that have been authorized for baking. *)
+
+val public_key :
+  #Client_context.wallet ->
+  Signature.public_key_hash -> Signature.public_key tzresult Lwt.t
+(** [public_key cctxt pkh] returns the public key whose hash is [pkh]
+    iff it is present if [cctxt]. *)
+
+val sign :
+  #Client_context.wallet ->
+  Signer_messages.Sign.Request.t ->
+  ?magic_bytes:int list ->
+  check_high_watermark:bool -> require_auth:bool -> Signature.t tzresult Lwt.t
+(** [sign cctxt req ?magic_bytes ~check_high_watermark ~require_auth]
+    signs [req] and returns a signature. *)
+
+val deterministic_nonce :
+  #Client_context.wallet ->
+  Signer_messages.Deterministic_nonce.Request.t ->
+  require_auth:bool -> MBytes.t tzresult Lwt.t
+(** [deterministic_nonce cctxt req ~require_auth] generates
+    deterministically a nonce from [req.data]. *)
+
+val deterministic_nonce_hash :
+  #Client_context.wallet ->
+  Signer_messages.Deterministic_nonce_hash.Request.t ->
+  require_auth:bool -> MBytes.t tzresult Lwt.t
+(** [deterministic_nonce_hash cctxt req ~require_auth] generates
+    deterministically a nonce from [req.data] and returns the hash of
+    this nonce. *)
+
+val supports_deterministic_nonces :
+  #Client_context.wallet ->
+  Signature.public_key_hash ->
+  bool tzresult Lwt.t
+(** [supports_deterministic_nonces cctxt pkh] determines whether the
+    the signer provides the determinsitic nonce functionality. *)
diff --git a/vendors/tezos-modded/src/bin_signer/http_daemon.ml b/vendors/tezos-modded/src/bin_signer/http_daemon.ml
new file mode 100644
index 000000000..9b8747059
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/http_daemon.ml
@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 log = Signer_logging.lwt_log_notice
+open Signer_logging
+
+let run (cctxt : #Client_context.wallet) ~hosts ?magic_bytes ~check_high_watermark ~require_auth mode =
+  let dir = RPC_directory.empty in
+  let dir =
+    RPC_directory.register1 dir Signer_services.sign begin fun pkh signature data ->
+      Handler.sign cctxt { pkh ; data ; signature } ?magic_bytes ~check_high_watermark ~require_auth
+    end in
+  let dir =
+    RPC_directory.register1 dir Signer_services.public_key begin fun pkh () () ->
+      Handler.public_key cctxt pkh
+    end in
+  let dir =
+    RPC_directory.register0 dir Signer_services.authorized_keys begin fun () () ->
+      if require_auth then
+        Handler.Authorized_key.load cctxt >>=? fun keys ->
+        return_some (keys |> List.split |> snd |> List.map Signature.Public_key.hash)
+      else
+        return_none
+    end in
+  Lwt.catch
+    (fun () ->
+       List.map
+         (fun host ->
+            let host = Ipaddr.V6.to_string host in
+            log Tag.DSL.(fun f ->
+                f "Listening on address %s"
+                -% t event "signer_listening"
+                -% s host_name host) >>= fun () ->
+            RPC_server.launch ~host mode dir
+              ~media_types:Media_type.all_media_types
+            >>= fun _server ->
+            fst (Lwt.wait ()))
+         hosts |> Lwt.choose)
+    (function
+      | Unix.Unix_error(Unix.EADDRINUSE, "bind","") ->
+          failwith "Port already in use."
+      | exn -> Lwt.return (error_exn exn))
+
+let run_https (cctxt : #Client_context.wallet) ~host ~port ~cert ~key ?magic_bytes ~check_high_watermark ~require_auth =
+  Lwt_utils_unix.getaddrinfo ~passive:true ~node:host ~service:(string_of_int port) >>= function
+  | []->
+      failwith "Cannot resolve listening address: %S" host
+  | points ->
+      let hosts = fst (List.split points) in
+      log Tag.DSL.(fun f ->
+          f "Accepting HTTPS requests on port %d"
+          -% t event "accepting_https_requests"
+          -% s port_number port) >>= fun () ->
+      let mode : Conduit_lwt_unix.server =
+        `TLS (`Crt_file_path cert, `Key_file_path key, `No_password, `Port port) in
+      run (cctxt : #Client_context.wallet) ~hosts ?magic_bytes ~check_high_watermark ~require_auth mode
+
+let run_http (cctxt : #Client_context.wallet) ~host ~port ?magic_bytes ~check_high_watermark ~require_auth =
+  Lwt_utils_unix.getaddrinfo ~passive:true ~node:host ~service:(string_of_int port) >>= function
+  | [] ->
+      failwith "Cannot resolve listening address: %S" host
+  | points ->
+      let hosts = fst (List.split points) in
+      log Tag.DSL.(fun f ->
+          f "Accepting HTTP requests on port %d"
+          -% t event "accepting_http_requests"
+          -% s port_number port) >>= fun () ->
+      let mode : Conduit_lwt_unix.server =
+        `TCP (`Port port) in
+      run (cctxt : #Client_context.wallet) ~hosts ?magic_bytes ~check_high_watermark ~require_auth mode
diff --git a/vendors/tezos-modded/src/bin_signer/http_daemon.mli b/vendors/tezos-modded/src/bin_signer/http_daemon.mli
new file mode 100644
index 000000000..e07043652
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/http_daemon.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 run_https:
+  #Client_context.io_wallet ->
+  host:string -> port:int -> cert:string -> key:string ->
+  ?magic_bytes: int list ->
+  check_high_watermark: bool ->
+  require_auth: bool ->
+  'a tzresult Lwt.t
+
+val run_http:
+  #Client_context.io_wallet ->
+  host:string -> port:int ->
+  ?magic_bytes: int list ->
+  check_high_watermark: bool ->
+  require_auth: bool ->
+  'a tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/bin_signer/main_signer.ml b/vendors/tezos-modded/src/bin_signer/main_signer.ml
new file mode 100644
index 000000000..766fd66ea
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/main_signer.ml
@@ -0,0 +1,421 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 default_tcp_host =
+  match Sys.getenv_opt "TEZOS_SIGNER_TCP_HOST" with
+  | None -> "localhost"
+  | Some host -> host
+
+let default_tcp_port =
+  match Sys.getenv_opt "TEZOS_SIGNER_TCP_PORT" with
+  | None -> "7732"
+  | Some port -> port
+
+let default_unix_path =
+  match Sys.getenv_opt "TEZOS_SIGNER_UNIX_PATH" with
+  | None -> Filename.concat (Sys.getenv "HOME") (".tezos-signer.sock")
+  | Some path -> path
+
+let default_https_host =
+  match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_HOST" with
+  | None -> "localhost"
+  | Some host -> host
+
+let default_https_port =
+  match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_PORT" with
+  | None -> "443"
+  | Some port -> port
+
+let default_http_host =
+  match Sys.getenv_opt "TEZOS_SIGNER_HTTP_HOST" with
+  | None -> "localhost"
+  | Some host -> host
+
+let default_http_port =
+  match Sys.getenv_opt "TEZOS_SIGNER_HTTP_PORT" with
+  | None -> "6732"
+  | Some port -> port
+
+open Clic
+
+let group =
+  { Clic.name = "signer" ;
+    title = "Commands specific to the signing daemon" }
+
+let magic_bytes_arg =
+  Clic.arg
+    ~doc: "values allowed for the magic bytes, defaults to any"
+    ~short: 'M'
+    ~long: "magic-bytes"
+    ~placeholder: "0xHH,0xHH,..."
+    (Clic.parameter (fun _ s ->
+         try
+           return
+             (List.map
+                (fun s ->
+                   let b = int_of_string s in
+                   if b < 0 || b > 255 then raise Exit else b)
+                (String.split ',' s))
+         with _ ->
+           failwith "Bad format for magic bytes, a series of numbers \
+                     is expected, separated by commas."))
+
+let high_watermark_switch =
+  Clic.switch
+    ~doc: "high watermark restriction\n\
+           Stores the highest level signed for blocks and endorsements \
+           for each address, and forbids to sign a level that is \
+           inferior or equal afterwards, except for the exact same \
+           input data."
+    ~short: 'W'
+    ~long: "check-high-watermark"
+    ()
+
+let pidfile_arg =
+  arg
+    ~doc: "write process id in file"
+    ~short: 'P'
+    ~long: "pidfile"
+    ~placeholder: "filename"
+    (parameter (fun _ s -> return s))
+
+let init_signal () =
+  let handler name id = try
+      Format.eprintf "Received the %s signal, triggering shutdown.@." name ;
+      exit id
+    with _ -> () in
+  ignore (Lwt_unix.on_signal Sys.sigint (handler "INT") : Lwt_unix.signal_handler_id) ;
+  ignore (Lwt_unix.on_signal Sys.sigterm (handler "TERM") : Lwt_unix.signal_handler_id)
+
+let may_setup_pidfile = function
+  | None -> return_unit
+  | Some pidfile ->
+      trace (failure "Failed to create the pidfile: %s" pidfile) @@
+      Lwt_lock_file.create ~unlink_on_exit:true pidfile
+
+let commands base_dir require_auth : Client_context.full command list =
+  Tezos_signer_backends.Ledger.commands () @
+  List.map
+    (Clic.map_command
+       (fun (o : Client_context.full) -> (o :> Client_context.io_wallet)))
+    (Client_keys_commands.commands None @
+     [ command ~group
+         ~desc: "Launch a signer daemon over a TCP socket."
+         (args5
+            pidfile_arg
+            magic_bytes_arg
+            high_watermark_switch
+            (default_arg
+               ~doc: "listening address or host name"
+               ~short: 'a'
+               ~long: "address"
+               ~placeholder: "host|address"
+               ~default: default_tcp_host
+               (parameter (fun _ s -> return s)))
+            (default_arg
+               ~doc: "listening TCP port or service name"
+               ~short: 'p'
+               ~long: "port"
+               ~placeholder: "port number"
+               ~default: default_tcp_port
+               (parameter (fun _ s -> return s))))
+         (prefixes [ "launch" ; "socket" ; "signer" ] @@ stop)
+         (fun (pidfile, magic_bytes, check_high_watermark, host, port) cctxt ->
+            init_signal () ;
+            may_setup_pidfile pidfile >>=? fun () ->
+            Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
+            Socket_daemon.run
+              cctxt (Tcp (host, port, [AI_SOCKTYPE SOCK_STREAM]))
+              ?magic_bytes ~check_high_watermark ~require_auth >>=? fun _ ->
+            return_unit) ;
+       command ~group
+         ~desc: "Launch a signer daemon over a local Unix socket."
+         (args4
+            pidfile_arg
+            magic_bytes_arg
+            high_watermark_switch
+            (default_arg
+               ~doc: "path to the local socket file"
+               ~short: 's'
+               ~long: "socket"
+               ~placeholder: "path"
+               ~default: (Filename.concat base_dir "socket")
+               (parameter (fun _ s -> return s))))
+         (prefixes [ "launch" ; "local" ; "signer" ] @@ stop)
+         (fun (pidfile, magic_bytes, check_high_watermark, path) cctxt ->
+            init_signal () ;
+            may_setup_pidfile pidfile >>=? fun () ->
+            Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
+            Socket_daemon.run
+              cctxt (Unix path) ?magic_bytes ~check_high_watermark ~require_auth >>=? fun _ ->
+            return_unit) ;
+       command ~group
+         ~desc: "Launch a signer daemon over HTTP."
+         (args5
+            pidfile_arg
+            magic_bytes_arg
+            high_watermark_switch
+            (default_arg
+               ~doc: "listening address or host name"
+               ~short: 'a'
+               ~long: "address"
+               ~placeholder: "host|address"
+               ~default: default_http_host
+               (parameter (fun _ s -> return s)))
+            (default_arg
+               ~doc: "listening HTTP port"
+               ~short: 'p'
+               ~long: "port"
+               ~placeholder: "port number"
+               ~default: default_http_port
+               (parameter
+                  (fun _ x ->
+                     try return (int_of_string x)
+                     with Failure _ -> failwith "Invalid port %s" x))))
+         (prefixes [ "launch" ; "http" ; "signer" ] @@ stop)
+         (fun (pidfile, magic_bytes, check_high_watermark, host, port) cctxt ->
+            init_signal () ;
+            may_setup_pidfile pidfile >>=? fun () ->
+            Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
+            Http_daemon.run_http cctxt ~host ~port ?magic_bytes ~check_high_watermark ~require_auth) ;
+       command ~group
+         ~desc: "Launch a signer daemon over HTTPS."
+         (args5
+            pidfile_arg
+            magic_bytes_arg
+            high_watermark_switch
+            (default_arg
+               ~doc: "listening address or host name"
+               ~short: 'a'
+               ~long: "address"
+               ~placeholder: "host|address"
+               ~default: default_https_host
+               (parameter (fun _ s -> return s)))
+            (default_arg
+               ~doc: "listening HTTPS port"
+               ~short: 'p'
+               ~long: "port"
+               ~placeholder: "port number"
+               ~default: default_https_port
+               (parameter
+                  (fun _ x ->
+                     try return (int_of_string x)
+                     with Failure _ -> failwith "Invalid port %s" x))))
+         (prefixes [ "launch" ; "https" ; "signer" ] @@
+          param
+            ~name:"cert"
+            ~desc: "path to the TLS certificate"
+            (parameter (fun _ s ->
+                 if not (Sys.file_exists s) then
+                   failwith "No such TLS certificate file %s" s
+                 else
+                   return s)) @@
+          param
+            ~name:"key"
+            ~desc: "path to the TLS key"
+            (parameter (fun _ s ->
+                 if not (Sys.file_exists s) then
+                   failwith "No such TLS key file %s" s
+                 else
+                   return s)) @@ stop)
+         (fun (pidfile, magic_bytes, check_high_watermark, host, port) cert key cctxt ->
+            init_signal () ;
+            may_setup_pidfile pidfile >>=? fun () ->
+            Tezos_signer_backends.Encrypted.decrypt_all cctxt >>=? fun () ->
+            Http_daemon.run_https cctxt ~host ~port ~cert ~key ?magic_bytes ~check_high_watermark ~require_auth) ;
+       command ~group
+         ~desc: "Authorize a given public key to perform signing requests."
+         (args1
+            (arg
+               ~doc: "an optional name for the key (defaults to the hash)"
+               ~short: 'N'
+               ~long: "name"
+               ~placeholder: "name"
+               (parameter (fun _ s -> return s))))
+         (prefixes [ "add" ; "authorized" ; "key" ] @@
+          param
+            ~name:"pk"
+            ~desc: "full public key (Base58 encoded)"
+            (parameter (fun _ s -> Lwt.return (Signature.Public_key.of_b58check s))) @@
+          stop)
+         (fun name key cctxt ->
+            let pkh = Signature.Public_key.hash key in
+            let name = match name with
+              | Some name -> name
+              | None -> Signature.Public_key_hash.to_b58check pkh in
+            Handler.Authorized_key.add ~force:false cctxt name key)
+     ])
+
+
+let home = try Sys.getenv "HOME" with Not_found -> "/root"
+
+let default_base_dir =
+  Filename.concat home ".tezos-signer"
+
+let (//) = Filename.concat
+
+let string_parameter () : (string, _) parameter =
+  parameter (fun _ x -> return x)
+
+let base_dir_arg () =
+  arg
+    ~long:"base-dir"
+    ~short:'d'
+    ~placeholder:"path"
+    ~doc:("signer data directory\n\
+           The directory where the Tezos client will store all its data.\n\
+           By default: '" ^ default_base_dir ^"'.")
+    (string_parameter ())
+
+let require_auth_arg () =
+  switch
+    ~long:"require-authentication"
+    ~short:'A'
+    ~doc:"Require a signature from the caller to sign."
+    ()
+
+let password_filename_arg () =
+  arg
+    ~long:"password-file"
+    ~short:'f'
+    ~placeholder:"filename"
+    ~doc:"Absolute path of the password file"
+    (string_parameter ())
+
+let global_options () =
+  args3
+    (base_dir_arg ())
+    (require_auth_arg ())
+    (password_filename_arg ())
+
+(* Main (lwt) entry *)
+let main () =
+  let executable_name = Filename.basename Sys.executable_name in
+  let original_args, autocomplete =
+    (* for shell aliases *)
+    let rec move_autocomplete_token_upfront acc = function
+      | "bash_autocomplete" :: prev_arg :: cur_arg :: script :: args ->
+          let args = List.rev acc @ args in
+          args, Some (prev_arg, cur_arg, script)
+      | x :: rest -> move_autocomplete_token_upfront (x :: acc) rest
+      | [] -> List.rev acc, None in
+    match Array.to_list Sys.argv with
+    | _ :: args -> move_autocomplete_token_upfront [] args
+    | [] -> [], None in
+  Random.self_init () ;
+  ignore Clic.(setup_formatter Format.std_formatter
+                 (if Unix.isatty Unix.stdout then Ansi else Plain) Short) ;
+  ignore Clic.(setup_formatter Format.err_formatter
+                 (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
+  begin
+    begin
+      parse_global_options
+        (global_options ()) () original_args >>=?
+      fun ((base_dir, require_auth, password_filename), remaining) ->
+      let base_dir = Option.unopt ~default:default_base_dir base_dir in
+      let cctxt =
+        new Client_context_unix.unix_full
+          ~block:Client_config.default_block
+          ~confirmations:None
+          ~password_filename
+          ~base_dir
+          ~rpc_config:RPC_client.default_config in
+      Client_keys.register_signer
+        (module Tezos_signer_backends.Encrypted.Make(struct
+             let cctxt = new Client_context_unix.unix_prompter
+           end)) ;
+      Client_keys.register_signer
+        (module Tezos_signer_backends.Unencrypted) ;
+      Client_keys.register_signer
+        (module Tezos_signer_backends.Ledger) ;
+      Logging_unix.init () >>= fun () ->
+      let module Remote_params = struct
+        let authenticate pkhs payload =
+          Client_keys.list_keys cctxt >>=? fun keys ->
+          match List.filter_map begin function
+              | (_, known_pkh, _, Some known_sk_uri)
+                when List.exists (fun pkh -> Signature.Public_key_hash.equal pkh known_pkh) pkhs ->
+                  Some known_sk_uri
+              | _ -> None
+            end keys with
+          | sk_uri :: _ ->
+              Client_keys.sign cctxt sk_uri payload
+          | [] -> failwith
+                    "remote signer expects authentication signature, \
+                     but no authorized key was found in the wallet"
+        let logger = RPC_client.full_logger Format.err_formatter
+      end in
+      let module Socket = Tezos_signer_backends.Socket.Make(Remote_params) in
+      let module Http = Tezos_signer_backends.Http.Make(Remote_params) in
+      let module Https = Tezos_signer_backends.Https.Make(Remote_params) in
+      Client_keys.register_signer (module Socket.Unix) ;
+      Client_keys.register_signer (module Socket.Tcp) ;
+      Client_keys.register_signer (module Http) ;
+      Client_keys.register_signer (module Https) ;
+      let commands =
+        Clic.add_manual
+          ~executable_name
+          ~global_options:(global_options ())
+          (if Unix.isatty Unix.stdout then Clic.Ansi else Clic.Plain)
+          Format.std_formatter
+          (commands base_dir require_auth) in
+      begin match autocomplete with
+        | Some (prev_arg, cur_arg, script) ->
+            Clic.autocompletion
+              ~script ~cur_arg ~prev_arg ~args:original_args
+              ~global_options:(global_options ())
+              commands cctxt >>=? fun completions ->
+            List.iter print_endline completions ;
+            return_unit
+        | None ->
+            Clic.dispatch commands cctxt remaining
+      end
+    end >>= function
+    | Ok () ->
+        Lwt.return 0
+    | Error [ Clic.Help command ] ->
+        Clic.usage
+          Format.std_formatter
+          ~executable_name
+          ~global_options:(global_options ())
+          (match command with None -> [] | Some c -> [ c ]) ;
+        Lwt.return 0
+    | Error errs ->
+        Clic.pp_cli_errors
+          Format.err_formatter
+          ~executable_name
+          ~global_options:(global_options ())
+          ~default:Error_monad.pp
+          errs ;
+        Lwt.return 1
+  end >>= fun retcode ->
+  Format.pp_print_flush Format.err_formatter () ;
+  Format.pp_print_flush Format.std_formatter () ;
+  Logging_unix.close () >>= fun () ->
+  Lwt.return retcode
+
+let () =
+  Pervasives.exit (Lwt_main.run (main ()))
diff --git a/vendors/tezos-modded/src/bin_signer/main_signer.mli b/vendors/tezos-modded/src/bin_signer/main_signer.mli
new file mode 100644
index 000000000..f36053c81
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/main_signer.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* empty *)
diff --git a/vendors/tezos-modded/src/bin_signer/signer_logging.ml b/vendors/tezos-modded/src/bin_signer/signer_logging.ml
new file mode 100644
index 000000000..488e8ee95
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/signer_logging.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.signer" end)
+
+let host_name = Tag.def ~doc:"Host name" "host" Format.pp_print_text
+let service_name = Tag.def ~doc:"Service name" "service" Format.pp_print_text
+let port_number = Tag.def ~doc:"Port number" "port" Format.pp_print_int
+let magic_byte = Tag.def ~doc:"Magic byte" "magic_byte" Format.pp_print_int
+let num_bytes = Tag.def ~doc:"Number of bytes" "num_bytes" Format.pp_print_int
+let unix_socket_path = Tag.def ~doc:"UNIX socket file path" "unix_socket" Format.pp_print_text
diff --git a/vendors/tezos-modded/src/bin_signer/signer_logging.mli b/vendors/tezos-modded/src/bin_signer/signer_logging.mli
new file mode 100644
index 000000000..0d7b2d0e5
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/signer_logging.mli
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.SEMLOG
+
+val host_name: string Tag.def
+val service_name: string Tag.def
+val port_number: int Tag.def
+val magic_byte: int Tag.def
+val num_bytes: int Tag.def
+val unix_socket_path: string Tag.def
diff --git a/vendors/tezos-modded/src/bin_signer/socket_daemon.ml b/vendors/tezos-modded/src/bin_signer/socket_daemon.ml
new file mode 100644
index 000000000..d7de0b1c0
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/socket_daemon.ml
@@ -0,0 +1,112 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Signer_logging
+open Signer_messages
+
+let log = lwt_log_notice
+
+let handle_client ?magic_bytes ~check_high_watermark ~require_auth cctxt fd =
+  Lwt_utils_unix.Socket.recv fd Request.encoding >>=? function
+  | Sign req ->
+      let encoding = result_encoding Sign.Response.encoding in
+      Handler.sign cctxt req ?magic_bytes ~check_high_watermark ~require_auth >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Deterministic_nonce req ->
+      let encoding = result_encoding Deterministic_nonce.Response.encoding in
+      Handler.deterministic_nonce cctxt req ~require_auth >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Deterministic_nonce_hash req ->
+      let encoding = result_encoding Deterministic_nonce_hash.Response.encoding in
+      Handler.deterministic_nonce_hash cctxt req ~require_auth >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Supports_deterministic_nonces req ->
+      let encoding = result_encoding Supports_deterministic_nonces.Response.encoding in
+      Handler.supports_deterministic_nonces cctxt req >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Public_key pkh ->
+      let encoding = result_encoding Public_key.Response.encoding in
+      Handler.public_key cctxt pkh >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+  | Authorized_keys ->
+      let encoding = result_encoding Authorized_keys.Response.encoding in
+      begin if require_auth then
+          Handler.Authorized_key.load cctxt >>=? fun keys ->
+          return (Authorized_keys.Response.Authorized_keys
+                    (keys |> List.split |> snd |> List.map Signature.Public_key.hash))
+        else return Authorized_keys.Response.No_authentication
+      end >>= fun res ->
+      Lwt_utils_unix.Socket.send fd encoding res >>= fun _ ->
+      Lwt_unix.close fd >>= fun () ->
+      return_unit
+
+let run (cctxt : #Client_context.wallet) path ?magic_bytes ~check_high_watermark ~require_auth =
+  let open Lwt_utils_unix.Socket in
+  begin
+    match path with
+    | Tcp (host, service, _opts) ->
+        log Tag.DSL.(fun f ->
+            f "Accepting TCP requests on %s:%s"
+            -% t event "accepting_tcp_requests"
+            -% s host_name host
+            -% s service_name service)
+    | Unix path ->
+        ListLabels.iter Sys.[sigint ; sigterm] ~f:begin fun signal ->
+          Sys.set_signal signal (Signal_handle begin fun _ ->
+              Format.printf "Removing the local socket file and quitting.@." ;
+              Unix.unlink path ;
+              exit 0
+            end)
+        end ;
+        log Tag.DSL.(fun f ->
+            f "Accepting UNIX requests on %s"
+            -% t event "accepting_unix_requests"
+            -% s unix_socket_path path)
+  end >>= fun () ->
+  bind path >>=? fun fds ->
+  let rec loop fd =
+    Lwt_unix.accept fd >>= fun (cfd, _) ->
+    Lwt.async begin fun () ->
+      protect
+        ~on_error:(function
+            | [Exn End_of_file] -> return_unit
+            | errs -> Lwt.return (Error errs))
+        (fun () ->
+           handle_client ?magic_bytes ~check_high_watermark ~require_auth cctxt cfd)
+    end ;
+    loop fd
+  in
+  Lwt_list.map_p loop fds >>=
+  return
diff --git a/vendors/tezos-modded/src/bin_signer/socket_daemon.mli b/vendors/tezos-modded/src/bin_signer/socket_daemon.mli
new file mode 100644
index 000000000..c54c2374c
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/socket_daemon.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 run:
+  #Client_context.io_wallet ->
+  Lwt_utils_unix.Socket.addr ->
+  ?magic_bytes: int list ->
+  check_high_watermark: bool ->
+  require_auth: bool ->
+  'a list tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/bin_signer/tezos-signer.opam b/vendors/tezos-modded/src/bin_signer/tezos-signer.opam
new file mode 100644
index 000000000..1375d511b
--- /dev/null
+++ b/vendors/tezos-modded/src/bin_signer/tezos-signer.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-base"
+  "tezos-client-base-unix"
+  "tezos-client-commands"
+  "tezos-signer-services"
+  "tezos-rpc-http"
+  "tezos-stdlib-unix"
+  "tezos-signer-backends"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_base/base_logging.ml b/vendors/tezos-modded/src/lib_base/base_logging.ml
new file mode 100644
index 000000000..0c8a6b140
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/base_logging.ml
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "base" end)
+
+let pp_exn_trace ppf backtrace =
+  if String.length backtrace <> 0 then
+    Format.fprintf ppf
+      "@,Backtrace:@,  @[<h>%a@]"
+      Format.pp_print_text backtrace
+
+let pid = Tag.def ~doc:"unix process ID where problem occurred" "pid" Format.pp_print_int
+let exn_trace = Tag.def ~doc:"backtrace from native Ocaml exception" "exn_trace" pp_exn_trace
diff --git a/vendors/tezos-modded/src/lib_base/base_logging.mli b/vendors/tezos-modded/src/lib_base/base_logging.mli
new file mode 100644
index 000000000..f269167ce
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/base_logging.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.SEMLOG
+
+val pid : int Tag.def
+val exn_trace : string Tag.def
diff --git a/vendors/tezos-modded/src/lib_base/block_header.ml b/vendors/tezos-modded/src/lib_base/block_header.ml
new file mode 100644
index 000000000..d6ce8c61f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/block_header.ml
@@ -0,0 +1,124 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type shell_header = {
+  level: Int32.t ;
+  proto_level: int ; (* uint8 *)
+  predecessor: Block_hash.t ;
+  timestamp: Time.t ;
+  validation_passes: int ; (* uint8 *)
+  operations_hash: Operation_list_list_hash.t ;
+  fitness: Fitness.t ;
+  context: Context_hash.t ;
+}
+
+let shell_header_encoding =
+  let open Data_encoding in
+  def "block_header.shell" @@
+  conv
+    (fun { level ; proto_level ; predecessor ;
+           timestamp ; validation_passes ; operations_hash ; fitness ;
+           context } ->
+      (level, proto_level, predecessor,
+       timestamp, validation_passes, operations_hash, fitness,
+       context))
+    (fun (level, proto_level, predecessor,
+          timestamp, validation_passes, operations_hash, fitness,
+          context) ->
+      { level ; proto_level ; predecessor ;
+        timestamp ; validation_passes ; operations_hash ; fitness ;
+        context })
+    (obj8
+       (req "level" int32)
+       (req "proto" uint8)
+       (req "predecessor" Block_hash.encoding)
+       (req "timestamp" Time.encoding)
+       (req "validation_pass" uint8)
+       (req "operations_hash" Operation_list_list_hash.encoding)
+       (req "fitness" Fitness.encoding)
+       (req "context" Context_hash.encoding))
+
+type t = {
+  shell: shell_header ;
+  protocol_data: MBytes.t ;
+}
+
+include Compare.Make (struct
+    type nonrec t = t
+    let compare b1 b2 =
+      let (>>) x y = if x = 0 then y () else x in
+      let rec list compare xs ys =
+        match xs, ys with
+        | [], [] -> 0
+        | _ :: _, [] -> -1
+        | [], _ :: _ -> 1
+        | x :: xs, y :: ys ->
+            compare x y >> fun () -> list compare xs ys in
+      Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
+      compare b1.protocol_data b2.protocol_data >> fun () ->
+      Operation_list_list_hash.compare
+        b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
+      Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
+      list compare b1.shell.fitness b2.shell.fitness
+  end)
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { shell ; protocol_data } -> (shell, protocol_data))
+    (fun (shell, protocol_data) -> { shell ; protocol_data })
+    (merge_objs
+       shell_header_encoding
+       (obj1 (req "protocol_data" Variable.bytes)))
+
+let bounded_encoding ?max_size () =
+  match max_size with
+  | None -> encoding
+  | Some max_size -> Data_encoding.check_size max_size encoding
+
+let pp ppf op =
+  Data_encoding.Json.pp ppf
+    (Data_encoding.Json.construct encoding op)
+
+let to_bytes v = Data_encoding.Binary.to_bytes_exn encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+
+let hash block = Block_hash.hash_bytes [to_bytes block]
+let hash_raw bytes = Block_hash.hash_bytes [bytes]
+
+let forced_protocol_upgrades : (Int32.t * Protocol_hash.t) list = [
+  (* nothing *)
+]
+
+module LevelMap =
+  Map.Make(struct type t = Int32.t let compare = Int32.compare end)
+let get_forced_protocol_upgrade =
+  let table =
+    List.fold_left
+      (fun map (level, hash) -> LevelMap.add level hash map)
+      LevelMap.empty
+      forced_protocol_upgrades in
+  fun ~level -> LevelMap.find_opt level table
diff --git a/vendors/tezos-modded/src/lib_base/block_header.mli b/vendors/tezos-modded/src/lib_base/block_header.mli
new file mode 100644
index 000000000..9586b6145
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/block_header.mli
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type shell_header = {
+  level: Int32.t ;
+  (** Height of the block, from the genesis block. *)
+  proto_level: int ; (* uint8 *)
+  (** Number of protocol changes since genesis modulo 256. *)
+  predecessor: Block_hash.t ;
+  (** Hash of the preceding block. *)
+  timestamp: Time.t ;
+  (** Timestamp at which the block is claimed to have been created. *)
+  validation_passes: int ; (* uint8 *)
+  (** Number of validation passes (also number of lists of operations). *)
+  operations_hash: Operation_list_list_hash.t ;
+  (** Hash of the list of lists (actually root hashes of merkle trees)
+      of operations included in the block. There is one list of
+      operations per validation pass. *)
+  fitness: Fitness.t ;
+  (** 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. *)
+  context: Context_hash.t ;
+  (** Hash of the state of the context after application of this block. *)
+}
+
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  protocol_data: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Block_hash.t
+val of_bytes_exn: MBytes.t -> t
+
+val bounded_encoding: ?max_size:int -> unit -> t Data_encoding.t
+
+val get_forced_protocol_upgrade: level:Int32.t -> Protocol_hash.t option
diff --git a/vendors/tezos-modded/src/lib_base/block_locator.ml b/vendors/tezos-modded/src/lib_base/block_locator.ml
new file mode 100644
index 000000000..b0d9c7769
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/block_locator.ml
@@ -0,0 +1,215 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+type t = raw
+and raw = Block_header.t * Block_hash.t list
+
+let raw x = x
+
+let pp ppf (hd, h_lst) =
+  let repeats = 10 in
+  let coef = 2 in
+  (* list of hashes *)
+  let rec pp_hash_list ppf (h_lst , acc , d , r) =
+    match h_lst with
+    | [] ->
+        Format.fprintf ppf ""
+    | hd :: tl ->
+        let new_d = if r > 1 then d else d * coef in
+        let new_r = if r > 1 then r - 1 else repeats in
+        Format.fprintf ppf "%a (%i)\n%a"
+          Block_hash.pp hd acc pp_hash_list (tl , acc - d , new_d , new_r) in
+  Format.fprintf ppf "%a (head)\n%a"
+    Block_hash.pp (Block_header.hash hd)
+    pp_hash_list (h_lst , -1, 1, repeats - 1)
+
+let pp_short ppf (hd, h_lst) =
+  Format.fprintf ppf "head: %a, %d predecessors"
+    Block_hash.pp (Block_header.hash hd)
+    (List.length h_lst)
+
+let encoding =
+  let open Data_encoding in
+  (* TODO add a [description] *)
+  (obj2
+     (req "current_head" (dynamic_size Block_header.encoding))
+     (req "history" (Variable.list Block_hash.encoding)))
+
+let bounded_encoding ?max_header_size ?max_length () =
+  let open Data_encoding in
+  (* TODO add a [description] *)
+  (obj2
+     (req "current_head"
+        (dynamic_size
+           (Block_header.bounded_encoding ?max_size:max_header_size ())))
+     (req "history" (Variable.list ?max_length Block_hash.encoding)))
+
+
+type seed = {
+  sender_id: P2p_peer.Id.t ;
+  receiver_id: P2p_peer.Id.t ;
+}
+
+(* Random generator for locator steps.
+
+   We draw steps by sequence of 10. The first sequence's steps are of
+   length 1 (consecutive). The second sequence's steps are of a random
+   length between 1 and 2. The third sequence's steps are of a random
+   length between 2 and 4, and so on...
+
+   The sequence is deterministic for a given triple of sender,
+   receiver and block hash. *)
+module Step : sig
+
+  type state
+  val init: seed -> Block_hash.t -> state
+  val next: state -> int * state
+
+end = struct
+
+  type state = Int32.t * int * MBytes.t
+
+  let init seed head =
+    let open Hacl.Hash in
+    let st = SHA256.init () in
+    List.iter (SHA256.update st) [
+      P2p_peer.Id.to_bytes seed.sender_id ;
+      P2p_peer.Id.to_bytes seed.receiver_id ;
+      Block_hash.to_bytes head ] ;
+    (1l, 9, SHA256.finish st)
+
+  let draw seed n =
+    Int32.rem (MBytes.get_int32 seed 0) n,
+    Hacl.Hash.SHA256.digest seed
+
+  let next (step, counter, seed) =
+    let random_gap, seed =
+      if step <= 1l then
+        0l, seed
+      else
+        draw seed (Int32.succ (Int32.div step 2l)) in
+    let new_state =
+      if counter = 0 then
+        (Int32.mul step 2l, 9, seed)
+      else
+        (step, counter - 1, seed) in
+    Int32.to_int (Int32.sub step random_gap), new_state
+
+end
+
+let estimated_length seed (head, hist) =
+  let rec loop acc state = function
+    | [] -> acc
+    | _ :: hist ->
+        let step, state = Step.next state in
+        loop (acc + step) state hist in
+  let state = Step.init seed (Block_header.hash head) in
+  let step, state = Step.next state in
+  loop step state hist
+
+let fold ~f ~init (head, hist) seed =
+  let rec loop state acc = function
+    | [] | [_] -> acc
+    | block :: (pred :: rem as hist) ->
+        let step, state = Step.next state in
+        let acc = f acc ~block ~pred ~step ~strict_step:(rem <> []) in
+        loop state acc hist in
+  let head = Block_header.hash head in
+  let state = Step.init seed head in
+  loop state init (head :: hist)
+
+type step = {
+  block: Block_hash.t ;
+  predecessor: Block_hash.t ;
+  step: int ;
+  strict_step: bool ;
+}
+
+let pp_step ppf step = Format.fprintf ppf "%d%s" step.step (if step.strict_step then "" else " max")
+
+let to_steps seed locator =
+  fold locator seed
+    ~init:[]
+    ~f: begin fun acc ~block ~pred ~step ~strict_step ->
+      { block ; predecessor = pred ; step ; strict_step } :: acc
+    end
+
+let compute ~predecessor ~genesis block_hash header seed ~size =
+  let rec loop acc size state block =
+    if size = 0 then
+      Lwt.return (List.rev acc)
+    else
+      let step, state = Step.next state in
+      predecessor block step >>= function
+      | None ->
+          (* We reached genesis before size *)
+          if Block_hash.equal block genesis then
+            Lwt.return (List.rev acc)
+          else
+            Lwt.return (List.rev (genesis :: acc))
+      | Some pred ->
+          loop (pred :: acc) (size - 1) state pred in
+  if size <= 0 then
+    Lwt.return (header, [])
+  else
+    let state = Step.init seed block_hash in
+    let step, state = Step.next state in
+    predecessor block_hash step >>= function
+    | None -> Lwt.return (header, [])
+    | Some p ->
+        loop [p] (size-1) state p >>= fun hist ->
+        Lwt.return (header, hist)
+
+type validity =
+  | Unknown
+  | Known_valid
+  | Known_invalid
+
+let unknown_prefix ~is_known (head, hist) =
+  let rec loop hist acc =
+    match hist with
+    | [] -> Lwt.return_none
+    | h :: t ->
+        is_known h >>= function
+        | Known_valid ->
+            Lwt.return_some (h, (List.rev (h :: acc)))
+        | Known_invalid ->
+            Lwt.return_none
+        | Unknown ->
+            loop t (h :: acc)
+  in
+  is_known (Block_header.hash head) >>= function
+  | Known_valid ->
+      Lwt.return_some (Block_header.hash head, (head, []))
+  | Known_invalid ->
+      Lwt.return_none
+  | Unknown ->
+      loop hist [] >>= function
+      | None ->
+          Lwt.return_none
+      | Some (tail, hist) ->
+          Lwt.return_some (tail, (head, hist))
diff --git a/vendors/tezos-modded/src/lib_base/block_locator.mli b/vendors/tezos-modded/src/lib_base/block_locator.mli
new file mode 100644
index 000000000..2be85842d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/block_locator.mli
@@ -0,0 +1,87 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = private raw
+(** A type for sparse block locator (/à la/ Bitcoin) *)
+
+and raw = Block_header.t * Block_hash.t list
+(** Non private version of Block_store_locator.t for coercions *)
+
+val raw: t -> raw
+val pp: Format.formatter -> t -> unit
+val pp_short: Format.formatter -> t -> unit
+val encoding: t Data_encoding.t
+val bounded_encoding:
+  ?max_header_size:int ->
+  ?max_length:int ->
+  unit -> t Data_encoding.t
+
+type seed = {
+  sender_id: P2p_peer.Id.t ;
+  receiver_id: P2p_peer.Id.t
+}
+(** Argument to the seed used to randomize the locator. *)
+
+val estimated_length: seed -> t -> int
+(** [estimated_length seed locator] estimate the length of the chain
+    represented by [locator] using [seed]. *)
+
+val compute:
+  predecessor: (Block_hash.t -> int -> Block_hash.t option Lwt.t) ->
+  genesis:Block_hash.t ->
+  Block_hash.t -> Block_header.t -> seed -> size:int -> t Lwt.t
+(** [compute block seed max_length] compute the sparse block locator using
+    [seed] to compute random jumps for the [block]. The locator contains at
+    most [max_length] elements. *)
+
+type step = {
+  block: Block_hash.t ;
+  predecessor: Block_hash.t ;
+  step: int ;
+  strict_step: bool ;
+}
+(** A 'step' in a locator is a couple of consecutive hashes in the
+    locator, and the expected difference of level between the two
+    blocks (or an upper bounds when [strict_step = false]). *)
+
+val pp_step: Format.formatter -> step -> unit
+
+val to_steps: seed -> t -> step list
+(** Build all the 'steps' composing the locator using a given seed,
+    starting with the oldest one (typically the predecessor of the
+    first step will be `genesis`).
+    All steps contains [strict_step = true], except the oldest one. *)
+
+type validity =
+  | Unknown
+  | Known_valid
+  | Known_invalid
+
+val unknown_prefix:
+  is_known:(Block_hash.t -> validity Lwt.t) ->
+  t -> (Block_hash.t * t) option Lwt.t
+(** [unknown_prefix validity locator] keeps only the unknown part of
+    the locator up to the first valid block. If there is no known valid
+    block or there is a known invalid one, None is returned. *)
diff --git a/vendors/tezos-modded/src/lib_base/current_git_info.ml b/vendors/tezos-modded/src/lib_base/current_git_info.ml
new file mode 100644
index 000000000..f1e1eba70
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/current_git_info.ml
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 raw_commit_hash = "$Format:%H$"
+
+let commit_hash =
+  if String.equal raw_commit_hash ("$Format:"^"%H$"(*trick to avoid git-subst*))
+  then Generated_git_info.commit_hash
+  else raw_commit_hash
+
+let raw_abbreviated_commit_hash = "$Format:%h$"
+
+let abbreviated_commit_hash =
+  if String.equal raw_abbreviated_commit_hash ("$Format:"^"%h$")
+  then Generated_git_info.abbreviated_commit_hash
+  else raw_abbreviated_commit_hash
+
+let raw_committer_date = "$Format:%ci$"
+
+let committer_date =
+  if String.equal raw_committer_date ("$Format:"^"%ci$")
+  then Generated_git_info.committer_date
+  else raw_committer_date
diff --git a/vendors/tezos-modded/src/lib_base/current_git_info.mli b/vendors/tezos-modded/src/lib_base/current_git_info.mli
new file mode 100644
index 000000000..fc4f9eff6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/current_git_info.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 commit_hash : string
+val abbreviated_commit_hash : string
+val committer_date : string
diff --git a/vendors/tezos-modded/src/lib_base/dune b/vendors/tezos-modded/src/lib_base/dune
new file mode 100644
index 000000000..2d3b672a3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/dune
@@ -0,0 +1,36 @@
+(library
+ (name tezos_base)
+ (public_name tezos-base)
+ (modules :standard \ Get-git-info)
+ (flags (:standard -w -30
+                   -open Tezos_stdlib
+                   -open Tezos_crypto
+                   -open Tezos_data_encoding
+                   -open Tezos_error_monad
+                   -open Tezos_rpc
+                   -open Tezos_clic
+                   -open Tezos_micheline
+                   -safe-string))
+ (libraries tezos-stdlib
+            tezos-crypto
+            tezos-data-encoding
+            tezos-error-monad
+            tezos-rpc
+            tezos-clic
+            tezos-micheline
+            re.str
+            calendar
+            ezjsonm
+            lwt.unix
+            mtime.clock.os
+            ipaddr.unix))
+
+(rule
+    (targets generated_git_info.ml)
+    (deps get-git-info.ml)
+    (action (with-stdout-to %{targets} (run %{ocaml} unix.cma %{deps}))))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_base/fitness.ml b/vendors/tezos-modded/src/lib_base/fitness.ml
new file mode 100644
index 000000000..223e1df99
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/fitness.ml
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = MBytes.t list
+
+include Compare.Make(struct
+
+    type nonrec t = t
+
+    (* Fitness comparison:
+       - shortest lists are smaller ;
+       - lexicographical order for lists of the same length. *)
+    let compare_bytes b1 b2 =
+      let len1 = MBytes.length b1 in
+      let len2 = MBytes.length b2 in
+      let c = compare len1 len2 in
+      if c <> 0
+      then c
+      else
+        let rec compare_byte b1 b2 pos len =
+          if pos = len
+          then 0
+          else
+            let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
+            if c <> 0
+            then c
+            else compare_byte b1 b2 (pos+1) len
+        in
+        compare_byte b1 b2 0 len1
+
+    let compare f1 f2 =
+      let rec compare_rec f1 f2 = match f1, f2 with
+        | [], [] -> 0
+        | i1 :: f1, i2 :: f2 ->
+            let i = compare_bytes i1 i2 in
+            if i = 0 then compare_rec f1 f2 else i
+        | _, _ -> assert false in
+      let len = compare (List.length f1) (List.length f2) in
+      if len = 0 then compare_rec f1 f2 else len
+  end)
+
+let rec pp fmt = function
+  | [] -> ()
+  | [f] -> Format.fprintf fmt "%a" Hex.pp (MBytes.to_hex f)
+  | f1 :: f -> Format.fprintf fmt "%a::%a" Hex.pp (MBytes.to_hex f1) pp f
+
+let encoding =
+  let open Data_encoding in
+  def "fitness"
+    ~title: "Block fitness"
+    ~description:
+      "The fitness, or score, of a block, that allow the Tezos to \
+       decide which chain is the best. A fitness value is a list of \
+       byte sequences. They are compared as follows: shortest lists \
+       are smaller; lists of the same length are compared according to \
+       the lexicographical order." @@
+  splitted
+    ~json: (list bytes)
+    ~binary:
+      (list (def "fitness.elem" bytes))
+
+let to_bytes v = Data_encoding.Binary.to_bytes_exn encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
diff --git a/vendors/tezos-modded/src/lib_base/fitness.mli b/vendors/tezos-modded/src/lib_base/fitness.mli
new file mode 100644
index 000000000..4936f3ed8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/fitness.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.T with type t = MBytes.t list
diff --git a/vendors/tezos-modded/src/lib_base/get-git-info.ml b/vendors/tezos-modded/src/lib_base/get-git-info.ml
new file mode 100755
index 000000000..1ebb716d2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/get-git-info.ml
@@ -0,0 +1,19 @@
+#!/usr/bin/env ocaml
+
+               #load "unix.cma"
+
+let query cmd =
+  let chan = Unix.open_process_in cmd in
+  try
+    let out = input_line chan in
+    if Unix.close_process_in chan = Unix.WEXITED 0 then out
+    else "unkown"
+  with End_of_file -> "unkown"
+
+let () =
+  Format.printf "@[<v>let commit_hash = \"%s\"@,"
+    (query "git show -s --pretty=format:%H");
+  Format.printf "let abbreviated_commit_hash = \"%s\"@,"
+    (query "git show -s --pretty=format:%h");
+  Format.printf "let committer_date = \"%s\"@]@."
+    (query "git show -s --pretty=format:%ci")
diff --git a/vendors/tezos-modded/src/lib_base/lwt_exit.ml b/vendors/tezos-modded/src/lib_base/lwt_exit.ml
new file mode 100644
index 000000000..8fa30b78c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/lwt_exit.ml
@@ -0,0 +1,43 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+exception Exit
+
+let termination_thread, exit_wakener = Lwt.wait ()
+let exit x = Lwt.wakeup exit_wakener x; raise Exit
+
+let () =
+  Lwt.async_exception_hook :=
+    (function
+      | Exit -> ()
+      | e ->
+          let backtrace = Printexc.get_backtrace () in
+          Base_logging.(fatal_error Tag.DSL.(fun f ->
+              f "@[<v 2>@[Uncaught (asynchronous) exception (%d):@ %a@]%a@]"
+              -% t event "uncaught_async_exception"
+              -% s pid (Unix.getpid ())
+              -% a exn e
+              -% a exn_trace backtrace)) ;
+          Lwt.wakeup exit_wakener 1)
diff --git a/vendors/tezos-modded/src/lib_base/lwt_exit.mli b/vendors/tezos-modded/src/lib_base/lwt_exit.mli
new file mode 100644
index 000000000..9c6573017
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/lwt_exit.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** A global thread that resumes the first time {!exit} is called
+    anywhere in the program. Called by the main to wait for any other
+    thread in the system to call {!exit}. *)
+val termination_thread: int Lwt.t
+
+(** Awakens the {!termination_thread} with the given return value, and
+    raises an exception that cannot be caught, except by a
+    catch-all. Should only be called once. *)
+val exit: int -> 'a
diff --git a/vendors/tezos-modded/src/lib_base/mempool.ml b/vendors/tezos-modded/src/lib_base/mempool.ml
new file mode 100644
index 000000000..9972accc6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/mempool.ml
@@ -0,0 +1,52 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  known_valid: Operation_hash.t list ;
+  pending: Operation_hash.Set.t ;
+}
+type mempool = t
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { known_valid ; pending } -> (known_valid, pending))
+    (fun (known_valid, pending) -> { known_valid ; pending })
+    (obj2
+       (req "known_valid" (list Operation_hash.encoding))
+       (req "pending" (dynamic_size Operation_hash.Set.encoding)))
+
+let bounded_encoding ?max_operations () =
+  match max_operations with
+  | None -> encoding
+  | Some max_operations ->
+      Data_encoding.check_size
+        (8 + max_operations * Operation_hash.size)
+        encoding
+
+let empty = {
+  known_valid = [] ;
+  pending = Operation_hash.Set.empty ;
+}
diff --git a/vendors/tezos-modded/src/lib_base/mempool.mli b/vendors/tezos-modded/src/lib_base/mempool.mli
new file mode 100644
index 000000000..bd1156c9e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/mempool.mli
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell Module - Mempool, a.k.a. the operations safe to be
+    broadcasted. *)
+
+type t = {
+  known_valid: Operation_hash.t list ;
+  (** A valid sequence of operations on top of the current head. *)
+  pending: Operation_hash.Set.t ;
+  (** Set of known not-invalid operation. *)
+}
+type mempool = t
+
+val encoding: mempool Data_encoding.t
+val bounded_encoding: ?max_operations:int -> unit -> mempool Data_encoding.t
+
+val empty: mempool
+(** Empty mempool. *)
diff --git a/vendors/tezos-modded/src/lib_base/operation.ml b/vendors/tezos-modded/src/lib_base/operation.ml
new file mode 100644
index 000000000..a16d43756
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/operation.ml
@@ -0,0 +1,97 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type shell_header = {
+  branch: Block_hash.t ;
+}
+
+let shell_header_encoding =
+  let open Data_encoding in
+  conv
+    (fun { branch } -> branch)
+    (fun branch -> { branch })
+    (obj1 (req "branch" Block_hash.encoding))
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare o1 o2 =
+      let (>>) x y = if x = 0 then y () else x in
+      Block_hash.compare o1.shell.branch o1.shell.branch >> fun () ->
+      MBytes.compare o1.proto o2.proto
+  end)
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { shell ; proto } -> (shell, proto))
+    (fun (shell, proto) -> { shell ; proto })
+    (merge_objs
+       shell_header_encoding
+       (obj1 (req "data" Variable.bytes)))
+
+let bounded_encoding ?max_size () =
+  match max_size with
+  | None -> encoding
+  | Some max_size -> Data_encoding.check_size max_size encoding
+
+let bounded_list_encoding
+    ?max_length ?max_size ?max_operation_size ?max_pass () =
+  let open Data_encoding in
+  let op_encoding = bounded_encoding ?max_size:max_operation_size () in
+  let op_list_encoding =
+    match max_size with
+    | None ->
+        Variable.list ?max_length (dynamic_size op_encoding)
+    | Some max_size ->
+        check_size max_size
+          (Variable.list ?max_length (dynamic_size op_encoding)) in
+  obj2
+    (req "operation_hashes_path"
+       (Operation_list_list_hash.bounded_path_encoding ?max_length:max_pass ()))
+    (req "operations" op_list_encoding)
+
+let bounded_hash_list_encoding ?max_length ?max_pass () =
+  let open Data_encoding in
+  obj2
+    (req "operation_hashes_path"
+       (Operation_list_list_hash.bounded_path_encoding ?max_length:max_pass ()))
+    (req "operation_hashes" (Variable.list ?max_length Operation_hash.encoding))
+
+let pp fmt op =
+  Data_encoding.Json.pp fmt
+    (Data_encoding.Json.construct encoding op)
+
+let to_bytes v = Data_encoding.Binary.to_bytes_exn encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+
+let hash op = Operation_hash.hash_bytes [to_bytes op]
+let hash_raw bytes = Operation_hash.hash_bytes [bytes]
+
diff --git a/vendors/tezos-modded/src/lib_base/operation.mli b/vendors/tezos-modded/src/lib_base/operation.mli
new file mode 100644
index 000000000..54c22cd20
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/operation.mli
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type shell_header = {
+  branch: Block_hash.t ;
+}
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Operation_hash.t
+val of_bytes_exn: MBytes.t -> t
+
+val bounded_encoding: ?max_size:int -> unit -> t Data_encoding.t
+val bounded_list_encoding:
+  ?max_length:int ->
+  ?max_size:int ->
+  ?max_operation_size:int ->
+  ?max_pass:int ->
+  unit -> (Operation_list_list_hash.path * t list) Data_encoding.t
+val bounded_hash_list_encoding:
+  ?max_length:int ->
+  ?max_pass:int ->
+  unit -> (Operation_list_list_hash.path * Operation_hash.t list) Data_encoding.t
+
diff --git a/vendors/tezos-modded/src/lib_base/p2p_addr.ml b/vendors/tezos-modded/src/lib_base/p2p_addr.ml
new file mode 100644
index 000000000..d9139c4b5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_addr.ml
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Ipaddr.V6.t
+
+let encoding =
+  let open Data_encoding in
+  splitted
+    ~json:begin
+      conv
+        Ipaddr.V6.to_string
+        Ipaddr.V6.of_string_exn
+        string
+    end
+    ~binary:begin
+      conv
+        Ipaddr.V6.to_bytes
+        Ipaddr.V6.of_bytes_exn
+        string
+    end
+
+type port = int
+
+let pp ppf addr =
+  match Ipaddr.v4_of_v6 addr with
+  | Some addr ->
+      Format.fprintf ppf "%a" Ipaddr.V4.pp addr
+  | None ->
+      Format.fprintf ppf "[%a]" Ipaddr.V6.pp addr
+
+let of_string_opt str =
+  match Ipaddr.of_string str with
+  | Ok (Ipaddr.V4 addr) -> Some (Ipaddr.v6_of_v4 addr)
+  | Ok (V6 addr) -> Some addr
+  | Error (`Msg _) -> None
+
+let of_string_exn str =
+  match of_string_opt str with
+  | None -> Pervasives.failwith "P2p_addr.of_string"
+  | Some t -> t
+
+let to_string saddr = Format.asprintf "%a" pp saddr
diff --git a/vendors/tezos-modded/src/lib_base/p2p_addr.mli b/vendors/tezos-modded/src/lib_base/p2p_addr.mli
new file mode 100644
index 000000000..7c7b04246
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_addr.mli
@@ -0,0 +1,36 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Ipaddr.V6.t
+type port = int
+
+val encoding : t Data_encoding.t
+
+val pp : Format.formatter -> t -> unit
+
+val of_string_opt : string -> t option
+val of_string_exn : string -> t
+
+val to_string : t -> string
diff --git a/vendors/tezos-modded/src/lib_base/p2p_connection.ml b/vendors/tezos-modded/src/lib_base/p2p_connection.ml
new file mode 100644
index 000000000..0b8c9aec0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_connection.ml
@@ -0,0 +1,379 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id = struct
+
+  (* A net point (address x port). *)
+  type t = P2p_addr.t * P2p_addr.port option
+  let compare (a1, p1) (a2, p2) =
+    match Ipaddr.V6.compare a1 a2 with
+    | 0 -> Pervasives.compare p1 p2
+    | x -> x
+  let equal p1 p2 = compare p1 p2 = 0
+  let hash = Hashtbl.hash
+  let pp ppf (addr, port) =
+    match port with
+    | None ->
+        Format.fprintf ppf "[%a]:??" Ipaddr.V6.pp addr
+    | Some port ->
+        Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp addr port
+  let pp_opt ppf = function
+    | None -> Format.pp_print_string ppf "none"
+    | Some point -> pp ppf point
+  let to_string t = Format.asprintf "%a" pp t
+
+  let is_local (addr, _) = Ipaddr.V6.is_private addr
+  let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
+
+  let of_point (addr, port) = addr, Some port
+  let to_point = function
+    | _, None -> None
+    | addr, Some port -> Some (addr, port)
+  let to_point_exn = function
+    | _, None -> invalid_arg "to_point_exn"
+    | addr, Some port -> addr, port
+
+  let encoding =
+    let open Data_encoding in
+    (obj2
+       (req "addr" P2p_addr.encoding)
+       (opt "port" uint16))
+
+end
+
+module Map = Map.Make (Id)
+module Set = Set.Make (Id)
+module Table = Hashtbl.Make (Id)
+
+module Info = struct
+
+  type 'meta t = {
+    incoming : bool ;
+    peer_id : P2p_peer_id.t ;
+    id_point : Id.t ;
+    remote_socket_port : P2p_addr.port ;
+    versions : P2p_version.t list ;
+    private_node : bool ;
+    local_metadata : 'meta ;
+    remote_metadata : 'meta ;
+  }
+
+  let encoding metadata_encoding =
+    let open Data_encoding in
+    conv
+      (fun { incoming ; peer_id ; id_point ; remote_socket_port ;
+             versions ; private_node ; local_metadata ; remote_metadata } ->
+        (incoming, peer_id, id_point, remote_socket_port,
+         versions, private_node, local_metadata, remote_metadata))
+      (fun (incoming, peer_id, id_point, remote_socket_port,
+            versions, private_node, local_metadata, remote_metadata) ->
+        { incoming ; peer_id ; id_point ; remote_socket_port ;
+          versions ; private_node ; local_metadata ; remote_metadata })
+      (obj8
+         (req "incoming" bool)
+         (req "peer_id" P2p_peer_id.encoding)
+         (req "id_point" Id.encoding)
+         (req "remote_socket_port" uint16)
+         (req "versions" (list P2p_version.encoding))
+         (req "private" bool)
+         (req "local_metadata" metadata_encoding)
+         (req "remote_metadata" metadata_encoding))
+
+  let pp pp_meta ppf
+      { incoming ; id_point = (remote_addr, remote_port) ;
+        remote_socket_port ; peer_id ; versions ; private_node ;
+        local_metadata = _ ; remote_metadata } =
+    let version = List.hd versions in
+    let point = match remote_port with
+      | None -> remote_addr, remote_socket_port
+      | Some port -> remote_addr, port in
+    Format.fprintf ppf "%s %a %a (%a)%s%a"
+      (if incoming then "↘" else "↗")
+      P2p_peer_id.pp peer_id
+      P2p_point.Id.pp point
+      P2p_version.pp version
+      (if private_node then " private" else "")
+      pp_meta remote_metadata
+
+end
+
+module Pool_event = struct
+
+  (** Pool-level events *)
+
+  type t =
+
+    | Too_few_connections
+    | Too_many_connections
+
+    | New_point of P2p_point.Id.t
+    | New_peer of P2p_peer_id.t
+
+    | Gc_points
+    | Gc_peer_ids
+
+    | Incoming_connection of P2p_point.Id.t
+    | Outgoing_connection of P2p_point.Id.t
+    | Authentication_failed of P2p_point.Id.t
+    | Accepting_request of P2p_point.Id.t * Id.t * P2p_peer_id.t
+    | Rejecting_request of P2p_point.Id.t * Id.t * P2p_peer_id.t
+    | Request_rejected of P2p_point.Id.t * (Id.t * P2p_peer_id.t) option
+    | Connection_established of Id.t * P2p_peer_id.t
+
+    | Swap_request_received of { source : P2p_peer_id.t }
+    | Swap_ack_received of { source : P2p_peer_id.t }
+    | Swap_request_sent of { source : P2p_peer_id.t }
+    | Swap_ack_sent of { source : P2p_peer_id.t }
+    | Swap_request_ignored of { source : P2p_peer_id.t }
+    | Swap_success of { source : P2p_peer_id.t }
+    | Swap_failure of { source : P2p_peer_id.t }
+
+    | Disconnection of P2p_peer_id.t
+    | External_disconnection of P2p_peer_id.t
+
+  let pp ppf (event:t) =
+    match event with
+    | Too_few_connections -> Format.pp_print_string ppf "Too_few_connections"
+    | Too_many_connections -> Format.pp_print_string ppf "Too_many_connections"
+    | New_point p -> Format.pp_print_string ppf "New_point " ; P2p_point.Id.pp ppf p
+    | New_peer p -> Format.pp_print_string ppf "New_peer " ; P2p_peer_id.pp ppf p
+    | Gc_points -> Format.pp_print_string ppf "Gc_points"
+    | Gc_peer_ids -> Format.pp_print_string ppf "Gc_peer_ids"
+    | Incoming_connection p ->
+        Format.pp_print_string ppf "Incoming_connection " ;
+        P2p_point.Id.pp ppf p
+    | Outgoing_connection p ->
+        Format.pp_print_string ppf "Outgoing_connection " ;
+        P2p_point.Id.pp ppf p
+    | Authentication_failed p ->
+        Format.pp_print_string ppf "Authentication_failed " ;
+        P2p_point.Id.pp ppf p
+    | Accepting_request (pi, _, _) ->
+        Format.pp_print_string ppf "Accepting_request " ;
+        P2p_point.Id.pp ppf pi
+    | Rejecting_request (pi, _, _) ->
+        Format.pp_print_string ppf "Rejecting_request " ;
+        P2p_point.Id.pp ppf pi
+    | Request_rejected (pi, _) ->
+        Format.pp_print_string ppf "Request_rejected " ;
+        P2p_point.Id.pp ppf pi
+    | Connection_established (_, pi) ->
+        Format.pp_print_string ppf "Connection_established " ;
+        P2p_peer_id.pp ppf pi
+    | Swap_request_received { source } ->
+        Format.pp_print_string ppf "Swap_request_received " ;
+        P2p_peer_id.pp ppf source
+    | Swap_ack_received { source } ->
+        Format.pp_print_string ppf "Swap_ack_received " ;
+        P2p_peer_id.pp ppf source
+    | Swap_request_sent { source } ->
+        Format.pp_print_string ppf "Swap_request_sent " ;
+        P2p_peer_id.pp ppf source
+    | Swap_ack_sent { source } ->
+        Format.pp_print_string ppf "Swap_ack_sent " ;
+        P2p_peer_id.pp ppf source
+    | Swap_request_ignored { source } ->
+        Format.pp_print_string ppf "Swap_request_ignored " ;
+        P2p_peer_id.pp ppf source
+    | Swap_success { source } ->
+        Format.pp_print_string ppf "Swap_success " ;
+        P2p_peer_id.pp ppf source
+    | Swap_failure { source } ->
+        Format.pp_print_string ppf "Swap_failure " ;
+        P2p_peer_id.pp ppf source
+    | Disconnection source ->
+        Format.pp_print_string ppf "Disconnection " ;
+        P2p_peer_id.pp ppf source
+    | External_disconnection source ->
+        Format.pp_print_string ppf "External_disconnection " ;
+        P2p_peer_id.pp ppf source
+
+  let encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0)
+        ~title:"Too_few_connections"
+        (branch_encoding "too_few_connections" empty)
+        (function Too_few_connections -> Some () | _ -> None)
+        (fun () -> Too_few_connections) ;
+      case (Tag 1)
+        ~title:"Too_many_connections"
+        (branch_encoding "too_many_connections" empty)
+        (function Too_many_connections -> Some () | _ -> None)
+        (fun () -> Too_many_connections) ;
+      case (Tag 2)
+        ~title:"New_point"
+        (branch_encoding "new_point"
+           (obj1 (req "point" P2p_point.Id.encoding)))
+        (function New_point p -> Some p | _ -> None)
+        (fun p -> New_point p) ;
+      case (Tag 3)
+        ~title:"New_peer"
+        (branch_encoding "new_peer"
+           (obj1 (req "peer_id" P2p_peer_id.encoding)))
+        (function New_peer p -> Some p | _ -> None)
+        (fun p -> New_peer p) ;
+      case (Tag 4)
+        ~title:"Incoming_connection"
+        (branch_encoding "incoming_connection"
+           (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Incoming_connection p -> Some p | _ -> None)
+        (fun p -> Incoming_connection p) ;
+      case (Tag 5)
+        ~title:"Outgoing_connection"
+        (branch_encoding "outgoing_connection"
+           (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Outgoing_connection p -> Some p | _ -> None)
+        (fun p -> Outgoing_connection p) ;
+      case (Tag 6)
+        ~title:"Authentication_failed"
+        (branch_encoding "authentication_failed"
+           (obj1 (req "point" P2p_point.Id.encoding)))
+        (function Authentication_failed p -> Some p | _ -> None)
+        (fun p -> Authentication_failed p) ;
+      case (Tag 7)
+        ~title:"Accepting_request"
+        (branch_encoding "accepting_request"
+           (obj3
+              (req "point" P2p_point.Id.encoding)
+              (req "id_point" Id.encoding)
+              (req "peer_id" P2p_peer_id.encoding)))
+        (function Accepting_request (p, id_p, g) ->
+           Some (p, id_p, g) | _ -> None)
+        (fun (p, id_p, g) -> Accepting_request (p, id_p, g)) ;
+      case (Tag 8)
+        ~title:"Rejecting_request"
+        (branch_encoding "rejecting_request"
+           (obj3
+              (req "point" P2p_point.Id.encoding)
+              (req "id_point" Id.encoding)
+              (req "peer_id" P2p_peer_id.encoding)))
+        (function Rejecting_request (p, id_p, g) ->
+           Some (p, id_p, g) | _ -> None)
+        (fun (p, id_p, g) -> Rejecting_request (p, id_p, g)) ;
+      case (Tag 9)
+        ~title:"Request_rejected"
+        (branch_encoding "request_rejected"
+           (obj2
+              (req "point" P2p_point.Id.encoding)
+              (opt "identity"
+                 (tup2 Id.encoding P2p_peer_id.encoding))))
+        (function Request_rejected (p, id) -> Some (p, id) | _ -> None)
+        (fun (p, id) -> Request_rejected (p, id)) ;
+      case (Tag 10)
+        ~title:"Connection_established"
+        (branch_encoding "connection_established"
+           (obj2
+              (req "id_point" Id.encoding)
+              (req "peer_id" P2p_peer_id.encoding)))
+        (function Connection_established (id_p, g) ->
+           Some (id_p, g) | _ -> None)
+        (fun (id_p, g) -> Connection_established (id_p, g)) ;
+      case (Tag 11)
+        ~title:"Disconnection"
+        (branch_encoding "disconnection"
+           (obj1 (req "peer_id" P2p_peer_id.encoding)))
+        (function Disconnection g -> Some g | _ -> None)
+        (fun g -> Disconnection g) ;
+      case (Tag 12)
+        ~title:"External_disconnection"
+        (branch_encoding "external_disconnection"
+           (obj1 (req "peer_id" P2p_peer_id.encoding)))
+        (function External_disconnection g -> Some g | _ -> None)
+        (fun g -> External_disconnection g) ;
+      case (Tag 13)
+        ~title:"Gc_points"
+        (branch_encoding "gc_points" empty)
+        (function Gc_points -> Some () | _ -> None)
+        (fun () -> Gc_points) ;
+      case (Tag 14)
+        ~title:"Gc_peer_ids"
+        (branch_encoding "gc_peer_ids" empty)
+        (function Gc_peer_ids -> Some () | _ -> None)
+        (fun () -> Gc_peer_ids) ;
+      case (Tag 15)
+        ~title:"Swap_request_received"
+        (branch_encoding "swap_request_received"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_request_received { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_received { source }) ;
+      case (Tag 16)
+        ~title:"Swap_ack_received"
+        (branch_encoding "swap_ack_received"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_ack_received { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_ack_received { source }) ;
+      case (Tag 17)
+        ~title:"Swap_request_sent"
+        (branch_encoding "swap_request_sent"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_request_sent { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_sent { source }) ;
+      case (Tag 18)
+        ~title:"Swap_ack_sent"
+        (branch_encoding "swap_ack_sent"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_ack_sent { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_ack_sent { source }) ;
+      case (Tag 19)
+        ~title:"Swap_request_ignored"
+        (branch_encoding "swap_request_ignored"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_request_ignored { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_request_ignored { source }) ;
+      case (Tag 20)
+        ~title:"Swap_success"
+        (branch_encoding "swap_success"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_success { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_success { source }) ;
+      case (Tag 21)
+        ~title:"Swap_failure"
+        (branch_encoding "swap_failure"
+           (obj1 (req "source" P2p_peer_id.encoding)))
+        (function
+          | Swap_failure { source } -> Some source
+          | _ -> None)
+        (fun source -> Swap_failure { source }) ;
+    ]
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_connection.mli b/vendors/tezos-modded/src/lib_base/p2p_connection.mli
new file mode 100644
index 000000000..1906a328f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_connection.mli
@@ -0,0 +1,128 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id : sig
+
+  type t = P2p_addr.t * P2p_addr.port option
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val pp : Format.formatter -> t -> unit
+  val pp_opt : Format.formatter -> t option -> unit
+  val to_string : t -> string
+  val encoding : t Data_encoding.t
+  val is_local : t -> bool
+  val is_global : t -> bool
+  val of_point : P2p_point.Id.t -> t
+  val to_point : t -> P2p_point.Id.t option
+  val to_point_exn : t -> P2p_point.Id.t
+
+end
+
+module Map : Map.S with type key = Id.t
+module Set : Set.S with type elt = Id.t
+module Table : Hashtbl.S with type key = Id.t
+
+(** Information about a connection *)
+module Info : sig
+
+  type 'meta t = {
+    incoming : bool;
+    peer_id : P2p_peer_id.t;
+    id_point : Id.t;
+    remote_socket_port : P2p_addr.port;
+    versions : P2p_version.t list ;
+    private_node : bool ;
+    local_metadata : 'meta ;
+    remote_metadata : 'meta ;
+  }
+
+  val pp :
+    (Format.formatter -> 'meta -> unit) ->
+    Format.formatter -> 'meta t -> unit
+  val encoding : 'meta Data_encoding.t -> 'meta t Data_encoding.t
+
+end
+
+module Pool_event : sig
+
+  type t =
+
+    | Too_few_connections
+    | Too_many_connections
+
+    | New_point of P2p_point.Id.t
+    | New_peer of P2p_peer_id.t
+
+    | Gc_points
+    (** Garbage collection of known point table has been triggered. *)
+
+    | Gc_peer_ids
+    (** Garbage collection of known peer_ids table has been triggered. *)
+
+    (* Connection-level events *)
+
+    | Incoming_connection of P2p_point.Id.t
+    (** We accept(2)-ed an incoming connection *)
+    | Outgoing_connection of P2p_point.Id.t
+    (** We connect(2)-ed to a remote endpoint *)
+    | Authentication_failed of P2p_point.Id.t
+    (** Remote point failed authentication *)
+
+    | Accepting_request of P2p_point.Id.t * Id.t * P2p_peer_id.t
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request of P2p_point.Id.t * Id.t * P2p_peer_id.t
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected of P2p_point.Id.t * (Id.t * P2p_peer_id.t) option
+    (** The remote peer rejected our connection. *)
+
+    | Connection_established of Id.t * P2p_peer_id.t
+    (** We successfully established a authentified connection. *)
+
+    | Swap_request_received of { source : P2p_peer_id.t }
+    (** A swap request has been received. *)
+    | Swap_ack_received of { source : P2p_peer_id.t }
+    (** A swap ack has been received *)
+    | Swap_request_sent of { source : P2p_peer_id.t }
+    (** A swap request has been sent *)
+    | Swap_ack_sent of { source : P2p_peer_id.t }
+    (** A swap ack has been sent *)
+    | Swap_request_ignored of { source : P2p_peer_id.t }
+    (** A swap request has been ignored *)
+    | Swap_success of { source : P2p_peer_id.t }
+    (** A swap operation has succeeded *)
+    | Swap_failure of { source : P2p_peer_id.t }
+    (** A swap operation has failed *)
+
+    | Disconnection of P2p_peer_id.t
+    (** We decided to close the connection. *)
+    | External_disconnection of P2p_peer_id.t
+    (** The connection was closed for external reason. *)
+
+  val pp : Format.formatter -> t -> unit
+
+  val encoding : t Data_encoding.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_id_point.ml b/vendors/tezos-modded/src/lib_base/p2p_id_point.ml
new file mode 100644
index 000000000..e69de29bb
diff --git a/vendors/tezos-modded/src/lib_base/p2p_id_point.mli b/vendors/tezos-modded/src/lib_base/p2p_id_point.mli
new file mode 100644
index 000000000..87e22816f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_id_point.mli
@@ -0,0 +1,25 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
diff --git a/vendors/tezos-modded/src/lib_base/p2p_identity.ml b/vendors/tezos-modded/src/lib_base/p2p_identity.ml
new file mode 100644
index 000000000..6194cf0b8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_identity.ml
@@ -0,0 +1,97 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  peer_id : P2p_peer.Id.t ;
+  public_key : Crypto_box.public_key ;
+  secret_key : Crypto_box.secret_key ;
+  proof_of_work_stamp : Crypto_box.nonce ;
+}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { peer_id ; public_key ; secret_key ; proof_of_work_stamp } ->
+       (Some peer_id, public_key, secret_key, proof_of_work_stamp))
+    (fun (peer_id_opt, public_key, secret_key, proof_of_work_stamp) ->
+       let peer_id =
+         match peer_id_opt with
+         | Some peer_id -> peer_id
+         | None -> Tezos_crypto.Crypto_box.hash public_key in
+       { peer_id ; public_key ; secret_key ; proof_of_work_stamp })
+    (obj4
+       (opt "peer_id" P2p_peer_id.encoding)
+       (req "public_key" Crypto_box.public_key_encoding)
+       (req "secret_key" Crypto_box.secret_key_encoding)
+       (req "proof_of_work_stamp" Crypto_box.nonce_encoding))
+
+let generate ?max target =
+  let secret_key, public_key, peer_id = Crypto_box.random_keypair () in
+  let proof_of_work_stamp =
+    Crypto_box.generate_proof_of_work ?max public_key target in
+  { peer_id ; public_key ; secret_key ; proof_of_work_stamp }
+
+let animation = [|
+  "|.....|" ;
+  "|o....|" ;
+  "|oo...|" ;
+  "|ooo..|" ;
+  "|.ooo.|" ;
+  "|..ooo|" ;
+  "|...oo|" ;
+  "|....o|" ;
+  "|.....|" ;
+  "|.....|" ;
+  "|.....|" ;
+  "|.....|" ;
+|]
+
+let init = String.make (String.length animation.(0)) '\ '
+let clean = String.make (String.length animation.(0)) '\b'
+let animation = Array.map (fun x -> clean ^ x) animation
+let animation_size = Array.length animation
+let duration = 1200 / animation_size
+
+let generate_with_animation ppf target =
+  Format.fprintf ppf "%s%!" init ;
+  let count = ref 10000 in
+  let rec loop n =
+    let start = Mtime_clock.counter () in
+    Format.fprintf ppf "%s%!" animation.(n mod animation_size);
+    try generate ~max:!count target
+    with Not_found ->
+      let time = Mtime.Span.to_ms (Mtime_clock.count start) in
+      count :=
+        if time <= 0. then
+          !count * 10
+        else
+          !count * duration / int_of_float time ;
+      loop (n+1)
+  in
+  let id = loop 0 in
+  Format.fprintf ppf "%s%s\n%!" clean init ;
+  id
+
+let generate target = generate target
diff --git a/vendors/tezos-modded/src/lib_base/p2p_identity.mli b/vendors/tezos-modded/src/lib_base/p2p_identity.mli
new file mode 100644
index 000000000..1a7a0d2e7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_identity.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  peer_id : P2p_peer.Id.t ;
+  public_key : Crypto_box.public_key ;
+  secret_key : Crypto_box.secret_key ;
+  proof_of_work_stamp : Crypto_box.nonce ;
+}
+(** Type of an identity, comprising a peer_id, a crypto keypair, and a
+    proof of work stamp with enough difficulty so that the network
+    accept this identity as genuine. *)
+
+val encoding : t Data_encoding.t
+
+val generate : Crypto_box.target -> t
+(** [generate target] is a freshly minted identity whose proof of
+    work stamp difficulty is at least equal to [target]. *)
+
+val generate_with_animation :
+  Format.formatter -> Crypto_box.target -> t
+(** [generate_with_animation ppf target] is a freshly minted identity
+    whose proof of work stamp difficulty is at least equal to [target]. *)
+
diff --git a/vendors/tezos-modded/src/lib_base/p2p_peer.ml b/vendors/tezos-modded/src/lib_base/p2p_peer.ml
new file mode 100644
index 000000000..17e663191
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_peer.ml
@@ -0,0 +1,190 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id = P2p_peer_id
+
+module Table = Id.Table
+module Map = Id.Map
+module Set = Id.Set
+
+module Filter = struct
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  let rpc_arg =
+    RPC_arg.make
+      ~name:"p2p.point.state_filter"
+      ~destruct:(function
+          | "accepted" -> Ok Accepted
+          | "running" -> Ok Running
+          | "disconnected" -> Ok Disconnected
+          | s -> Error (Format.asprintf "Invalid state: %s" s))
+      ~construct:(function
+          | Accepted -> "accepted"
+          | Running -> "running"
+          | Disconnected -> "disconnected")
+      ()
+
+end
+
+module State = struct
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  let pp_digram ppf = function
+    | Accepted -> Format.fprintf ppf "⚎"
+    | Running -> Format.fprintf ppf "⚌"
+    | Disconnected -> Format.fprintf ppf "⚏"
+
+  let encoding =
+    let open Data_encoding in
+    string_enum [
+      "accepted", Accepted ;
+      "running", Running ;
+      "disconnected", Disconnected ;
+    ]
+
+  let raw_filter (f : Filter.t) (s : t) =
+    match f, s with
+    | Accepted, Accepted -> true
+    | Accepted, (Running | Disconnected)
+    | (Running | Disconnected), Accepted -> false
+    | Running, Running -> true
+    | Disconnected, Disconnected -> true
+    | Running, Disconnected
+    | Disconnected, Running -> false
+
+  let filter filters state =
+    List.exists (fun f -> raw_filter f state) filters
+
+end
+
+module Info = struct
+
+  type ('peer_meta, 'conn_meta) t = {
+    score : float ;
+    trusted : bool ;
+    conn_metadata : 'conn_meta option ;
+    peer_metadata : 'peer_meta ;
+    state : State.t ;
+    id_point : P2p_connection.Id.t option ;
+    stat : P2p_stat.t ;
+    last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    last_seen : (P2p_connection.Id.t * Time.t) option ;
+    last_miss : (P2p_connection.Id.t * Time.t) option ;
+  }
+
+  let encoding peer_metadata_encoding conn_metadata_encoding =
+    let open Data_encoding in
+    conv
+      (fun (
+         { score ; trusted ; conn_metadata ; peer_metadata ;
+           state ; id_point ; stat ;
+           last_failed_connection ; last_rejected_connection ;
+           last_established_connection ; last_disconnection ;
+           last_seen ; last_miss }) ->
+         ((score, trusted, conn_metadata, peer_metadata,
+           state, id_point, stat),
+          (last_failed_connection, last_rejected_connection,
+           last_established_connection, last_disconnection,
+           last_seen, last_miss)))
+      (fun ((score, trusted, conn_metadata, peer_metadata,
+             state, id_point, stat),
+            (last_failed_connection, last_rejected_connection,
+             last_established_connection, last_disconnection,
+             last_seen, last_miss)) ->
+        { score ; trusted ; conn_metadata ; peer_metadata ;
+          state ; id_point ; stat ;
+          last_failed_connection ; last_rejected_connection ;
+          last_established_connection ; last_disconnection ;
+          last_seen ; last_miss })
+      (merge_objs
+         (obj7
+            (req "score" float)
+            (req "trusted" bool)
+            (opt "conn_metadata" conn_metadata_encoding)
+            (req "peer_metadata" peer_metadata_encoding)
+            (req "state" State.encoding)
+            (opt "reachable_at" P2p_connection.Id.encoding)
+            (req "stat" P2p_stat.encoding))
+         (obj6
+            (opt "last_failed_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_rejected_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_established_connection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_disconnection" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_seen" (tup2 P2p_connection.Id.encoding Time.encoding))
+            (opt "last_miss" (tup2 P2p_connection.Id.encoding Time.encoding))))
+
+end
+
+module Pool_event = struct
+
+  type kind =
+    | Accepting_request
+    | Rejecting_request
+    | Request_rejected
+    | Connection_established
+    | Disconnection
+    | External_disconnection
+
+  let kind_encoding =
+    Data_encoding.string_enum [
+      "incoming_request", Accepting_request ;
+      "rejecting_request", Rejecting_request ;
+      "request_rejected", Request_rejected ;
+      "connection_established", Connection_established ;
+      "disconnection", Disconnection ;
+      "external_disconnection", External_disconnection ;
+    ]
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+    point : P2p_connection.Id.t ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { kind ; timestamp ; point = (addr, port) } ->
+         (kind, timestamp, addr, port))
+      (fun (kind, timestamp, addr, port) ->
+         { kind ; timestamp ; point = (addr, port) })
+      (obj4
+         (req "kind" kind_encoding)
+         (req "timestamp" Time.encoding)
+         (req "addr" P2p_addr.encoding)
+         (opt "port" uint16))
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_peer.mli b/vendors/tezos-modded/src/lib_base/p2p_peer.mli
new file mode 100644
index 000000000..8cdc0a304
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_peer.mli
@@ -0,0 +1,104 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id = P2p_peer_id
+
+module Map = Id.Map
+module Set = Id.Set
+module Table = Id.Table
+
+module Filter : sig
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  val rpc_arg : t RPC_arg.t
+
+end
+
+module State : sig
+
+  type t =
+    | Accepted
+    | Running
+    | Disconnected
+
+  val pp_digram : Format.formatter -> t -> unit
+  val encoding : t Data_encoding.t
+
+  val filter : Filter.t list -> t -> bool
+
+end
+
+module Info : sig
+
+  type ('peer_meta, 'conn_meta) t = {
+    score : float ;
+    trusted : bool ;
+    conn_metadata : 'conn_meta option ;
+    peer_metadata : 'peer_meta ;
+    state : State.t ;
+    id_point : P2p_connection.Id.t option ;
+    stat : P2p_stat.t ;
+    last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    last_seen : (P2p_connection.Id.t * Time.t) option ;
+    last_miss : (P2p_connection.Id.t * Time.t) option ;
+  }
+
+  val encoding : 'peer_meta Data_encoding.t ->
+    'conn_meta Data_encoding.t -> ('peer_meta, 'conn_meta) t Data_encoding.t
+
+end
+
+module Pool_event : sig
+
+  type kind =
+    | Accepting_request
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected
+    (** The remote peer rejected our connection. *)
+    | Connection_established
+    (** We successfully established a authentified connection. *)
+    | Disconnection
+    (** We decided to close the connection. *)
+    | External_disconnection
+    (** The connection was closed for external reason. *)
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+    point : P2p_connection.Id.t ;
+  }
+
+  val encoding : t Data_encoding.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_peer_id.ml b/vendors/tezos-modded/src/lib_base/p2p_peer_id.ml
new file mode 100644
index 000000000..66fd43125
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_peer_id.ml
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Crypto_box.Public_key_hash
+
+let rpc_arg =
+  RPC_arg.like
+    rpc_arg
+    ~descr:"A cryptographic node identity (Base58Check-encoded)"
+    "peer_id"
+
+let pp_source ppf = function
+  | None -> ()
+  | Some peer -> Format.fprintf ppf " from peer %a" pp peer
+
+module Logging = struct
+  open Tezos_stdlib.Logging
+  include Make_semantic(struct let name = "node.distributed_db.p2p_reader" end)
+  let mk_tag pp = Tag.def ~doc:"P2P peer ID" "p2p_peer_id" pp
+  let tag = mk_tag pp_short
+  let tag_opt = mk_tag (fun ppf -> function
+      | None -> ()
+      | Some peer -> pp_short ppf peer)
+  let tag_source = Tag.def ~doc:"Peer which provided information" "p2p_peer_id_source" pp_source
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_peer_id.mli b/vendors/tezos-modded/src/lib_base/p2p_peer_id.mli
new file mode 100644
index 000000000..b33239d13
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_peer_id.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_crypto.S.HASH with type t = Crypto_box.Public_key_hash.t
+
+module Logging: sig
+  val tag: t Tag.def
+  val tag_opt: t option Tag.def
+  val tag_source: t option Tag.def
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_point.ml b/vendors/tezos-modded/src/lib_base/p2p_point.ml
new file mode 100644
index 000000000..b7445ad5a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_point.ml
@@ -0,0 +1,355 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id = struct
+
+  (* A net point (address x port). *)
+  type t = P2p_addr.t * P2p_addr.port
+  let compare (a1, p1) (a2, p2) =
+    match Ipaddr.V6.compare a1 a2 with
+    | 0 -> p1 - p2
+    | x -> x
+  let equal p1 p2 = compare p1 p2 = 0
+  let hash = Hashtbl.hash
+  let pp ppf (addr, port) =
+    match Ipaddr.v4_of_v6 addr with
+    | Some addr ->
+        Format.fprintf ppf "%a:%d" Ipaddr.V4.pp addr port
+    | None ->
+        Format.fprintf ppf "[%a]:%d" Ipaddr.V6.pp addr port
+  let pp_opt ppf = function
+    | None -> Format.pp_print_string ppf "none"
+    | Some point -> pp ppf point
+  let pp_list ppf point_list =
+    Format.pp_print_list  ~pp_sep:Format.pp_print_space pp ppf point_list
+
+  let is_local (addr, _) = Ipaddr.V6.is_private addr
+  let is_global (addr, _) = not @@ Ipaddr.V6.is_private addr
+
+  let check_port port =
+    if TzString.mem_char port '[' ||
+       TzString.mem_char port ']' ||
+       TzString.mem_char port ':' then
+      invalid_arg "Utils.parse_addr_port (invalid character in port)"
+
+  let parse_addr_port s =
+    let len = String.length s in
+    if len = 0 then
+      ("", "")
+    else if s.[0] = '[' then begin (* inline IPv6 *)
+      match String.rindex_opt s ']' with
+      | None ->
+          invalid_arg "Utils.parse_addr_port (missing ']')"
+      | Some pos ->
+          let addr = String.sub s 1 (pos - 1) in
+          let port =
+            if pos = len - 1 then
+              ""
+            else if s.[pos+1] <> ':' then
+              invalid_arg "Utils.parse_addr_port (unexpected char after ']')"
+            else
+              String.sub s (pos + 2) (len - pos - 2) in
+          check_port port ;
+          addr, port
+    end else begin
+      match String.rindex_opt s ']' with
+      | Some _pos ->
+          invalid_arg "Utils.parse_addr_port (unexpected char ']')"
+      | None ->
+          match String.index s ':' with
+          | exception _ -> s, ""
+          | pos ->
+              match String.index_from s (pos+1) ':'  with
+              | exception _ ->
+                  let addr = String.sub s 0 pos in
+                  let port = String.sub s (pos + 1) (len - pos - 1) in
+                  check_port port ;
+                  addr, port
+              | _pos ->
+                  invalid_arg "Utils.parse_addr_port: IPv6 addresses must be bracketed"
+    end
+
+  let of_string_exn str =
+    let addr, port = parse_addr_port str in
+    let port = int_of_string port in
+    if port < 0 && port > 1 lsl 16 - 1 then
+      invalid_arg "port must be between 0 and 65535" ;
+    match Ipaddr.of_string_exn addr with
+    | V4 addr -> Ipaddr.v6_of_v4 addr, port
+    | V6 addr -> addr, port
+
+  let of_string str =
+    try Ok (of_string_exn str) with
+    | Invalid_argument s -> Error s
+    | Failure s -> Error s
+    | _ -> Error "P2p_point.of_string"
+
+  let to_string saddr = Format.asprintf "%a" pp saddr
+
+  let encoding =
+    Data_encoding.conv to_string of_string_exn Data_encoding.string
+
+  let rpc_arg =
+    RPC_arg.make
+      ~name:"point"
+      ~descr:"A network point (ipv4:port or [ipv6]:port)."
+      ~destruct:of_string
+      ~construct:to_string
+      ()
+
+end
+
+module Map = Map.Make (Id)
+module Set = Set.Make (Id)
+module Table = Hashtbl.Make (Id)
+
+module Filter = struct
+
+  type t =
+    | Requested
+    | Accepted
+    | Running
+    | Disconnected
+
+  let rpc_arg =
+    RPC_arg.make
+      ~name:"p2p.point.state_filter"
+      ~destruct:(function
+          | "requested" -> Ok Requested
+          | "accepted" -> Ok Accepted
+          | "running" -> Ok Running
+          | "disconnected" -> Ok Disconnected
+          | s -> Error (Format.asprintf "Invalid state: %s" s))
+      ~construct:(function
+          | Requested -> "requested"
+          | Accepted -> "accepted"
+          | Running -> "running"
+          | Disconnected -> "disconnected")
+      ()
+
+end
+
+module State = struct
+
+  type t =
+    | Requested
+    | Accepted of P2p_peer_id.t
+    | Running of P2p_peer_id.t
+    | Disconnected
+
+  let of_p2p_peer_id = function
+    | Requested -> None
+    | Accepted pi -> Some pi
+    | Running pi -> Some pi
+    | Disconnected -> None
+
+  let of_peerid_state state pi =
+    match state, pi with
+    | Requested, _ -> Requested
+    | Accepted _, Some pi -> Accepted pi
+    | Running _, Some pi -> Running pi
+    | Disconnected, _ -> Disconnected
+    | _ -> invalid_arg "state_of_state_peerid"
+
+  let pp_digram ppf = function
+    | Requested -> Format.fprintf ppf "⚎"
+    | Accepted _ -> Format.fprintf ppf "⚍"
+    | Running _ -> Format.fprintf ppf "⚌"
+    | Disconnected -> Format.fprintf ppf "⚏"
+
+  let encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event_kind" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0)
+        ~title:"Requested"
+        (branch_encoding "requested" empty)
+        (function Requested -> Some () | _ -> None)
+        (fun () -> Requested) ;
+      case (Tag 1)
+        ~title:"Accepted"
+        (branch_encoding "accepted"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Accepted p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Accepted p2p_peer_id) ;
+      case (Tag 2)
+        ~title:"Running"
+        (branch_encoding "running"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Running p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Running p2p_peer_id) ;
+      case (Tag 3)
+        ~title:"Disconnected"
+        (branch_encoding "disconnected" empty)
+        (function Disconnected -> Some () | _ -> None)
+        (fun () -> Disconnected) ;
+    ]
+
+  let raw_filter (f : Filter.t) (s : t) =
+    match f, s with
+    | Requested, Requested -> true
+    | Requested, (Accepted _ | Running _ | Disconnected)
+    | (Accepted | Running | Disconnected), Requested -> false
+    | Accepted, Accepted _-> true
+    | Accepted, (Running _ | Disconnected)
+    | (Running | Disconnected), Accepted _ -> false
+    | Running, Running _ -> true
+    | Disconnected, Disconnected -> true
+    | Running, Disconnected
+    | Disconnected, Running _ -> false
+
+  let filter filters state =
+    List.exists (fun f -> raw_filter f state) filters
+
+end
+
+module Info = struct
+
+  type t = {
+    trusted : bool ;
+    greylisted_until : Time.t ;
+    state : State.t ;
+    last_failed_connection : Time.t option ;
+    last_rejected_connection : (P2p_peer_id.t * Time.t) option ;
+    last_established_connection : (P2p_peer_id.t * Time.t) option ;
+    last_disconnection : (P2p_peer_id.t * Time.t) option ;
+    last_seen : (P2p_peer_id.t * Time.t) option ;
+    last_miss : Time.t option ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { trusted ; greylisted_until ; state ;
+             last_failed_connection ; last_rejected_connection ;
+             last_established_connection ; last_disconnection ;
+             last_seen ; last_miss } ->
+        let p2p_peer_id = State.of_p2p_peer_id state in
+        (trusted, greylisted_until, state, p2p_peer_id,
+         last_failed_connection, last_rejected_connection,
+         last_established_connection, last_disconnection,
+         last_seen, last_miss))
+      (fun (trusted, greylisted_until, state, p2p_peer_id,
+            last_failed_connection, last_rejected_connection,
+            last_established_connection, last_disconnection,
+            last_seen, last_miss) ->
+        let state = State.of_peerid_state state p2p_peer_id in
+        { trusted ; greylisted_until ; state ;
+          last_failed_connection ; last_rejected_connection ;
+          last_established_connection ; last_disconnection ;
+          last_seen ; last_miss })
+      (obj10
+         (req "trusted" bool)
+         (dft "greylisted_until" Time.encoding Time.epoch)
+         (req "state" State.encoding)
+         (opt "p2p_peer_id" P2p_peer_id.encoding)
+         (opt "last_failed_connection" Time.encoding)
+         (opt "last_rejected_connection" (tup2 P2p_peer_id.encoding Time.encoding))
+         (opt "last_established_connection" (tup2 P2p_peer_id.encoding Time.encoding))
+         (opt "last_disconnection" (tup2 P2p_peer_id.encoding Time.encoding))
+         (opt "last_seen" (tup2 P2p_peer_id.encoding Time.encoding))
+         (opt "last_miss" Time.encoding))
+
+end
+
+module Pool_event = struct
+
+  type kind =
+    | Outgoing_request
+    | Accepting_request of P2p_peer_id.t
+    | Rejecting_request of P2p_peer_id.t
+    | Request_rejected of P2p_peer_id.t option
+    | Connection_established of P2p_peer_id.t
+    | Disconnection of P2p_peer_id.t
+    | External_disconnection of P2p_peer_id.t
+
+  let kind_encoding =
+    let open Data_encoding in
+    let branch_encoding name obj =
+      conv (fun x -> (), x) (fun ((), x) -> x)
+        (merge_objs
+           (obj1 (req "event_kind" (constant name))) obj) in
+    union ~tag_size:`Uint8 [
+      case (Tag 0)
+        ~title:"Outgoing_request"
+        (branch_encoding "outgoing_request" empty)
+        (function Outgoing_request -> Some () | _ -> None)
+        (fun () -> Outgoing_request) ;
+      case (Tag 1)
+        ~title:"Accepting_request"
+        (branch_encoding "accepting_request"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Accepting_request p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Accepting_request p2p_peer_id) ;
+      case (Tag 2)
+        ~title:"Rejecting_request"
+        (branch_encoding "rejecting_request"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Rejecting_request p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Rejecting_request p2p_peer_id) ;
+      case (Tag 3)
+        ~title:"Rejecting_rejected"
+        (branch_encoding "request_rejected"
+           (obj1 (opt "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Request_rejected p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Request_rejected p2p_peer_id) ;
+      case (Tag 4)
+        ~title:"Connection_established"
+        (branch_encoding "rejecting_request"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Connection_established p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Connection_established p2p_peer_id) ;
+      case (Tag 5)
+        ~title:"Disconnection"
+        (branch_encoding "rejecting_request"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function Disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> Disconnection p2p_peer_id) ;
+      case (Tag 6)
+        ~title:"External_disconnection"
+        (branch_encoding "rejecting_request"
+           (obj1 (req "p2p_peer_id" P2p_peer_id.encoding)))
+        (function External_disconnection p2p_peer_id -> Some p2p_peer_id | _ -> None)
+        (fun p2p_peer_id -> External_disconnection p2p_peer_id) ;
+    ]
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { kind ; timestamp ; } -> (kind, timestamp))
+      (fun (kind, timestamp) -> { kind ; timestamp ; })
+      (obj2
+         (req "kind" kind_encoding)
+         (req "timestamp" Time.encoding))
+end
diff --git a/vendors/tezos-modded/src/lib_base/p2p_point.mli b/vendors/tezos-modded/src/lib_base/p2p_point.mli
new file mode 100644
index 000000000..63f475f28
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_point.mli
@@ -0,0 +1,127 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Id : sig
+
+  type t = P2p_addr.t * P2p_addr.port
+  val compare : t -> t -> int
+  val equal :  t -> t -> bool
+
+  val pp : Format.formatter -> t -> unit
+  val pp_opt : Format.formatter -> t option -> unit
+  val pp_list : Format.formatter -> t list -> unit
+
+  val of_string_exn : string -> t
+  val of_string : string -> (t, string) result
+  val to_string : t -> string
+  val encoding : t Data_encoding.t
+  val is_local : t -> bool
+  val is_global : t -> bool
+  val parse_addr_port : string -> string * string
+
+  val rpc_arg : t RPC_arg.t
+end
+
+module Map : Map.S with type key = Id.t
+module Set : Set.S with type elt = Id.t
+module Table : Hashtbl.S with type key = Id.t
+
+module Filter : sig
+
+  type t =
+    | Requested
+    | Accepted
+    | Running
+    | Disconnected
+
+  val rpc_arg : t RPC_arg.t
+
+end
+
+module State : sig
+
+  type t =
+    | Requested
+    | Accepted of P2p_peer_id.t
+    | Running of P2p_peer_id.t
+    | Disconnected
+
+  val pp_digram : Format.formatter -> t -> unit
+  val encoding : t Data_encoding.t
+
+  val of_p2p_peer_id : t -> P2p_peer_id.t option
+  val of_peerid_state : t -> P2p_peer_id.t option -> t
+
+  val filter : Filter.t list -> t -> bool
+
+end
+
+module Info : sig
+
+  type t = {
+    trusted : bool ;
+    greylisted_until : Time.t ;
+    state : State.t ;
+    last_failed_connection : Time.t option ;
+    last_rejected_connection : (P2p_peer_id.t * Time.t) option ;
+    last_established_connection : (P2p_peer_id.t * Time.t) option ;
+    last_disconnection : (P2p_peer_id.t * Time.t) option ;
+    last_seen : (P2p_peer_id.t * Time.t) option ;
+    last_miss : Time.t option ;
+  }
+
+  val encoding: t Data_encoding.t
+
+end
+
+module Pool_event : sig
+
+  type kind =
+    | Outgoing_request
+    (** We initiated a connection. *)
+    | Accepting_request of P2p_peer_id.t
+    (** We accepted a connection after authentifying the remote peer. *)
+    | Rejecting_request of P2p_peer_id.t
+    (** We rejected a connection after authentifying the remote peer. *)
+    | Request_rejected of P2p_peer_id.t option
+    (** The remote peer rejected our connection. *)
+    | Connection_established of P2p_peer_id.t
+    (** We successfully established a authentified connection. *)
+    | Disconnection of P2p_peer_id.t
+    (** We decided to close the connection. *)
+    | External_disconnection of P2p_peer_id.t
+    (** The connection was closed for external reason. *)
+
+  type t = {
+    kind : kind ;
+    timestamp : Time.t ;
+  }
+
+  val encoding : t Data_encoding.t
+
+end
+
+
diff --git a/vendors/tezos-modded/src/lib_base/p2p_stat.ml b/vendors/tezos-modded/src/lib_base/p2p_stat.ml
new file mode 100644
index 000000000..cd0c327ce
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_stat.ml
@@ -0,0 +1,80 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  total_sent : int64 ;
+  total_recv : int64 ;
+  current_inflow : int ;
+  current_outflow : int ;
+}
+
+let empty = {
+  total_sent = 0L ;
+  total_recv = 0L ;
+  current_inflow = 0 ;
+  current_outflow = 0 ;
+}
+
+let print_size ppf sz =
+  let ratio n = (float_of_int sz /. float_of_int (1 lsl n)) in
+  if sz < 1 lsl 10 then
+    Format.fprintf ppf "%d B" sz
+  else if sz < 1 lsl 20 then
+    Format.fprintf ppf "%.2f kiB" (ratio 10)
+  else
+    Format.fprintf ppf "%.2f MiB" (ratio 20)
+
+let print_size64 ppf sz =
+  let open Int64 in
+  let ratio n = (to_float sz /. float_of_int (1 lsl n)) in
+  if sz < shift_left 1L 10 then
+    Format.fprintf ppf "%Ld B" sz
+  else if sz < shift_left 1L 20 then
+    Format.fprintf ppf "%.2f kiB" (ratio 10)
+  else if sz < shift_left 1L 30 then
+    Format.fprintf ppf "%.2f MiB" (ratio 20)
+  else if sz < shift_left 1L 40 then
+    Format.fprintf ppf "%.2f GiB" (ratio 30)
+  else
+    Format.fprintf ppf "%.2f TiB" (ratio 40)
+
+let pp ppf stat =
+  Format.fprintf ppf
+    "↗ %a (%a/s) ↘ %a (%a/s)"
+    print_size64 stat.total_sent print_size stat.current_outflow
+    print_size64 stat.total_recv print_size stat.current_inflow
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { total_sent ; total_recv ; current_inflow ; current_outflow } ->
+       (total_sent, total_recv, current_inflow, current_outflow))
+    (fun (total_sent, total_recv, current_inflow, current_outflow) ->
+       { total_sent ; total_recv ; current_inflow ; current_outflow })
+    (obj4
+       (req "total_sent" int64)
+       (req "total_recv" int64)
+       (req "current_inflow" int31)
+       (req "current_outflow" int31))
diff --git a/vendors/tezos-modded/src/lib_base/p2p_stat.mli b/vendors/tezos-modded/src/lib_base/p2p_stat.mli
new file mode 100644
index 000000000..616464f39
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_stat.mli
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Bandwidth usage statistics *)
+
+type t = {
+  total_sent : int64 ;
+  total_recv : int64 ;
+  current_inflow : int ;
+  current_outflow : int ;
+}
+
+val empty : t
+val pp : Format.formatter -> t -> unit
+val encoding : t Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_base/p2p_version.ml b/vendors/tezos-modded/src/lib_base/p2p_version.ml
new file mode 100644
index 000000000..198778c7f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_version.ml
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  name : string ;
+  major : int ;
+  minor : int ;
+}
+
+let pp ppf { name ; major ; minor } =
+  Format.fprintf ppf "%s.%d.%d" name major minor
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { name; major; minor } -> (name, major, minor))
+    (fun (name, major, minor) -> { name; major; minor })
+    (obj3
+       (req "name" string)
+       (req "major" uint16)
+       (req "minor" uint16))
+
+let common la lb =
+  let la = List.sort (fun l r -> compare r l) la in
+  let lb = List.sort (fun l r -> compare r l) lb in
+  let rec find = function
+    | [], _ | _, [] -> None
+    | ((a :: ta) as la), ((b :: tb) as lb) ->
+        if a = b then Some a
+        else if a > b then find (ta, lb)
+        else find (la, tb)
+  in find (la, lb)
+
+let best lv =
+  if lv = [] then
+    invalid_arg "P2p_version.best"
+  else
+    List.hd (List.sort (fun l r -> compare r l) lv)
diff --git a/vendors/tezos-modded/src/lib_base/p2p_version.mli b/vendors/tezos-modded/src/lib_base/p2p_version.mli
new file mode 100644
index 000000000..edc8c11bc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/p2p_version.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Network protocol version. *)
+
+(** Type of a network protocol version. *)
+type t = {
+  name : string ;
+  major : int ;
+  minor : int ;
+}
+
+val pp : Format.formatter -> t -> unit
+val encoding : t Data_encoding.t
+
+(** Selects the prefered common version for a pair of version
+    lists. Used during network protocol negociation. If any, it is the
+    maximum one, in lexicographic order (name, then major, minor). *)
+val common : t list -> t list -> t option
+
+(** Gives the prefered version in a list: the one selected by
+    {!common} among the list of compatible ones. *)
+val best : t list -> t
+
diff --git a/vendors/tezos-modded/src/lib_base/preapply_result.ml b/vendors/tezos-modded/src/lib_base/preapply_result.ml
new file mode 100644
index 000000000..839f891e7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/preapply_result.ml
@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'error t = {
+  applied: (Operation_hash.t * Operation.t) list;
+  refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
+}
+
+let empty = {
+  applied = [] ;
+  refused = Operation_hash.Map.empty ;
+  branch_refused = Operation_hash.Map.empty ;
+  branch_delayed = Operation_hash.Map.empty ;
+}
+
+let map f r = {
+  applied = r.applied;
+  refused = Operation_hash.Map.map f r.refused ;
+  branch_refused = Operation_hash.Map.map f r.branch_refused ;
+  branch_delayed = Operation_hash.Map.map f r.branch_delayed ;
+}
+
+let encoding error_encoding =
+  let open Data_encoding in
+  let operation_encoding =
+    merge_objs
+      (obj1 (req "hash" Operation_hash.encoding))
+      (dynamic_size Operation.encoding) in
+  let refused_encoding =
+    merge_objs
+      (obj1 (req "hash" Operation_hash.encoding))
+      (merge_objs
+         (dynamic_size Operation.encoding)
+         (obj1 (req "error" error_encoding))) in
+  let build_list map = Operation_hash.Map.bindings map in
+  let build_map list =
+    List.fold_right
+      (fun (k, e) m -> Operation_hash.Map.add k e m)
+      list Operation_hash.Map.empty in
+  conv
+    (fun { applied ; refused ; branch_refused ; branch_delayed } ->
+       (applied, build_list refused,
+        build_list branch_refused, build_list branch_delayed))
+    (fun (applied, refused, branch_refused, branch_delayed) ->
+       let refused = build_map refused in
+       let branch_refused = build_map branch_refused in
+       let branch_delayed = build_map branch_delayed in
+       { applied ; refused ; branch_refused ; branch_delayed })
+    (obj4
+       (req "applied" (list operation_encoding))
+       (req "refused" (list refused_encoding))
+       (req "branch_refused" (list refused_encoding))
+       (req "branch_delayed" (list refused_encoding)))
+
+let operations t =
+  let ops =
+    List.fold_left
+      (fun acc (h, op) -> Operation_hash.Map.add h op acc)
+      Operation_hash.Map.empty t.applied in
+  let ops =
+    Operation_hash.Map.fold
+      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
+      t.branch_delayed ops in
+  let ops =
+    Operation_hash.Map.fold
+      (fun h (op, _err) acc -> Operation_hash.Map.add h op acc)
+      t.branch_refused ops in
+  ops
diff --git a/vendors/tezos-modded/src/lib_base/preapply_result.mli b/vendors/tezos-modded/src/lib_base/preapply_result.mli
new file mode 100644
index 000000000..9d1629ce9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/preapply_result.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'error t = {
+  applied: (Operation_hash.t * Operation.t) list;
+  refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. invalid signature *)
+  branch_refused: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. insufficent balance *)
+  branch_delayed: (Operation.t * 'error list) Operation_hash.Map.t;
+  (* e.g. timestamp in the future *)
+}
+
+val empty : 'error t
+
+val map :
+  (Operation.t * 'a list -> Operation.t * 'b list) -> 'a t -> 'b t
+
+val operations :
+  'error t -> Operation.t Operation_hash.Map.t
+
+val encoding :
+  'error list Data_encoding.t ->
+  'error t Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_base/protocol.ml b/vendors/tezos-modded/src/lib_base/protocol.ml
new file mode 100644
index 000000000..5eaebb506
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/protocol.ml
@@ -0,0 +1,134 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  expected_env: env_version ;
+  components: component list ;
+}
+
+and component = {
+  name: string ;
+  interface: string option ;
+  implementation: string ;
+}
+
+and env_version = V1
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = Pervasives.compare
+  end)
+
+let component_encoding =
+  let open Data_encoding in
+  conv
+    (fun { name ; interface; implementation } ->
+       (name, interface, implementation))
+    (fun (name, interface, implementation) ->
+       { name ; interface ; implementation })
+    (obj3
+       (req "name" string)
+       (opt "interface" (conv MBytes.of_string MBytes.to_string bytes))
+       (req "implementation" (conv MBytes.of_string MBytes.to_string bytes)))
+
+let env_version_encoding =
+  let open Data_encoding in
+  conv
+    (function V1 -> 0)
+    (function 0 -> V1 | _ -> failwith "unexpected environment version")
+    int16
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { expected_env ; components } -> (expected_env, components))
+    (fun (expected_env, components) -> { expected_env ; components })
+    (obj2
+       (req "expected_env_version" env_version_encoding)
+       (req "components" (list component_encoding)))
+
+let bounded_encoding ?max_size () =
+  match max_size with
+  | None -> encoding
+  | Some max_size -> Data_encoding.check_size max_size encoding
+
+let pp ppf op =
+  Data_encoding.Json.pp ppf
+    (Data_encoding.Json.construct encoding op)
+
+let env_version_to_string = function
+  | V1 -> "V1"
+
+let pp_ocaml_component ppf { name ; interface ; implementation } =
+  Format.fprintf ppf
+    "@[{@[<v 1> name = %S ;@ interface = %a ;@ implementation = %S ;@]@ }@]"
+    name
+    (fun ppf -> function
+       | None -> Format.fprintf ppf "None"
+       | Some s -> Format.fprintf ppf "Some %S" s)
+    interface
+    implementation
+
+let pp_ocaml ppf { expected_env ; components } =
+  Format.fprintf ppf
+    "@[{@[<v 1> expected_env = %s ;@ components = [@[<v>%a@]] ;@]@ }@]"
+    (env_version_to_string expected_env)
+    (Format.pp_print_list
+       ~pp_sep:(fun ppf () -> Format.fprintf ppf " ;@ ")
+       pp_ocaml_component)
+    components
+
+let to_bytes v = Data_encoding.Binary.to_bytes_exn encoding v
+let of_bytes b = Data_encoding.Binary.of_bytes encoding b
+let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
+let hash proto = Protocol_hash.hash_bytes [to_bytes proto]
+let hash_raw proto = Protocol_hash.hash_bytes [proto]
+
+module Meta = struct
+
+  type t = {
+    hash: Protocol_hash.t option ;
+    expected_env_version: env_version option ;
+    modules: string list ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { hash ; expected_env_version ; modules } ->
+         (hash, expected_env_version, modules))
+      (fun (hash, expected_env_version, modules) ->
+         { hash ; expected_env_version ; modules }) @@
+    obj3
+      (opt "hash"
+         ~description:"Used to force the hash of the protocol"
+         Protocol_hash.encoding)
+      (opt "expected_env_version"
+         env_version_encoding)
+      (req "modules"
+         ~description:"Modules comprising the protocol"
+         (list string))
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/protocol.mli b/vendors/tezos-modded/src/lib_base/protocol.mli
new file mode 100644
index 000000000..4e2b5a6e5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/protocol.mli
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  expected_env: env_version ;
+  components: component list ;
+}
+
+and component = {
+  name: string ;
+  interface: string option ;
+  implementation: string ;
+}
+
+and env_version = V1
+
+val component_encoding: component Data_encoding.t
+val env_version_encoding: env_version Data_encoding.t
+
+val pp_ocaml: Format.formatter -> t -> unit
+
+include S.HASHABLE with type t := t
+                    and type hash := Protocol_hash.t
+val of_bytes_exn: MBytes.t -> t
+
+val bounded_encoding: ?max_size:int -> unit -> t Data_encoding.t
+
+module Meta: sig
+
+  type t = {
+    hash: Protocol_hash.t option ;
+    expected_env_version: env_version option ;
+    modules: string list ;
+  }
+
+  val encoding: t Data_encoding.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_base/s.ml b/vendors/tezos-modded/src/lib_base/s.ml
new file mode 100644
index 000000000..01b358067
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/s.ml
@@ -0,0 +1,115 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type T = sig
+
+  type t
+  include Compare.S with type t := t
+
+  val pp: Format.formatter -> t -> unit
+
+  val encoding: t Data_encoding.t
+  val to_bytes: t -> MBytes.t
+  val of_bytes: MBytes.t -> t option
+
+end
+
+module type HASHABLE = sig
+
+  include T
+
+  type hash
+  val hash: t -> hash
+  val hash_raw: MBytes.t -> hash
+
+end
+
+module type SET = sig
+  type elt
+  type t
+  val empty: t
+  val is_empty: t -> bool
+  val mem: elt -> t -> bool
+  val add: elt -> t -> t
+  val singleton: elt -> t
+  val remove: elt -> t -> t
+  val union: t -> t -> t
+  val inter: t -> t -> t
+  val diff: t -> t -> t
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
+  val subset: t -> t -> bool
+  val iter: (elt -> unit) -> t -> unit
+  val map: (elt -> elt) -> t -> t
+  val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val for_all: (elt -> bool) -> t -> bool
+  val exists: (elt -> bool) -> t -> bool
+  val filter: (elt -> bool) -> t -> t
+  val partition: (elt -> bool) -> t -> t * t
+  val cardinal: t -> int
+  val elements: t -> elt list
+  val min_elt_opt: t -> elt option
+  val max_elt_opt: t -> elt option
+  val choose_opt: t -> elt option
+  val split: elt -> t -> t * bool * t
+  val find_opt: elt -> t -> elt option
+  val find_first_opt: (elt -> bool) -> t -> elt option
+  val find_last_opt: (elt -> bool) -> t -> elt option
+  val of_list: elt list -> t
+end
+
+module type MAP = sig
+  type key
+  type (+'a) t
+  val empty: 'a t
+  val is_empty: 'a t -> bool
+  val mem: key -> 'a t -> bool
+  val add: key -> 'a -> 'a t -> 'a t
+  val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
+  val singleton: key -> 'a -> 'a t
+  val remove: key -> 'a t -> 'a t
+  val merge:
+    (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+  val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+  val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+  val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+  val iter: (key -> 'a -> unit) -> 'a t -> unit
+  val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  val for_all: (key -> 'a -> bool) -> 'a t -> bool
+  val exists: (key -> 'a -> bool) -> 'a t -> bool
+  val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+  val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+  val cardinal: 'a t -> int
+  val bindings: 'a t -> (key * 'a) list
+  val min_binding_opt: 'a t -> (key * 'a) option
+  val max_binding_opt: 'a t -> (key * 'a) option
+  val choose_opt: 'a t -> (key * 'a) option
+  val split: key -> 'a t -> 'a t * 'a option * 'a t
+  val find_opt: key -> 'a t -> 'a option
+  val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option
+  val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option
+  val map: ('a -> 'b) -> 'a t -> 'b t
+  val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+end
diff --git a/vendors/tezos-modded/src/lib_base/test_chain_status.ml b/vendors/tezos-modded/src/lib_base/test_chain_status.ml
new file mode 100644
index 000000000..ebf3e8474
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/test_chain_status.ml
@@ -0,0 +1,91 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t =
+  | Not_running
+  | Forking of {
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+  | Running of {
+      chain_id: Chain_id.t ;
+      genesis: Block_hash.t ;
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+
+let encoding =
+  let open Data_encoding in
+  def "test_chain_status" @@
+  union [
+    case (Tag 0) ~title:"Not_running"
+      (obj1 (req "status" (constant "not_running")))
+      (function Not_running -> Some () | _ -> None)
+      (fun () -> Not_running) ;
+    case (Tag 1) ~title:"Forking"
+      (obj3
+         (req "status" (constant "forking"))
+         (req "protocol" Protocol_hash.encoding)
+         (req "expiration" Time.encoding))
+      (function
+        | Forking { protocol ; expiration } ->
+            Some ((), protocol, expiration)
+        | _ -> None)
+      (fun ((), protocol, expiration) ->
+         Forking { protocol ; expiration }) ;
+    case (Tag 2) ~title:"Running"
+      (obj5
+         (req "status" (constant "running"))
+         (req "chain_id" Chain_id.encoding)
+         (req "genesis" Block_hash.encoding)
+         (req "protocol" Protocol_hash.encoding)
+         (req "expiration" Time.encoding))
+      (function
+        | Running { chain_id ; genesis ; protocol ; expiration } ->
+            Some ((), chain_id, genesis, protocol, expiration)
+        | _ -> None)
+      (fun ((), chain_id, genesis, protocol, expiration) ->
+         Running { chain_id ; genesis ; protocol ; expiration }) ;
+  ]
+
+let pp ppf = function
+  | Not_running -> Format.fprintf ppf "@[<v 2>Not running@]"
+  | Forking { protocol ; expiration } ->
+      Format.fprintf ppf
+        "@[<v 2>Forking %a (expires %a)@]"
+        Protocol_hash.pp
+        protocol
+        Time.pp_hum
+        expiration
+  | Running { chain_id ; genesis ; protocol ; expiration } ->
+      Format.fprintf ppf
+        "@[<v 2>Running %a\
+         @ Genesis: %a\
+         @ Net id: %a\
+         @ Expiration: %a@]"
+        Protocol_hash.pp protocol
+        Block_hash.pp genesis
+        Chain_id.pp chain_id
+        Time.pp_hum expiration
diff --git a/vendors/tezos-modded/src/lib_base/test_chain_status.mli b/vendors/tezos-modded/src/lib_base/test_chain_status.mli
new file mode 100644
index 000000000..fbf840e85
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/test_chain_status.mli
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t =
+  | Not_running
+  | Forking of {
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+  | Running of {
+      chain_id: Chain_id.t ;
+      genesis: Block_hash.t ;
+      protocol: Protocol_hash.t ;
+      expiration: Time.t ;
+    }
+
+val encoding: t Data_encoding.t
+
+val pp : Format.formatter -> t -> unit
diff --git a/vendors/tezos-modded/src/lib_base/tezos-base.opam b/vendors/tezos-modded/src/lib_base/tezos-base.opam
new file mode 100644
index 000000000..1882940b1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/tezos-base.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib"
+  "tezos-crypto"
+  "tezos-data-encoding"
+  "tezos-error-monad"
+  "tezos-micheline"
+  "tezos-rpc"
+  "calendar"
+  "ezjsonm" { >= "0.5.0" }
+  "ipaddr" { >= "3.0.0" }
+  "mtime" { >= "1.0.0" }
+  "re" { >= "1.7.2" }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_base/time.ml b/vendors/tezos-modded/src/lib_base/time.ml
new file mode 100644
index 000000000..a51861b6d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/time.ml
@@ -0,0 +1,172 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 CalendarLib
+
+module T = struct
+  include Int64
+
+  let diff a b =
+    let sign = a >= b in
+    let res = Int64.sub a b in
+    let res_sign = res >= 0L in
+    if sign = res_sign then res else invalid_arg "Time.diff" ;;
+
+  let add a d =
+    let sign = d >= 0L in
+    let res = Int64.add a d in
+    let incr_sign = res >= a in
+    if sign = incr_sign then res else invalid_arg "Time.add" ;;
+
+  let recent a1 a2 =
+    match a1, a2 with
+    | (None, None) -> None
+    | (None, (Some _ as a))
+    | (Some _ as a, None) -> a
+    | (Some (_, t1), Some (_, t2)) ->
+        if compare t1 t2 < 0 then a2 else a1
+
+  let hash = to_int
+  let min_value = min_int
+  let epoch = 0L
+  let max_value = max_int
+
+  let now () = Int64.of_float (Unix.gettimeofday ())
+
+  let of_seconds x = x
+  let to_seconds x = x
+
+  let formats =
+    [ "%Y-%m-%dT%H:%M:%SZ" ; "%Y-%m-%d %H:%M:%SZ";
+      "%Y-%m-%dT%H:%M:%S%:z"; "%Y-%m-%d %H:%M:%S%:z"; ]
+
+  let int64_of_calendar c =
+    let round fc =
+      let f, i = modf fc in
+      Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in
+    round @@ Calendar.Precise.to_unixfloat c
+
+  let rec iter_formats s = function
+    | [] -> None
+    | f :: fs ->
+        try
+          Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
+        with _ -> iter_formats s fs
+
+  let of_notation s =
+    iter_formats s formats
+  let of_notation_exn s =
+    match of_notation s with
+    | None -> invalid_arg "Time.of_notation: can't parse."
+    | Some t -> t
+
+  let to_notation t =
+    let ft = Int64.to_float t in
+    if Int64.of_float ft <> t then
+      "out_of_range"
+    else
+      Printer.Precise_Calendar.sprint
+        "%Y-%m-%dT%H:%M:%SZ"
+        (Calendar.Precise.from_unixfloat ft)
+
+  let rfc_encoding =
+    let open Data_encoding in
+    def
+      "timestamp.rfc"
+      ~title:
+        "RFC 3339 formatted timestamp"
+      ~description:
+        "A date in human readble form as specified in RFC 3339." @@
+    conv
+      to_notation
+      (fun s -> match of_notation s with
+         | Some s -> s
+         | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
+      string
+
+  let encoding =
+    let open Data_encoding in
+    def "timestamp" @@
+    splitted
+      ~binary: int64
+      ~json:
+        (union [
+            case Json_only
+              ~title:"RFC encoding"
+              rfc_encoding
+              (fun i -> Some i)
+              (fun i -> i) ;
+            case Json_only
+              ~title:"Second since epoch"
+              int64
+              (fun _ -> None)
+              (fun i -> i) ;
+          ])
+
+  let rpc_arg =
+    RPC_arg.make
+      ~name:(Format.asprintf "date")
+      ~descr:(Format.asprintf "A date in seconds from epoch")
+      ~destruct:
+        (fun s ->
+           if s = "none" || s = "epoch" then
+             Ok epoch
+           else
+             match of_notation s with
+             | None -> begin
+                 match Int64.of_string s with
+                 | exception _ -> begin
+                     Error (Format.asprintf "failed to parse time (epoch): %S" s)
+                   end
+                 | t -> Ok t
+               end
+             | Some t -> Ok t)
+      ~construct:Int64.to_string
+      ()
+
+  type 'a timed_data = {
+    data: 'a ;
+    time: t ;
+  }
+
+  let timed_encoding arg_encoding =
+    let open Data_encoding in
+    conv
+      (fun {time; data} -> (time, data))
+      (fun (time, data) -> {time; data})
+      (tup2 encoding arg_encoding)
+
+  let make_timed data = {
+    data ; time = now () ;
+  }
+
+  let pp_hum ppf t = Format.pp_print_string ppf (to_notation t)
+end
+
+include T
+include Compare.Make (T)
+module Set = Set.Make (T)
+module Map = Map.Make (T)
+module Table = Hashtbl.Make (T)
diff --git a/vendors/tezos-modded/src/lib_base/time.mli b/vendors/tezos-modded/src/lib_base/time.mli
new file mode 100644
index 000000000..b7ad6abc0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/time.mli
@@ -0,0 +1,68 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+include Compare.S with type t := t
+
+val hash : t -> int
+
+val min_value : t
+val epoch : t
+val max_value : t
+
+val add : t -> int64 -> t
+val diff : t -> t -> int64
+
+val of_seconds : int64 -> t
+val to_seconds : t -> int64
+
+val of_notation : string -> t option
+val of_notation_exn : string -> t
+val to_notation : t -> string
+
+val now : unit -> t
+
+val encoding : t Data_encoding.t
+val rfc_encoding : t Data_encoding.t
+
+val rpc_arg : t RPC_arg.t
+
+val pp_hum : Format.formatter -> t -> unit
+
+type 'a timed_data = {
+  data: 'a ;
+  time: t ;
+}
+
+val make_timed : 'a -> 'a timed_data
+
+val timed_encoding : 'a Data_encoding.t -> 'a timed_data Data_encoding.t
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t
+module Table : Hashtbl.S with type key = t
+
+val recent :
+  ('a * t) option -> ('a * t) option -> ('a * t) option
diff --git a/vendors/tezos-modded/src/lib_base/tzPervasives.ml b/vendors/tezos-modded/src/lib_base/tzPervasives.ml
new file mode 100644
index 000000000..1b17ecb66
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/tzPervasives.ml
@@ -0,0 +1,67 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib
+include Tezos_error_monad
+include Tezos_rpc
+include Tezos_clic
+include Tezos_crypto
+include Tezos_micheline
+
+module Data_encoding = Tezos_data_encoding.Data_encoding
+
+module List = struct
+  include List
+  include Tezos_stdlib.TzList
+end
+module String = struct
+  include String
+  include Tezos_stdlib.TzString
+end
+
+module Time = Time
+module Fitness = Fitness
+module Block_header = Block_header
+module Operation = Operation
+module Protocol = Protocol
+
+module Test_chain_status = Test_chain_status
+module Preapply_result = Preapply_result
+
+module Block_locator = Block_locator
+module Mempool = Mempool
+
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
+
+module Lwt_exit = Lwt_exit
+
+include Utils.Infix
+include Error_monad
diff --git a/vendors/tezos-modded/src/lib_base/tzPervasives.mli b/vendors/tezos-modded/src/lib_base/tzPervasives.mli
new file mode 100644
index 000000000..1cf5fd7f7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_base/tzPervasives.mli
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include (module type of (struct include Tezos_stdlib end))
+include (module type of (struct include Tezos_error_monad end))
+include (module type of (struct include Tezos_rpc end))
+include (module type of (struct include Tezos_clic end))
+include (module type of (struct include Tezos_crypto end))
+
+module Data_encoding = Data_encoding
+
+module List : sig
+  include (module type of (struct include List end))
+  include (module type of (struct include Tezos_stdlib.TzList end))
+end
+module String : sig
+  include (module type of (struct include String end))
+  include (module type of (struct include Tezos_stdlib.TzString end))
+end
+
+module Time = Time
+module Fitness = Fitness
+module Block_header = Block_header
+module Operation = Operation
+module Protocol = Protocol
+module Test_chain_status = Test_chain_status
+module Preapply_result = Preapply_result
+module Block_locator = Block_locator
+module Mempool = Mempool
+
+module P2p_addr = P2p_addr
+module P2p_identity = P2p_identity
+module P2p_peer = P2p_peer
+module P2p_point = P2p_point
+module P2p_connection = P2p_connection
+module P2p_stat = P2p_stat
+module P2p_version = P2p_version
+
+module Lwt_exit = Lwt_exit
+
+include (module type of (struct include Utils.Infix end))
+include (module type of (struct include Error_monad end))
diff --git a/vendors/tezos-modded/src/lib_clic/clic.ml b/vendors/tezos-modded/src/lib_clic/clic.ml
new file mode 100644
index 000000000..00822d4ff
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_clic/clic.ml
@@ -0,0 +1,1362 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+type ('p, 'ctx) parameter =
+  { converter: ('ctx -> string -> 'p tzresult Lwt.t) ;
+    autocomplete: ('ctx -> string list tzresult Lwt.t) option }
+
+let parameter ?autocomplete converter =
+  { converter ; autocomplete }
+
+let compose_parameters { converter = c1; autocomplete = a1' } { converter = c2; autocomplete = a2' } =
+  { converter = (fun ctx s ->
+        c1 ctx s >>= function
+        | Ok r -> return r
+        | Error _ -> c2 ctx s);
+    autocomplete = match a1' with
+      | None -> a2'
+      | Some a1 -> match a2' with
+        | None -> a1'
+        | Some a2 -> Some (fun ctx ->
+            a1 ctx >>=? fun r1 ->
+            a2 ctx >>=? fun r2 ->
+            return (List.concat [r1; r2]))
+  }
+
+let map_parameter ~f { converter; autocomplete } =
+  { converter = (fun ctx s -> converter ctx s >>|? f);
+    autocomplete
+  }
+
+type label =
+  { long : string ;
+    short : char option }
+
+type ('a, 'ctx) arg =
+  | Arg : { doc : string ;
+            label : label ;
+            placeholder : string ;
+            kind : ('p, 'ctx) parameter } ->
+    ('p option, 'ctx) arg
+  | DefArg : { doc : string ;
+               label : label ;
+               placeholder : string ;
+               kind : ('p, 'ctx) parameter ;
+               default : string } -> ('p, 'ctx) arg
+  | Switch : { label : label ;
+               doc : string } ->
+    (bool, 'ctx) arg
+  | Constant : 'a  -> ('a, 'ctx) arg
+
+type ('a, 'arg) args =
+  | NoArgs : (unit, 'args) args
+  | AddArg : ('a, 'args) arg * ('b, 'args) args ->
+    ('a * 'b, 'args) args
+
+(* A simple structure for command interpreters.
+   This is more generic than the exported one, see end of file. *)
+type ('a, 'ctx) params =
+  | Prefix : string * ('a, 'ctx) params ->
+    ('a, 'ctx) params
+  | Param : string * string *
+            ('p, 'ctx) parameter *
+            ('a, 'ctx) params ->
+    ('p -> 'a, 'ctx) params
+  | Stop :
+      ('ctx -> unit tzresult Lwt.t, 'ctx) params
+  | Seq : string * string *
+          ('p, 'ctx) parameter ->
+    ('p list -> 'ctx -> unit tzresult Lwt.t, 'ctx) params
+
+type (_, _) options =
+    Argument : { spec : ('a, 'arg) args ;
+                 converter : 'a -> 'b } -> ('b, 'arg) options
+
+(* A command group *)
+type group =
+  { name : string ;
+    title : string }
+
+(* A command wraps a callback with its type and info *)
+type 'arg command =
+  | Command
+    : { params : ('a, 'iarg) params ;
+        options : ('b, 'iarg) options ;
+        handler : 'b -> 'a ;
+        desc : string ;
+        group : group option ;
+        conv : 'arg -> 'iarg }
+    -> 'arg command
+
+type error += Bad_argument of int * string
+type error += Unterminated_command : string list * 'ctx command list -> error
+type error += Command_not_found : string list * 'ctx command list -> error
+type error += Unknown_option : string * 'ctx command option -> error
+type error += Option_expected_argument : string * 'ctx command option -> error
+type error += Bad_option_argument : string * 'ctx command option -> error
+type error += Multiple_occurences : string * 'ctx command option -> error
+type error += Extra_arguments : string list * 'ctx command -> error
+
+let trim s = (* config-file wokaround *)
+  TzString.split '\n' s |>
+  List.map String.trim |>
+  String.concat "\n"
+
+let print_desc ppf doc =
+  let short, long = try
+      let len = String.index doc '\n' in
+      String.sub doc 0 len,
+      Some (String.sub doc (len + 1) (String.length doc - len - 1))
+    with _ -> doc, None in
+  match long with
+  | None ->
+      Format.fprintf ppf "%s" short
+  | Some doc ->
+      Format.fprintf ppf "%s@{<full>@\n  @[<hov 0>%a@]@}" short Format.pp_print_text doc
+
+let print_label ppf = function
+  | { long ; short = None } -> Format.fprintf ppf "--%s" long
+  | { long ; short = Some short } -> Format.fprintf ppf "-%c --%s" short long
+
+let print_options_detailed (type ctx) =
+  let help_option : type a.Format.formatter -> (a, ctx) arg -> unit =
+    fun ppf -> function
+      | Arg { label ; placeholder ; doc ; _ } ->
+          Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
+            print_label label placeholder
+            print_desc doc ;
+      | DefArg { label ; placeholder ; doc ; default ; _ } ->
+          Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
+            print_label label placeholder
+            print_desc (doc ^ "\nDefaults to `" ^ default ^ "`.")
+      | Switch { label ; doc } ->
+          Format.fprintf ppf "@{<opt>%a@}: %a"
+            print_label label
+            print_desc doc
+      | Constant _ -> () in
+  let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
+    fun ppf -> function
+      | NoArgs -> ()
+      | AddArg (arg, NoArgs) ->
+          Format.fprintf ppf "%a"
+            help_option arg
+      | AddArg (arg, rest) ->
+          Format.fprintf ppf "%a@,%a"
+            help_option arg help rest
+  in help
+
+let has_args : type a ctx. (a, ctx) args -> bool = function
+  | NoArgs -> false
+  | AddArg (_,_) -> true
+
+let print_options_brief (type ctx) =
+  let help_option :
+    type a. Format.formatter -> (a, ctx) arg -> unit =
+    fun ppf -> function
+      | DefArg { label ; placeholder ; _ } ->
+          Format.fprintf ppf "[@{<opt>%a <%s>@}]"
+            print_label label placeholder
+      | Arg { label ; placeholder ; _ } ->
+          Format.fprintf ppf "[@{<opt>%a <%s>@}]"
+            print_label  label placeholder
+      | Switch { label ; _ } ->
+          Format.fprintf ppf "[@{<opt>%a@}]"
+            print_label label
+      | Constant _ -> ()
+  in let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
+       fun ppf -> function
+         | NoArgs -> ()
+         | AddArg (arg, NoArgs) ->
+             Format.fprintf ppf "%a" help_option arg
+         | AddArg (arg, rest) ->
+             Format.fprintf ppf "%a@ %a"
+               help_option arg help rest
+  in help
+
+let print_highlight highlight_strings formatter str =
+  let rec print_string = function
+    | [] -> Format.fprintf formatter "%s" str
+    | regex :: tl ->
+        begin match Re.Str.full_split regex str with
+          | []
+          | [ Re.Str.Text _ ] -> print_string tl
+          | list ->
+              List.iter
+                (function
+                  | Re.Str.Text text -> Format.fprintf formatter "%s" text
+                  | Re.Str.Delim delimiter ->
+                      Format.fprintf formatter "@{<hilight>%s@}" delimiter)
+                list
+        end
+  in print_string (List.map Re.Str.regexp_string highlight_strings)
+
+let print_commandline ppf (highlights, options, args) =
+  let rec print
+    : type a ctx. Format.formatter -> (a, ctx) params -> unit =
+    fun ppf -> function
+      | Stop -> Format.fprintf ppf "%a" print_options_brief options
+      | Seq (n, _, _) when not (has_args options) ->
+          Format.fprintf ppf "[@{<arg>%s@}...]" n
+      | Seq (n, _, _) ->
+          Format.fprintf ppf "[@{<arg>%s@}...] %a" n print_options_brief options
+      | Prefix (n, Stop) when not (has_args options) ->
+          Format.fprintf ppf "@{<kwd>%a@}" (print_highlight highlights) n
+      | Prefix (n, next) ->
+          Format.fprintf ppf "@{<kwd>%a@} %a"
+            (print_highlight highlights) n print next
+      | Param (n, _, _, Stop) when not (has_args options) ->
+          Format.fprintf ppf "@{<arg>%s@}" n
+      | Param (n, _, _, next) ->
+          Format.fprintf ppf "@{<arg>%s@} %a" n print next in
+  Format.fprintf ppf "@{<commandline>%a@}" print args
+
+let rec print_params_detailed
+  : type a b ctx. (b, ctx) args -> Format.formatter -> (a, ctx) params -> unit
+  = fun spec ppf -> function
+    | Stop -> print_options_detailed ppf spec
+    | Seq (n, desc, _) ->
+        Format.fprintf ppf "@{<arg>%s@}: %a"
+          n print_desc (trim desc) ;
+        begin match spec with
+          | NoArgs -> ()
+          | _ -> Format.fprintf ppf "@,%a" print_options_detailed spec
+        end
+    | Prefix (_, next) ->
+        print_params_detailed spec ppf next
+    | Param (n, desc, _, Stop) ->
+        Format.fprintf ppf "@{<arg>%s@}: %a"
+          n print_desc (trim desc);
+        begin match spec with
+          | NoArgs -> ()
+          | _ -> Format.fprintf ppf "@,%a" print_options_detailed spec
+        end
+    | Param (n, desc, _, next) ->
+        Format.fprintf ppf "@{<arg>%s@}: %a@,%a"
+          n print_desc (trim desc) (print_params_detailed spec) next
+
+let contains_params_args :
+  type arg ctx. (arg, ctx) params -> (_, ctx) args -> bool
+  = fun params args ->
+    let rec help : (arg, ctx) params -> bool = function
+      | Stop -> has_args args
+      | Seq (_, _, _) -> true
+      | Prefix (_, next) -> help next
+      | Param (_, _, _, _) -> true
+    in help params
+
+let print_command :
+  type ctx.
+  ?prefix:(Format.formatter -> unit -> unit) ->
+  ?highlights:string list -> Format.formatter -> ctx command -> unit
+  = fun
+    ?(prefix = (fun _ () -> ()))
+    ?(highlights=[]) ppf
+    (Command { params ; desc ; options = Argument { spec ; _ } ; _ }) ->
+    if contains_params_args params spec
+    then
+      Format.fprintf ppf "@{<command>%a%a@{<short>@,@{<commanddoc>%a@,%a@}@}@}"
+        prefix ()
+        print_commandline (highlights, spec, params)
+        print_desc desc
+        (print_params_detailed spec) params
+    else
+      Format.fprintf ppf "@{<command>%a%a@{<short>@,@{<commanddoc>%a@}@}@}"
+        prefix ()
+        print_commandline (highlights, spec, params)
+        print_desc desc
+
+type ex_command = Ex : _ command -> ex_command
+
+let group_commands commands =
+  let (grouped, ungrouped) =
+    List.fold_left
+      (fun (grouped, ungrouped) (Ex (Command { group ; _ }) as command) ->
+         match group with
+         | None -> (grouped, command :: ungrouped)
+         | Some group ->
+             match
+               List.find_opt (fun ({ name ; _ }, _) -> group.name = name) grouped with
+             | None -> ((group, ref [ command ]) :: grouped, ungrouped)
+             | Some ({ title ; _ }, r) ->
+                 if title <> group.title then
+                   invalid_arg "Clic.usage: duplicate group name" ;
+                 r := command :: !r ;
+                 (grouped, ungrouped))
+      ([], [])
+      commands in
+  List.map (fun (g, c) -> (g, List.rev !c))
+    (match ungrouped with
+     | [] -> grouped
+     | l -> (grouped @
+             [ { name = "misc" ;
+                 title = "Miscellaneous commands" },
+               ref l ]))
+
+let print_group print_command ppf ({ title ; _ }, commands) =
+  Format.fprintf ppf "@{<title>%s@}@,@{<list>%a@}"
+    title
+    (Format.pp_print_list print_command) commands
+
+type formatter_state =
+  Format.formatter_out_functions * Format.formatter_tag_functions * bool
+
+type format = Plain | Ansi | Html
+type verbosity = Terse | Short | Details | Full
+
+let setup_formatter ppf format verbosity =
+  let skip = ref false in
+  let orig_out_functions, _, _ as orig_state =
+    Format.pp_get_formatter_out_functions ppf (),
+    Format.pp_get_formatter_tag_functions ppf (),
+    Format.pp_get_print_tags ppf () in
+  begin
+    Format.pp_print_flush ppf () ;
+    Format.pp_set_formatter_out_functions ppf
+      { out_string =
+          (fun s b a ->
+             if s = "\000\000\000" then skip := true
+             else if s = "\255\255\255" then skip := false
+             else if not !skip then orig_out_functions.out_string s b a) ;
+        out_spaces = (fun n -> if not !skip then orig_out_functions.out_spaces n) ;
+        out_newline = (fun () -> if not !skip then orig_out_functions.out_newline ()) ;
+        out_flush = (fun () -> if not !skip then orig_out_functions.out_flush ()) ;
+        out_indent = orig_out_functions.out_indent } ;
+    let levels = ref [] in
+    let setup_level (level, op) =
+      if op level verbosity then
+        Format.fprintf ppf "@<0>%s" "\255\255\255"
+      else Format.fprintf ppf "@<0>%s" "\000\000\000" in
+    let push_level level =
+      levels := level :: !levels ;
+      setup_level level in
+    let pop_level () =
+      match !levels with
+      | _ :: level :: rest -> levels := level :: rest ; setup_level level
+      | [ _ ] | [] -> Pervasives.failwith "Clic: unclosed verbosity tag" in
+    push_level (Terse, (<=)) ;
+    let push_level_tag tag =
+      let push op = function
+        | "full" -> push_level (Full, op)
+        | "details" -> push_level (Details, op)
+        | "short" -> push_level (Short, op)
+        | "terse" -> push_level (Terse, op)
+        | tag -> Pervasives.failwith ("Clic: invalid semantic tag <" ^ tag ^ ">") in
+      if String.length tag > 0 && String.get tag 0 = '=' then
+        push (=) (String.sub tag 1 (String.length tag - 1))
+      else if String.length tag > 0 && String.get tag 0 = '-' then
+        push (>) (String.sub tag 1 (String.length tag - 1))
+      else push (<=) tag in
+    let pop_level_tag = function
+      | "full" | "details" | "short" | "terse"
+      | "-full" | "-details" | "-short" | "-terse"
+      | "=full" | "=details" | "=short" | "=terse" -> pop_level ()
+      | tag -> Pervasives.failwith ("Clic: invalid semantic tag <" ^ tag ^ ">") in
+    match format with
+    | Ansi ->
+        let color_num = function
+          | `Auto -> None
+          | `Black -> Some 0
+          | `Red -> Some 1
+          | `Green -> Some 2
+          | `Yellow -> Some 3
+          | `Blue -> Some 4
+          | `Magenta -> Some 5
+          | `Cyan -> Some 6
+          | `White -> Some 7 in
+        let ansi_format ppf (fg, bg, b, u) =
+          Format.fprintf ppf "@<0>%s" "\027[0m" ;
+          match
+            (match color_num fg with Some n -> [ string_of_int (30 + n) ] | None -> []) @
+            (match color_num bg with Some n -> [ string_of_int (40 + n) ] | None -> []) @
+            (if b then [ "1" ] else []) @
+            (if u then [ "4" ] else [])
+          with
+          | [] -> ()
+          | l -> Format.fprintf ppf "@<0>%s" ("\027[" ^ String.concat ";" l ^ "m") in
+        let ansi_stack = ref [ (`Auto, `Auto, false, false) ] in
+        let push_ansi_format (fg, bg, b, u) =
+          let format = match !ansi_stack with
+            | (pfg, pbg, pb, pu) :: _ ->
+                (Option.unopt ~default: pfg fg,
+                 Option.unopt ~default: pbg bg,
+                 pb || b,
+                 pu || u)
+            | [] -> assert false in
+          ansi_stack := format :: !ansi_stack ;
+          Format.fprintf ppf "@<0>%a" ansi_format format in
+        let pop_ansi_format () =
+          Format.fprintf ppf "@<0>%s" "\027[0m" ;
+          match !ansi_stack with
+          | _ :: format :: rest ->
+              ansi_stack := format :: rest ;
+              Format.fprintf ppf "@<0>%a" ansi_format format
+          | [ _ ] | [] -> Pervasives.failwith "Clic: unclosed ansi format" in
+        Format.pp_set_formatter_tag_functions ppf
+          { mark_open_tag = (fun _ -> "") ;
+            mark_close_tag = (fun _ -> "") ;
+            print_open_tag = begin function
+              | "title" -> push_ansi_format (None, None, true, true)
+              | "commandline" -> Format.fprintf ppf "@[<hov 4>"
+              | "commanddoc" -> Format.fprintf ppf "  @[<v 0>"
+              | "opt" -> push_ansi_format (Some `Green, None, false, false)
+              | "arg" -> push_ansi_format (Some `Yellow, None, false, false) ; Format.fprintf ppf "<"
+              | "kwd" -> push_ansi_format (None, None, false, true)
+              | "error" -> push_ansi_format (Some `Red, None, true, true)
+              | "warning" -> push_ansi_format (Some `Yellow, None, true, true)
+              | "hilight" -> push_ansi_format (Some `White, Some `Yellow, true, true)
+              | "list" -> Format.fprintf ppf "  @[<v 0>"
+              | "command" -> Format.fprintf ppf "@[<v 0>"
+              | "document" -> Format.fprintf ppf "@[<v 0>"
+              | other -> push_level_tag other
+            end ;
+            print_close_tag = begin function
+              | "title" -> Format.fprintf ppf ":" ; pop_ansi_format ()
+              | "commandline" -> Format.fprintf ppf "@]"
+              | "commanddoc" -> Format.fprintf ppf "@]"
+              | "opt" -> pop_ansi_format ()
+              | "arg" -> Format.fprintf ppf ">" ; pop_ansi_format ()
+              | "kwd" -> pop_ansi_format ()
+              | "error" -> pop_ansi_format ()
+              | "warning" -> pop_ansi_format ()
+              | "hilight" -> pop_ansi_format ()
+              | "command" | "list" -> Format.fprintf ppf "@]"
+              | "document" -> Format.fprintf ppf "@]"
+              | other -> pop_level_tag other
+            end } ;
+        Format.pp_set_print_tags ppf true
+    | Plain ->
+        Format.pp_set_formatter_tag_functions ppf
+          { mark_open_tag = (fun _ -> "") ;
+            mark_close_tag = (fun _ -> "") ;
+            print_open_tag = begin function
+              | "title" -> ()
+              | "commandline" -> Format.fprintf ppf "@[<hov 4>"
+              | "commanddoc" -> Format.fprintf ppf "  @[<v 0>"
+              | "opt" -> ()
+              | "arg" -> Format.fprintf ppf "<"
+              | "kwd" -> ()
+              | "hilight" -> ()
+              | "error" -> ()
+              | "warning" -> ()
+              | "list" -> Format.fprintf ppf "  @[<v 0>"
+              | "command" -> Format.fprintf ppf "@[<v 0>"
+              | "document" -> Format.fprintf ppf "@[<v 0>"
+              | other -> push_level_tag other
+            end ;
+            print_close_tag = begin function
+              | "title" -> Format.fprintf ppf ":"
+              | "commandline" -> Format.fprintf ppf "@]"
+              | "commanddoc" -> Format.fprintf ppf "@]"
+              | "opt" -> ()
+              | "arg" -> Format.fprintf ppf ">"
+              | "kwd" -> ()
+              | "error" -> ()
+              | "warning" -> ()
+              | "hilight" -> ()
+              | "command" | "list" -> Format.fprintf ppf "@]"
+              | "document" -> Format.fprintf ppf "@]"
+              | other -> pop_level_tag other
+            end } ;
+        Format.pp_set_print_tags ppf true
+    | Html ->
+        Format.pp_set_formatter_tag_functions ppf
+          { mark_open_tag = (fun _ -> "") ;
+            mark_close_tag = (fun _ -> "") ;
+            print_open_tag = begin function
+              | "title" -> Format.fprintf ppf "\003h3\004"
+              | "commandline" -> Format.fprintf ppf "\003div class='cmdline'\004@[<h>"
+              | "commanddoc" -> Format.fprintf ppf "\003div class='cmddoc'\004"
+              | "opt" -> Format.fprintf ppf "\003span class='opt'\004"
+              | "arg" -> Format.fprintf ppf "\003span class='arg'\004"
+              | "kwd" -> Format.fprintf ppf "\003span class='kwd'\004"
+              | "hilight" -> ()
+              | "error" -> ()
+              | "warning" -> ()
+              | "list" -> Format.fprintf ppf "\003ul\004@\n"
+              | "command" -> Format.fprintf ppf "\003li\004@\n"
+              | "document" ->
+                  Format.fprintf ppf
+                    "@[<v 0>\003style\004\
+                     .cmdline { font-family: monospace }\
+                     .cmddoc { white-space: pre-wrap ; font-family: monospace; line-height: 170%%; margin: 0 0 20px 0 }\
+                     .cmdline { background: #343131; padding: 2px 8px;	border-radius:10px; color: white; margin: 5px; }\
+                     .cmdline+.cmddoc { margin: -5px 5px 0 20px; padding: 5px }\
+                     .opt,.arg { background: #343131; font-weight: bold;  padding: 2px 4px; border-radius:5px; }\
+                     .kwd { font-weight: bold; } .opt { color:#CF0; background: #460; } .arg { color: #CEF; background: #369; }\
+                     \003/style\004@\n" ;
+              | other -> push_level_tag other
+            end ;
+            print_close_tag = begin function
+              | "title" -> Format.fprintf ppf "\003/h3\004@\n"
+              | "commandline" -> Format.fprintf ppf "@]\003/div\004@\n"
+              | "commanddoc" -> Format.fprintf ppf "\003/div\004@\n"
+              | "opt" | "arg" | "kwd" -> Format.fprintf ppf "\003/span\004"
+              | "error" | "warning" | "hilight" -> ()
+              | "list" -> Format.fprintf ppf "\003/ul\004@\n"
+              | "command" -> Format.fprintf ppf "\003/li\004@\n"
+              | "document" -> Format.fprintf ppf "@]"
+              | other -> pop_level_tag other
+            end } ;
+        let orig_out_functions =
+          Format.pp_get_formatter_out_functions ppf () in
+        Format.pp_set_formatter_out_functions ppf
+          { orig_out_functions with
+            out_string = (fun s i j ->
+                let buf = Buffer.create (j - i) in
+                for n = i to j - 1 do match String.get s n with
+                  | '\003' -> Buffer.add_char buf '<'
+                  | '\004' -> Buffer.add_char buf '>'
+                  | '>' -> Buffer.add_string buf ">"
+                  | '<' -> Buffer.add_string buf "<"
+                  | c -> Buffer.add_char buf c
+                done ;
+                let s' = Buffer.contents buf in
+                orig_out_functions.out_string s' 0 (String.length s'))} ;
+        Format.pp_set_print_tags ppf true
+  end ;
+  orig_state
+
+let restore_formatter ppf (out_functions, tag_functions, tags) =
+  Format.pp_print_flush ppf () ;
+  Format.pp_set_formatter_out_functions ppf out_functions ;
+  Format.pp_set_formatter_tag_functions ppf tag_functions ;
+  Format.pp_set_print_tags ppf tags
+
+let usage_internal ppf ~executable_name ~global_options ?(highlights=[]) commands =
+  let by_group = group_commands commands in
+  let (Argument { spec ; _ }) = global_options in
+  let print_groups =
+    Format.pp_print_list
+      ~pp_sep: (fun ppf () -> Format.fprintf ppf "@,@,")
+      (print_group (fun ppf (Ex command) -> print_command ?prefix:None ~highlights ppf command)) in
+  Format.fprintf ppf
+    "@{<document>@{<title>Usage@}@,\
+     @{<list>\
+     @{<command>@{<commandline>\
+     %s [@{<opt>global options@}] @{<kwd>command@} [@{<opt>command options@}]@}@}@,\
+     @{<command>@{<commandline>\
+     %s @{<opt>--help@} (for global options)@}@}@,\
+     @{<command>@{<commandline>\
+     %s [@{<opt>global options@}] @{<kwd>command@} @{<opt>--help@} (for command options)@}@}\
+     @}@,@,\
+     @{<title>To browse the documentation@}@,\
+     @{<list>\
+     @{<command>@{<commandline>\
+     %s [@{<opt>global options@}] @{<kwd>man@} (for a list of commands)@}@}@,\
+     @{<command>@{<commandline>\
+     %s [@{<opt>global options@}] @{<kwd>man@} @{<opt>-v 3@} (for the full manual)@}@}\
+     @}@,@,\
+     @{<title>Global options (must come before the command)@}@,\
+     @{<commanddoc>%a@}%a\
+     %a@}@."
+    executable_name executable_name executable_name executable_name executable_name
+    print_options_detailed spec
+    (fun ppf () -> if by_group <> [] then Format.fprintf ppf "@,@,") ()
+    print_groups by_group
+
+let constant c = Constant c
+
+let arg ~doc ?short ~long ~placeholder kind =
+  Arg { doc ;
+        label = { long ; short } ;
+        placeholder ;
+        kind }
+
+let default_arg ~doc ?short ~long ~placeholder ~default kind =
+  DefArg { doc ;
+           placeholder ;
+           label = { long ; short } ;
+           kind ;
+           default }
+
+let switch ~doc ?short ~long () =
+  Switch { doc ; label = { long ; short } }
+
+let parse_arg :
+  type a ctx. ?command:_ command -> (a, ctx) arg -> string list TzString.Map.t -> ctx -> a tzresult Lwt.t =
+  fun ?command spec args_dict ctx ->
+    match spec with
+    | Arg { label = { long ; short = _ } ; kind = { converter ; _  } ; _ } ->
+        begin match TzString.Map.find_opt long args_dict with
+          | None
+          | Some [] -> return_none
+          | Some [ s ] ->
+              (trace
+                 (Bad_option_argument ("--" ^ long, command))
+                 (converter ctx s)) >>|? fun x ->
+              Some x
+          | Some (_ :: _) ->
+              fail (Multiple_occurences ("--" ^ long, command))
+        end
+    | DefArg { label = { long ; short = _ } ; kind = { converter ; _ } ; default ; _ } ->
+        converter ctx default >>= fun default ->
+        begin match default with
+          | Ok x -> return x
+          | Error _ ->
+              invalid_arg
+                (Format.sprintf
+                   "Value provided as default for '%s' could not be parsed by converter function."
+                   long) end >>=? fun default ->
+        begin match TzString.Map.find_opt long args_dict with
+          | None
+          | Some [] -> return default
+          | Some [ s ] ->
+              (trace
+                 (Bad_option_argument (long, command))
+                 (converter ctx s))
+          | Some (_ :: _) ->
+              fail (Multiple_occurences (long, command))
+        end
+    | Switch { label = { long ; short = _ } ; _ } ->
+        begin match TzString.Map.find_opt long args_dict with
+          | None
+          | Some [] -> return_false
+          | Some [ _ ] -> return_true
+          | Some (_ :: _) -> fail (Multiple_occurences (long, command))
+        end
+    | Constant c -> return c
+
+(* Argument parsing *)
+let rec parse_args :
+  type a ctx. ?command:_ command -> (a, ctx) args -> string list TzString.Map.t -> ctx -> a tzresult Lwt.t =
+  fun ?command spec args_dict ctx ->
+    match spec with
+    | NoArgs -> return_unit
+    | AddArg (arg, rest) ->
+        parse_arg ?command arg args_dict ctx >>=? fun arg ->
+        parse_args ?command rest args_dict ctx >>|? fun rest ->
+        (arg, rest)
+
+let empty_args_dict = TzString.Map.empty
+
+let rec make_arities_dict :
+  type a b. (a, b) args -> (int * string) TzString.Map.t -> (int * string) TzString.Map.t =
+  fun args acc -> match args with
+    | NoArgs -> acc
+    | AddArg (arg, rest) ->
+        let recur { long ; short } num =
+          (match short with
+           | None -> acc
+           | Some c -> TzString.Map.add ("-" ^ String.make 1 c) (num, long) acc) |>
+          TzString.Map.add ("-" ^ long) (num, long) |>
+          TzString.Map.add ("--" ^ long) (num, long) |>
+          make_arities_dict rest in
+        match arg with
+        | Arg { label ; _ } -> recur label 1
+        | DefArg { label ; _ } -> recur label 1
+        | Switch { label ; _ } -> recur label 0
+        | Constant _c -> make_arities_dict rest acc
+
+type error += Help : 'a command option -> error
+
+let check_help_flag ?command = function
+  | ("-h" | "--help") :: _ -> fail (Help command)
+  | _ -> return_unit
+
+let add_occurrence long value acc =
+  match TzString.Map.find_opt long acc with
+  | Some v -> TzString.Map.add long v acc
+  | None -> TzString.Map.add long [ value ] acc
+
+let make_args_dict_consume ?command spec args =
+  let rec make_args_dict completing arities acc args =
+    check_help_flag ?command args >>=? fun () ->
+    match args with
+    | [] -> return (acc, [])
+    | arg :: tl ->
+        if String.length arg > 0 && String.get arg 0 = '-' then
+          if TzString.Map.mem arg arities then
+            let arity, long = TzString.Map.find arg arities in
+            check_help_flag ?command tl >>=? fun () ->
+            match arity, tl with
+            | 0, tl' ->
+                make_args_dict completing arities (add_occurrence long "" acc) tl'
+            | 1, value :: tl' ->
+                make_args_dict completing arities (add_occurrence long value acc) tl'
+            | 1, [] when completing ->
+                return (acc, [])
+            | 1, [] ->
+                fail (Option_expected_argument (arg, None))
+            | _, _ ->
+                raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
+          else
+            fail (Unknown_option (arg, None))
+        else return (acc, args)
+  in make_args_dict false (make_arities_dict spec TzString.Map.empty) TzString.Map.empty args
+
+let make_args_dict_filter ?command spec args =
+  let rec make_args_dict arities (dict, other_args) args =
+    check_help_flag ?command args >>=? fun () ->
+    match args with
+    | [] -> return (dict, other_args)
+    | arg :: tl ->
+        if TzString.Map.mem arg arities
+        then let arity, long = TzString.Map.find arg arities in
+          check_help_flag ?command tl >>=? fun () ->
+          match arity, tl with
+          | 0, tl -> make_args_dict arities (add_occurrence long "" dict, other_args) tl
+          | 1, value :: tl' -> make_args_dict arities (add_occurrence long value dict, other_args) tl'
+          | 1, [] -> fail (Option_expected_argument (arg, command))
+          | _, _ ->
+              raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
+        else make_args_dict arities (dict, arg :: other_args) tl
+  in make_args_dict
+    (make_arities_dict spec TzString.Map.empty)
+    (TzString.Map.empty, [])
+    args >>|? fun (dict, remaining) ->
+  (dict, List.rev remaining)
+
+let (>>) arg1 arg2 = AddArg (arg1, arg2)
+let args1 spec =
+  Argument { spec = spec >> NoArgs;
+             converter = fun (arg, ()) -> arg }
+let args2 spec1 spec2 =
+  Argument { spec = spec1 >> (spec2 >> NoArgs) ;
+             converter = fun (arg1, (arg2, ())) -> arg1, arg2 }
+let args3 spec1 spec2 spec3 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> NoArgs)) ;
+             converter = fun (arg1, (arg2, (arg3, ()))) -> arg1, arg2, arg3 }
+let args4 spec1 spec2 spec3 spec4 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> NoArgs))) ;
+             converter = fun (arg1, (arg2, (arg3, (arg4, ())))) -> arg1, arg2, arg3, arg4 }
+let args5 spec1 spec2 spec3 spec4 spec5 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> NoArgs)))) ;
+             converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, ()))))) -> arg1, arg2, arg3, arg4, arg5 }
+let args6 spec1 spec2 spec3 spec4 spec5 spec6 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> NoArgs))))) ;
+             converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, ())))))) ->
+               arg1, arg2, arg3, arg4, arg5, spec6 }
+let args7 spec1 spec2 spec3 spec4 spec5 spec6 spec7 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> NoArgs)))))) ;
+             converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, ()))))))) ->
+               arg1, arg2, arg3, arg4, arg5, spec6, spec7 }
+let args8 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 =
+  Argument { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> NoArgs))))))) ;
+             converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, ())))))))) ->
+               arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8 }
+let args9 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> NoArgs)))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, ()))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9 }
+let args10 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> NoArgs))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, ())))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10 }
+let args11 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> NoArgs)))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, ()))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11 }
+
+let args12 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 spec12 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> (spec12 >> NoArgs))))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, (spec12, ())))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11, spec12 }
+
+let args13 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 spec12 spec13 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> (spec12 >> (spec13 >> NoArgs)))))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, (spec12, (spec13, ()))))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11, spec12, spec13 }
+
+let args14 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 spec12 spec13 spec14 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> (spec12 >> (spec13 >> (spec14 >> NoArgs))))))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, (spec12, (spec13, (spec14, ())))))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11, spec12, spec13, spec14 }
+
+let args15 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 spec12 spec13 spec14 spec15 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> (spec12 >> (spec13 >> (spec14 >> (spec15 >> NoArgs)))))))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, (spec12, (spec13, (spec14, (spec15, ()))))))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11, spec12, spec13, spec14, spec15 }
+
+let args16 spec1 spec2 spec3 spec4 spec5 spec6 spec7 spec8 spec9 spec10 spec11 spec12 spec13 spec14 spec15 spec16 =
+  Argument
+    { spec = spec1 >> (spec2 >> (spec3 >> (spec4 >> (spec5 >> (spec6 >> (spec7 >> (spec8 >> (spec9 >> (spec10 >> (spec11 >> (spec12 >> (spec13 >> (spec14 >> (spec15 >> (spec16 >> NoArgs))))))))))))))) ;
+      converter = fun (arg1, (arg2, (arg3, (arg4, (arg5, (spec6, (spec7, (spec8, (spec9, (spec10, (spec11, (spec12, (spec13, (spec14, (spec15, (spec16, ())))))))))))))))) ->
+        arg1, arg2, arg3, arg4, arg5, spec6, spec7, spec8, spec9, spec10, spec11, spec12, spec13, spec14, spec15, spec16 }
+
+(* Some combinators for writing commands concisely. *)
+let param ~name ~desc kind next = Param (name, desc, kind, next)
+let seq_of_param param =
+  match param Stop with
+  | Param (n, desc, parameter, Stop) -> Seq (n, desc, parameter)
+  | _ -> invalid_arg "Clic.seq_of_param"
+
+let prefix keyword next = Prefix (keyword, next)
+let rec fixed =
+  function [] -> Stop | n :: r -> Prefix (n, fixed r)
+let rec prefixes p next =
+  match p with [] -> next | n :: r -> Prefix (n, prefixes r next)
+let stop = Stop
+let no_options = Argument { spec=NoArgs ; converter=fun () -> () }
+let command ?group ~desc options params handler =
+  Command { params ; options ; handler ; desc ; group ; conv = (fun x -> x) }
+
+(* Param combinators *)
+let string ~name ~desc next =
+  param ~name ~desc { converter=(fun _ s -> return s) ; autocomplete=None } next
+
+let string_contains ~needle ~haystack =
+  try
+    Some (Re.Str.search_forward (Re.Str.regexp_string needle) haystack 0)
+  with Not_found ->
+    None
+
+let rec search_params_prefix : type a arg. string -> (a, arg) params -> bool =
+  fun prefix -> function
+    | Prefix (keyword, next) ->
+        begin
+          match string_contains ~needle:prefix ~haystack:keyword with
+          | None -> search_params_prefix prefix next
+          | Some _ -> true
+        end
+    | Param (_, _, _, next) -> search_params_prefix prefix next
+    | Stop -> false
+    | Seq _ -> false
+
+let search_command keyword (Command { params ; _ }) =
+  search_params_prefix keyword params
+
+
+(* Command execution *)
+let exec
+    (type ctx)
+    (Command { options = (Argument { converter ; spec = options_spec }) ;
+               params = spec ; handler ; conv ; _ } as command)
+    (ctx : ctx) params args_dict =
+  let rec exec
+    : type ctx a. int -> ctx -> (a, ctx) params -> a -> string list -> unit tzresult Lwt.t
+    = fun i ctx spec cb params ->
+      match spec, params with
+      | Stop, _ -> cb ctx
+      | Seq (_, _, { converter ; _ }), seq ->
+          let rec do_seq i acc = function
+            | [] -> return (List.rev acc)
+            | p :: rest ->
+                Lwt.catch
+                  (fun () -> converter ctx p)
+                  (function
+                    | Failure msg -> Error_monad.failwith "%s" msg
+                    | exn -> fail (Exn exn))
+                |> trace (Bad_argument (i, p)) >>=? fun v ->
+                do_seq (succ i) (v :: acc) rest in
+          do_seq i [] seq >>=? fun parsed ->
+          cb parsed ctx
+      | Prefix (n, next), p :: rest when n = p ->
+          exec (succ i) ctx next cb rest
+      | Param (_, _, { converter ; _ }, next), p :: rest ->
+          Lwt.catch
+            (fun () -> converter ctx p)
+            (function
+              | Failure msg -> Error_monad.failwith "%s" msg
+              | exn -> fail (Exn exn))
+          |> trace (Bad_argument (i, p)) >>=? fun v ->
+          exec (succ i) ctx next (cb v) rest
+      | _ -> raise (Failure ("cli_entries internal error: exec no case matched"))
+  in
+  let ctx = conv ctx in
+  parse_args ~command options_spec args_dict ctx >>=? fun parsed_options ->
+  exec 1 ctx spec (handler (converter parsed_options)) params
+
+(* Command dispatch tree *)
+type 'arg level =
+  { stop : ('arg) command option ;
+    prefix : (string * 'arg tree) list }
+and 'arg param_level =
+  { stop : 'arg command option ;
+    autocomplete : ('arg -> string list tzresult Lwt.t) option ;
+    tree : 'arg tree }
+and 'ctx tree =
+  | TPrefix : 'ctx level -> 'ctx tree
+  | TParam : 'ctx param_level -> 'ctx tree
+  | TStop : 'ctx command -> 'ctx tree
+  | TSeq : 'ctx command * ('ctx -> string list tzresult Lwt.t) option -> 'ctx tree
+  | TEmpty : 'ctx tree
+
+let has_options : type ctx. ctx command -> bool =
+  fun (Command { options = Argument { spec ; _ } ; _ }) ->
+    let args_help : type a ctx. (a, ctx) args -> bool = function
+      | NoArgs -> false
+      | AddArg (_, _) -> true
+    in args_help spec
+
+let insert_in_dispatch_tree :
+  type ctx. ctx tree -> ctx command -> ctx tree =
+  fun root (Command { params ; conv ; _ } as command) ->
+    let access_autocomplete :
+      type p ctx. (p, ctx) parameter -> (ctx -> string list tzresult Lwt.t) option =
+      fun { autocomplete ; _ } -> autocomplete in
+    let rec insert_tree
+      : type a ictx.
+        (ctx -> ictx) ->
+        ctx tree -> (a, ictx) params -> ctx tree
+      = fun conv t c ->
+        let insert_tree t c = insert_tree conv t c in
+        match t, c with
+        | TEmpty, Stop -> TStop command
+        | TEmpty, Seq (_, _, { autocomplete ; _ }) ->
+            TSeq (command,
+                  Option.map autocomplete ~f:(fun a c -> a (conv c)))
+        | TEmpty, Param (_, _, param, next) ->
+            let autocomplete = access_autocomplete param in
+            let autocomplete = Option.map autocomplete ~f:(fun a c -> a (conv c)) in
+            TParam { tree = insert_tree TEmpty next ; stop = None ; autocomplete}
+        | TEmpty, Prefix (n, next) ->
+            TPrefix { stop = None ; prefix = [ (n, insert_tree TEmpty next) ] }
+        | TStop cmd, Param (_, _, param, next) ->
+            let autocomplete = access_autocomplete param in
+            let autocomplete = Option.map autocomplete ~f:(fun a c -> a (conv c)) in
+            if not (has_options cmd)
+            then TParam { tree = insert_tree TEmpty next ;
+                          stop = Some cmd ;
+                          autocomplete }
+            else raise (Failure "Command cannot have both prefix and options")
+        | TStop cmd, Prefix (n, next) ->
+            TPrefix { stop = Some cmd ;
+                      prefix = [ (n, insert_tree TEmpty next) ] }
+        | TParam t, Param (_, _, _, next) ->
+            TParam { t with tree = insert_tree t.tree next }
+        | TPrefix ({ prefix ; _ } as l), Prefix (n, next) ->
+            let rec insert_prefix = function
+              | [] -> [ (n, insert_tree TEmpty next) ]
+              | (n', t) :: rest when n = n' -> (n, insert_tree t next) :: rest
+              | item :: rest -> item :: insert_prefix rest in
+            TPrefix { l with prefix = insert_prefix prefix }
+        | TPrefix ({ stop = None ; _ } as l), Stop ->
+            TPrefix { l with stop = Some command }
+        | TParam ({ stop = None ; _ } as l), Stop ->
+            TParam { l with stop = Some command }
+        | _, _ ->
+            Pervasives.failwith
+              "Clic.Command_tree.insert: conflicting commands" in
+    insert_tree conv root params
+
+
+let make_dispatch_tree commands =
+  List.fold_left insert_in_dispatch_tree TEmpty commands
+
+let rec gather_commands ?(acc=[]) tree =
+  match tree with
+  | TEmpty -> acc
+  | TSeq (c, _)
+  | TStop c -> c :: acc
+  | TPrefix { stop ; prefix } ->
+      gather_assoc ~acc:(match stop with
+          | None -> acc
+          | Some c -> c :: acc)
+        prefix
+  | TParam { tree ; stop ; _ } ->
+      gather_commands tree
+        ~acc:(match stop with
+            | None -> acc
+            | Some c -> c :: acc)
+
+and gather_assoc ?(acc=[]) trees =
+  List.fold_left (fun acc (_, tree) -> gather_commands tree ~acc) acc trees
+
+let find_command tree initial_arguments =
+  let rec traverse tree arguments acc =
+    match tree, arguments with
+    | (TStop _ | TSeq _
+      | TPrefix { stop = Some _ ; _ }
+      | TParam { stop = Some _ ; _}), ("-h" | "--help") :: _ ->
+        begin match gather_commands tree with
+          | [] -> assert false
+          | [ command ] -> fail (Help (Some command))
+          | more -> fail (Unterminated_command (initial_arguments, more))
+        end
+    | TStop c, [] -> return (c, empty_args_dict, initial_arguments)
+    | TStop (Command { options = Argument { spec ; _ } ; _ } as command), remaining ->
+        make_args_dict_filter ~command spec remaining >>=? fun (args_dict, unparsed) ->
+        begin match unparsed with
+          | [] -> return (command, args_dict, initial_arguments)
+          | hd :: _ ->
+              if String.length hd > 0 && String.get hd 0 = '-' then
+                fail (Unknown_option (hd, Some command))
+              else
+                fail (Extra_arguments (unparsed, command))
+        end
+    | TSeq (Command { options = Argument { spec ; _ } ; _ } as command, _), remaining ->
+        if List.exists (function "-h" | "--help" -> true | _ -> false) remaining then
+          fail (Help (Some command))
+        else
+          make_args_dict_filter ~command spec remaining >>|? fun (dict, remaining) ->
+          (command, dict, List.rev_append acc remaining)
+    | TPrefix { stop = Some cmd ; _ }, [] ->
+        return (cmd, empty_args_dict, initial_arguments)
+    | TPrefix { stop = None ; prefix }, ([] | ("-h" | "--help") :: _) ->
+        fail (Unterminated_command (initial_arguments, gather_assoc prefix))
+    | TPrefix { prefix ; _ }, hd_arg :: tl ->
+        begin
+          try
+            return (List.assoc hd_arg prefix)
+          with Not_found -> fail (Command_not_found (List.rev acc, gather_assoc prefix))
+        end >>=? fun tree' ->
+        traverse tree' tl (hd_arg :: acc)
+    | TParam { stop = None ; _ }, ([] | ("-h" | "--help") :: _) ->
+        fail (Unterminated_command (initial_arguments, gather_commands tree))
+    | TParam { stop = Some c ; _ }, [] ->
+        return (c, empty_args_dict, initial_arguments)
+    | TParam { tree ; _ }, parameter :: arguments' ->
+        traverse tree arguments' (parameter :: acc)
+    | TEmpty, _ ->
+        fail (Command_not_found (List.rev acc, []))
+  in traverse tree initial_arguments []
+
+
+let get_arg_label (type a) (arg : (a, _) arg) =
+  match arg with
+  | Arg { label ; _ } -> label
+  | DefArg { label ; _ } -> label
+  | Switch { label ; _ } -> label
+  | Constant _ -> assert false
+
+let get_arg
+  : type a ctx. (a, ctx) arg -> string list
+  = fun arg ->
+    let { long ; short } = get_arg_label arg in
+    ("--" ^ long) :: match short with None -> [] | Some c -> [ "-" ^ String.make 1 c ]
+
+let rec list_args : type arg ctx. (arg, ctx) args -> string list = function
+  | NoArgs -> []
+  | AddArg (Constant _, args) -> list_args args
+  | AddArg (arg, args) -> get_arg arg @ list_args args
+
+let complete_func autocomplete cctxt =
+  match autocomplete with
+  | None -> return_nil
+  | Some autocomplete -> autocomplete cctxt
+
+let list_command_args (Command { options = Argument { spec ; _ } ; _ }) =
+  list_args spec
+
+let complete_arg : type a ctx. ctx -> (a, ctx) arg -> string list tzresult Lwt.t =
+  fun ctx -> function
+    | Arg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx
+    | DefArg { kind = { autocomplete ; _ } ; _ } -> complete_func autocomplete ctx
+    | Switch _ -> return_nil
+    | Constant _ -> return_nil
+
+let rec remaining_spec :
+  type a ctx. TzString.Set.t -> (a, ctx) args -> string list =
+  fun seen -> function
+    | NoArgs -> []
+    | AddArg (Constant _, rest) ->
+        remaining_spec seen rest
+    | AddArg (arg, rest) ->
+        let { long ; _ } = get_arg_label arg in
+        if TzString.Set.mem long seen
+        then remaining_spec seen rest
+        else get_arg arg @ remaining_spec seen rest
+
+let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
+  let arities = make_arities_dict args_spec TzString.Map.empty in
+  let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t =
+    fun name -> function
+      | NoArgs -> return_nil
+      | AddArg (Constant _, rest) ->
+          complete_spec name rest
+      | AddArg (arg, rest) ->
+          if (get_arg_label arg).long = name
+          then complete_arg ctx arg
+          else complete_spec name rest in
+  let rec help args ind seen =
+    match args with
+    | _ when ind = 0 ->
+        continuation args 0 >>|? fun cont_args ->
+        cont_args @ remaining_spec seen args_spec
+    | [] ->
+        Pervasives.failwith
+          "cli_entries internal autocomplete error"
+    | arg :: tl ->
+        if TzString.Map.mem arg arities
+        then
+          let arity, long = TzString.Map.find arg arities in
+          let seen = TzString.Set.add long seen in
+          match arity, tl with
+          | 0, args when ind = 0 ->
+              continuation args 0 >>|? fun cont_args ->
+              remaining_spec seen args_spec @ cont_args
+          | 0, args -> help args (ind - 1) seen
+          | 1, _ when ind = 1 -> complete_spec arg args_spec
+          | 1, _ :: tl -> help tl (ind - 2) seen
+          | _ -> Pervasives.failwith "cli_entries internal error, invalid arity"
+        else continuation args ind
+  in help args ind TzString.Set.empty
+
+let complete_next_tree cctxt = function
+  | TPrefix { stop; prefix } ->
+      return
+        ((match stop with
+            | None -> []
+            | Some command -> list_command_args command)
+         @ (List.map fst prefix))
+  | TSeq (command, autocomplete) ->
+      complete_func autocomplete cctxt >>|? fun completions ->
+      completions @ (list_command_args command)
+  | TParam { autocomplete ; _ } ->
+      complete_func autocomplete cctxt
+  | TStop command -> return (list_command_args command)
+  | TEmpty -> return_nil
+
+let complete_tree cctxt tree index args =
+  let rec help tree args ind =
+    if ind = 0
+    then complete_next_tree cctxt tree
+    else
+      match tree, args with
+      | TSeq _, _ -> complete_next_tree cctxt tree
+      | TPrefix { prefix ; _ }, hd :: tl ->
+          begin
+            try help (List.assoc hd prefix) tl (ind - 1)
+            with Not_found -> return_nil
+          end
+      | TParam { tree ; _ }, _ :: tl ->
+          help tree tl (ind - 1)
+      | TStop Command { options = Argument { spec ; _ } ; conv ;_ }, args ->
+          complete_options (fun _ _ -> return_nil) args spec ind (conv cctxt)
+      | (TParam _ | TPrefix _), []
+      | TEmpty, _ -> return_nil
+  in help tree args index
+
+let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cctxt =
+  let tree = make_dispatch_tree commands in
+  let rec ind n = function
+    | [] -> None
+    | hd :: tl ->
+        if hd = prev_arg
+        then Some (Option.unopt ~default:(n + 1) (ind (n + 1) tl))
+        else (ind (n + 1) tl) in
+  begin
+    if prev_arg = script
+    then complete_next_tree cctxt tree >>|? fun command_completions ->
+      begin
+        let (Argument { spec ; _ }) = global_options in
+        list_args spec @ command_completions
+      end
+    else
+      match ind 0 args with
+      | None ->
+          return_nil
+      | Some index ->
+          begin
+            let Argument { spec ; _ } = global_options in
+            complete_options
+              (fun args ind -> complete_tree cctxt tree ind args)
+              args spec index cctxt
+          end
+  end >>|? fun completions ->
+  List.filter
+    (fun completion -> Re.Str.(string_match (regexp_string cur_arg) completion 0))
+    completions
+
+let parse_global_options global_options ctx args =
+  let Argument { spec ; converter } = global_options in
+  make_args_dict_consume spec args >>=? fun (dict, remaining) ->
+  parse_args spec dict ctx >>=? fun nested ->
+  return (converter nested, remaining)
+
+let dispatch commands ctx args =
+  let tree = make_dispatch_tree commands in
+  match args with
+  | [] | [ "-h" | "--help" ] ->
+      fail (Help None)
+  | _ ->
+      find_command tree args >>=? fun (command, args_dict, filtered_args) ->
+      exec command ctx filtered_args args_dict
+
+type error += No_manual_entry of string list
+
+let manual_group =
+  { name = "man" ;
+    title = "Access the documentation" }
+
+let add_manual ~executable_name ~global_options format ppf commands =
+  let rec with_manual = lazy
+    (commands @
+     [ command
+         ~group:manual_group
+         ~desc:"Print documentation of commands.\n\
+                Add search keywords to narrow list.\n\
+                Will display only the commands by default, \
+                unless [-verbosity <2|3>] is passed or the list \
+                of matching commands if less than 3."
+         (args2
+            (arg
+               ~doc:"level of details\n\
+                     0. Only shows command mnemonics, without documentation.\n\
+                     1. Shows command mnemonics with short descriptions.\n\
+                     2. Show commands and arguments with short descriptions\n\
+                     3. Show everything"
+               ~long:"verbosity"
+               ~short:'v'
+               ~placeholder:"0|1|2|3"
+               (parameter
+                  ~autocomplete: (fun _ -> return [ "0" ; "1" ; "2" ; "3" ])
+                  (fun _ arg -> match arg with
+                     | "0" -> return Terse
+                     | "1" -> return Short
+                     | "2" -> return Details
+                     | "3" -> return Full
+                     | _ -> failwith "Level of details out of range")))
+            (default_arg
+               ~doc:"the manual's output format"
+               ~placeholder: "plain|colors|html"
+               ~long: "format"
+               ~default:
+                 (match format with
+                  | Ansi -> "colors"
+                  | Plain -> "plain"
+                  | Html -> "html")
+               (parameter
+                  ~autocomplete: (fun _ -> return [ "colors" ; "plain" ; "html" ])
+                  (fun _ arg -> match arg with
+                     | "colors" -> return Ansi
+                     | "plain" -> return Plain
+                     | "html" -> return Html
+                     | _ -> failwith "Unknown manual format"))))
+         (prefix "man"
+            (seq_of_param (string ~name:"keyword"
+                             ~desc:"keyword to search for\n\
+                                    If several are given they must all appear in the command.")))
+         (fun (verbosity, format) keywords _ ->
+            let commands =
+              List.fold_left
+                (fun commands keyword -> List.filter (search_command keyword) commands)
+                (Lazy.force with_manual)
+                keywords in
+            let verbosity = match verbosity with
+              | Some verbosity -> verbosity
+              | None when List.length commands <= 3 -> Full
+              | None -> Short in
+            match commands with
+            | [] -> fail (No_manual_entry keywords)
+            | _ ->
+                let state = setup_formatter ppf format verbosity in
+                let commands = List.map (fun c -> Ex c) commands in
+                usage_internal ppf ~executable_name ~global_options ~highlights:keywords commands ;
+                restore_formatter ppf state ;
+                return_unit) ]) in
+  Lazy.force with_manual
+
+let pp_cli_errors ppf ~executable_name ~global_options ~default errs =
+  let pp_one = function
+    | Bad_argument (i, v) ->
+        Format.fprintf ppf
+          "Erroneous command line argument %d (%s)." i v ;
+        Some []
+    | Option_expected_argument (arg, command) ->
+        Format.fprintf ppf
+          "Command line option @{<opt>%s@} expects an argument." arg ;
+        Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
+    | Bad_option_argument (arg, command) ->
+        Format.fprintf ppf
+          "Wrong value for command line option @{<opt>%s@}." arg ;
+        Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
+    | Multiple_occurences (arg, command) ->
+        Format.fprintf ppf
+          "Command line option @{<opt>%s@} appears multiple times." arg ;
+        Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
+    | No_manual_entry [ keyword ] ->
+        Format.fprintf ppf
+          "No manual entry that match @{<hilight>%s@}."
+          keyword ;
+        Some []
+    | No_manual_entry (keyword :: keywords) ->
+        Format.fprintf ppf
+          "No manual entry that match %a and @{<hilight>%s@}."
+          (Format.pp_print_list
+             ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
+             (fun ppf keyword -> Format.fprintf ppf "@{<hilight>%s@}" keyword))
+          keywords
+          keyword ;
+        Some []
+    | Unknown_option (option, command) ->
+        Format.fprintf ppf
+          "Unexpected command line option @{<opt>%s@}."
+          option ;
+        Some (Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command)
+    | Extra_arguments (extra, command) ->
+        Format.fprintf ppf
+          "Extra command line arguments:@, @[<h>%a@]."
+          (Format.pp_print_list (fun ppf -> Format.fprintf ppf "%s")) extra ;
+        Some [ Ex command ]
+    | Unterminated_command (_, commands) ->
+        Format.fprintf ppf
+          "@[<v 2>Unterminated command, here are possible completions.@,%a@]"
+          (Format.pp_print_list
+             (fun ppf (Command { params ; options = Argument { spec ; _ } ; _ }) ->
+                print_commandline ppf ([], spec, params))) commands ;
+        Some (List.map (fun c -> Ex c) commands)
+    | Command_not_found ([], _all_commands) ->
+        Format.fprintf ppf
+          "@[<v 0>Unrecognized command.@,\
+           Try using the @{<kwd>man@} command to get more information.@]" ;
+        Some []
+    | Command_not_found (_, commands) ->
+        Format.fprintf ppf
+          "@[<v 0>Unrecognized command.@,\
+           Did you mean one of the following?@,  @[<v 0>%a@]@]"
+          (Format.pp_print_list
+             (fun ppf (Command { params ; options = Argument { spec ; _ } ; _ }) ->
+                print_commandline ppf ([], spec, params))) commands ;
+        Some (List.map (fun c -> Ex c) commands)
+    | err -> default ppf err ; None in
+  let rec pp acc errs =
+    let return command =
+      match command, acc with
+      | None, _ -> acc
+      | Some command, Some commands -> Some (command @ commands)
+      | Some command, None -> Some command in
+    match errs with
+    | [] -> None
+    | [ last ] -> return (pp_one last)
+    | err :: errs ->
+        let acc = return (pp_one err) in
+        Format.fprintf ppf "@," ;
+        pp acc errs in
+  Format.fprintf ppf "@[<v 2>@{<error>@{<title>Error@}@}@," ;
+  match pp None errs with
+  | None ->
+      Format.fprintf ppf "@]@\n"
+  | Some commands ->
+      Format.fprintf ppf "@]@\n@\n@[<v 0>%a@]"
+        (fun ppf commands -> usage_internal ppf ~executable_name ~global_options commands)
+        commands
+
+let usage ppf ~executable_name ~global_options commands =
+  usage_internal ppf
+    ~executable_name ~global_options
+    (List.map (fun c -> Ex c) commands)
+
+let map_command f (Command c) =
+  (Command { c with conv = (fun x -> c.conv (f x)) })
diff --git a/vendors/tezos-modded/src/lib_clic/clic.mli b/vendors/tezos-modded/src/lib_clic/clic.mli
new file mode 100644
index 000000000..395b26910
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_clic/clic.mli
@@ -0,0 +1,413 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+(** Command Line Interpretation Combinators.
+
+    Supports command lines of the following form:
+
+    [executable [global options] command [command options]]
+
+    Global options must be passed before the command, and may define
+    the set of supported commands.
+
+    Commands are series of fixed keywords and positional arguments, in
+    order to support command lines close to a natural language. *)
+
+(** {2 Argument parsers.} *)
+
+(** The type for argument parsers, used for both positional and
+    optional arguments.
+
+    The first type parameter is the OCaml type of the argument once
+    parsed from its string notation. The second parameter is a context
+    that is passed througout the parsing of the command line. Some
+    parameters (for instance a simple [int]) can remain polymorphic,
+    while others need a context to be parsed. Of course, a command line
+    can only contain parameters that bear the same context type. *)
+type ('a, 'ctx) parameter
+
+(** Build an argument parser, combining a parsing function and an
+    autocompletion function. The autocompletion must simply return the
+    list of all valid values for the parameter. *)
+val parameter :
+  ?autocomplete:('ctx -> string list tzresult Lwt.t) ->
+  ('ctx -> string -> 'a tzresult Lwt.t) ->
+  ('a, 'ctx) parameter
+
+(** Build an argument parser by composing two other parsers. The
+    resulting parser will try the first parser and if it fails will
+    try the second. The auto-complete contents of the two will be
+    concatenated. *)
+val compose_parameters : ('a, 'ctx) parameter -> ('a, 'ctx) parameter -> ('a, 'ctx) parameter
+
+(** Map a pure function over the result of a parameter parser. *)
+val map_parameter : f:('a -> 'b) -> ('a, 'ctx) parameter -> ('b, 'ctx) parameter
+
+(** {2 Flags and Options } *)
+
+(** The type for optional arguments (and switches).
+
+    Extends a parser with a parameter name and a placeholder to
+    display in help screens.
+
+    Also adds a documentation for the switch, that must be of the form
+    ["lowercase short description\nOptional longer description."]. *)
+type ('a, 'ctx) arg
+
+val constant: 'a -> ('a, 'ctx) arg
+
+(** [arg ~doc ~long ?short converter] creates an argument to a command.
+    The [~long] argument is the long format, without the double dashes.
+    The [?short] argument is the optional one letter shortcut.
+    If the argument is not provided, [None] is returned. *)
+val arg :
+  doc:string ->
+  ?short:char ->
+  long:string ->
+  placeholder:string ->
+  ('a, 'ctx) parameter ->
+  ('a option, 'ctx) arg
+
+(** Create an argument that will contain the [~default] value if it is not provided. *)
+val default_arg :
+  doc:string ->
+  ?short:char ->
+  long:string ->
+  placeholder:string ->
+  default:string ->
+  ('a, 'ctx) parameter ->
+  ('a, 'ctx) arg
+
+(** Create a boolean switch.
+    The value will be set to [true] if the switch is provided and [false] if it is not. *)
+val switch :
+  doc:string ->
+  ?short:char ->
+  long:string ->
+  unit ->
+  (bool, 'ctx) arg
+
+(** {2 Groups of Optional Arguments} *)
+
+(** Defines a group of options, either the global options or the
+    command options. *)
+
+(** The type of a series of labeled arguments to a command *)
+type ('a, 'ctx) options
+
+(** Include no optional parameters *)
+val no_options : (unit, 'ctx) options
+
+(** Include 1 optional parameter *)
+val args1 :
+  ('a, 'ctx) arg ->
+  ('a, 'ctx) options
+
+(** Include 2 optional parameters *)
+val args2 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('a * 'b, 'ctx) options
+
+(** Include 3 optional parameters *)
+val args3 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('a * 'b * 'c, 'ctx) options
+
+(** Include 4 optional parameters *)
+val args4 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('a * 'b * 'c * 'd, 'ctx) options
+
+(** Include 5 optional parameters *)
+val args5 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e, 'ctx) options
+
+(** Include 6 optional parameters *)
+val args6 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg ->
+  ('f, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f, 'ctx) options
+
+(** Include 7 optional parameters *)
+val args7 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g, 'ctx) options
+
+(** Include 8 optional parameters *)
+val args8 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h, 'ctx) options
+
+(** Include 9 optional parameters *)
+val args9 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i, 'ctx) options
+
+(** Include 10 optional parameters *)
+val args10 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j, 'ctx) options
+
+(** Include 11 optional parameters *)
+val args11 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k, 'ctx) options
+
+(** Include 12 optional parameters *)
+val args12 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg -> ('l, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l, 'ctx) options
+
+(** Include 13 optional parameters *)
+val args13 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg -> ('l, 'ctx) arg -> ('m, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm, 'ctx) options
+
+(** Include 14 optional parameters *)
+val args14 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg -> ('l, 'ctx) arg ->
+  ('m, 'ctx) arg -> ('n, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n, 'ctx) options
+
+(** Include 15 optional parameters *)
+val args15 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg -> ('l, 'ctx) arg ->
+  ('m, 'ctx) arg -> ('n, 'ctx) arg -> ('o, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n * 'o, 'ctx) options
+
+(** Include 16 optional parameters *)
+val args16 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg -> ('k, 'ctx) arg -> ('l, 'ctx) arg ->
+  ('m, 'ctx) arg -> ('n, 'ctx) arg -> ('o, 'ctx) arg -> ('p, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n * 'o * 'p, 'ctx) options
+
+(** {2 Parameter based command lines} *)
+
+(** Type of parameters for a command *)
+type ('a, 'ctx) params
+
+(** A piece of data inside a command line *)
+val param:
+  name: string ->
+  desc: string ->
+  ('a, 'ctx) parameter ->
+  ('b, 'ctx) params ->
+  ('a -> 'b, 'ctx) params
+
+(** A word in a command line.
+    Should be descriptive. *)
+val prefix:
+  string ->
+  ('a, 'ctx) params ->
+  ('a, 'ctx) params
+
+(** Multiple words given in sequence for a command line *)
+val prefixes:
+  string list ->
+  ('a, 'ctx) params ->
+  ('a, 'ctx) params
+
+(** A fixed series of words that trigger a command. *)
+val fixed:
+  string list ->
+  ('ctx -> unit tzresult Lwt.t, 'ctx) params
+
+(** End the description of the command line *)
+val stop:
+  ('ctx -> unit tzresult Lwt.t, 'ctx) params
+
+(** Take a sequence of parameters instead of only a single one.
+    Must be the last thing in the command line. *)
+val seq_of_param:
+  (('ctx -> unit tzresult Lwt.t, 'ctx) params ->
+   ('a -> 'ctx -> unit tzresult Lwt.t, 'ctx) params) ->
+  ('a list -> 'ctx -> unit tzresult Lwt.t, 'ctx) params
+
+(** Parameter that expects a string *)
+val string:
+  name: string ->
+  desc: string ->
+  ('a, 'ctx) params ->
+  (string -> 'a, 'ctx) params
+
+(** {2 Commands }  *)
+
+(** Command, including a parameter specification, optional arguments, and handlers  *)
+type 'ctx command
+
+(** Type of a group of commands.
+    Groups have their documentation printed together
+    and should include a descriptive title. *)
+type group =
+  { name : string ;
+    title : string }
+
+(** A complete command, with documentation, a specification of its
+    options, parameters, and handler function. *)
+val command:
+  ?group: group ->
+  desc: string ->
+  ('b, 'ctx) options ->
+  ('a, 'ctx) params ->
+  ('b -> 'a) ->
+  'ctx command
+
+(** Combinator to use a command in an adaptated context. *)
+val map_command: ('a -> 'b) -> 'b command -> 'a command
+
+(** {2 Output formatting} *)
+
+(** Used to restore the formatter state after [setup_formatter]. *)
+type formatter_state
+
+(** Supported output formats.
+    Currently: black and white, colors using ANSI escapes, and HTML.*)
+type format = Plain | Ansi | Html
+
+(** Verbosity level, from terse to verbose. *)
+type verbosity = Terse | Short | Details | Full
+
+(** Updates the formatter's functions to interprete some semantic tags
+    used in manual production. Returns the previous state of the
+    formatter to restore it afterwards if needed.
+
+    Toplevel structure tags:
+
+      * [<document>]: a toplevel group
+      * [<title>]: a section title (just below a [<document])
+      * [<list>]: a list section (just below a [<document])
+
+    Structure tags used internally for generating the manual:
+
+    * [<command>]: wraps the full documentation bloc for a command
+    * [<commandline>]: wraps the command line in a [<command>]
+    * [<commanddoc>]: wraps everything but the command line in a [<command>]
+
+    Cosmetic tags for hilighting text:
+
+    * [<opt>]: optional arguments * [<arg>]: positional arguments
+    * [<kwd>]: positional keywords * [<hilight>]: search results
+
+    Verbosity levels, in order, and how they are used in the manual:
+
+    * [<terse>]: titles, commands lines
+    * [<short>]: lists of arguments
+    * [<details>]: single line descriptions
+    * [<full>]: with long descriptions
+
+    Wrapping a piece of text with a debug level means that the
+    contents are only printed if the verbosity is equal to or
+    above that level. Use prefix [=] for an exact match, or [-]
+    for the inverse interpretation. *)
+val setup_formatter :
+  Format.formatter ->
+  format ->
+  verbosity ->
+  formatter_state
+
+(** Restore the formatter state after [setup_formatter]. *)
+val restore_formatter : Format.formatter -> formatter_state -> unit
+
+(** {2 Parsing and error reporting} *)
+
+(** Help error (not really an error), thrown by {!dispatch} and {!parse_initial_options}. *)
+type error += Help : _ command option -> error
+
+(** Find and call the applicable command on the series of arguments.
+    @raises [Failure] if the command list would be ambiguous. *)
+val dispatch: 'ctx command list -> 'ctx -> string list -> unit tzresult Lwt.t
+
+(** Parse the global options, and return their value, with the rest of
+    the command to be parsed. *)
+val parse_global_options : ('a, 'ctx) options -> 'ctx -> string list -> ('a * string list) tzresult Lwt.t
+
+(** Pretty printfs the error messages to the given formatter.
+    [executable_name] and [global_options] are for help screens.
+    [default] is used to print non-cli errors. *)
+val pp_cli_errors :
+  Format.formatter ->
+  executable_name: string ->
+  global_options: (_, _) options ->
+  default: (Format.formatter -> error -> unit) ->
+  error list ->
+  unit
+
+(** Acts as {!dispatch}, but stops if the given command up to
+    [prev_arg] is a valid prefix command, returning the list of valid
+    next words, filtered with [cur_arg]. *)
+val autocompletion :
+  script:string -> cur_arg:string -> prev_arg:string -> args:string list ->
+  global_options:('a, 'ctx) options -> 'ctx command list -> 'ctx ->
+  string list Error_monad.tzresult Lwt.t
+
+(** Displays a help page for the given commands. *)
+val usage :
+  Format.formatter ->
+  executable_name:string ->
+  global_options:(_, _) options ->
+  _ command list ->
+  unit
+
+(** {2 Manual} *)
+
+(** Add manual commands to a list of commands.
+    For this to work, the command list must be complete.
+    Commands added later will not appear in the manual. *)
+val add_manual :
+  executable_name: string ->
+  global_options: ('a, 'ctx) options ->
+  format ->
+  Format.formatter ->
+  'ctx command list ->
+  'ctx command list
diff --git a/vendors/tezos-modded/src/lib_clic/dune b/vendors/tezos-modded/src/lib_clic/dune
new file mode 100644
index 000000000..b574473f9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_clic/dune
@@ -0,0 +1,14 @@
+(library
+ (name tezos_clic)
+ (public_name tezos-clic)
+ (flags (:standard -w -30
+                   -safe-string
+                   -open Tezos_stdlib
+                   -open Tezos_error_monad))
+ (libraries tezos-stdlib
+            tezos-error-monad))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_clic/tezos-clic.opam b/vendors/tezos-modded/src/lib_clic/tezos-clic.opam
new file mode 100644
index 000000000..7e3f1bbaf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_clic/tezos-clic.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib"
+  "tezos-error-monad"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_client_base/client_aliases.ml b/vendors/tezos-modded/src/lib_client_base/client_aliases.ml
new file mode 100644
index 000000000..cce4abfa9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_aliases.ml
@@ -0,0 +1,322 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Command line interface - Local Storage for Configuration *)
+
+open Lwt.Infix
+open Clic
+
+module type Entity = sig
+  type t
+  val encoding : t Data_encoding.t
+  val of_source : string -> t tzresult Lwt.t
+  val to_source : t -> string tzresult Lwt.t
+  val name : string
+end
+
+module type Alias = sig
+  type t
+  type fresh_param
+  val load :
+    #Client_context.wallet ->
+    (string * t) list tzresult Lwt.t
+  val set :
+    #Client_context.wallet ->
+    (string * t) list ->
+    unit tzresult Lwt.t
+  val find :
+    #Client_context.wallet ->
+    string -> t tzresult Lwt.t
+  val find_opt :
+    #Client_context.wallet ->
+    string -> t option tzresult Lwt.t
+  val rev_find :
+    #Client_context.wallet ->
+    t -> string option tzresult Lwt.t
+  val name :
+    #Client_context.wallet ->
+    t -> string tzresult Lwt.t
+  val mem :
+    #Client_context.wallet ->
+    string -> bool tzresult Lwt.t
+  val add :
+    force:bool ->
+    #Client_context.wallet ->
+    string -> t -> unit tzresult Lwt.t
+  val del :
+    #Client_context.wallet ->
+    string -> unit tzresult Lwt.t
+  val update :
+    #Client_context.wallet ->
+    string -> t -> unit tzresult Lwt.t
+  val of_source : string -> t tzresult Lwt.t
+  val to_source : t -> string tzresult Lwt.t
+  val alias_parameter : unit -> (string * t, #Client_context.wallet) Clic.parameter
+  val alias_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'b)) Clic.params ->
+    (string * t -> 'a, 'b) Clic.params
+  val fresh_alias_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (< .. > as 'obj)) Clic.params ->
+    (fresh_param -> 'a, 'obj) Clic.params
+  val force_switch :
+    unit -> (bool, _) arg
+  val of_fresh :
+    #Client_context.wallet ->
+    bool ->
+    fresh_param ->
+    string tzresult Lwt.t
+  val source_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'obj)) Clic.params ->
+    (t -> 'a, 'obj) Clic.params
+  val source_arg :
+    ?long:string ->
+    ?placeholder:string ->
+    ?doc:string ->
+    unit -> (t option, (#Client_context.wallet as 'obj)) Clic.arg
+  val autocomplete:
+    #Client_context.wallet -> string list tzresult Lwt.t
+end
+
+module Alias = functor (Entity : Entity) -> struct
+
+  open Client_context
+
+  let wallet_encoding : (string * Entity.t) list Data_encoding.encoding =
+    let open Data_encoding in
+    list (obj2
+            (req "name" string)
+            (req "value" Entity.encoding))
+
+  let load (wallet : #wallet) =
+    wallet#load Entity.name ~default:[] wallet_encoding
+
+  let set (wallet : #wallet) entries =
+    wallet#write Entity.name entries wallet_encoding
+
+  let autocomplete wallet =
+    load wallet >>= function
+    | Error _ -> return_nil
+    | Ok list -> return (List.map fst list)
+
+  let find_opt (wallet : #wallet) name =
+    load wallet >>=? fun list ->
+    try return_some (List.assoc name list)
+    with Not_found -> return_none
+
+  let find (wallet : #wallet) name =
+    load wallet >>=? fun list ->
+    try return (List.assoc name list)
+    with Not_found ->
+      failwith "no %s alias named %s" Entity.name name
+
+  let rev_find (wallet : #wallet) v =
+    load wallet >>=? fun list ->
+    try return_some (List.find (fun (_, v') -> v = v') list |> fst)
+    with Not_found -> return_none
+
+  let mem (wallet : #wallet) name =
+    load wallet >>=? fun list ->
+    try
+      ignore (List.assoc name list) ;
+      return_true
+    with
+    | Not_found -> return_false
+
+  let add ~force (wallet : #wallet) name value =
+    let keep = ref false in
+    load wallet >>=? fun list ->
+    begin
+      if force then
+        return_unit
+      else
+        iter_s (fun (n, v) ->
+            if n = name && v = value then begin
+              keep := true ;
+              return_unit
+            end else if n = name && v <> value then begin
+              failwith
+                "another %s is already aliased as %s, \
+                 use --force to update"
+                Entity.name n
+            end else if n <> name && v = value then begin
+              failwith
+                "this %s is already aliased as %s, \
+                 use --force to insert duplicate"
+                Entity.name n
+            end else begin
+              return_unit
+            end)
+          list
+    end >>=? fun () ->
+    let list = List.filter (fun (n, _) -> n <> name) list in
+    let list = (name, value) :: list in
+    if !keep then
+      return_unit
+    else
+      wallet#write Entity.name list wallet_encoding
+
+  let del (wallet : #wallet) name =
+    load wallet >>=? fun list ->
+    let list = List.filter (fun (n, _) -> n <> name) list in
+    wallet#write Entity.name list wallet_encoding
+
+  let update (wallet : #wallet) name value =
+    load wallet >>=? fun list ->
+    let list =
+      List.map
+        (fun (n, v) -> (n, if n = name then value else v))
+        list in
+    wallet#write Entity.name list wallet_encoding
+
+  let save wallet list =
+    wallet#write Entity.name wallet_encoding list
+
+  include Entity
+
+  let alias_parameter () = parameter
+      ~autocomplete
+      (fun cctxt s ->
+         find cctxt s >>=? fun v ->
+         return (s, v))
+
+  let alias_param
+      ?(name = "name") ?(desc = "existing " ^ Entity.name ^ " alias") next =
+    param ~name ~desc (alias_parameter ()) next
+
+  type fresh_param = Fresh of string
+
+  let of_fresh (wallet : #wallet) force (Fresh s) =
+    load wallet >>=? fun list ->
+    begin if force then
+        return_unit
+      else
+        iter_s
+          (fun (n, v) ->
+             if n = s then
+               Entity.to_source v >>=? fun value ->
+               failwith
+                 "@[<v 2>The %s alias %s already exists.@,\
+                  The current value is %s.@,\
+                  Use --force to update@]"
+                 Entity.name n
+                 value
+             else
+               return_unit)
+          list
+    end >>=? fun () ->
+    return s
+
+  let fresh_alias_param
+      ?(name = "new") ?(desc = "new " ^ Entity.name ^ " alias") next =
+    param ~name ~desc
+      (parameter (fun (_ : < .. >) s -> return @@ Fresh s))
+      next
+
+  let parse_source_string cctxt s =
+    let read path =
+      Lwt.catch
+        (fun () ->
+           Lwt_io.(with_file ~mode:Input path read) >>= fun content ->
+           return content)
+        (fun exn ->
+           failwith
+             "cannot read file (%s)" (Printexc.to_string exn))
+      >>=? fun content ->
+      of_source content in
+    begin
+      match String.split ~limit:1 ':' s with
+      | [ "alias" ; alias ]->
+          find cctxt alias
+      | [ "text" ; text ] ->
+          of_source text
+      | [ "file" ; path ] ->
+          read path
+      | _ ->
+          find cctxt s >>= function
+          | Ok v -> return v
+          | Error a_errs ->
+              read s >>= function
+              | Ok v -> return v
+              | Error r_errs ->
+                  of_source s >>= function
+                  | Ok v -> return v
+                  | Error s_errs ->
+                      let all_errs =
+                        List.flatten [ a_errs ; r_errs ; s_errs ] in
+                      Lwt.return (Error all_errs)
+    end
+
+  let source_param ?(name = "src") ?(desc = "source " ^ Entity.name) next =
+    let desc =
+      Format.asprintf
+        "%s\n\
+         Can be a %s name, a file or a raw %s literal. If the \
+         parameter is not the name of an existing %s, the client will \
+         look for a file containing a %s, and if it does not exist, \
+         the argument will be read as a raw %s.\n\
+         Use 'alias:name', 'file:path' or 'text:literal' to disable \
+         autodetect."
+        desc Entity.name Entity.name Entity.name Entity.name Entity.name in
+    param ~name ~desc
+      (parameter parse_source_string)
+      next
+
+  let source_arg
+      ?(long = "source " ^ Entity.name)
+      ?(placeholder = "src")
+      ?(doc = "") () =
+    let doc =
+      Format.asprintf
+        "%s\n\
+         Can be a %s name, a file or a raw %s literal. If the \
+         parameter is not the name of an existing %s, the client will \
+         look for a file containing a %s, and if it does not exist, \
+         the argument will be read as a raw %s.\n\
+         Use 'alias:name', 'file:path' or 'text:literal' to disable \
+         autodetect."
+        doc Entity.name Entity.name Entity.name Entity.name Entity.name in
+    arg
+      ~long
+      ~placeholder
+      ~doc
+      (parameter parse_source_string)
+
+  let force_switch () =
+    Clic.switch
+      ~long:"force" ~short:'f'
+      ~doc:("overwrite existing " ^ Entity.name) ()
+
+  let name (wallet : #wallet) d =
+    rev_find wallet d >>=? function
+    | None -> Entity.to_source d
+    | Some name -> return name
+
+end
diff --git a/vendors/tezos-modded/src/lib_client_base/client_aliases.mli b/vendors/tezos-modded/src/lib_client_base/client_aliases.mli
new file mode 100644
index 000000000..dee6d3771
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_aliases.mli
@@ -0,0 +1,103 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+module type Entity = sig
+  type t
+  val encoding : t Data_encoding.t
+  val of_source : string -> t tzresult Lwt.t
+  val to_source : t -> string tzresult Lwt.t
+  val name : string
+end
+
+module type Alias = sig
+  type t
+  type fresh_param
+  val load :
+    #Client_context.wallet ->
+    (string * t) list tzresult Lwt.t
+  val set :
+    #Client_context.wallet ->
+    (string * t) list ->
+    unit tzresult Lwt.t
+  val find :
+    #Client_context.wallet ->
+    string -> t tzresult Lwt.t
+  val find_opt :
+    #Client_context.wallet ->
+    string -> t option tzresult Lwt.t
+  val rev_find :
+    #Client_context.wallet ->
+    t -> string option tzresult Lwt.t
+  val name :
+    #Client_context.wallet ->
+    t -> string tzresult Lwt.t
+  val mem :
+    #Client_context.wallet ->
+    string -> bool tzresult Lwt.t
+  val add :
+    force:bool ->
+    #Client_context.wallet ->
+    string -> t -> unit tzresult Lwt.t
+  val del :
+    #Client_context.wallet ->
+    string -> unit tzresult Lwt.t
+  val update :
+    #Client_context.wallet ->
+    string -> t -> unit tzresult Lwt.t
+  val of_source : string -> t tzresult Lwt.t
+  val to_source : t -> string tzresult Lwt.t
+  val alias_parameter : unit -> (string * t, #Client_context.wallet) Clic.parameter
+  val alias_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'b)) Clic.params ->
+    (string * t -> 'a, 'b) Clic.params
+  val fresh_alias_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (< .. > as 'obj)) Clic.params ->
+    (fresh_param -> 'a, 'obj) Clic.params
+  val force_switch :
+    unit -> (bool, _) Clic.arg
+  val of_fresh :
+    #Client_context.wallet ->
+    bool ->
+    fresh_param ->
+    string tzresult Lwt.t
+  val source_param :
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'obj)) Clic.params ->
+    (t -> 'a, 'obj) Clic.params
+  val source_arg :
+    ?long:string ->
+    ?placeholder:string ->
+    ?doc:string ->
+    unit -> (t option, (#Client_context.wallet as 'obj)) Clic.arg
+  val autocomplete:
+    #Client_context.wallet -> string list tzresult Lwt.t
+end
+module Alias (Entity : Entity) : Alias with type t = Entity.t
diff --git a/vendors/tezos-modded/src/lib_client_base/client_confirmations.ml b/vendors/tezos-modded/src/lib_client_base/client_confirmations.ml
new file mode 100644
index 000000000..fe2a3d2a1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_confirmations.ml
@@ -0,0 +1,253 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 in_block operation_hash operations =
+  let exception Found of int * int in
+  try
+    List.iteri
+      (fun i ops ->
+         List.iteri (fun j op ->
+             if Operation_hash.equal operation_hash op then
+               raise (Found (i,j))) ops)
+      operations ;
+    None
+  with Found (i,j) -> Some (i, j)
+
+let wait_for_bootstrapped (ctxt : #Client_context.full) =
+  let display = ref false in
+  Lwt.async begin fun () ->
+    Lwt_unix.sleep 0.3 >>= fun () ->
+    if not !display then
+      ctxt#answer "Waiting for the node to be bootstrapped before injection..." >>= fun () ->
+      display := true ;
+      Lwt.return_unit
+    else
+      Lwt.return_unit
+  end ;
+  Monitor_services.bootstrapped ctxt >>=? fun (stream, _stop) ->
+  Lwt_stream.iter_s
+    (fun (hash, time) ->
+       if !display then
+         ctxt#message "Current head: %a (timestamp: %a, validation: %a)"
+           Block_hash.pp_short hash
+           Time.pp_hum time
+           Time.pp_hum (Time.now ())
+       else Lwt.return_unit) stream >>= fun () ->
+  display := true ;
+  ctxt#answer "Node is bootstrapped, ready for injecting operations." >>= fun () ->
+  return_unit
+
+type operation_status =
+  | Confirmed of (Block_hash.t * int * int)
+  | Pending
+  | Still_not_found
+
+let wait_for_operation_inclusion
+    (ctxt : #Client_context.full)
+    ~chain
+    ?(predecessors = 10)
+    ?(confirmations = 1)
+    ?branch
+    operation_hash =
+
+  let exception WrapError of error list in
+  let exception Outdated of Operation_hash.t in
+
+  (* Table of known blocks:
+     - None: if neither the block or its predecessors contains the operation
+     - (Some ((hash, i, j), n)):
+          if the `hash` contains the operation in list `i` at position `j`
+          and if `hash` denotes the `n-th` predecessors of the block. *)
+
+  let blocks : ((Block_hash.t * int * int) * int) option Block_hash.Table.t =
+    Block_hash.Table.create confirmations in
+
+  (* Fetch _all_ the 'unknown' predecessors af a block. *)
+
+  let fetch_predecessors (hash, header) =
+    let rec loop acc (_hash, header) =
+      let predecessor = header.Block_header.predecessor in
+      if Block_hash.Table.mem blocks predecessor then
+        return acc
+      else
+        Chain_services.Blocks.Header.shell_header
+          ctxt ~chain ~block:(`Hash (predecessor, 0)) () >>=? fun shell ->
+        let block = (predecessor, shell) in
+        loop (block :: acc) block in
+    loop [hash, header.Block_header.shell] (hash, header.shell) >>= function
+    | Ok blocks -> Lwt.return blocks
+    | Error err ->
+        ctxt#warning
+          "Error while fetching block (ignored): %a"
+          pp_print_error err >>= fun () ->
+        (* Will be retried when a new head arrives *)
+        Lwt.return_nil in
+
+  (* Check whether a block as enough confirmations. This function
+     assumes that the block predecessor has been processed already. *)
+
+  let process hash header =
+    let block = `Hash (hash, 0) in
+    let predecessor = header.Tezos_base.Block_header.predecessor in
+    match Block_hash.Table.find blocks predecessor with
+    | Some (block_with_op, n) ->
+        ctxt#answer
+          "Operation received %d confirmations as of block: %a"
+          (n+1) Block_hash.pp hash >>= fun () ->
+        Block_hash.Table.add blocks hash (Some (block_with_op, n+1)) ;
+        if n+1 < confirmations then begin
+          return Pending
+        end else
+          return (Confirmed block_with_op)
+    | None ->
+        Shell_services.Blocks.Operation_hashes.operation_hashes
+          ctxt ~chain ~block () >>=? fun operations ->
+        match in_block operation_hash operations with
+        | None ->
+            Block_hash.Table.add blocks hash None ;
+            return Still_not_found
+        | Some (i, j) -> begin
+            ctxt#answer
+              "Operation found in block: %a (pass: %d, offset: %d)"
+              Block_hash.pp hash i j >>= fun () ->
+            Block_hash.Table.add blocks hash (Some ((hash, i, j), 0)) ;
+            if confirmations <= 0 then
+              return (Confirmed (hash, i, j))
+            else
+              return Pending
+          end in
+
+  (* Checks if the given branch is considered alive.*)
+
+  let check_branch_alive () =
+    match branch with
+    | Some branch_hash ->
+        Shell_services.Blocks.live_blocks
+          ctxt ~chain ~block:(`Head 0) () >>= begin function
+          | Ok live_blocks ->
+              if Block_hash.Set.mem branch_hash live_blocks then
+                Lwt.return_unit
+              else
+                ctxt#error
+                  "The operation %a is outdated and may \
+                   never be included in the chain.@,\
+                   We recommand to use an external block explorer."
+                  Operation_hash.pp operation_hash >>= fun () ->
+                Lwt.fail (Outdated operation_hash)
+          | Error err -> Lwt.fail (WrapError err)
+        end
+    | None -> Lwt.return_unit
+  in
+
+  Shell_services.Monitor.heads ctxt chain >>=? fun (stream, stop) ->
+  Lwt_stream.get stream >>= function
+  | None -> assert false
+  | Some (head, _) ->
+      let rec loop n =
+        if n >= 0 then
+          (*Search for the operation in the n head predecessors*)
+          let block = `Hash (head, n) in
+          Shell_services.Blocks.hash ctxt ~chain ~block () >>=? fun hash ->
+          Shell_services.Blocks.Header.shell_header ctxt
+            ~chain ~block () >>=? fun shell ->
+          process hash shell >>=? function
+          | Confirmed block ->
+              stop () ;
+              return block
+          | Pending | Still_not_found ->
+              loop (n-1)
+        else
+          (*Search for the operation in new heads*)
+          Lwt.catch
+            (fun () ->
+               (*Fetching potential unknown blocks from potential new heads*)
+               let stream = Lwt_stream.map_list_s fetch_predecessors stream in
+               Lwt_stream.find_s
+                 (fun (hash, header) ->
+                    process hash header >>= function
+                    | Ok Pending ->
+                        Lwt.return_false
+                    | Ok Still_not_found ->
+                        check_branch_alive () >>= fun () ->
+                        Lwt.return_false
+                    | Ok (Confirmed _) ->
+                        Lwt.return_true
+                    | Error err ->
+                        Lwt.fail (WrapError err)) stream >>= return)
+            (function
+              | WrapError e -> Lwt.return (Error e)
+              | exn -> Lwt.fail exn) >>=? function
+          | None ->
+              failwith "..."
+          | Some (hash, _) ->
+              stop () ;
+              match Block_hash.Table.find_opt blocks hash with
+              | None | Some None -> assert false
+              | Some (Some (hash, _)) ->
+                  return hash in
+      begin
+        match branch with
+        | Some branch_hash ->
+            Shell_services.Blocks.Header.shell_header
+              ctxt ~chain ~block:(`Hash(branch_hash,0)) () >>=? fun branch_header ->
+            let branch_level = branch_header.Block_header.level in
+            Shell_services.Blocks.Header.shell_header
+              ctxt ~chain ~block:(`Hash (head,0)) () >>=? fun head_shell ->
+            let head_level = head_shell.Block_header.level in
+            return (Int32.(to_int (sub head_level branch_level)))
+        | None -> return predecessors
+      end
+      >>=? fun block_hook ->
+      Block_services.Empty.hash
+        ctxt ~block:(`Hash (head, block_hook+1)) () >>=? fun oldest ->
+      Block_hash.Table.add blocks oldest None ;
+      loop block_hook
+
+let lookup_operation_in_previous_block ctxt chain operation_hash i =
+  Block_services.Empty.hash ctxt ~block:(`Head i) ()
+  >>=? fun block ->
+  Shell_services.Blocks.Operation_hashes.operation_hashes ctxt ~chain
+    ~block:(`Hash (block, 0)) ()
+  >>=? fun operations ->
+  match in_block operation_hash operations with
+  | None -> return_none
+  | Some (a, b) -> return_some (block, a, b)
+
+let lookup_operation_in_previous_blocks
+    (ctxt : #Client_context.full)
+    ~chain
+    ~predecessors
+    operation_hash =
+  let rec loop i =
+    if i = predecessors + 1 then
+      return_none
+    else begin
+      lookup_operation_in_previous_block ctxt chain operation_hash i >>=?
+      function
+      | None -> loop (i + 1)
+      | Some (block, a, b) -> return_some (block, a, b)
+    end
+  in
+  loop 0
diff --git a/vendors/tezos-modded/src/lib_client_base/client_confirmations.mli b/vendors/tezos-modded/src/lib_client_base/client_confirmations.mli
new file mode 100644
index 000000000..21332860f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_confirmations.mli
@@ -0,0 +1,52 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** [wait_for_operation_inclusion chain ~predecessors ~confirmations
+    oph] waits for `oph` to appears in the main chain with at least
+    `confirmations`. It returns the hash of the block that contains
+    the operation and the operation position in the block.
+
+    This functions also looks for the operations in the `predecessors`
+    of the intial chain head. *)
+val wait_for_operation_inclusion:
+  #Client_context.full ->
+  chain:Chain_services.chain ->
+  ?predecessors:int ->
+  ?confirmations:int ->
+  ?branch:Block_hash.t ->
+  Operation_hash.t ->
+  (Block_hash.t * int * int) tzresult Lwt.t
+
+val wait_for_bootstrapped:
+  #Client_context.full -> unit tzresult Lwt.t
+
+(** lookup an operation in [predecessors] previous blocks, starting 
+    from head *)
+val lookup_operation_in_previous_blocks:
+  #Client_context.full ->
+  chain:Block_services.chain ->
+  predecessors:int ->
+  Operation_list_hash.elt ->
+  (Block_hash.t * int * int) option tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_client_base/client_context.ml b/vendors/tezos-modded/src/lib_client_base/client_context.ml
new file mode 100644
index 000000000..173fcfa89
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_context.ml
@@ -0,0 +1,126 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('a, 'b) lwt_format =
+  ('a, Format.formatter, unit, 'b Lwt.t) format4
+
+class type printer = object
+  method error : ('a, 'b) lwt_format -> 'a
+  method warning : ('a, unit) lwt_format -> 'a
+  method message : ('a, unit) lwt_format -> 'a
+  method answer :  ('a, unit) lwt_format -> 'a
+  method log : string -> ('a, unit) lwt_format -> 'a
+end
+
+class type prompter = object
+  method prompt : ('a, string tzresult) lwt_format -> 'a
+  method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a
+end
+
+class type io = object
+  inherit printer
+  inherit prompter
+end
+
+class simple_printer log =
+  let message =
+    (fun x ->
+       Format.kasprintf (fun msg -> log "stdout" msg) x) in
+  object
+    method error : type a b. (a, b) lwt_format -> a =
+      Format.kasprintf
+        (fun msg ->
+           Lwt.fail (Failure msg))
+    method warning : type a. (a, unit) lwt_format -> a =
+      Format.kasprintf
+        (fun msg -> log "stderr" msg)
+    method message : type a. (a, unit) lwt_format -> a = message
+    method answer : type a. (a, unit) lwt_format -> a = message
+    method log : type a. string -> (a, unit) lwt_format -> a =
+      fun name ->
+        Format.kasprintf
+          (fun msg -> log name msg)
+  end
+
+class type wallet = object
+  method password_filename : string option
+  method with_lock : (unit -> 'a Lwt.t) -> 'a Lwt.t
+  method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
+  method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
+end
+
+class type block = object
+  method block : Shell_services.block
+  method confirmations : int option
+end
+
+class type io_wallet = object
+  inherit printer
+  inherit prompter
+  inherit wallet
+end
+
+class type io_rpcs = object
+  inherit printer
+  inherit prompter
+  inherit RPC_context.json
+end
+
+class type full = object
+  inherit printer
+  inherit prompter
+  inherit wallet
+  inherit RPC_context.json
+  inherit block
+end
+
+class proxy_context (obj : full) = object
+  method password_filename = obj#password_filename
+  method base = obj#base
+  method block = obj#block
+  method confirmations = obj#confirmations
+  method answer : type a. (a, unit) lwt_format -> a = obj#answer
+  method call_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t = obj#call_service
+  method call_streamed_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = obj#call_streamed_service
+  method error : type a b. (a, b) lwt_format -> a = obj#error
+  method generic_json_call = obj#generic_json_call
+  method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t = obj#with_lock
+  method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t = obj#load
+  method log : type a. string -> (a, unit) lwt_format -> a = obj#log
+  method message : type a. (a, unit) lwt_format -> a = obj#message
+  method warning : type a. (a, unit) lwt_format -> a  = obj#warning
+  method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write
+  method prompt : type a. (a, string tzresult) lwt_format -> a = obj#prompt
+  method prompt_password : type a. (a, MBytes.t tzresult) lwt_format -> a = obj#prompt_password
+end
diff --git a/vendors/tezos-modded/src/lib_client_base/client_context.mli b/vendors/tezos-modded/src/lib_client_base/client_context.mli
new file mode 100644
index 000000000..56b6078c4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_context.mli
@@ -0,0 +1,81 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('a, 'b) lwt_format =
+  ('a, Format.formatter, unit, 'b Lwt.t) format4
+
+class type printer = object
+  method error : ('a, 'b) lwt_format -> 'a
+  method warning : ('a, unit) lwt_format -> 'a
+  method message : ('a, unit) lwt_format -> 'a
+  method answer :  ('a, unit) lwt_format -> 'a
+  method log : string -> ('a, unit) lwt_format -> 'a
+end
+
+class type prompter = object
+  method prompt : ('a, string tzresult) lwt_format -> 'a
+  method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a
+end
+
+class type io = object
+  inherit printer
+  inherit prompter
+end
+
+class type wallet = object
+  method password_filename : string option
+  method with_lock : (unit -> 'a Lwt.t) -> 'a  Lwt.t
+  method load : string -> default:'a -> 'a Data_encoding.encoding -> 'a tzresult Lwt.t
+  method write : string -> 'a -> 'a Data_encoding.encoding -> unit tzresult Lwt.t
+end
+
+class type block = object
+  method block : Shell_services.block
+  method confirmations : int option
+end
+
+class type io_wallet = object
+  inherit printer
+  inherit prompter
+  inherit wallet
+end
+
+class type io_rpcs = object
+  inherit printer
+  inherit prompter
+  inherit RPC_context.json
+end
+
+class type full = object
+  inherit printer
+  inherit prompter
+  inherit wallet
+  inherit RPC_context.json
+  inherit block
+end
+
+class simple_printer : (string -> string -> unit Lwt.t) -> printer
+class proxy_context : full -> full
diff --git a/vendors/tezos-modded/src/lib_client_base/client_keys.ml b/vendors/tezos-modded/src/lib_client_base/client_keys.ml
new file mode 100644
index 000000000..136157df4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_keys.ml
@@ -0,0 +1,342 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Unregistered_key_scheme of string
+type error += Invalid_uri of Uri.t
+
+let () =
+  register_error_kind `Permanent
+    ~id: "cli.unregistered_key_scheme"
+    ~title: "Unregistered key scheme"
+    ~description: "A key has been provided with an \
+                   unregistered scheme (no corresponding plugin)"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "No matching plugin for key scheme %s" s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Unregistered_key_scheme s -> Some s | _ -> None)
+    (fun s -> Unregistered_key_scheme s) ;
+  register_error_kind `Permanent
+    ~id: "cli.key.invalid_uri"
+    ~title: "Invalid key uri"
+    ~description: "A key has been provided with an invalid uri."
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Cannot parse the key uri: %s" s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_uri s -> Some (Uri.to_string s) | _ -> None)
+    (fun s -> Invalid_uri (Uri.of_string s))
+
+module Public_key_hash = struct
+  include Client_aliases.Alias (struct
+      type t =  Signature.Public_key_hash.t
+      let encoding = Signature.Public_key_hash.encoding
+      let of_source s = Lwt.return (Signature.Public_key_hash.of_b58check s)
+      let to_source p = return (Signature.Public_key_hash.to_b58check p)
+      let name = "public key hash"
+    end)
+end
+
+module Logging = struct
+  let tag = Tag.def ~doc:"Identity" "pk_alias" Format.pp_print_text
+end
+
+module type KEY = sig
+  type t
+  val to_b58check : t -> string
+  val of_b58check_exn : string -> t
+end
+
+let uri_encoding =
+  Data_encoding.(conv Uri.to_string Uri.of_string string)
+
+type pk_uri = Uri.t
+let make_pk_uri x = x
+
+type sk_uri = Uri.t
+let make_sk_uri x = x
+
+let pk_uri_parameter () = Clic.parameter (fun _ s ->
+    try return (make_pk_uri @@ Uri.of_string s)
+    with Failure s -> failwith "Error while parsing URI: %s" s)
+
+let pk_uri_param ?name ?desc params =
+  let name = Option.unopt ~default:"uri" name in
+  let desc = Option.unopt
+      ~default:"public key\n\
+                Varies from one scheme to the other.\n\
+                Use command `list signing schemes` for more \
+                information." desc in
+  Clic.param ~name ~desc (pk_uri_parameter ()) params
+
+let sk_uri_parameter () = Clic.parameter (fun _ s ->
+    try return (make_sk_uri @@ Uri.of_string s)
+    with Failure s -> failwith "Error while parsing URI: %s" s)
+
+let sk_uri_param ?name ?desc params =
+  let name = Option.unopt ~default:"uri" name in
+  let desc = Option.unopt
+      ~default:"secret key\n\
+                Varies from one scheme to the other.\n\
+                Use command `list signing schemes` for more \
+                information." desc in
+  Clic.param ~name ~desc (sk_uri_parameter ()) params
+
+module Secret_key =
+  Client_aliases.Alias (struct
+    let name = "secret_key"
+    type t = Uri.t
+    let pp = Uri.pp_hum
+    let of_source s = return (Uri.of_string s)
+    let to_source t = return (Uri.to_string t)
+    let encoding = uri_encoding
+  end)
+
+module Public_key =
+  Client_aliases.Alias (struct
+    let name = "public_key"
+    type t = Uri.t * Signature.Public_key.t option
+    let pp ppf (loc, _) = Uri.pp_hum ppf loc
+    let of_source s = return (Uri.of_string s, None)
+    let to_source (t, _) = return (Uri.to_string t)
+    let encoding =
+      let open Data_encoding in
+      union
+        [ case Json_only
+            ~title: "Locator_only"
+            uri_encoding
+            (function (uri, None) -> Some uri | (_, Some _) -> None)
+            (fun uri -> (uri, None)) ;
+          case Json_only
+            ~title: "Locator_and_full_key"
+            (obj2
+               (req "locator" uri_encoding)
+               (req "key" Signature.Public_key.encoding))
+            (function (uri, Some key) -> Some (uri, key) | (_, None) -> None)
+            (fun (uri, key) -> (uri, Some key)) ]
+  end)
+
+module type SIGNER = sig
+  val scheme : string
+  val title : string
+  val description : string
+  val neuterize : sk_uri -> pk_uri tzresult Lwt.t
+  val public_key :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  val public_key_hash :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+  val sign :
+    ?watermark: Signature.watermark ->
+    sk_uri -> MBytes.t -> Signature.t tzresult Lwt.t
+  val deterministic_nonce : sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+  val deterministic_nonce_hash : sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+  val supports_deterministic_nonces : sk_uri -> bool tzresult Lwt.t
+end
+
+let signers_table : (string, (module SIGNER)) Hashtbl.t = Hashtbl.create 13
+
+let register_signer signer =
+  let module Signer = (val signer : SIGNER) in
+  Hashtbl.replace signers_table Signer.scheme signer
+
+let find_signer_for_key ~scheme =
+  match Hashtbl.find_opt signers_table scheme with
+  | None ->
+      fail (Unregistered_key_scheme scheme)
+  | Some signer -> return signer
+
+let registered_signers () : (string * (module SIGNER)) list =
+  Hashtbl.fold (fun k v acc -> (k, v) :: acc) signers_table []
+
+type error += Signature_mismatch of sk_uri
+
+let () =
+  register_error_kind `Permanent
+    ~id: "cli.signature_mismatch"
+    ~title: "Signature mismatch"
+    ~description: "The signer produced an invalid signature"
+    ~pp:
+      (fun ppf sk ->
+         Format.fprintf ppf
+           "The signer for %a produced an invalid signature"
+           Uri.pp_hum sk)
+    Data_encoding.(obj1 (req "locator" uri_encoding))
+    (function Signature_mismatch sk -> Some sk | _ -> None)
+    (fun sk -> Signature_mismatch sk)
+
+let neuterize sk_uri =
+  let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.neuterize sk_uri
+
+let public_key ?interactive pk_uri =
+  let scheme = Option.unopt ~default:"" (Uri.scheme pk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.public_key ?interactive pk_uri
+
+let public_key_hash ?interactive pk_uri =
+  public_key ?interactive pk_uri >>=? fun pk ->
+  return (Signature.Public_key.hash pk, Some pk)
+
+let sign cctxt ?watermark sk_uri buf =
+  let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.sign ?watermark sk_uri buf >>=? fun signature ->
+  Signer.neuterize sk_uri >>=? fun pk_uri ->
+  Secret_key.rev_find cctxt sk_uri >>=? begin function
+    | None ->
+        public_key pk_uri
+    | Some name ->
+        Public_key.find cctxt name >>=? function
+        | (_, None) ->
+            public_key pk_uri >>=? fun pk ->
+            Public_key.update cctxt name (pk_uri, Some pk) >>=? fun () ->
+            return pk
+        | (_, Some pubkey) -> return pubkey
+  end >>=? fun pubkey ->
+  fail_unless
+    (Signature.check ?watermark pubkey signature buf)
+    (Signature_mismatch sk_uri) >>=? fun () ->
+  return signature
+
+let append cctxt ?watermark loc buf =
+  sign cctxt ?watermark loc buf >>|? fun signature ->
+  Signature.concat buf signature
+
+let check ?watermark pk_uri signature buf =
+  public_key pk_uri >>=? fun pk ->
+  return (Signature.check ?watermark pk signature buf)
+
+let deterministic_nonce sk_uri data =
+  let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.deterministic_nonce sk_uri data
+
+let deterministic_nonce_hash sk_uri data =
+  let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.deterministic_nonce_hash sk_uri data
+
+let supports_deterministic_nonces sk_uri =
+  let scheme = Option.unopt ~default:"" (Uri.scheme sk_uri) in
+  find_signer_for_key ~scheme >>=? fun signer ->
+  let module Signer = (val signer : SIGNER) in
+  Signer.supports_deterministic_nonces sk_uri
+
+let register_key cctxt ?(force=false) (public_key_hash, pk_uri, sk_uri) ?public_key name =
+  Public_key.add ~force cctxt name (pk_uri, public_key) >>=? fun () ->
+  Secret_key.add ~force cctxt name sk_uri >>=? fun () ->
+  Public_key_hash.add ~force cctxt name public_key_hash >>=? fun () ->
+  return_unit
+
+let raw_get_key (cctxt : #Client_context.wallet) pkh =
+  begin
+    Public_key_hash.rev_find cctxt pkh >>=? function
+    | None -> failwith "no keys for the source contract manager"
+    | Some n ->
+        Secret_key.find_opt cctxt n >>=? fun sk_uri ->
+        Public_key.find_opt cctxt n >>=? begin function
+          | None -> return_none
+          | Some (_, Some pk) -> return_some pk
+          | Some (pk_uri, None) ->
+              public_key pk_uri >>=? fun pk ->
+              Public_key.update cctxt n (pk_uri, Some pk) >>=? fun () ->
+              return_some pk
+        end >>=? fun pk ->
+        return (n, pk, sk_uri)
+  end >>= function
+  | (Ok (_, None, None) | Error _) as initial_result -> begin
+      begin
+        (* try to lookup for a remote key *)
+        find_signer_for_key ~scheme:"remote" >>=? fun signer ->
+        let module Signer = (val signer : SIGNER) in
+        let path = Signature.Public_key_hash.to_b58check pkh in
+        let uri = Uri.make ~scheme:Signer.scheme ~path () in
+        Signer.public_key uri >>=? fun pk ->
+        return (path, Some pk, Some uri)
+      end >>= function
+      | Error _ -> Lwt.return initial_result
+      | Ok _ as success -> Lwt.return success
+    end
+  | Ok _ as success -> Lwt.return success
+
+let get_key cctxt pkh =
+  raw_get_key cctxt pkh >>=? function
+  | (pkh, Some pk, Some sk) -> return (pkh, pk, sk)
+  | (_pkh, _pk, None) -> failwith "Unknown secret key for %a" Signature.Public_key_hash.pp pkh
+  | (_pkh, None, _sk) -> failwith "Unknown public key for %a" Signature.Public_key_hash.pp pkh
+
+let get_public_key cctxt pkh =
+  raw_get_key cctxt pkh >>=? function
+  | (pkh, Some pk, _sk) -> return (pkh, pk)
+  | (_pkh, None, _sk) -> failwith "Unknown public key for %a" Signature.Public_key_hash.pp pkh
+
+let get_keys (cctxt : #Client_context.wallet) =
+  Secret_key.load cctxt >>=? fun sks ->
+  Lwt_list.filter_map_s begin fun (name, sk_uri) ->
+    begin
+      Public_key_hash.find cctxt name >>=? fun pkh ->
+      Public_key.find cctxt name >>=? begin function
+        | _, Some pk -> return pk
+        | pk_uri, None ->
+            public_key pk_uri >>=? fun pk ->
+            Public_key.update cctxt name (pk_uri, Some pk) >>=? fun () ->
+            return pk
+      end >>=? fun pk ->
+      return (name, pkh, pk, sk_uri)
+    end >>= function
+    | Ok r -> Lwt.return_some r
+    | Error _ -> Lwt.return_none
+  end sks >>= fun keys ->
+  return keys
+
+let list_keys cctxt =
+  Public_key_hash.load cctxt >>=? fun l ->
+  map_s
+    (fun (name, pkh) ->
+       raw_get_key cctxt pkh >>= function
+       | Ok (_name, pk, sk_uri) ->
+           return (name, pkh, pk, sk_uri)
+       | Error _ ->
+           return (name, pkh, None, None))
+    l
+
+let alias_keys cctxt name =
+  Public_key_hash.find cctxt name >>=? fun pkh ->
+  raw_get_key cctxt pkh >>= function
+  | Ok (_name, pk, sk_uri) -> return_some (pkh, pk, sk_uri)
+  | Error _ -> return_none
+
+let force_switch () =
+  Clic.switch
+    ~long:"force" ~short:'f'
+    ~doc:"overwrite existing keys" ()
diff --git a/vendors/tezos-modded/src/lib_client_base/client_keys.mli b/vendors/tezos-modded/src/lib_client_base/client_keys.mli
new file mode 100644
index 000000000..48698b927
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/client_keys.mli
@@ -0,0 +1,187 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** {2 Cryptographic keys tables } *)
+
+type pk_uri = private Uri.t
+type sk_uri = private Uri.t
+
+val pk_uri_parameter : unit -> (pk_uri, 'a) Clic.parameter
+val pk_uri_param :
+  ?name:string -> ?desc:string ->
+  ('a, 'b) Clic.params -> (pk_uri -> 'a, 'b) Clic.params
+val sk_uri_parameter : unit -> (sk_uri, 'a) Clic.parameter
+val sk_uri_param :
+  ?name:string -> ?desc:string ->
+  ('a, 'b) Clic.params -> (sk_uri -> 'a, 'b) Clic.params
+
+type error += Unregistered_key_scheme of string
+type error += Invalid_uri of Uri.t
+
+module Public_key_hash :
+  Client_aliases.Alias with type t = Signature.Public_key_hash.t
+module Public_key :
+  Client_aliases.Alias with type t = pk_uri * Signature.Public_key.t option
+module Secret_key :
+  Client_aliases.Alias with type t = sk_uri
+
+module Logging : sig
+  val tag : string Tag.def
+end
+
+(** {2 Interface for external signing modules.} *)
+
+module type SIGNER = sig
+
+  val scheme : string
+  (** [scheme] is the name of the scheme implemented by this signer
+      module. *)
+
+  val title : string
+  (** [title] is a one-line human readable description of the signer. *)
+
+  val description : string
+  (** [description] is a multi-line human readable description of the
+      signer, that should include the format of key specifications. *)
+
+  val neuterize : sk_uri -> pk_uri tzresult Lwt.t
+  (** [neuterize sk] is the corresponding [pk]. *)
+
+  val public_key :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri -> Signature.Public_key.t tzresult Lwt.t
+  (** [public_key pk] is the Ed25519 version of [pk].
+
+      Some signer implementations improve long-term security by
+      requiring human/manual validation while importing keys, the
+      [?interactive] argument can be used to prompt the user in such
+      case. *)
+
+  val public_key_hash :
+    ?interactive: Client_context.io_wallet ->
+    pk_uri ->
+    (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+  (** [public_key_hash pk] is the hash of [pk].
+      As some signers will query the full public key to obtain the hash,
+      it can be optionally returned to reduce the amount of queries.
+
+      See {!public_key} for the [?interactive] argument. *)
+
+  val sign :
+    ?watermark: Signature.watermark ->
+    sk_uri -> MBytes.t -> Signature.t tzresult Lwt.t
+  (** [sign ?watermark sk data] is signature obtained by signing [data] with
+        [sk]. *)
+
+  val deterministic_nonce :
+    sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+  (** [deterministic_nonce sk data] is a nonce obtained
+      deterministically from [data] and [sk]. *)
+
+  val deterministic_nonce_hash :
+    sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+  (** [deterministic_nonce_hash sk data] is a nonce hash obtained
+      deterministically from [data] and [sk]. *)
+
+  val supports_deterministic_nonces : sk_uri -> bool tzresult Lwt.t
+  (** [supports_deterministic_nonces] indicates whether the
+      [deterministic_nonce] functionality is supported. *)
+
+end
+
+val register_signer : (module SIGNER) -> unit
+(** [register_signer signer] registers first-class module [signer] as
+    signer for keys with scheme [(val signer : SIGNER).scheme]. *)
+
+val registered_signers : unit -> (string * (module SIGNER)) list
+
+val public_key :
+  ?interactive: Client_context.io_wallet ->
+  pk_uri -> Signature.Public_key.t tzresult Lwt.t
+
+val public_key_hash :
+  ?interactive: Client_context.io_wallet ->
+  pk_uri -> (Signature.Public_key_hash.t * Signature.Public_key.t option) tzresult Lwt.t
+
+val neuterize : sk_uri -> pk_uri tzresult Lwt.t
+
+val sign :
+  #Client_context.wallet ->
+  ?watermark:Signature.watermark ->
+  sk_uri -> MBytes.t -> Signature.t tzresult Lwt.t
+
+val append :
+  #Client_context.wallet ->
+  ?watermark:Signature.watermark ->
+  sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+
+val check :
+  ?watermark:Signature.watermark ->
+  pk_uri -> Signature.t -> MBytes.t -> bool tzresult Lwt.t
+
+val deterministic_nonce :
+  sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+
+val deterministic_nonce_hash :
+  sk_uri -> MBytes.t -> MBytes.t tzresult Lwt.t
+
+val supports_deterministic_nonces :
+  sk_uri -> bool tzresult Lwt.t
+
+val register_key :
+  #Client_context.wallet ->
+  ?force:bool ->
+  (Signature.Public_key_hash.t * pk_uri * sk_uri) ->
+  ?public_key: Signature.Public_key.t ->
+  string -> unit tzresult Lwt.t
+
+val list_keys :
+  #Client_context.wallet ->
+  (string * Public_key_hash.t * Signature.public_key option * sk_uri option) list tzresult Lwt.t
+
+val alias_keys :
+  #Client_context.wallet -> string ->
+  (Public_key_hash.t * Signature.public_key option * sk_uri option) option tzresult Lwt.t
+
+val get_key :
+  #Client_context.wallet ->
+  Public_key_hash.t ->
+  (string * Signature.Public_key.t * sk_uri) tzresult Lwt.t
+
+val get_public_key :
+  #Client_context.wallet ->
+  Public_key_hash.t ->
+  (string * Signature.Public_key.t) tzresult Lwt.t
+
+val get_keys:
+  #Client_context.wallet ->
+  (string * Public_key_hash.t * Signature.Public_key.t * sk_uri) list tzresult Lwt.t
+
+val force_switch : unit -> (bool, 'ctx) Clic.arg
+
+(**/**)
+
+val make_pk_uri : Uri.t -> pk_uri
+val make_sk_uri : Uri.t -> sk_uri
diff --git a/vendors/tezos-modded/src/lib_client_base/dune b/vendors/tezos-modded/src/lib_client_base/dune
new file mode 100644
index 000000000..4ba2cd808
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/dune
@@ -0,0 +1,17 @@
+(library
+ (name tezos_client_base)
+ (public_name tezos-client-base)
+ (libraries tezos-base
+            tezos-shell-services
+            tezos-rpc)
+ (library_flags (:standard -linkall))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc
+                   -open Tezos_shell_services)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_client_base/tezos-client-base.opam b/vendors/tezos-modded/src/lib_client_base/tezos-client-base.opam
new file mode 100644
index 000000000..803f358f0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base/tezos-client-base.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-stdlib-unix"
+  "tezos-shell-services"
+  "tezos-storage"
+  "tezos-rpc-http"
+  "cmdliner"
+  "pbkdf"
+  "bip39"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/client_config.ml b/vendors/tezos-modded/src/lib_client_base_unix/client_config.ml
new file mode 100644
index 000000000..50c8988c7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/client_config.ml
@@ -0,0 +1,476 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Command line interface - Configuration and Arguments Parsing *)
+
+type error += Invalid_block_argument of string
+type error += Invalid_protocol_argument of string
+type error += Invalid_port_arg of string
+type error += Invalid_remote_signer_argument of string
+type error += Invalid_wait_arg of string
+let () =
+  register_error_kind
+    `Branch
+    ~id: "badBlockArgument"
+    ~title: "Bad Block Argument"
+    ~description: "Block argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value %s is not a value block reference." s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_block_argument s -> Some s | _ -> None)
+    (fun s -> Invalid_block_argument s) ;
+  register_error_kind
+    `Branch
+    ~id: "badProtocolArgument"
+    ~title: "Bad Protocol Argument"
+    ~description: "Protocol argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value %s does not correspond to any known protocol." s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_protocol_argument s -> Some s | _ -> None)
+    (fun s -> Invalid_protocol_argument s) ;
+  register_error_kind
+    `Branch
+    ~id: "invalidPortArgument"
+    ~title: "Bad Port Argument"
+    ~description: "Port argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value %s is not a valid TCP port." s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_port_arg s -> Some s | _ -> None)
+    (fun s -> Invalid_port_arg s) ;
+  register_error_kind
+    `Branch
+    ~id: "invalid_remote_signer_argument"
+    ~title: "Unexpected URI of remote signer"
+    ~description: "The remote signer argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value '%s' is not a valid URI." s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_remote_signer_argument s -> Some s | _ -> None)
+    (fun s -> Invalid_remote_signer_argument s) ;
+  register_error_kind
+    `Branch
+    ~id: "invalidWaitArgument"
+    ~title: "Bad Wait Argument"
+    ~description: "Wait argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value %s is not a valid number of confirmation, nor 'none'." s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_wait_arg s -> Some s | _ -> None)
+    (fun s -> Invalid_wait_arg s)
+
+let home = try Sys.getenv "HOME" with Not_found -> "/root"
+
+let default_base_dir =
+  Filename.concat home ".tezos-client"
+
+let default_block = `Head 0
+
+let (//) = Filename.concat
+
+module Cfg_file = struct
+
+  type t =  {
+    base_dir: string ;
+    node_addr: string ;
+    node_port: int ;
+    tls: bool ;
+    web_port: int ;
+    remote_signer: Uri.t option ;
+    confirmations: int option ;
+    password_filename: string option ;
+  }
+
+  let default = {
+    base_dir = default_base_dir ;
+    node_addr = "localhost" ;
+    node_port = 8732 ;
+    tls = false ;
+    web_port = 8080 ;
+    remote_signer = None ;
+    confirmations = Some 0 ;
+    password_filename = None ;
+  }
+
+  open Data_encoding
+
+  let encoding =
+    conv
+      (fun { base_dir ; node_addr ; node_port ; tls ; web_port ;
+             remote_signer ; confirmations ; password_filename } ->
+        (base_dir, Some node_addr, Some node_port,
+         Some tls, Some web_port, remote_signer, confirmations, password_filename ))
+      (fun (base_dir, node_addr, node_port, tls, web_port,
+            remote_signer, confirmations, password_filename) ->
+        let node_addr = Option.unopt ~default:default.node_addr node_addr in
+        let node_port = Option.unopt ~default:default.node_port node_port in
+        let tls = Option.unopt ~default:default.tls tls in
+        let web_port = Option.unopt ~default:default.web_port web_port in
+        { base_dir ; node_addr ; node_port ; tls ; web_port ;
+          remote_signer ; confirmations ; password_filename })
+      (obj8
+         (req "base_dir" string)
+         (opt "node_addr" string)
+         (opt "node_port" int16)
+         (opt "tls" bool)
+         (opt "web_port" int16)
+         (opt "remote_signer" RPC_client.uri_encoding)
+         (opt "confirmations" int8)
+         (opt "password_filename" string)
+      )
+
+  let from_json json =
+    Data_encoding.Json.destruct encoding json
+
+  let read fp =
+    Lwt_utils_unix.Json.read_file fp >>=? fun json ->
+    return (from_json json)
+
+  let write out cfg =
+    Lwt_utils_unix.Json.write_file out
+      (Data_encoding.Json.construct encoding cfg)
+
+end
+
+type cli_args = {
+  block: Shell_services.block ;
+  confirmations: int option ;
+  password_filename: string option ;
+  protocol: Protocol_hash.t option ;
+  print_timings: bool ;
+  log_requests: bool ;
+}
+
+let default_cli_args = {
+  block = default_block ;
+  confirmations = Some 0 ;
+  password_filename = None ;
+  protocol = None ;
+  print_timings = false ;
+  log_requests = false ;
+}
+
+
+open Clic
+
+let string_parameter () : (string, #Client_context.full) parameter =
+  parameter (fun _ x -> return x)
+
+let block_parameter () =
+  parameter
+    (fun _ block ->
+       match Block_services.parse_block block with
+       | Error _ -> fail (Invalid_block_argument block)
+       | Ok block -> return block)
+
+let wait_parameter () =
+  parameter
+    (fun _ wait ->
+       match wait with
+       | "no" | "none" -> return_none
+       | _ ->
+           try
+             let w = int_of_string wait in
+             if 0 <= w then
+               return_some w
+             else
+               fail (Invalid_wait_arg wait)
+           with _ -> fail (Invalid_wait_arg wait))
+
+let protocol_parameter () =
+  parameter
+    (fun _ arg ->
+       try
+         let (hash,_commands) =
+           List.find (fun (hash,_commands) ->
+               String.has_prefix ~prefix:arg
+                 (Protocol_hash.to_b58check hash))
+             (Client_commands.get_versions ())
+         in
+         return_some hash
+       with Not_found -> fail (Invalid_protocol_argument arg)
+    )
+
+(* Command-line only args (not in config file) *)
+let base_dir_arg () =
+  arg
+    ~long:"base-dir"
+    ~short:'d'
+    ~placeholder:"path"
+    ~doc:("client data directory\n\
+           The directory where the Tezos client will store all its data.\n\
+           By default: '" ^ default_base_dir ^"'.")
+    (string_parameter ())
+let config_file_arg () =
+  arg
+    ~long:"config-file"
+    ~short:'c'
+    ~placeholder:"path"
+    ~doc:"configuration file"
+    (string_parameter ())
+let timings_switch () =
+  switch
+    ~long:"timings"
+    ~short:'t'
+    ~doc:"show RPC request times"
+    ()
+let block_arg () =
+  default_arg
+    ~long:"block"
+    ~short:'b'
+    ~placeholder:"hash|tag"
+    ~doc:"block on which to apply contextual commands"
+    ~default:(Block_services.to_string default_cli_args.block)
+    (block_parameter ())
+let wait_arg () =
+  arg
+    ~long:"wait"
+    ~short:'w'
+    ~placeholder:"none|<int>"
+    ~doc:"how many confirmation blocks before to consider an operation as included"
+    (wait_parameter ())
+let protocol_arg () =
+  arg
+    ~long:"protocol"
+    ~short:'p'
+    ~placeholder:"hash"
+    ~doc:"use commands of a specific protocol"
+    (protocol_parameter ())
+let log_requests_switch () =
+  switch
+    ~long:"log-requests"
+    ~short:'l'
+    ~doc:"log all requests to the node"
+    ()
+
+(* Command-line args which can be set in config file as well *)
+let addr_arg () =
+  arg
+    ~long:"addr"
+    ~short:'A'
+    ~placeholder:"IP addr|host"
+    ~doc:"IP address of the node"
+    (string_parameter ())
+let port_arg () =
+  arg
+    ~long:"port"
+    ~short:'P'
+    ~placeholder:"number"
+    ~doc:"RPC port of the node"
+    (parameter
+       (fun _ x -> try
+           return (int_of_string x)
+         with Failure _ ->
+           fail (Invalid_port_arg x)))
+let tls_switch () =
+  switch
+    ~long:"tls"
+    ~short:'S'
+    ~doc:"use TLS to connect to node."
+    ()
+let remote_signer_arg () =
+  arg
+    ~long:"remote-signer"
+    ~short:'R'
+    ~placeholder:"uri"
+    ~doc:"URI of the remote signer"
+    (parameter
+       (fun _ x -> Tezos_signer_backends.Remote.parse_base_uri x))
+let password_filename_arg () =
+  arg
+    ~long:"password-filename"
+    ~short:'f'
+    ~placeholder:"filename"
+    ~doc:"path to the password filename"
+    (string_parameter ())
+
+let read_config_file config_file =
+  Lwt_utils_unix.Json.read_file config_file >>=? fun cfg_json ->
+  try return @@ Cfg_file.from_json cfg_json
+  with exn ->
+    failwith
+      "Can't parse the configuration file: %s@,%a"
+      config_file (fun ppf exn -> Json_encoding.print_error ppf exn) exn
+
+let default_config_file_name = "config"
+
+let commands config_file cfg =
+  let open Clic in
+  let group = { Clic.name = "config" ;
+                title = "Commands for editing and viewing the client's config file" } in
+  [ command ~group ~desc:"Show the config file."
+      no_options
+      (fixed [ "config" ; "show" ])
+      (fun () (cctxt : #Client_context.full) ->
+         let pp_cfg ppf cfg = Format.fprintf ppf "%a" Data_encoding.Json.pp (Data_encoding.Json.construct Cfg_file.encoding cfg) in
+         if not @@ Sys.file_exists config_file then
+           cctxt#warning
+             "@[<v 2>Warning: no config file at %s,@,\
+              displaying the default configuration.@]"
+             config_file >>= fun () ->
+           cctxt#warning "%a@," pp_cfg Cfg_file.default >>= return
+         else
+           read_config_file config_file >>=? fun cfg ->
+           cctxt#message "%a@," pp_cfg cfg >>= return) ;
+
+    command ~group ~desc:"Reset the config file to the factory defaults."
+      no_options
+      (fixed [ "config" ; "reset" ])
+      (fun () _cctxt ->
+         Cfg_file.(write config_file default)) ;
+
+    command ~group
+      ~desc:"Update the config based on the current cli values.\n\
+             Loads the current configuration (default or as specified \
+             with `-config-file`), applies alterations from other \
+             command line arguments (such as the node's address, \
+             etc.), and overwrites the updated configuration file."
+      no_options
+      (fixed [ "config" ; "update" ])
+      (fun () _cctxt ->
+         Cfg_file.(write config_file cfg)) ;
+
+    command ~group
+      ~desc:"Create a config file based on the current CLI values.\n\
+             If the `-file` option is not passed, this will initialize \
+             the default config file, based on default parameters, \
+             altered by other command line options (such as the node's \
+             address, etc.).\n\
+             Otherwise, it will create a new config file, based on the \
+             default parameters (or the the ones specified with \
+             `-config-file`), altered by other command line \
+             options.\n\
+             The command will always fail if the file already exists."
+      (args1
+         (default_arg
+            ~long:"output"
+            ~short:'o'
+            ~placeholder:"path"
+            ~doc:"path at which to create the file"
+            ~default:(cfg.base_dir // default_config_file_name)
+            (parameter (fun _ctx str -> return str))))
+      (fixed [ "config" ; "init" ])
+      (fun config_file _cctxt ->
+         if not (Sys.file_exists config_file)
+         then Cfg_file.(write config_file cfg) (* Should be default or command would have failed *)
+         else failwith "Config file already exists at location") ;
+  ]
+
+let global_options () =
+  args12
+    (base_dir_arg ())
+    (config_file_arg ())
+    (timings_switch ())
+    (block_arg ())
+    (wait_arg ())
+    (protocol_arg ())
+    (log_requests_switch ())
+    (addr_arg ())
+    (port_arg ())
+    (tls_switch ())
+    (remote_signer_arg ())
+    (password_filename_arg ())
+
+let parse_config_args (ctx : #Client_context.full) argv =
+  parse_global_options
+    (global_options ())
+    ctx
+    argv >>=?
+  fun ((base_dir,
+        config_file,
+        timings,
+        block,
+        confirmations,
+        protocol,
+        log_requests,
+        node_addr,
+        node_port,
+        tls,
+        remote_signer,
+        password_filename), remaining) ->
+  begin match base_dir with
+    | None ->
+        let base_dir = default_base_dir in
+        unless (Sys.file_exists base_dir) begin fun () ->
+          Lwt_utils_unix.create_dir base_dir >>= return
+        end >>=? fun () ->
+        return base_dir
+    | Some dir ->
+        if not (Sys.file_exists dir)
+        then failwith "Specified -base-dir does not exist. Please create the directory and try again."
+        else if Sys.is_directory dir
+        then return dir
+        else failwith "Specified -base-dir must be a directory"
+  end >>=? fun base_dir ->
+  begin match config_file with
+    | None -> return @@ base_dir // default_config_file_name
+    | Some config_file ->
+        if Sys.file_exists config_file
+        then return config_file
+        else failwith "Config file specified in option does not exist. Use `client config init` to create one."
+  end >>=? fun config_file ->
+  let config_dir = Filename.dirname config_file in
+  let protocol =
+    match protocol with
+    | None -> None
+    | Some p -> p
+  in
+  begin
+    if not (Sys.file_exists config_file) then
+      return { Cfg_file.default with base_dir = base_dir }
+    else
+      read_config_file config_file
+  end >>=? fun cfg ->
+  let tls = cfg.tls || tls in
+  let node_addr = Option.unopt ~default:cfg.node_addr node_addr in
+  let node_port = Option.unopt ~default:cfg.node_port node_port in
+  Tezos_signer_backends.Remote.read_base_uri_from_env () >>=? fun remote_signer_env ->
+  let remote_signer =
+    Option.first_some remote_signer
+      (Option.first_some remote_signer_env cfg.remote_signer) in
+  let confirmations = Option.unopt ~default:cfg.confirmations confirmations in
+  let cfg = { cfg with tls ; node_port ; node_addr ;
+                       remote_signer ; confirmations ; password_filename } in
+  if Sys.file_exists base_dir && not (Sys.is_directory base_dir) then begin
+    Format.eprintf "%s is not a directory.@." base_dir ;
+    exit 1 ;
+  end ;
+  if Sys.file_exists config_dir && not (Sys.is_directory config_dir) then begin
+    Format.eprintf "%s is not a directory.@." config_dir ;
+    exit 1 ;
+  end ;
+  Lwt_utils_unix.create_dir config_dir >>= fun () ->
+  return
+    (cfg,
+     { block ; confirmations ; password_filename ;
+       print_timings = timings ; log_requests ; protocol },
+     commands config_file cfg, remaining)
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.ml b/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.ml
new file mode 100644
index 000000000..43dd66812
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.ml
@@ -0,0 +1,144 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Client_context
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.context.unix" end)
+
+let filename_tag = Tag.def ~doc:"Filename" "filename"  Format.pp_print_string
+
+class unix_wallet ~base_dir ~password_filename : wallet = object (self)
+
+  method password_filename = password_filename
+
+  method private filename alias_name =
+    Filename.concat
+      base_dir
+      (Str.(global_replace (regexp_string " ") "_" alias_name) ^ "s")
+
+  method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t =
+    (fun f ->
+       let unlock fd =
+         let fd = Lwt_unix.unix_file_descr fd in
+         Unix.lockf fd Unix.F_ULOCK 0 ;
+         Unix.close fd in
+       let lock () =
+         Lwt_unix.openfile (Filename.concat base_dir "wallet_lock")
+           Lwt_unix.[ O_CREAT ; O_WRONLY ] 0o644 >>= fun fd ->
+         Lwt_unix.lockf fd Unix.F_LOCK 0 >>= fun () ->
+         Lwt.return (fd, (Lwt_unix.on_signal Sys.sigint
+                            (fun _s ->
+                               unlock fd ;
+                               exit 0 (* exit code? *) ))) in
+       lock () >>= fun (fd, sh) ->
+       (* catch might be useless if f always uses the error monad *)
+       Lwt.catch f (function e -> Lwt.return (unlock fd ; raise e)) >>= fun res ->
+       Lwt.return (unlock fd) >>= fun () ->
+       Lwt_unix.disable_signal_handler sh ;
+       Lwt.return res)
+
+  method load : type a. string -> default:a -> a Data_encoding.encoding -> a tzresult Lwt.t =
+    fun alias_name ~default encoding ->
+      let filename = self#filename alias_name in
+      if not (Sys.file_exists filename) then
+        return default
+      else
+        Lwt_utils_unix.Json.read_file filename
+        |> generic_trace
+          "could not read the %s alias file" alias_name >>=? fun json ->
+        match Data_encoding.Json.destruct encoding json with
+        | exception e ->
+            lwt_log_error Tag.DSL.(fun f ->
+                f "did not understand the %s alias file %s : %a"
+                -% t event "load error"
+                -% s filename_tag alias_name
+                -% s filename_tag filename
+                -% a exn e) >>= fun () ->
+            failwith "did not understand the %s alias file %s" alias_name filename
+        | data ->
+            return data
+
+  method write :
+    type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t =
+    fun alias_name list encoding ->
+      Lwt.catch
+        (fun () ->
+           Lwt_utils_unix.create_dir base_dir >>= fun () ->
+           let filename = self#filename alias_name in
+           let json = Data_encoding.Json.construct encoding list in
+           Lwt_utils_unix.Json.write_file filename json)
+        (fun exn -> Lwt.return (error_exn exn))
+      |> generic_trace "could not write the %s alias file." alias_name
+end
+
+class unix_prompter = object
+  method prompt : type a. (a, string tzresult) lwt_format -> a =
+    Format.kasprintf begin fun msg ->
+      print_string msg ;
+      let line = read_line () in
+      return line
+    end
+
+  method prompt_password : type a. (a, MBytes.t tzresult) lwt_format -> a =
+    Format.kasprintf begin fun msg ->
+      print_string msg ;
+      let line = Lwt_utils_unix.getpass () in
+      return (MBytes.of_string line)
+    end
+end
+
+class unix_logger ~base_dir =
+  let startup =
+    CalendarLib.Printer.Precise_Calendar.sprint
+      "%Y-%m-%dT%H:%M:%SZ"
+      (CalendarLib.Calendar.Precise.now ()) in
+  let log channel msg = match channel with
+    | "stdout" ->
+        print_endline msg ;
+        Lwt.return_unit
+    | "stderr" ->
+        prerr_endline msg ;
+        Lwt.return_unit
+    | log ->
+        let (//) = Filename.concat in
+        Lwt_utils_unix.create_dir (base_dir // "logs" // log) >>= fun () ->
+        Lwt_io.with_file
+          ~flags: Unix.[ O_APPEND ; O_CREAT ; O_WRONLY ]
+          ~mode: Lwt_io.Output
+          (base_dir // "logs" // log // startup)
+          (fun chan -> Lwt_io.write chan msg) in
+  object
+    inherit Client_context.simple_printer log
+  end
+
+class unix_full ~base_dir ~block ~confirmations ~password_filename ~rpc_config : Client_context.full =
+  object
+    inherit unix_logger ~base_dir
+    inherit unix_prompter
+    inherit unix_wallet ~base_dir ~password_filename
+    inherit RPC_client.http_ctxt rpc_config Media_type.all_media_types
+    method block = block
+    method confirmations = confirmations
+  end
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.mli b/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.mli
new file mode 100644
index 000000000..4a6262b1b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/client_context_unix.mli
@@ -0,0 +1,42 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+class unix_wallet :
+  base_dir:string ->
+  password_filename: string option ->
+  Client_context.wallet
+class unix_prompter :
+  Client_context.prompter
+class unix_logger :
+  base_dir:string ->
+  Client_context.printer
+class unix_full :
+  base_dir:string ->
+  block:Shell_services.block ->
+  confirmations:int option ->
+  password_filename: string option ->
+  rpc_config:RPC_client.config ->
+  Client_context.full
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.ml b/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.ml
new file mode 100644
index 000000000..ea2a7f6fa
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.ml
@@ -0,0 +1,194 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Command line interface - Main Program *)
+
+open Client_context_unix
+
+let builtin_commands =
+  let open Clic in
+  [
+    command
+      ~desc: "List the protocol versions that this client understands."
+      no_options
+      (fixed [ "list" ; "understood" ; "protocols" ])
+      (fun () (cctxt : #Client_context.full) ->
+         Lwt_list.iter_s
+           (fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver)
+           (Client_commands.get_versions ()) >>= fun () ->
+         return_unit) ;
+  ]
+
+(* Main (lwt) entry *)
+let main select_commands =
+  let executable_name = Filename.basename Sys.executable_name in
+  let global_options = Client_config.global_options () in
+  let original_args, autocomplete =
+    (* for shell aliases *)
+    let rec move_autocomplete_token_upfront acc = function
+      | "bash_autocomplete" :: prev_arg :: cur_arg :: script :: args ->
+          let args = List.rev acc @ args in
+          args, Some (prev_arg, cur_arg, script)
+      | x :: rest -> move_autocomplete_token_upfront (x :: acc) rest
+      | [] -> List.rev acc, None in
+    match Array.to_list Sys.argv with
+    | _ :: args -> move_autocomplete_token_upfront [] args
+    | [] -> [], None in
+  Random.self_init () ;
+  ignore Clic.(setup_formatter Format.std_formatter
+                 (if Unix.isatty Unix.stdout then Ansi else Plain) Short) ;
+  ignore Clic.(setup_formatter Format.err_formatter
+                 (if Unix.isatty Unix.stderr then Ansi else Plain) Short) ;
+  Logging_unix.init () >>= fun () ->
+  Lwt.catch begin fun () -> begin
+      Client_config.parse_config_args
+        (new unix_full
+          ~block:Client_config.default_block
+          ~confirmations:None
+          ~password_filename:None
+          ~base_dir:Client_config.default_base_dir
+          ~rpc_config:RPC_client.default_config)
+        original_args
+      >>=? fun (parsed_config_file, parsed_args, config_commands, remaining) ->
+      let rpc_config : RPC_client.config = {
+        RPC_client.default_config with
+        host = parsed_config_file.node_addr ;
+        port = parsed_config_file.node_port ;
+        tls = parsed_config_file.tls ;
+      } in
+      let ctxt = new RPC_client.http_ctxt rpc_config Media_type.all_media_types in
+      let rpc_config =
+        if parsed_args.print_timings then
+          { rpc_config with
+            logger = RPC_client.timings_logger Format.err_formatter }
+        else if parsed_args.log_requests
+        then { rpc_config with logger = RPC_client.full_logger Format.err_formatter }
+        else rpc_config
+      in
+      let client_config =
+        new unix_full
+          ~block:parsed_args.block
+          ~confirmations:parsed_args.confirmations
+          ~password_filename: parsed_args.password_filename
+          ~base_dir:parsed_config_file.base_dir
+          ~rpc_config:rpc_config in
+      Client_keys.register_signer
+        (module Tezos_signer_backends.Unencrypted) ;
+      Client_keys.register_signer
+        (module Tezos_signer_backends.Encrypted.Make(struct
+             let cctxt = (client_config :> Client_context.prompter)
+           end)) ;
+      let module Remote_params = struct
+        let authenticate pkhs payload =
+          Client_keys.list_keys client_config >>=? fun keys ->
+          match List.filter_map
+                  (function
+                    | (_, known_pkh, _, Some known_sk_uri)
+                      when List.exists (fun pkh -> Signature.Public_key_hash.equal pkh known_pkh) pkhs ->
+                        Some known_sk_uri
+                    | _ -> None)
+                  keys with
+          | sk_uri :: _ ->
+              Client_keys.sign client_config sk_uri payload
+          | [] -> failwith
+                    "remote signer expects authentication signature, \
+                     but no authorized key was found in the wallet"
+        let logger = rpc_config.logger
+      end in
+      let module Https = Tezos_signer_backends.Https.Make(Remote_params) in
+      let module Http = Tezos_signer_backends.Http.Make(Remote_params) in
+      let module Socket = Tezos_signer_backends.Socket.Make(Remote_params) in
+      Client_keys.register_signer (module Https) ;
+      Client_keys.register_signer (module Http) ;
+      Client_keys.register_signer (module Socket.Unix) ;
+      Client_keys.register_signer (module Socket.Tcp) ;
+      Option.iter parsed_config_file.remote_signer ~f: begin fun signer ->
+        Client_keys.register_signer
+          (module Tezos_signer_backends.Remote.Make(struct
+               let default = signer
+               include Remote_params
+             end))
+      end ;
+      Client_keys.register_signer (module Tezos_signer_backends.Ledger) ;
+      select_commands ctxt parsed_args >>=? fun commands ->
+      let commands =
+        Clic.add_manual
+          ~executable_name
+          ~global_options
+          (if Unix.isatty Unix.stdout then Clic.Ansi else Clic.Plain)
+          Format.std_formatter
+          (config_commands @ builtin_commands @ commands) in
+      begin match autocomplete with
+        | Some (prev_arg, cur_arg, script) ->
+            Clic.autocompletion
+              ~script ~cur_arg ~prev_arg ~args:original_args ~global_options
+              commands client_config >>=? fun completions ->
+            List.iter print_endline completions ;
+            return_unit
+        | None ->
+            Clic.dispatch commands client_config remaining
+      end
+    end >>= function
+    | Ok () ->
+        Lwt.return 0
+    | Error [ Clic.Help command ] ->
+        Clic.usage
+          Format.std_formatter
+          ~executable_name
+          ~global_options
+          (match command with None -> [] | Some c -> [ c ]) ;
+        Lwt.return 0
+    | Error errs ->
+        Clic.pp_cli_errors
+          Format.err_formatter
+          ~executable_name
+          ~global_options
+          ~default:Error_monad.pp
+          errs ;
+        Lwt.return 1
+  end begin function
+    | Client_commands.Version_not_found ->
+        Format.eprintf "@{<error>@{<title>Fatal error@}@} unknown protocol version.@." ;
+        Lwt.return 1
+    | Failure message ->
+        Format.eprintf "@{<error>@{<title>Fatal error@}@}@.\
+                       \  @[<h 0>%a@]@."
+          Format.pp_print_text message ;
+        Lwt.return 1
+    | exn ->
+        Format.printf "@{<error>@{<title>Fatal error@}@}@.\
+                      \  @[<h 0>%a@]@."
+          Format.pp_print_text (Printexc.to_string exn) ;
+        Lwt.return 1
+  end >>= fun retcode ->
+  Format.pp_print_flush Format.err_formatter () ;
+  Format.pp_print_flush Format.std_formatter () ;
+  Logging_unix.close () >>= fun () ->
+  Lwt.return retcode
+
+(* Where all the user friendliness starts *)
+let run select_commands =
+  Pervasives.exit (Lwt_main.run (main select_commands))
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.mli b/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.mli
new file mode 100644
index 000000000..4e8f1bf1e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/client_main_run.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 run :
+  (RPC_client.http_ctxt ->
+   Client_config.cli_args ->
+   Client_context.full Clic.command list tzresult Lwt.t) ->
+  unit
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/dune b/vendors/tezos-modded/src/lib_client_base_unix/dune
new file mode 100644
index 000000000..ab8d7a069
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/dune
@@ -0,0 +1,24 @@
+(library
+ (name tezos_client_base_unix)
+ (public_name tezos-client-base-unix)
+ (libraries tezos-base
+            tezos-client-base
+            tezos-client-commands
+            tezos-stdlib-unix
+            tezos-rpc-http
+            tezos-signer-backends
+            tezos-shell-services)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc_http
+                   -open Tezos_shell_services
+                   -open Tezos_stdlib_unix
+                   -open Tezos_client_base
+                   -open Tezos_client_commands
+                   -linkall)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_client_base_unix/tezos-client-base-unix.opam b/vendors/tezos-modded/src/lib_client_base_unix/tezos-client-base-unix.opam
new file mode 100644
index 000000000..fa4cf1547
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_base_unix/tezos-client-base-unix.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-base"
+  "tezos-stdlib-unix"
+  "tezos-rpc-http"
+  "tezos-signer-backends"
+  "tezos-client-commands"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.ml
new file mode 100644
index 000000000..0dc307864
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.ml
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands () =
+  let open Clic in
+  let group = { name = "admin" ;
+                title = "Commands to perform privileged operations on the node" } in
+  [
+    command ~group
+      ~desc: "Make the node forget its decision of rejecting blocks."
+      no_options
+      (prefixes [ "unmark" ; "invalid" ]
+       @@ seq_of_param (Block_hash.param ~name:"block" ~desc:"blocks to remove from invalid list"))
+      (fun () blocks (cctxt : #Client_context.full) ->
+         iter_s
+           (fun block ->
+              Shell_services.Invalid_blocks.delete cctxt block >>=? fun () ->
+              cctxt#message
+                "Block %a no longer marked invalid."
+                Block_hash.pp block >>= fun () ->
+              return_unit)
+           blocks) ;
+
+    command ~group
+      ~desc: "Make the node forget every decision of rejecting blocks."
+      no_options
+      (prefixes [ "unmark" ; "all" ; "invalid" ; "blocks" ]
+       @@ stop)
+      (fun () (cctxt : #Client_context.full) ->
+         Shell_services.Invalid_blocks.list cctxt () >>=? fun invalid_blocks ->
+         iter_s (fun { Chain_services.hash } ->
+             Shell_services.Invalid_blocks.delete cctxt hash >>=? fun () ->
+             cctxt#message
+               "Block %a no longer marked invalid."
+               Block_hash.pp_short hash >>= fun () ->
+             return_unit)
+           invalid_blocks) ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.mli
new file mode 100644
index 000000000..4393cb83b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_admin_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands : unit -> #Client_context.full Clic.command list
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_commands.ml
new file mode 100644
index 000000000..27aedc133
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_commands.ml
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_context
+
+type command = full Clic.command
+type network = [ `Mainnet | `Alphanet | `Zeronet | `Sandbox ]
+
+exception Version_not_found
+
+let versions = Protocol_hash.Table.create 7
+
+let get_versions () =
+  Protocol_hash.Table.fold
+    (fun k c acc -> (k, c) :: acc)
+    versions
+    []
+
+let register name commands =
+  let previous =
+    try Protocol_hash.Table.find versions name
+    with Not_found -> (fun (_network : network option) -> ([] : command list)) in
+  Protocol_hash.Table.replace versions name
+    (fun (network : network option) -> (commands network @ previous network))
+
+let commands_for_version version =
+  try Protocol_hash.Table.find versions version
+  with Not_found -> raise Version_not_found
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_commands.mli
new file mode 100644
index 000000000..4bf16b4f1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_commands.mli
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_context
+
+type command = full Clic.command
+type network = [ `Mainnet | `Alphanet | `Zeronet | `Sandbox ]
+
+exception Version_not_found
+
+val register: Protocol_hash.t -> (network option -> command list) -> unit
+val commands_for_version: Protocol_hash.t -> network option -> command list
+val get_versions: unit -> (Protocol_hash.t * (network option -> command list)) list
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.ml
new file mode 100644
index 000000000..58a4c05f4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.ml
@@ -0,0 +1,69 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 unique_switch =
+  Clic.switch
+    ~long:"unique"
+    ~short:'u'
+    ~doc:"Fail when there is more than one possible completion."
+    ()
+
+let commands () = Clic.[
+    command
+      ~desc: "Autocomplete a prefix of Base58Check-encoded hash.\n\
+              This actually works only for blocks, operations, public \
+              key and contract identifiers."
+      (args1 unique_switch)
+      (prefixes [ "complete" ] @@
+       string
+         ~name: "prefix"
+         ~desc: "the prefix of the hash to complete" @@
+       stop)
+      (fun unique prefix (cctxt : #Client_context.full) ->
+         Shell_services.Blocks.Helpers.complete
+           cctxt ~block:cctxt#block prefix >>=? fun completions ->
+         match completions with
+         | [] -> Pervasives.exit 3
+         | _ :: _ :: _ when unique -> Pervasives.exit 3
+         | completions ->
+             List.iter print_endline completions ;
+             return_unit) ;
+    command
+      ~desc: "Wait for the node to be bootstrapped."
+      no_options
+      (prefixes [ "bootstrapped" ] @@
+       stop)
+      (fun () (cctxt : #Client_context.full) ->
+         Monitor_services.bootstrapped cctxt >>=? fun (stream, _) ->
+         Lwt_stream.iter_s
+           (fun (hash, time) ->
+              cctxt#message "Current head: %a (timestamp: %a, validation: %a)"
+                Block_hash.pp_short hash
+                Time.pp_hum time
+                Time.pp_hum (Time.now ())) stream >>= fun () ->
+         cctxt#answer "Bootstrapped." >>= fun () ->
+         return_unit
+      )
+  ]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.mli
new file mode 100644
index 000000000..d50cc7538
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_helpers_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands: unit -> Client_commands.command list
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.ml
new file mode 100644
index 000000000..d37e3433e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.ml
@@ -0,0 +1,482 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_keys
+
+let group =
+  { Clic.name = "keys" ;
+    title = "Commands for managing the wallet of cryptographic keys" }
+
+let sig_algo_arg =
+  Clic.default_arg
+    ~doc:"use custom signature algorithm"
+    ~long:"sig"
+    ~short:'s'
+    ~placeholder:"ed25519|secp256k1|p256"
+    ~default: "ed25519"
+    (Signature.algo_param ())
+
+let gen_keys_containing
+    ?(encrypted = false) ?(prefix=false) ?(force=false)
+    ~containing ~name (cctxt : #Client_context.io_wallet) =
+  let unrepresentable =
+    List.filter (fun s -> not @@ Base58.Alphabet.all_in_alphabet Base58.Alphabet.bitcoin s) containing in
+  let good_initial_char = "KLMNPQRSTUVWXYZabcdefghi" in
+  let bad_initial_char = "123456789ABCDEFGHJjkmnopqrstuvwxyz" in
+  match unrepresentable with
+  | _ :: _ ->
+      cctxt#error
+        "@[<v 0>The following words can't be written in the key alphabet: %a.@,\
+         Valid characters: %a@,\
+         Extra restriction for the first character: %s@]"
+        (Format.pp_print_list
+           ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
+           (fun ppf s -> Format.fprintf ppf "'%s'" s))
+        unrepresentable
+        Base58.Alphabet.pp Base58.Alphabet.bitcoin
+        good_initial_char
+  | [] ->
+      let unrepresentable =
+        List.filter (fun s -> prefix &&
+                              String.contains bad_initial_char s.[0]) containing in
+      match unrepresentable with
+      | _ :: _ ->
+          cctxt#error
+            "@[<v 0>The following words don't respect the first character restriction: %a.@,\
+             Valid characters: %a@,\
+             Extra restriction for the first character: %s@]"
+            (Format.pp_print_list
+               ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ")
+               (fun ppf s -> Format.fprintf ppf "'%s'" s))
+            unrepresentable
+            Base58.Alphabet.pp Base58.Alphabet.bitcoin
+            good_initial_char
+      | [] ->
+          Public_key_hash.mem cctxt name >>=? fun name_exists ->
+          if name_exists && not force
+          then
+            cctxt#warning
+              "Key for name '%s' already exists. Use --force to update." name >>= return
+          else
+            begin
+              cctxt#warning "This process uses a brute force search and \
+                             may take a long time to find a key." >>= fun () ->
+              let matches =
+                if prefix then
+                  let containing_tz1 = List.map ((^) "tz1") containing in
+                  (fun key -> List.exists
+                      (fun containing ->
+                         String.sub key 0 (String.length containing) = containing)
+                      containing_tz1)
+                else
+                  let re = Re.Str.regexp (String.concat "\\|" containing) in
+                  (fun key -> try ignore (Re.Str.search_forward re key 0); true
+                    with Not_found -> false) in
+              let rec loop attempts =
+                let public_key_hash, public_key, secret_key =
+                  Signature.generate_key () in
+                let hash = Signature.Public_key_hash.to_b58check @@
+                  Signature.Public_key.hash public_key in
+                if matches hash
+                then
+                  let pk_uri = Tezos_signer_backends.Unencrypted.make_pk public_key in
+                  begin
+                    if encrypted then
+                      Tezos_signer_backends.Encrypted.encrypt cctxt secret_key
+                    else
+                      return (Tezos_signer_backends.Unencrypted.make_sk secret_key)
+                  end >>=? fun sk_uri ->
+                  register_key cctxt ~force
+                    (public_key_hash, pk_uri, sk_uri) name >>=? fun () ->
+                  return hash
+                else begin if attempts mod 25_000 = 0
+                  then
+                    cctxt#message "Tried %d keys without finding a match" attempts
+                  else Lwt.return_unit end >>= fun () ->
+                  loop (attempts + 1) in
+              loop 1 >>=? fun key_hash ->
+              cctxt#message
+                "Generated '%s' under the name '%s'." key_hash name >>= fun () ->
+              return_unit
+            end
+
+let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) =
+  let rec get_boolean_answer (cctxt : #Client_context.io_wallet) ~default ~msg =
+    let prompt = if default then "(Y/n/q)" else "(y/N/q)" in
+    cctxt#prompt "%s %s: " msg prompt >>=? fun gen ->
+    match default, String.lowercase_ascii gen with
+    | default, "" -> return default
+    | _, "y" -> return_true
+    | _, "n" -> return_false
+    | _, "q" -> failwith "Exit by user request."
+    | _ -> get_boolean_answer cctxt ~msg ~default in
+  cctxt#prompt "Enter the e-mail used for the paper wallet: " >>=? fun email ->
+  let rec loop_words acc i =
+    if i > 14 then return (List.rev acc) else
+      cctxt#prompt_password "Enter word %d: " i >>=? fun word ->
+      match Bip39.index_of_word (MBytes.to_string word) with
+      | None -> loop_words acc i
+      | Some wordidx -> loop_words (wordidx :: acc) (succ i) in
+  loop_words [] 0 >>=? fun words ->
+  match Bip39.of_indices words with
+  | None -> assert false
+  | Some t ->
+      cctxt#prompt_password
+        "Enter the password used for the paper wallet: " >>=? fun password ->
+      (* TODO: unicode normalization (NFKD)... *)
+      let passphrase = MBytes.(concat "" [of_string email ; password]) in
+      let sk = Bip39.to_seed ~passphrase t in
+      let sk = MBytes.sub sk 0 32 in
+      let sk : Signature.Secret_key.t =
+        Ed25519
+          (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in
+      let pk = Signature.Secret_key.to_public_key sk in
+      let pkh = Signature.Public_key.hash pk in
+      let msg = Format.asprintf
+          "Your public Tezos address is %a is that correct?"
+          Signature.Public_key_hash.pp pkh in
+      get_boolean_answer cctxt ~msg ~default:true >>=? function
+      | true -> return sk
+      | false -> input_fundraiser_params cctxt
+
+let commands version : Client_context.io_wallet Clic.command list =
+  let open Clic in
+  let encrypted_switch () =
+    if List.exists
+        (fun (scheme, _) ->
+           scheme = Tezos_signer_backends.Unencrypted.scheme)
+        (Client_keys.registered_signers ()) then
+      Clic.switch
+        ~long:"encrypted"
+        ~doc:("Encrypt the key on-disk") ()
+    else
+      Clic.constant true in
+  let show_private_switch =
+    switch
+      ~long:"show-secret"
+      ~short:'S'
+      ~doc:"show the private key" () in
+  [
+    command ~group
+      ~desc: "List supported signing schemes.\n\
+              Signing schemes are identifiers for signer modules: the \
+              built-in signing routines, a hardware wallet, an \
+              external agent, etc.\n\
+              Each signer has its own format for describing secret \
+              keys, such a raw secret key for the default \
+              `unencrypted` scheme, the path on a hardware security \
+              module, an alias for an external agent, etc.\n\
+              This command gives the list of signer modules that this \
+              version of the tezos client supports."
+      no_options
+      (fixed [ "list" ; "signing" ; "schemes" ])
+      (fun () (cctxt : Client_context.io_wallet) ->
+         let signers =
+           List.sort
+             (fun (ka, _) (kb, _) -> String.compare ka kb)
+             (registered_signers ()) in
+         Lwt_list.iter_s
+           (fun (n, (module S : SIGNER))  ->
+              cctxt#message "@[<v 2>Scheme `%s`: %s@,@[<hov 0>%a@]@]"
+                n S.title Format.pp_print_text S.description)
+           signers >>= return) ;
+
+    begin match version with
+      | Some `Mainnet ->
+          command ~group ~desc: "Generate a pair of keys."
+            (args2 (Secret_key.force_switch ()) sig_algo_arg)
+            (prefixes [ "gen" ; "keys" ]
+             @@ Secret_key.fresh_alias_param
+             @@ stop)
+            (fun (force, algo) name (cctxt : Client_context.io_wallet) ->
+               Secret_key.of_fresh cctxt force name >>=? fun name ->
+               let (pkh, pk, sk) = Signature.generate_key ~algo () in
+               let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
+               Tezos_signer_backends.Encrypted.encrypt cctxt sk >>=? fun sk_uri ->
+               register_key cctxt ~force (pkh, pk_uri, sk_uri) name)
+      | _ ->
+          command ~group ~desc: "Generate a pair of keys."
+            (args3 (Secret_key.force_switch ()) sig_algo_arg (encrypted_switch ()))
+            (prefixes [ "gen" ; "keys" ]
+             @@ Secret_key.fresh_alias_param
+             @@ stop)
+            (fun (force, algo, encrypted) name (cctxt : Client_context.io_wallet) ->
+               Secret_key.of_fresh cctxt force name >>=? fun name ->
+               let (pkh, pk, sk) = Signature.generate_key ~algo () in
+               let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
+               begin
+                 if encrypted then
+                   Tezos_signer_backends.Encrypted.encrypt cctxt sk
+                 else
+                   return (Tezos_signer_backends.Unencrypted.make_sk sk)
+               end >>=? fun sk_uri ->
+               register_key cctxt ~force (pkh, pk_uri, sk_uri) name)
+    end ;
+
+    begin match version with
+      | Some `Mainnet ->
+          command ~group ~desc: "Generate keys including the given string."
+            (args2
+               (switch
+                  ~long:"prefix"
+                  ~short:'P'
+                  ~doc:"the key must begin with tz1[word]"
+                  ())
+               (force_switch ()))
+            (prefixes [ "gen" ; "vanity" ; "keys" ]
+             @@ Public_key_hash.fresh_alias_param
+             @@ prefix "matching"
+             @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
+            (fun (prefix, force) name containing (cctxt : Client_context.io_wallet) ->
+               Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+               gen_keys_containing ~encrypted:true ~force ~prefix ~containing ~name cctxt)
+      | _ ->
+          command ~group ~desc: "Generate keys including the given string."
+            (args3
+               (switch
+                  ~long:"prefix"
+                  ~short:'P'
+                  ~doc:"the key must begin with tz1[word]"
+                  ())
+               (force_switch ())
+               (encrypted_switch ()))
+            (prefixes [ "gen" ; "vanity" ; "keys" ]
+             @@ Public_key_hash.fresh_alias_param
+             @@ prefix "matching"
+             @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
+            (fun (prefix, force, encrypted) name containing (cctxt : Client_context.io_wallet) ->
+               Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+               gen_keys_containing ~encrypted ~force ~prefix ~containing ~name cctxt)
+    end ;
+
+    command ~group ~desc: "Encrypt an unencrypted secret key."
+      no_options
+      (prefixes [ "encrypt" ; "secret" ; "key" ]
+       @@ stop)
+      (fun () (cctxt : Client_context.io_wallet) ->
+         cctxt#prompt_password "Enter unencrypted secret key: " >>=? fun sk_uri ->
+         let sk_uri = Uri.of_string (MBytes.to_string sk_uri) in
+         begin match Uri.scheme sk_uri with
+           | None | Some "unencrypted" -> return_unit
+           | _ -> failwith "This command can only be used with the \"unencrypted\" scheme"
+         end >>=? fun () ->
+         Lwt.return (Signature.Secret_key.of_b58check (Uri.path sk_uri)) >>=? fun sk ->
+         Tezos_signer_backends.Encrypted.encrypt cctxt sk >>=? fun sk_uri ->
+         cctxt#message "Encrypted secret key %a" Uri.pp_hum (sk_uri :> Uri.t) >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Add a secret key to the wallet."
+      (args1 (Secret_key.force_switch ()))
+      (prefix "import"
+       @@ prefixes [ "secret" ; "key" ]
+       @@ Secret_key.fresh_alias_param
+       @@ Client_keys.sk_uri_param
+       @@ stop)
+      (fun force name sk_uri (cctxt : Client_context.io_wallet) ->
+         Secret_key.of_fresh cctxt force name >>=? fun name ->
+         Client_keys.neuterize sk_uri >>=? fun pk_uri ->
+         begin
+           Public_key.find_opt cctxt name >>=? function
+           | None -> return_unit
+           | Some (pk_uri_found, _) ->
+               fail_unless (pk_uri = pk_uri_found || force)
+                 (failure
+                    "public and secret keys '%s' don't correspond, \
+                     please don't use --force" name)
+         end >>=? fun () ->
+         Client_keys.public_key_hash ~interactive:cctxt pk_uri
+         >>=? fun (pkh, public_key) ->
+         cctxt#message
+           "Tezos address added: %a"
+           Signature.Public_key_hash.pp pkh >>= fun () ->
+         register_key cctxt ~force (pkh, pk_uri, sk_uri) ?public_key name) ;
+  ] @
+  (if version <> (Some `Mainnet) then [] else [
+      command ~group ~desc: "Add a fundraiser secret key to the wallet."
+        (args1 (Secret_key.force_switch ()))
+        (prefix "import"
+         @@ prefixes [ "fundraiser" ; "secret" ; "key" ]
+         @@ Secret_key.fresh_alias_param
+         @@ stop)
+        (fun force name (cctxt : Client_context.io_wallet) ->
+           Secret_key.of_fresh cctxt force name >>=? fun name ->
+           input_fundraiser_params cctxt >>=? fun sk ->
+           Tezos_signer_backends.Encrypted.encrypt cctxt sk >>=? fun sk_uri ->
+           Client_keys.neuterize sk_uri >>=? fun pk_uri ->
+           begin
+             Public_key.find_opt cctxt name >>=? function
+             | None -> return_unit
+             | Some (pk_uri_found, _) ->
+                 fail_unless (pk_uri = pk_uri_found || force)
+                   (failure
+                      "public and secret keys '%s' don't correspond, \
+                       please don't use --force" name)
+           end >>=? fun () ->
+           Client_keys.public_key_hash pk_uri >>=? fun (pkh, _public_key) ->
+           register_key cctxt ~force (pkh, pk_uri, sk_uri) name) ;
+    ]) @
+  [
+    command ~group ~desc: "Add a public key to the wallet."
+      (args1 (Public_key.force_switch ()))
+      (prefix "import"
+       @@ prefixes [ "public" ; "key" ]
+       @@ Public_key.fresh_alias_param
+       @@ Client_keys.pk_uri_param
+       @@ stop)
+      (fun force name pk_uri (cctxt : Client_context.io_wallet) ->
+         Public_key.of_fresh cctxt force name >>=? fun name ->
+         Client_keys.public_key_hash pk_uri >>=? fun (pkh, public_key) ->
+         Public_key_hash.add ~force cctxt name pkh >>=? fun () ->
+         cctxt#message
+           "Tezos address added: %a"
+           Signature.Public_key_hash.pp pkh >>= fun () ->
+         Public_key.add ~force cctxt name (pk_uri, public_key)) ;
+
+    command ~group ~desc: "Add an address to the wallet."
+      (args1 (Public_key.force_switch ()))
+      (prefixes [ "add" ; "address" ]
+       @@ Public_key_hash.fresh_alias_param
+       @@ Public_key_hash.source_param
+       @@ stop)
+      (fun force name hash cctxt ->
+         Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+         Public_key_hash.add ~force cctxt name hash) ;
+
+    command ~group ~desc: "List all addresses and associated keys."
+      no_options
+      (fixed [ "list" ; "known" ; "addresses" ])
+      (fun () (cctxt : #Client_context.io_wallet) ->
+         list_keys cctxt >>=? fun l ->
+         iter_s begin fun (name, pkh, pk, sk) ->
+           Public_key_hash.to_source pkh >>=? fun v ->
+           begin match pk, sk with
+             | None, None ->
+                 cctxt#message "%s: %s" name v
+             | _, Some uri ->
+                 let scheme =
+                   Option.unopt ~default:"unencrypted" @@
+                   Uri.scheme (uri : sk_uri :> Uri.t) in
+                 cctxt#message "%s: %s (%s sk known)" name v scheme
+             | Some _, _ ->
+                 cctxt#message "%s: %s (pk known)" name v
+           end >>= fun () -> return_unit
+         end l) ;
+
+    command ~group ~desc: "Show the keys associated with an implicit account."
+      (args1 show_private_switch)
+      (prefixes [ "show" ; "address"]
+       @@ Public_key_hash.alias_param
+       @@ stop)
+      (fun show_private (name, _) (cctxt : #Client_context.io_wallet) ->
+         alias_keys cctxt name >>=? fun key_info ->
+         match key_info with
+         | None ->
+             cctxt#message "No keys found for address" >>= fun () ->
+             return_unit
+         | Some (pkh, pk, skloc) ->
+             cctxt#message "Hash: %a"
+               Signature.Public_key_hash.pp pkh >>= fun () ->
+             match pk with
+             | None -> return_unit
+             | Some pk ->
+                 cctxt#message "Public Key: %a"
+                   Signature.Public_key.pp pk >>= fun () ->
+                 if show_private then
+                   match skloc with
+                   | None -> return_unit
+                   | Some skloc ->
+                       Secret_key.to_source skloc >>=? fun skloc ->
+                       cctxt#message "Secret Key: %s" skloc >>= fun () ->
+                       return_unit
+                 else
+                   return_unit) ;
+
+    command ~group ~desc: "Forget one address."
+      (args1 (Clic.switch
+                ~long:"force" ~short:'f'
+                ~doc:"delete associated keys when present" ()))
+      (prefixes [ "forget" ; "address"]
+       @@ Public_key_hash.alias_param
+       @@ stop)
+      (fun force (name, _pkh) (cctxt : Client_context.io_wallet) ->
+         Secret_key.mem cctxt name >>=? fun has_secret_key ->
+         Public_key.mem cctxt name >>=? fun has_public_key ->
+         fail_when (not force && (has_secret_key || has_public_key))
+           (failure "secret or public key present for %s, \
+                     use --force to delete" name) >>=? fun () ->
+         Secret_key.del cctxt name >>=? fun () ->
+         Public_key.del cctxt name >>=? fun () ->
+         Public_key_hash.del cctxt name) ;
+
+    command ~group ~desc: "Forget the entire wallet of keys."
+      (args1 (Clic.switch
+                ~long:"force" ~short:'f'
+                ~doc:"you got to use the force for that" ()))
+      (fixed [ "forget" ; "all" ; "keys" ])
+      (fun force (cctxt : Client_context.io_wallet) ->
+         fail_unless force
+           (failure "this can only be used with option --force") >>=? fun () ->
+         Public_key.set cctxt [] >>=? fun () ->
+         Secret_key.set cctxt [] >>=? fun () ->
+         Public_key_hash.set cctxt []) ;
+
+    command ~group ~desc: "Compute deterministic nonce."
+      no_options
+      (prefixes [ "generate" ; "nonce"; "for" ]
+       @@ Public_key_hash.alias_param
+       @@ prefixes [ "from" ]
+       @@ string
+         ~name: "data"
+         ~desc: "string from which to deterministically generate the nonce"
+       @@ stop)
+      (fun () (name, _pkh) data (cctxt : Client_context.io_wallet) ->
+         let data = MBytes.of_string data in
+         Secret_key.mem cctxt name >>=? fun sk_present ->
+         fail_unless sk_present
+           (failure "secret key not present for %s" name) >>=? fun () ->
+         Secret_key.find cctxt name >>=? fun sk_uri ->
+         Client_keys.deterministic_nonce sk_uri data >>=? fun nonce ->
+         cctxt#message "%a" MBytes.pp_hex nonce >>= fun () -> return_unit) ;
+
+    command ~group ~desc: "Compute deterministic nonce hash."
+      no_options
+      (prefixes [ "generate" ; "nonce"; "hash"; "for" ]
+       @@ Public_key_hash.alias_param
+       @@ prefixes [ "from" ]
+       @@ string
+         ~name: "data"
+         ~desc: "string from which to deterministically generate the nonce hash"
+       @@ stop)
+      (fun () (name, _pkh) data (cctxt : Client_context.io_wallet) ->
+         let data = MBytes.of_string data in
+         Secret_key.mem cctxt name >>=? fun sk_present ->
+         fail_unless sk_present
+           (failure "secret key not present for %s" name) >>=? fun () ->
+         Secret_key.find cctxt name >>=? fun sk_uri ->
+         Client_keys.deterministic_nonce_hash sk_uri data >>=? fun nonce_hash ->
+         cctxt#message "%a" MBytes.pp_hex nonce_hash >>= fun () -> return_unit) ;
+
+  ]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.mli
new file mode 100644
index 000000000..081070c65
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_keys_commands.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands:
+  [`Zeronet | `Alphanet | `Mainnet | `Sandbox] option ->
+  Client_context.io_wallet Clic.command list
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.ml
new file mode 100644
index 000000000..9ab4b996a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.ml
@@ -0,0 +1,255 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 = "p2p" ;
+    title = "Commands for monitoring and controlling p2p-layer state" }
+
+let pp_connection_info ppf conn = P2p_connection.Info.pp (fun _ _ -> ()) ppf conn
+
+let addr_parameter =
+  let open Clic in
+  param ~name:"address"
+    ~desc:"<IPv4>:PORT or <IPV6>:PORT address (PORT defaults to 9732)."
+    (parameter (fun _ x -> return (P2p_point.Id.of_string_exn x)))
+
+let commands () =
+  let open Clic in
+  [
+    command ~group ~desc: "show global network status"
+      no_options
+      (prefixes ["p2p" ; "stat"] stop) begin fun () (cctxt : #Client_context.full) ->
+      Shell_services.P2p.stat cctxt >>=? fun stat ->
+      Shell_services.P2p.Connections.list cctxt >>=? fun conns ->
+      Shell_services.P2p.Peers.list cctxt >>=? fun peers ->
+      Shell_services.P2p.Points.list cctxt >>=? fun points ->
+      cctxt#message "GLOBAL STATS" >>= fun () ->
+      cctxt#message "  %a" P2p_stat.pp stat >>= fun () ->
+      cctxt#message "CONNECTIONS" >>= fun () ->
+      let incoming, outgoing =
+        List.partition (fun c -> c.P2p_connection.Info.incoming) conns in
+      Lwt_list.iter_s begin fun conn ->
+        cctxt#message "  %a" pp_connection_info conn
+      end incoming >>= fun () ->
+      Lwt_list.iter_s begin fun conn ->
+        cctxt#message "  %a" pp_connection_info conn
+      end outgoing >>= fun () ->
+      cctxt#message "KNOWN PEERS" >>= fun () ->
+      Lwt_list.iter_s begin fun (p, pi) ->
+        cctxt#message "  %a  %.0f %a %a %s"
+          P2p_peer.State.pp_digram pi.P2p_peer.Info.state
+          pi.score
+          P2p_peer.Id.pp p
+          P2p_stat.pp pi.stat
+          (if pi.trusted then "★" else " ")
+      end peers >>= fun () ->
+      cctxt#message "KNOWN POINTS" >>= fun () ->
+      Lwt_list.iter_s begin fun (p, pi) ->
+        match pi.P2p_point.Info.state with
+        | Running peer_id ->
+            cctxt#message "  %a  %a %a %s"
+              P2p_point.State.pp_digram pi.state
+              P2p_point.Id.pp p
+              P2p_peer.Id.pp peer_id
+              (if pi.trusted then "★" else " ")
+        | _ ->
+            match pi.last_seen with
+            | Some (peer_id, ts) ->
+                cctxt#message "  %a  %a (last seen: %a %a) %s"
+                  P2p_point.State.pp_digram pi.state
+                  P2p_point.Id.pp p
+                  P2p_peer.Id.pp peer_id
+                  Time.pp_hum ts
+                  (if pi.trusted then "★" else " ")
+            | None ->
+                cctxt#message "  %a  %a %s"
+                  P2p_point.State.pp_digram pi.state
+                  P2p_point.Id.pp p
+                  (if pi.trusted then "★" else " ")
+      end points >>= fun () ->
+      return_unit
+    end ;
+
+    command ~group ~desc: "Connect to a new point."
+      no_options
+      (prefixes [ "connect" ; "address" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, port) (cctxt : #Client_context.full) ->
+         P2p_services.connect cctxt ~timeout:10. (address, port) >>=? fun () ->
+         cctxt#message "Connection to %a:%d established." P2p_addr.pp address port >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Kick a peer."
+      no_options
+      (prefixes [ "kick" ; "peer" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Connections.kick cctxt peer >>=? fun () ->
+         cctxt#message "Connection to %a interrupted." P2p_peer.Id.pp peer >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Add an IP address and all its ports to the \
+                           blacklist and kicks it. Remove the address \
+                           from the whitelist if it was previously in \
+                           it."
+      no_options
+      (prefixes [ "ban" ; "address" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, _port) (cctxt : #Client_context.full) ->
+         P2p_services.Points.ban cctxt (address, 0) >>=? fun () ->
+         cctxt#message "Address %a:* is now banned." P2p_addr.pp address >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Remove an IP address and all its ports \
+                           from the blacklist."
+      no_options
+      (prefixes [ "unban" ; "address" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, _port) (cctxt : #Client_context.full) ->
+         P2p_services.Points.unban cctxt (address, 0) >>=? fun () ->
+         cctxt#message "Address %a:* is now unbanned." P2p_addr.pp address >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Add an IP address to the whitelist. Remove \
+                           the address from the blacklist if it was \
+                           previously in it."
+      no_options
+      (prefixes [ "trust" ; "address" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, port) (cctxt : #Client_context.full) ->
+         P2p_services.Points.trust cctxt (address, port) >>=? fun () ->
+         cctxt#message "Address %a:%d is now trusted."
+           P2p_addr.pp address port >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Removes an IP address from the whitelist."
+      no_options
+      (prefixes [ "untrust" ; "address" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, port) (cctxt : #Client_context.full) ->
+         P2p_services.Points.untrust cctxt (address, port) >>=? fun () ->
+         cctxt#message "Address %a:%d is now untrusted."
+           P2p_addr.pp address port >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Check if an IP address is banned."
+      no_options
+      (prefixes [ "is" ; "address" ; "banned" ]
+       @@ addr_parameter
+       @@ stop)
+      (fun () (address, port) (cctxt : #Client_context.full) ->
+         P2p_services.Points.banned cctxt (address, port) >>=? fun banned ->
+         cctxt#message
+           "The given ip address is %s"
+           (if banned then "banned" else "not banned") >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Check if a peer ID is banned."
+      no_options
+      (prefixes [ "is" ; "peer" ; "banned" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Peers.banned cctxt peer >>=? fun banned ->
+         cctxt#message
+           "The given peer ID is %s"
+           (if banned then "banned" else "not banned") >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Add a peer ID to the blacklist and kicks \
+                           it. Remove the peer ID from the blacklist \
+                           if was previously in it."
+      no_options
+      (prefixes [ "ban" ; "peer" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Peers.ban cctxt peer >>=? fun () ->
+         cctxt#message "The peer %a is now banned."
+           P2p_peer.Id.pp_short peer >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Removes a peer ID from the blacklist."
+      no_options
+      (prefixes [ "unban" ; "peer" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Peers.unban cctxt peer >>=? fun () ->
+         cctxt#message "The peer %a is now unbanned."
+           P2p_peer.Id.pp_short peer >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Add a peer ID to the whitelist. Remove the \
+                           peer ID from the blacklist if it was \
+                           previously in it."
+      no_options
+      (prefixes [ "trust" ; "peer" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Peers.trust cctxt peer >>=? fun () ->
+         cctxt#message "The peer %a is now trusted."
+           P2p_peer.Id.pp_short peer >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Remove a peer ID from the whitelist."
+      no_options
+      (prefixes [ "untrust" ; "peer" ]
+       @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
+       @@ stop)
+      (fun () peer (cctxt : #Client_context.full) ->
+         P2p_services.Peers.untrust cctxt peer >>=? fun () ->
+         cctxt#message "The peer %a is now untrusted."
+           P2p_peer.Id.pp_short peer >>= fun () ->
+         return_unit
+      ) ;
+
+    command ~group ~desc: "Clear all access control rules."
+      no_options
+      (prefixes [ "clear" ; "acls" ] @@ stop)
+      (fun () (cctxt : #Client_context.full) ->
+         P2p_services.ACL.clear cctxt () >>=? fun () ->
+         cctxt#message "The access control rules are now cleared." >>= fun () ->
+         return_unit
+      ) ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.mli
new file mode 100644
index 000000000..d50cc7538
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_p2p_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands: unit -> Client_commands.command list
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_report_commands.ml b/vendors/tezos-modded/src/lib_client_commands/client_report_commands.ml
new file mode 100644
index 000000000..3c2afed43
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_report_commands.ml
@@ -0,0 +1,82 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Commands used to introspect the node's state *)
+
+let skip_line ppf =
+  Format.pp_print_newline ppf ();
+  return @@ Format.pp_print_newline ppf ()
+
+let print_invalid_blocks ppf (b: Shell_services.Chain.invalid_block) =
+  Format.fprintf ppf
+    "@[<v 2>Hash: %a\
+     @ Level: %ld\
+     @ %a@]"
+    Block_hash.pp b.hash
+    b.level
+    pp_print_error b.errors
+
+let commands () =
+  let open Clic in
+  let group = { name = "report" ;
+                title = "Commands to report the node's status" } in
+  let output_arg =
+    default_arg
+      ~doc:"write to a file"
+      ~long:"output"
+      ~short:'o'
+      ~placeholder:"path"
+      ~default: "-"
+      (parameter (fun _ -> function
+           | "-" -> return Format.std_formatter
+           | file ->
+               let ppf = Format.formatter_of_out_channel (open_out file) in
+               ignore Clic.(setup_formatter ppf Plain Full) ;
+               return ppf)) in
+  [
+    command ~group
+      ~desc: "The last heads that have been considered by the node."
+      (args1 output_arg)
+      (fixed [ "list" ; "heads" ])
+      (fun ppf cctxt ->
+         Shell_services.Blocks.list cctxt () >>=? fun heads ->
+         Format.fprintf ppf "@[<v>%a@]@."
+           (Format.pp_print_list Block_hash.pp)
+           (List.concat heads) ;
+         return_unit) ;
+    command ~group ~desc: "The blocks that have been marked invalid by the node."
+      (args1 output_arg)
+      (fixed [ "list" ; "rejected" ; "blocks" ])
+      (fun ppf cctxt ->
+         Shell_services.Invalid_blocks.list cctxt () >>=? function
+         | [] ->
+             Format.fprintf ppf "No invalid blocks." ;
+             return_unit
+         | _ :: _ as invalid ->
+             Format.fprintf ppf "@[<v>%a@]@."
+               (Format.pp_print_list print_invalid_blocks)
+               invalid ;
+             return_unit) ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_client_commands/client_report_commands.mli b/vendors/tezos-modded/src/lib_client_commands/client_report_commands.mli
new file mode 100644
index 000000000..7ad69a9f2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/client_report_commands.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands : unit -> #Client_context.full Clic.command list
diff --git a/vendors/tezos-modded/src/lib_client_commands/dune b/vendors/tezos-modded/src/lib_client_commands/dune
new file mode 100644
index 000000000..db6541a18
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/dune
@@ -0,0 +1,20 @@
+(library
+ (name tezos_client_commands)
+ (public_name tezos-client-commands)
+ (libraries tezos-base
+            tezos-client-base
+            tezos-rpc
+            tezos-shell-services
+            tezos-signer-backends)
+ (library_flags (:standard -linkall))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc
+                   -open Tezos_client_base
+                   -open Tezos_shell_services)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_client_commands/tezos-client-commands.opam b/vendors/tezos-modded/src/lib_client_commands/tezos-client-commands.opam
new file mode 100644
index 000000000..55df05989
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_client_commands/tezos-client-commands.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-base"
+  "tezos-rpc"
+  "tezos-shell-services"
+  "tezos-signer-backends"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_crypto/base58.ml b/vendors/tezos-modded/src/lib_crypto/base58.ml
new file mode 100644
index 000000000..a9087c02d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/base58.ml
@@ -0,0 +1,360 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+let base = 58
+let zbase = Z.of_int base
+
+module Alphabet = struct
+
+  type t = { encode: string ; decode: string }
+
+  let make alphabet =
+    if String.length alphabet <> base then
+      invalid_arg "Base58: invalid alphabet (length)" ;
+    let str = Bytes.make 256 '\255' in
+    for i = 0 to String.length alphabet - 1 do
+      let char = int_of_char alphabet.[i] in
+      if Bytes.get str char <> '\255' then
+        Format.kasprintf invalid_arg
+          "Base58: invalid alphabet (dup '%c' %d %d)"
+          (char_of_int char) (int_of_char @@ Bytes.get str char) i ;
+      Bytes.set str char (char_of_int i) ;
+    done ;
+    { encode = alphabet ; decode = Bytes.to_string str }
+
+  let bitcoin =
+    make "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
+  let ripple =
+    make "rpshnaf39wBUDNEGHJKLM4PQRST7VWXYZ2bcdeCg65jkm8oFqi1tuvAxyz"
+  let flickr =
+    make "123456789abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ"
+
+  let default = bitcoin
+
+  let all_in_alphabet alphabet string =
+    let ok = Array.make 256 false in
+    String.iter (fun x -> ok.(Char.code x) <- true) alphabet.encode ;
+    let res = ref true in
+    for i = 0 to (String.length string) - 1 do
+      res := !res && ok.(Char.code string.[i])
+    done;
+    !res
+
+  let pp ppf { encode ; _ } = Format.fprintf ppf "%s" encode
+
+end
+
+let count_trailing_char s c =
+  let len = String.length s in
+  let rec loop i =
+    if i < 0 then len
+    else if String.get s i <> c then (len-i-1)
+    else loop (i-1) in
+  loop (len-1)
+
+let count_leading_char s c =
+  let len = String.length s in
+  let rec loop i =
+    if i = len then len
+    else if String.get s i <> c then i
+    else loop (i+1) in
+  loop 0
+
+let of_char ?(alphabet=Alphabet.default) x =
+  let pos = String.get alphabet.decode (int_of_char x) in
+  match pos with
+  | '\255' -> None
+  | _ -> Some (int_of_char pos)
+
+let to_char ?(alphabet=Alphabet.default) x =
+  alphabet.encode.[x]
+
+let raw_encode ?(alphabet=Alphabet.default) s =
+  let len = String.length s in
+  let s = String.init len (fun i -> String.get s (len - i - 1)) in
+  let zero = alphabet.encode.[0] in
+  let zeros = count_trailing_char s '\000' in
+  let res_len = (len * 8 + 4) / 5 in
+  let res = Bytes.make res_len '\000' in
+  let s = Z.of_bits s in
+  let rec loop s =
+    if s = Z.zero then 0 else
+      let s, r = Z.div_rem s zbase in
+      let i = loop s in
+      Bytes.set res i (to_char ~alphabet (Z.to_int r)) ;
+      i + 1 in
+  let i = loop s in
+  let res = Bytes.sub_string res 0 i in
+  String.make zeros zero ^ res
+
+let raw_decode ?(alphabet=Alphabet.default) s =
+  TzString.fold_left begin fun a c ->
+    match a, of_char ~alphabet c with
+    | Some a, Some i -> Some Z.(add (of_int i) (mul a zbase))
+    | _ -> None
+  end (Some Z.zero) s |>
+  Option.map ~f:begin fun res ->
+    let res = Z.to_bits res in
+    let res_tzeros = count_trailing_char res '\000' in
+    let len = String.length res - res_tzeros in
+    let zeros = count_leading_char s alphabet.encode.[0] in
+    String.make zeros '\000' ^
+    String.init len (fun i -> String.get res (len - i - 1))
+  end
+
+let checksum s =
+  let hash =
+    Hacl.Hash.SHA256.(digest (digest (Bigstring.of_string s))) in
+  let res = Bytes.make 4 '\000' in
+  Bigstring.blit_to_bytes hash 0 res 0 4 ;
+  Bytes.to_string res
+
+(* Append a 4-bytes cryptographic checksum before encoding string s *)
+let safe_encode ?alphabet s =
+  raw_encode ?alphabet (s ^ checksum s)
+
+let safe_decode ?alphabet s =
+  raw_decode ?alphabet s |> Option.apply ~f:begin fun s ->
+    let len = String.length s in
+    if len < 4 then None else
+      (* only if the string is long enough to extract a checksum do we check it *)
+      let msg = String.sub s 0 (len-4) in
+      let msg_hash = String.sub s (len-4) 4 in
+      if msg_hash <> checksum msg then None
+      else Some msg
+  end
+
+type data = ..
+
+type 'a encoding = {
+  prefix: string ;
+  length: int ;
+  encoded_prefix: string ;
+  encoded_length: int ;
+  to_raw: 'a -> string ;
+  of_raw: string -> 'a option ;
+  wrap: 'a -> data ;
+}
+
+let prefix { prefix ; _ } = prefix
+
+let simple_decode ?alphabet { prefix ; of_raw ; _ } s =
+  safe_decode ?alphabet s |>
+  Option.apply ~f:(TzString.remove_prefix ~prefix) |>
+  Option.apply ~f:of_raw
+
+let simple_encode ?alphabet { prefix ; to_raw ; _ } d =
+  safe_encode ?alphabet (prefix ^ to_raw d)
+
+type registered_encoding = Encoding : 'a encoding -> registered_encoding
+
+module MakeEncodings(E: sig
+    val encodings: registered_encoding list
+  end) = struct
+
+  let encodings = ref E.encodings
+
+  let check_ambiguous_prefix prefix length encodings =
+    List.iter
+      (fun (Encoding { encoded_prefix = s ; length = l ; _ }) ->
+         if length = l && (TzString.remove_prefix ~prefix:s prefix <> None ||
+                           TzString.remove_prefix ~prefix s <> None) then
+           Format.ksprintf invalid_arg
+             "Base58.register_encoding: duplicate prefix: %S, %S." s prefix)
+      encodings
+
+  let make_encoded_prefix prefix len =
+    let zeros = safe_encode (prefix ^ String.make len '\000')
+    and ones = safe_encode (prefix ^ String.make len '\255') in
+    let len = String.length zeros in
+    if String.length ones <> len then
+      Format.ksprintf invalid_arg
+        "Base58.registered_encoding: variable length encoding." ;
+    let rec loop i =
+      if i = len then len
+      else if zeros.[i] = ones.[i] then loop (i+1)
+      else i in
+    let len = loop 0 in
+    if len = 0 then
+      invalid_arg
+        "Base58.register_encoding: not a unique prefix." ;
+    String.sub zeros 0 len, String.length zeros
+
+  let register_encoding ~prefix ~length ~to_raw ~of_raw ~wrap =
+    let to_raw x =
+      let s = to_raw x in assert (String.length s = length) ; s in
+    let of_raw s = assert (String.length s = length) ; of_raw s in
+    let encoded_prefix, encoded_length = make_encoded_prefix prefix length in
+    check_ambiguous_prefix encoded_prefix encoded_length !encodings ;
+    let encoding =
+      { prefix ; length ; encoded_prefix ; encoded_length ;
+        to_raw ; of_raw ; wrap } in
+    encodings := Encoding encoding :: !encodings ;
+    encoding
+
+  let check_encoded_prefix enc p l =
+    if enc.encoded_prefix <> p then
+      Format.kasprintf Pervasives.failwith
+        "Unexpected prefix %s (expected %s)"
+        p enc.encoded_prefix ;
+    if enc.encoded_length <> l then
+      Format.kasprintf Pervasives.failwith
+        "Unexpected encoded length %d for %s (expected %d)"
+        l p enc.encoded_length
+
+  let decode ?alphabet s =
+    let rec find s = function
+      | [] -> None
+      | Encoding { prefix ; of_raw ; wrap ; _ } :: encodings ->
+          match TzString.remove_prefix ~prefix s with
+          | None -> find s encodings
+          | Some msg -> of_raw msg |> Option.map ~f:wrap in
+    safe_decode ?alphabet s |>
+    Option.apply ~f:(fun s -> find s !encodings)
+
+end
+
+type 'a resolver =
+    Resolver : {
+      encoding: 'h encoding ;
+      resolver: 'a -> string -> 'h list Lwt.t ;
+    } -> 'a resolver
+
+module MakeResolvers(R: sig
+    type context
+  end) = struct
+
+  let resolvers = ref []
+
+  let register_resolver
+      (type a)
+      (encoding : a encoding)
+      (resolver : R.context -> string -> a list Lwt.t) =
+    resolvers := Resolver { encoding ; resolver } :: !resolvers
+
+  let partial_decode ?(alphabet=Alphabet.default) request len =
+    let zero = alphabet.encode.[0] in
+    let last = alphabet.encode.[base-1] in
+    let n = String.length request in
+    let min = raw_decode ~alphabet (request ^ String.make (len - n) zero) in
+    let max = raw_decode ~alphabet (request ^ String.make (len - n) last) in
+    match min, max with
+    | Some min, Some max ->
+        let prefix_len = TzString.common_prefix min max in
+        Some (String.sub min 0 prefix_len)
+    | _ -> None
+
+  let complete ?alphabet context request =
+    let rec find s = function
+      | [] -> Lwt.return_nil
+      | Resolver { encoding ; resolver } :: resolvers ->
+          if not (TzString.has_prefix ~prefix:encoding.encoded_prefix s) then
+            find s resolvers
+          else
+            match partial_decode ?alphabet request encoding.encoded_length with
+            | None -> find s resolvers
+            | Some prefix ->
+                let len = String.length prefix in
+                let ignored = String.length encoding.prefix in
+                let msg =
+                  if len <= ignored then ""
+                  else begin
+                    assert (String.sub prefix 0 ignored  = encoding.prefix) ;
+                    String.sub prefix ignored (len - ignored)
+                  end in
+                resolver context msg >|= fun msgs ->
+                TzList.filter_map
+                  (fun msg ->
+                     let res = simple_encode encoding ?alphabet msg in
+                     TzString.remove_prefix ~prefix:request res |>
+                     Option.map ~f:(fun _ -> res))
+                  msgs in
+    find request !resolvers
+
+end
+
+include MakeEncodings(struct let encodings = [] end)
+include MakeResolvers(struct
+    type context = unit
+  end)
+
+let register_resolver enc f = register_resolver enc (fun () s -> f s)
+let complete ?alphabet s = complete ?alphabet () s
+
+module Make(C: sig type context end) = struct
+  include MakeEncodings(struct let encodings = !encodings end)
+  include MakeResolvers(struct
+      type context = C.context
+    end)
+end
+
+module Prefix = struct
+
+  (* 32 *)
+  let block_hash = "\001\052" (* B(51) *)
+  let operation_hash = "\005\116" (* o(51) *)
+  let operation_list_hash = "\133\233" (* Lo(52) *)
+  let operation_list_list_hash = "\029\159\109" (* LLo(53) *)
+  let protocol_hash = "\002\170" (* P(51) *)
+  let context_hash = "\079\199" (* Co(52) *)
+
+  (* 20 *)
+  let ed25519_public_key_hash = "\006\161\159" (* tz1(36) *)
+  let secp256k1_public_key_hash = "\006\161\161" (* tz2(36) *)
+  let p256_public_key_hash = "\006\161\164" (* tz3(36) *)
+
+  (* 16 *)
+  let cryptobox_public_key_hash = "\153\103" (* id(30) *)
+
+  (* 32 *)
+  let ed25519_seed = "\013\015\058\007" (* edsk(54) *)
+  let ed25519_public_key = "\013\015\037\217" (* edpk(54) *)
+  let secp256k1_secret_key = "\017\162\224\201" (* spsk(54) *)
+  let p256_secret_key = "\016\081\238\189" (* p2sk(54) *)
+
+  (* 56 *)
+  let ed25519_encrypted_seed = "\007\090\060\179\041" (* edesk(88) *)
+  let secp256k1_encrypted_secret_key = "\009\237\241\174\150" (* spesk(88) *)
+  let p256_encrypted_secret_key = "\009\048\057\115\171" (* p2esk(88) *)
+
+  (* 33 *)
+  let secp256k1_public_key = "\003\254\226\086" (* sppk(55) *)
+  let p256_public_key = "\003\178\139\127" (* p2pk(55) *)
+  let secp256k1_scalar = "\038\248\136" (* SSp(53) *)
+  let secp256k1_element = "\005\092\000" (* GSp(54) *)
+
+  (* 64 *)
+  let ed25519_secret_key = "\043\246\078\007" (* edsk(98) *)
+  let ed25519_signature = "\009\245\205\134\018" (* edsig(99) *)
+  let secp256k1_signature =  "\013\115\101\019\063" (* spsig1(99) *)
+  let p256_signature =  "\054\240\044\052" (* p2sig(98) *)
+  let generic_signature = "\004\130\043" (* sig(96) *)
+
+  (* 4 *)
+  let chain_id = "\087\082\000" (* Net(15) *)
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/base58.mli b/vendors/tezos-modded/src/lib_crypto/base58.mli
new file mode 100644
index 000000000..37b6db9c3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/base58.mli
@@ -0,0 +1,166 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** {1 Prefixed Base58Check encodings} *)
+
+module Prefix : sig
+
+  val block_hash: string
+  val operation_hash: string
+  val operation_list_hash: string
+  val operation_list_list_hash: string
+  val protocol_hash: string
+  val context_hash: string
+  val ed25519_public_key_hash: string
+  val secp256k1_public_key_hash: string
+  val p256_public_key_hash: string
+  val cryptobox_public_key_hash: string
+  val ed25519_seed: string
+  val ed25519_public_key: string
+  val ed25519_secret_key: string
+  val ed25519_signature: string
+  val secp256k1_public_key: string
+  val secp256k1_secret_key: string
+  val secp256k1_signature: string
+  val p256_public_key: string
+  val p256_secret_key: string
+  val p256_signature: string
+  val ed25519_encrypted_seed: string
+  val secp256k1_encrypted_secret_key: string
+  val p256_encrypted_secret_key: string
+
+  val generic_signature: string
+  val chain_id: string
+  val secp256k1_element: string
+  val secp256k1_scalar: string
+
+end
+
+(** An extensible sum-type for decoded data: one case per known
+    "prefix". See for instance [Hash.Block_hash.Hash] or
+    [Environment.Ed25519.Public_key_hash]. *)
+type data = ..
+
+(** Abstract representation of registered encodings. The type paramater
+    is the type of the encoded data, for instance [Hash.Block_hash.t]. *)
+type 'a encoding = private {
+  prefix: string ;
+  length: int ;
+  encoded_prefix: string ;
+  encoded_length: int ;
+  to_raw: 'a -> string ;
+  of_raw: string -> 'a option ;
+  wrap: 'a -> data ;
+}
+
+(** Register a new encoding. The function might raise `Invalid_arg` if
+    the provided [prefix] overlap with a previously registered
+    prefix. The [to_raw] and [of_raw] are the ad-hoc
+    serialisation/deserialisation for the data. The [wrap] should wrap
+    the deserialised value into the extensible sum-type [data] (see
+    the generic function [decode]). *)
+val register_encoding:
+  prefix: string ->
+  length: int ->
+  to_raw: ('a -> string) ->
+  of_raw: (string -> 'a option) ->
+  wrap: ('a -> data) ->
+  'a encoding
+
+(** Checks that an encoding has a certain prefix and length. *)
+val check_encoded_prefix: 'a encoding -> string -> int -> unit
+
+module Alphabet : sig
+  type t
+  val bitcoin: t
+  val ripple: t
+  val flickr: t
+  val make: string -> t
+  val all_in_alphabet :  t -> string -> bool
+  val pp : Format.formatter -> t -> unit
+end
+
+(** Encoder for a given kind of data. *)
+val simple_encode: ?alphabet:Alphabet.t -> 'a encoding -> 'a -> string
+
+(** Decoder for a given kind of data. It returns [None] when
+    the decoded data does not start with the expected prefix. *)
+val simple_decode: ?alphabet:Alphabet.t -> 'a encoding -> string -> 'a option
+
+(** Generic decoder. It returns [None] when the decoded data does
+    not start with a registered prefix. *)
+val decode: ?alphabet:Alphabet.t -> string -> data option
+
+(** {2 Completion of partial Base58Check value} *)
+
+(** Register a (global) resolver for a previsously
+    registered kind af data. *)
+val register_resolver: 'a encoding -> (string -> 'a list Lwt.t) -> unit
+
+(** Try to complete a prefix of a Base58Check encoded data, by using
+    the previously registered resolver associated to this kind of
+    data. Note that a prefix of [n] characters of a Base58-encoded
+    value provides at least [n/2] bytes of a prefix of the original value. *)
+val complete: ?alphabet:Alphabet.t -> string -> string list Lwt.t
+
+(** {1 Low-level: distinct registering function for economic protocol} *)
+
+(** See [src/environment/v1/base58.mli] for an inlined
+    documentation. *)
+module Make(C: sig type context end) : sig
+
+  val register_encoding:
+    prefix: string ->
+    length: int ->
+    to_raw: ('a -> string) ->
+    of_raw: (string -> 'a option) ->
+    wrap: ('a -> data) ->
+    'a encoding
+
+  val decode: ?alphabet:Alphabet.t -> string -> data option
+
+  val register_resolver:
+    'a encoding -> (C.context -> string -> 'a list Lwt.t) -> unit
+
+  val complete:
+    ?alphabet:Alphabet.t -> C.context -> string -> string list Lwt.t
+
+end
+
+(** {2 Low-level Base58Check encodings} *)
+
+(** Base58Check-encoding/decoding functions (with error detections). *)
+val safe_encode: ?alphabet:Alphabet.t -> string -> string
+val safe_decode: ?alphabet:Alphabet.t -> string -> string option
+
+(** Base58-encoding/decoding functions (without error detections). *)
+val raw_encode: ?alphabet:Alphabet.t -> string -> string
+val raw_decode: ?alphabet:Alphabet.t -> string -> string option
+
+(**/**)
+
+val partial_decode: ?alphabet:Alphabet.t -> string -> int -> string option
+val make_encoded_prefix: string -> int -> string * int
+val prefix: 'a encoding -> string
diff --git a/vendors/tezos-modded/src/lib_crypto/blake2B.ml b/vendors/tezos-modded/src/lib_crypto/blake2B.ml
new file mode 100644
index 000000000..4cf9697cc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/blake2B.ml
@@ -0,0 +1,377 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+(*-- Type specific Hash builder ---------------------------------------------*)
+
+module type Name = sig
+  val name : string
+  val title : string
+  val size : int option
+end
+
+module type PrefixedName = sig
+  include Name
+  val b58check_prefix : string
+end
+
+module Make_minimal (K : Name) = struct
+
+  open Blake2
+  type t = Blake2b.hash
+
+  include K
+
+  let size =
+    match K.size with
+    | None -> 32
+    | Some x -> x
+
+  let of_string_opt s =
+    if String.length s <> size then
+      None
+    else
+      Some (Blake2b.Hash (MBytes.of_string s))
+  let of_string s =
+    match of_string_opt s with
+    | None ->
+        generic_error "%s.of_string: wrong string size (%d)"
+          K.name (String.length s)
+    | Some h -> Ok h
+  let of_string_exn s =
+    match of_string_opt s with
+    | None ->
+        Format.kasprintf invalid_arg
+          "%s.of_string: wrong string size (%d)"
+          K.name (String.length s)
+    | Some h -> h
+  let to_string (Blake2b.Hash h) = MBytes.to_string h
+
+  let of_hex s = of_string (Hex.to_string s)
+  let of_hex_opt s = of_string_opt (Hex.to_string s)
+  let of_hex_exn s = of_string_exn (Hex.to_string s)
+  let to_hex s = Hex.of_string (to_string s)
+
+  let pp ppf h =
+    let `Hex h = to_hex h in
+    Format.pp_print_string ppf h
+  let pp_short ppf h =
+    let `Hex h = to_hex h in
+    Format.pp_print_string ppf (String.sub h 0 8)
+
+  let of_bytes_opt b =
+    if MBytes.length b <> size then
+      None
+    else
+      Some (Blake2b.Hash b)
+  let of_bytes_exn b =
+    match of_bytes_opt b with
+    | None ->
+        let msg =
+          Printf.sprintf "%s.of_bytes: wrong string size (%d)"
+            K.name (MBytes.length b) in
+        raise (Invalid_argument msg)
+    | Some h -> h
+  let of_bytes s =
+    match of_bytes_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error "Failed to deserialize a hash (%s)" K.name
+  let to_bytes (Blake2b.Hash h) = h
+
+  (* let read src off = of_bytes_exn @@ MBytes.sub src off size *)
+  (* let write dst off h = MBytes.blit (to_bytes h) 0 dst off size *)
+
+  let hash_bytes ?key l =
+    let state = Blake2b.init ?key size in
+    List.iter (fun b -> Blake2b.update state b) l ;
+    Blake2b.final state
+
+  let hash_string ?key l =
+    let key = Option.map ~f:Bigstring.of_string key in
+    let state = Blake2b.init ?key size in
+    List.iter (fun s -> Blake2b.update state (MBytes.of_string s)) l ;
+    Blake2b.final state
+
+  let path_length = 6
+
+  (** Converts [key] to hex thus doubling its size then splits it into a list of
+      length [path_length] where each element is one byte, or two characters,
+      except the last one which contains the rest. *)
+  let to_path key l =
+    let `Hex key = to_hex key in
+    String.sub key 0 2 :: String.sub key 2 2 ::
+    String.sub key 4 2 :: String.sub key 6 2 ::
+    String.sub key 8 2 :: String.sub key 10 (size * 2 - 10) :: l
+  let of_path path =
+    let path = String.concat "" path in
+    of_hex_opt (`Hex path)
+  let of_path_exn path =
+    let path = String.concat "" path in
+    of_hex_exn (`Hex path)
+
+  let prefix_path p =
+    let `Hex p = Hex.of_string p in
+    let len = String.length p in
+    let p1 = if len >= 2 then String.sub p 0 2 else ""
+    and p2 = if len >= 4 then String.sub p 2 2 else ""
+    and p3 = if len >= 6 then String.sub p 4 2 else ""
+    and p4 = if len >= 8 then String.sub p 6 2 else ""
+    and p5 = if len >= 10 then String.sub p 8 2 else ""
+    and p6 = if len > 10 then String.sub p 10 (min (len - 10) (size * 2 - 10)) else "" in
+    [ p1 ; p2 ; p3 ; p4 ; p5 ; p6 ]
+
+  let zero = of_hex_exn (`Hex (String.make (size * 2) '0'))
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare (Blake2b.Hash h1) (Blake2b.Hash h2) = MBytes.compare h1 h2
+    end)
+
+end
+
+module Make (R : sig
+    val register_encoding:
+      prefix: string ->
+      length:int ->
+      to_raw: ('a -> string) ->
+      of_raw: (string -> 'a option) ->
+      wrap: ('a -> Base58.data) ->
+      'a Base58.encoding
+  end) (K : PrefixedName) = struct
+
+  include Make_minimal(K)
+
+  (* Serializers *)
+
+  let raw_encoding =
+    let open Data_encoding in
+    conv to_bytes of_bytes_exn (Fixed.bytes size)
+
+  let hash =
+    if Compare.Int.(size >= 8) then
+      fun h -> Int64.to_int (MBytes.get_int64 (to_bytes h) 0)
+    else if Compare.Int.(size >= 4) then
+      fun h -> Int32.to_int (MBytes.get_int32 (to_bytes h) 0)
+    else
+      fun h ->
+        let r = ref 0 in
+        let h = to_bytes h in
+        for i = 0 to size - 1 do
+          r := MBytes.get_uint8 h i + 8 * !r
+        done ;
+        !r
+
+  type Base58.data += Data of t
+
+  let b58check_encoding =
+    R.register_encoding
+      ~prefix: K.b58check_prefix
+      ~length: size
+      ~wrap: (fun s -> Data s)
+      ~of_raw: of_string_opt
+      ~to_raw: to_string
+
+  include Helpers.Make(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+      let raw_encoding = raw_encoding
+      let compare = compare
+      let equal = equal
+      let hash = hash
+    end)
+
+end
+
+module Generic_Merkle_tree (H : sig
+    type t
+    type elt
+    val empty : t
+    val leaf : elt -> t
+    val node : t -> t -> t
+  end) = struct
+
+  let rec step a n =
+    let m = (n+1) / 2 in
+    for i = 0 to m - 1 do
+      a.(i) <- H.node a.(2*i) a.(2*i+1)
+    done ;
+    a.(m) <- H.node a.(n) a.(n) ;
+    if m = 1 then
+      a.(0)
+    else if m mod 2 = 0 then
+      step a m
+    else begin
+      a.(m+1) <- a.(m) ;
+      step a (m+1)
+    end
+
+  let empty = H.empty
+
+  let compute xs =
+    match xs with
+    | [] -> H.empty
+    | [x] -> H.leaf x
+    | _ :: _ :: _ ->
+        let last = TzList.last_exn xs in
+        let n = List.length xs in
+        let a = Array.make (n+1) (H.leaf last) in
+        List.iteri (fun i x -> a.(i) <- H.leaf x) xs ;
+        step a n
+
+  type path =
+    | Left of path * H.t
+    | Right of H.t * path
+    | Op
+
+  let rec step_path a n p j =
+    let m = (n+1) / 2 in
+    let p = if j mod 2 = 0 then Left (p, a.(j+1)) else Right (a.(j-1), p) in
+    for i = 0 to m - 1 do
+      a.(i) <- H.node a.(2*i) a.(2*i+1)
+    done ;
+    a.(m) <- H.node a.(n) a.(n) ;
+    if m = 1 then
+      p
+    else if m mod 2 = 0 then
+      step_path a m p (j/2)
+    else begin
+      a.(m+1) <- a.(m) ;
+      step_path a (m+1) p (j/2)
+    end
+
+  let compute_path xs i =
+    match xs with
+    | [] -> invalid_arg "compute_path"
+    | [_] -> Op
+    | _ :: _ :: _ ->
+        let last = TzList.last_exn xs in
+        let n = List.length xs in
+        if i < 0 || n <= i then invalid_arg "compute_path" ;
+        let a = Array.make (n+1) (H.leaf last) in
+        List.iteri (fun i x -> a.(i) <- H.leaf x) xs ;
+        step_path a n Op i
+
+  let rec check_path p h =
+    match p with
+    | Op ->
+        H.leaf h, 1, 0
+    | Left (p, r) ->
+        let l, s, pos = check_path p h in
+        H.node l r, s * 2, pos
+    | Right (l, p) ->
+        let r, s, pos = check_path p h in
+        H.node l r, s * 2, pos + s
+
+  let check_path p h =
+    let h, _, pos = check_path p h in
+    h, pos
+
+end
+
+let rec log2 x = if x <= 1 then 0 else 1 + log2 ((x+1) / 2)
+
+module Make_merkle_tree
+    (R : sig
+       val register_encoding:
+         prefix: string ->
+         length:int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (K : PrefixedName)
+    (Contents: sig
+       type t
+       val to_bytes: t -> MBytes.t
+     end) = struct
+
+  include Make (R) (K)
+
+  type elt = Contents.t
+  let elt_bytes = Contents.to_bytes
+
+  let empty = hash_bytes []
+
+  include Generic_Merkle_tree(struct
+      type nonrec t = t
+      type nonrec elt = elt
+      let empty = empty
+      let leaf x = hash_bytes [Contents.to_bytes x]
+      let node x y = hash_bytes [to_bytes x; to_bytes y]
+    end)
+
+  let path_encoding =
+    let open Data_encoding in
+    mu "path"
+      (fun path_encoding ->
+         union [
+           case (Tag 240)
+             ~title:"Left"
+             (obj2
+                (req "path" path_encoding)
+                (req "right" encoding))
+             (function Left (p, r) -> Some (p, r) | _ -> None)
+             (fun (p, r) -> Left (p, r)) ;
+           case (Tag 15)
+             ~title:"Right"
+             (obj2
+                (req "left" encoding)
+                (req "path" path_encoding))
+             (function Right (r, p) -> Some (r, p) | _ -> None)
+             (fun (r, p) -> Right (r, p)) ;
+           case (Tag 0)
+             ~title:"Op"
+             unit
+             (function Op -> Some () | _ -> None)
+             (fun () -> Op)
+         ])
+
+  let bounded_path_encoding ?max_length () =
+    match max_length with
+    | None -> path_encoding
+    | Some max_length ->
+        let max_depth = log2 max_length in
+        Data_encoding.check_size (max_depth * (size + 1) + 1) path_encoding
+
+end
+
+include
+  Make_minimal (struct
+    let name = "Generic_hash"
+    let title = ""
+    let size = None
+  end)
+
+let pp ppf h =
+  let `Hex h = to_hex h in
+  Format.pp_print_string ppf h
+let pp_short ppf h =
+  let `Hex h = to_hex h in
+  Format.pp_print_string ppf (String.sub h 0 8)
diff --git a/vendors/tezos-modded/src/lib_crypto/blake2B.mli b/vendors/tezos-modded/src/lib_crypto/blake2B.mli
new file mode 100644
index 000000000..38442decf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/blake2B.mli
@@ -0,0 +1,96 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Manipulation and creation of hashes *)
+
+(** {2 Predefined Hashes } ****************************************************)
+
+include S.MINIMAL_HASH
+include S.RAW_DATA with type t := t
+
+(** {2 Building Hashes} *******************************************************)
+
+(** The parameters for creating a new Hash type using
+    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
+    used in error messages and serializers. *)
+
+module type Name = sig
+  val name : string
+  val title : string
+  val size : int option
+end
+
+module type PrefixedName = sig
+  include Name
+  val b58check_prefix : string
+end
+
+(** Builds a new Hash type using Blake2B. *)
+module Make_minimal (Name : Name) : S.MINIMAL_HASH
+module Make
+    (Register : sig
+       val register_encoding:
+         prefix: string ->
+         length: int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (Name : PrefixedName) : S.HASH
+
+(**/**)
+
+module Make_merkle_tree
+    (R : sig
+       val register_encoding:
+         prefix: string ->
+         length:int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (K : PrefixedName)
+    (Contents: sig
+       type t
+       val to_bytes: t -> MBytes.t
+     end) : S.MERKLE_TREE with type elt = Contents.t
+
+module Generic_Merkle_tree (H : sig
+    type t
+    type elt
+    val empty : t
+    val leaf : elt -> t
+    val node : t -> t -> t
+  end) : sig
+  val compute : H.elt list -> H.t
+  type path =
+    | Left of path * H.t
+    | Right of H.t * path
+    | Op
+  val compute_path: H.elt list -> int -> path
+  val check_path: path -> H.elt -> H.t * int
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/block_hash.ml b/vendors/tezos-modded/src/lib_crypto/block_hash.ml
new file mode 100644
index 000000000..9a8eb034d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/block_hash.ml
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "block_hash"
+    let title = "A block identifier"
+    let b58check_prefix = Base58.Prefix.block_hash
+    let size = None
+  end)
+
+
+module Logging = struct
+  let tag = Tag.def ~doc:"Block Hash" "block_hash" pp_short
+  let predecessor_tag = Tag.def ~doc:"Block Predecessor Hash" "predecessor_hash" pp_short
+end
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "B" 51
diff --git a/vendors/tezos-modded/src/lib_crypto/block_hash.mli b/vendors/tezos-modded/src/lib_crypto/block_hash.mli
new file mode 100644
index 000000000..0b4fa4f86
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/block_hash.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
+
+module Logging : sig
+  val tag : t Tag.def
+  val predecessor_tag : t Tag.def
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/chain_id.ml b/vendors/tezos-modded/src/lib_crypto/chain_id.ml
new file mode 100644
index 000000000..f5e1a5a0e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/chain_id.ml
@@ -0,0 +1,137 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+type t = string
+
+let name = "Chain_id"
+let title = "Network identifier"
+
+let extract bh =
+  MBytes.sub_string (Block_hash.to_bytes bh) 0 4
+let hash_bytes ?key l = extract (Block_hash.hash_bytes ?key l)
+let hash_string ?key l = extract (Block_hash.hash_string ?key l)
+
+let size = 4
+
+let of_string_opt s =
+  if String.length s <> size then None else Some s
+let of_string s =
+  match of_string_opt s with
+  | None ->
+      generic_error
+        "%s.of_string: wrong string size (%d)"
+        name (String.length s)
+  | Some h -> Ok h
+let of_string_exn s =
+  match of_string_opt s with
+  | None ->
+      Format.kasprintf invalid_arg
+        "%s.of_string_exn: wrong string size (%d)"
+        name (String.length s)
+  | Some h -> h
+
+let to_string s = s
+let of_hex s = of_string (Hex.to_string s)
+let of_hex_opt s = of_string_opt (Hex.to_string s)
+let of_hex_exn s = of_string_exn (Hex.to_string s)
+let to_hex s = Hex.of_string (to_string s)
+
+
+let of_bytes_opt b =
+  if MBytes.length b <> size then
+    None
+  else
+    Some (MBytes.to_string b)
+let of_bytes_exn b =
+  match of_bytes_opt b with
+  | None ->
+      let msg =
+        Printf.sprintf "%s.of_bytes: wrong string size (%d)"
+          name (MBytes.length b) in
+      raise (Invalid_argument msg)
+  | Some h -> h
+let of_bytes s =
+  match of_bytes_opt s with
+  | Some x -> Ok x
+  | None ->
+      generic_error "Failed to deserialize a hash (%s)" name
+let to_bytes = MBytes.of_string
+
+(* let read src off = of_bytes_exn @@ MBytes.sub src off size *)
+(* let write dst off h = MBytes.blit (to_bytes h) 0 dst off size *)
+
+let path_length = 1
+let to_path key l =
+  let `Hex h = to_hex key in
+  h :: l
+let of_path path =
+  let path = String.concat "" path in
+  of_hex_opt (`Hex path)
+let of_path_exn path =
+  let path = String.concat "" path in
+  of_hex_exn (`Hex path)
+
+let prefix_path p =
+  let `Hex p = Hex.of_string p in
+  [ p ]
+
+let zero = of_hex_exn (`Hex (String.make (size * 2) '0'))
+
+type Base58.data += Data of t
+
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.chain_id
+    ~length: size
+    ~wrap: (fun s -> Data s)
+    ~of_raw: of_string_opt
+    ~to_raw: to_string
+
+let raw_encoding =
+  let open Data_encoding in
+  conv to_bytes of_bytes_exn (Fixed.bytes size)
+
+let hash h =
+  Int32.to_int (MBytes.get_int32 (to_bytes h) 0)
+
+let of_block_hash bh = hash_bytes [Block_hash.to_bytes bh]
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = String.compare
+  end)
+
+include Helpers.Make(struct
+    type nonrec t = t
+    let title = title
+    let name = name
+    let b58check_encoding = b58check_encoding
+    let raw_encoding = raw_encoding
+    let compare = compare
+    let equal = equal
+    let hash = hash
+  end)
diff --git a/vendors/tezos-modded/src/lib_crypto/chain_id.mli b/vendors/tezos-modded/src/lib_crypto/chain_id.mli
new file mode 100644
index 000000000..ad033691f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/chain_id.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
+
+val of_block_hash: Block_hash.t -> t
diff --git a/vendors/tezos-modded/src/lib_crypto/context_hash.ml b/vendors/tezos-modded/src/lib_crypto/context_hash.ml
new file mode 100644
index 000000000..6518988c9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/context_hash.ml
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Context_hash"
+    let title = "A hash of context"
+    let b58check_prefix = Base58.Prefix.context_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "Co" 52
diff --git a/vendors/tezos-modded/src/lib_crypto/context_hash.mli b/vendors/tezos-modded/src/lib_crypto/context_hash.mli
new file mode 100644
index 000000000..2203c82e6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/context_hash.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_crypto/crypto_box.ml b/vendors/tezos-modded/src/lib_crypto/crypto_box.ml
new file mode 100644
index 000000000..79caac421
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/crypto_box.ml
@@ -0,0 +1,215 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - X25519/XSalsa20-Poly1305 cryptography *)
+
+open Hacl
+
+type secret_key = secret Box.key
+type public_key = public Box.key
+type channel_key = Box.combined Box.key
+type nonce = Bigstring.t
+type target = Z.t
+
+module Secretbox = struct
+  include Secretbox
+  let box_noalloc key nonce msg =
+    box ~key ~nonce ~msg ~cmsg:msg
+
+  let box_open_noalloc key nonce cmsg =
+    box_open ~key ~nonce ~cmsg ~msg:cmsg
+
+  let box key msg nonce =
+    let msglen = MBytes.length msg in
+    let cmsg = MBytes.create (msglen + zerobytes) in
+    MBytes.fill cmsg '\x00' ;
+    MBytes.blit msg 0 cmsg zerobytes msglen ;
+    box ~key ~nonce ~msg:cmsg ~cmsg ;
+    MBytes.sub cmsg boxzerobytes (msglen + zerobytes - boxzerobytes)
+
+  let box_open key cmsg nonce =
+    let cmsglen = MBytes.length cmsg in
+    let msg = MBytes.create (cmsglen + boxzerobytes) in
+    MBytes.fill msg '\x00' ;
+    MBytes.blit cmsg 0 msg boxzerobytes cmsglen ;
+    match box_open ~key ~nonce ~cmsg:msg ~msg with
+    | false -> None
+    | true -> Some (MBytes.sub msg zerobytes (cmsglen - boxzerobytes))
+end
+
+module Public_key_hash = Blake2B.Make (Base58) (struct
+    let name = "Crypto_box.Public_key_hash"
+    let title = "A Cryptobox public key ID"
+    let b58check_prefix = Base58.Prefix.cryptobox_public_key_hash
+    let size = Some 16
+  end)
+
+let () =
+  Base58.check_encoded_prefix Public_key_hash.b58check_encoding "id" 30
+
+let hash pk =
+  Public_key_hash.hash_bytes [Box.unsafe_to_bytes pk]
+
+let zerobytes = Box.zerobytes
+let boxzerobytes = Box.boxzerobytes
+
+let random_keypair () =
+  let pk, sk = Box.keypair () in
+  sk, pk, hash pk
+
+let zero_nonce = MBytes.make Nonce.bytes '\x00'
+let random_nonce = Nonce.gen
+let increment_nonce = Nonce.increment
+let generate_nonce mbytes =
+  let hash = Blake2B.hash_bytes mbytes in
+  Nonce.of_bytes_exn @@ (Bigstring.sub (Blake2B.to_bytes hash) 0 Nonce.bytes)
+
+let init_to_resp_seed = MBytes.of_string "Init -> Resp"
+let resp_to_init_seed  = MBytes.of_string "Resp -> Init"
+let generate_nonces ~incoming ~sent_msg ~recv_msg =
+  let (init_msg, resp_msg, false)
+    | (resp_msg, init_msg, true) = (sent_msg, recv_msg, incoming) in
+  let nonce_init_to_resp =
+    generate_nonce [ init_msg ; resp_msg ; init_to_resp_seed ] in
+  let nonce_resp_to_init =
+    generate_nonce [ init_msg ; resp_msg ; resp_to_init_seed ] in
+  if incoming then
+    (nonce_init_to_resp, nonce_resp_to_init)
+  else
+    (nonce_resp_to_init, nonce_init_to_resp)
+
+let precompute sk pk = Box.dh pk sk
+
+let fast_box_noalloc k nonce msg =
+  Box.box ~k ~nonce ~msg ~cmsg:msg
+
+let fast_box_open_noalloc k nonce cmsg =
+  Box.box_open ~k ~nonce ~cmsg ~msg:cmsg
+
+let fast_box k msg nonce =
+  let msglen = MBytes.length msg in
+  let cmsg = MBytes.create (msglen + zerobytes) in
+  MBytes.fill cmsg '\x00' ;
+  MBytes.blit msg 0 cmsg zerobytes msglen ;
+  Box.box ~k ~nonce ~msg:cmsg ~cmsg ;
+  cmsg
+
+let fast_box_open k cmsg nonce =
+  let cmsglen = MBytes.length cmsg in
+  let msg = MBytes.create cmsglen in
+  match Box.box_open ~k ~nonce ~cmsg ~msg with
+  | false -> None
+  | true -> Some (MBytes.sub msg zerobytes (cmsglen - zerobytes))
+
+let compare_target hash target =
+  let hash = Z.of_bits (Blake2B.to_string hash) in
+  Z.compare hash target <= 0
+
+let make_target f =
+  if f < 0. || 256. < f then invalid_arg "Cryptobox.target_of_float" ;
+  let frac, shift = modf f in
+  let shift = int_of_float shift in
+  let m =
+    Z.of_int64 @@
+    if frac = 0. then
+      Int64.(pred (shift_left 1L 54))
+    else
+      Int64.of_float (2. ** (54. -. frac))
+  in
+  if shift < 202 then
+    Z.logor
+      (Z.shift_left m (202 - shift))
+      (Z.pred @@ Z.shift_left Z.one (202 - shift))
+  else
+    Z.shift_right m (shift - 202)
+
+let default_target = make_target 24.
+
+let check_proof_of_work pk nonce target =
+  let hash =
+    Blake2B.hash_bytes [
+      Box.unsafe_to_bytes pk ;
+      nonce ;
+    ] in
+  compare_target hash target
+
+let generate_proof_of_work ?max pk target =
+  let may_interupt =
+    match max with
+    | None -> (fun _ -> ())
+    | Some max -> (fun cpt -> if max < cpt then raise Not_found) in
+  let rec loop nonce cpt =
+    may_interupt cpt ;
+    if check_proof_of_work pk nonce target then
+      nonce
+    else
+      loop (Nonce.increment nonce) (cpt + 1) in
+  loop (random_nonce ()) 0
+
+let public_key_to_bigarray pk =
+  let buf = MBytes.create Box.pkbytes in
+  Box.blit_to_bytes pk buf ;
+  buf
+
+let public_key_of_bigarray buf =
+  let pk = MBytes.copy buf in
+  Box.unsafe_pk_of_bytes pk
+
+let public_key_size = Box.pkbytes
+
+let secret_key_to_bigarray sk =
+  let buf = MBytes.create Box.skbytes in
+  Box.blit_to_bytes sk buf ;
+  buf
+
+let secret_key_of_bigarray buf =
+  let sk = MBytes.copy buf in
+  Box.unsafe_sk_of_bytes sk
+
+let secret_key_size = Box.skbytes
+
+let nonce_size = Nonce.bytes
+
+let public_key_encoding =
+  let open Data_encoding in
+  conv
+    public_key_to_bigarray
+    public_key_of_bigarray
+    (Fixed.bytes public_key_size)
+
+let secret_key_encoding =
+  let open Data_encoding in
+  conv
+    secret_key_to_bigarray
+    secret_key_of_bigarray
+    (Fixed.bytes secret_key_size)
+
+let nonce_encoding =
+  Data_encoding.Fixed.bytes nonce_size
+let neuterize : secret_key -> public_key = Box.neuterize
+let equal : public_key -> public_key -> bool = Box.equal
+
+let pp_pk ppf pk =
+  MBytes.pp_hex ppf (public_key_to_bigarray pk)
diff --git a/vendors/tezos-modded/src/lib_crypto/crypto_box.mli b/vendors/tezos-modded/src/lib_crypto/crypto_box.mli
new file mode 100644
index 000000000..a6cf448a8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/crypto_box.mli
@@ -0,0 +1,99 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - X25519/XSalsa20-Poly1305 cryptography *)
+
+type nonce = Bigstring.t
+val nonce_size : int
+
+val zero_nonce : nonce
+val random_nonce : unit -> nonce
+val increment_nonce : ?step:int -> nonce -> nonce
+
+(** [generate_nonces ~incoming ~sent_msg ~recv_msg] generates two
+    nonces by hashing (Blake2B) the arguments. The nonces should be
+    used to initialize the encryption on the communication
+    channels. Because an attacker cannot control both messages,
+    it cannot determine the nonces that will be used to encrypt
+    the messages. The sent message should contains a random nonce,
+    and we should never send the exact same message twice. *)
+val generate_nonces :
+  incoming:bool -> sent_msg:MBytes.t -> recv_msg:MBytes.t -> nonce * nonce
+
+module Secretbox : sig
+  type key
+
+  val unsafe_of_bytes : MBytes.t -> key
+
+  val box_noalloc : key -> nonce -> MBytes.t -> unit
+  val box_open_noalloc : key -> nonce -> MBytes.t -> bool
+
+  val box : key -> MBytes.t -> nonce -> MBytes.t
+  val box_open : key -> MBytes.t -> nonce -> MBytes.t option
+end
+
+type target
+val default_target : target
+val make_target : float -> target
+
+type secret_key
+type public_key
+module Public_key_hash : S.HASH
+type channel_key
+
+val hash : public_key -> Public_key_hash.t
+
+val zerobytes : int
+val boxzerobytes : int
+
+val random_keypair : unit -> secret_key * public_key * Public_key_hash.t
+
+val precompute : secret_key -> public_key -> channel_key
+
+val fast_box        : channel_key -> MBytes.t -> nonce -> MBytes.t
+val fast_box_open   : channel_key -> MBytes.t -> nonce -> MBytes.t option
+
+val fast_box_noalloc : channel_key -> nonce -> MBytes.t -> unit
+val fast_box_open_noalloc : channel_key -> nonce -> MBytes.t -> bool
+
+val check_proof_of_work : public_key -> nonce -> target -> bool
+val generate_proof_of_work : ?max:int -> public_key -> target -> nonce
+
+val public_key_to_bigarray : public_key -> Cstruct.buffer
+val public_key_of_bigarray : Cstruct.buffer -> public_key
+val public_key_size : int
+
+val secret_key_to_bigarray : secret_key -> Cstruct.buffer
+val secret_key_of_bigarray : Cstruct.buffer -> secret_key
+val secret_key_size : int
+
+val public_key_encoding : public_key Data_encoding.t
+val secret_key_encoding : secret_key Data_encoding.t
+val nonce_encoding : nonce Data_encoding.t
+
+val neuterize : secret_key -> public_key
+val equal : public_key -> public_key -> bool
+
+val pp_pk :Format.formatter -> public_key -> unit
diff --git a/vendors/tezos-modded/src/lib_crypto/dune b/vendors/tezos-modded/src/lib_crypto/dune
new file mode 100644
index 000000000..01b0fc225
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/dune
@@ -0,0 +1,25 @@
+(library
+ (name tezos_crypto)
+ (public_name tezos-crypto)
+ (flags (:standard -safe-string
+                   -open Tezos_stdlib
+                   -open Tezos_data_encoding
+                   -open Tezos_error_monad
+                   -open Tezos_rpc
+                   -open Tezos_clic))
+ (libraries tezos-stdlib
+            tezos-data-encoding
+            tezos-error-monad
+            tezos-rpc
+            tezos-clic
+            lwt
+            blake2
+            hacl
+            secp256k1
+            uecc
+            zarith))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_crypto/ed25519.ml b/vendors/tezos-modded/src/lib_crypto/ed25519.ml
new file mode 100644
index 000000000..6a646e459
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/ed25519.ml
@@ -0,0 +1,357 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+module Public_key_hash = struct
+  include Blake2B.Make(Base58)(struct
+      let name = "Ed25519.Public_key_hash"
+      let title = "An Ed25519 public key hash"
+      let b58check_prefix = Base58.Prefix.ed25519_public_key_hash
+      let size = Some 20
+    end)
+  module Logging = struct
+    let tag = Tag.def ~doc:title name pp
+  end
+end
+let () =
+  Base58.check_encoded_prefix Public_key_hash.b58check_encoding "tz1" 36
+
+open Hacl
+
+module Public_key = struct
+
+  type t = public Sign.key
+
+  let name = "Ed25519.Public_key"
+  let title = "Ed25519 public key"
+
+  let to_string s = MBytes.to_string (Sign.unsafe_to_bytes s)
+  let of_string_opt s =
+    if String.length s < Sign.pkbytes then None
+    else
+      let pk = MBytes.create Sign.pkbytes in
+      MBytes.blit_of_string s 0 pk 0 Sign.pkbytes ;
+      Some (Sign.unsafe_pk_of_bytes pk)
+
+  let to_bytes pk =
+    let buf = MBytes.create Sign.pkbytes in
+    Sign.blit_to_bytes pk buf ;
+    buf
+
+  let of_bytes_opt buf =
+    let buflen = MBytes.length buf in
+    if buflen < Sign.pkbytes then None
+    else
+      let pk = MBytes.create Sign.pkbytes in
+      MBytes.blit buf 0 pk 0 Sign.pkbytes ;
+      Some (Sign.unsafe_pk_of_bytes pk)
+
+  let size = Sign.pkbytes
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_public_key
+      ~length: size
+      ~to_raw: to_string
+      ~of_raw: of_string_opt
+      ~wrap: (fun x -> Data x)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "edpk" 54
+
+  let hash v =
+    Public_key_hash.hash_bytes [ Sign.unsafe_to_bytes v ]
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (Sign.unsafe_to_bytes a) (Sign.unsafe_to_bytes b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+module Secret_key = struct
+
+  type t = secret Sign.key
+
+  let name = "Ed25519.Secret_key"
+  let title = "An Ed25519 secret key"
+
+  let size = Sign.skbytes
+
+  let to_bytes sk =
+    let buf = MBytes.create Sign.skbytes in
+    Sign.blit_to_bytes sk buf ;
+    buf
+
+  let of_bytes_opt s =
+    if MBytes.length s > 64 then None
+    else
+      let sk = MBytes.create Sign.skbytes in
+      MBytes.blit s 0 sk 0 Sign.skbytes ;
+      Some (Sign.unsafe_sk_of_bytes sk)
+
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let to_public_key = Sign.neuterize
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_seed
+      ~length: size
+      ~to_raw: (fun sk -> MBytes.to_string (Sign.unsafe_to_bytes sk))
+      ~of_raw: (fun buf ->
+          if String.length buf <> Sign.skbytes then None
+          else Some (Sign.unsafe_sk_of_bytes (MBytes.of_string buf)))
+      ~wrap: (fun sk -> Data sk)
+
+  (* Legacy NaCl secret key encoding. Used to store both sk and pk. *)
+  let secret_key_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_secret_key
+      ~length: Sign.(skbytes + pkbytes)
+      ~to_raw: (fun sk ->
+          let pk = Sign.neuterize sk in
+          let buf = MBytes.create Sign.(skbytes + pkbytes) in
+          Sign.blit_to_bytes sk buf ;
+          Sign.blit_to_bytes pk ~pos:Sign.skbytes buf ;
+          MBytes.to_string buf)
+      ~of_raw: (fun buf ->
+          if String.length buf <> Sign.(skbytes + pkbytes) then None
+          else
+            let sk = MBytes.create Sign.skbytes in
+            MBytes.blit_of_string buf 0 sk 0 Sign.skbytes ;
+            Some (Sign.unsafe_sk_of_bytes sk))
+      ~wrap: (fun x -> Data x)
+
+  let of_b58check_opt s =
+    match Base58.simple_decode b58check_encoding s with
+    | Some x -> Some x
+    | None -> Base58.simple_decode secret_key_encoding s
+  let of_b58check_exn s =
+    match of_b58check_opt s with
+    | Some x -> x
+    | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" name
+  let of_b58check s =
+    match of_b58check_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error
+          "Failed to read a b58check_encoding data (%s): %S"
+          name s
+
+  let to_b58check s = Base58.simple_encode b58check_encoding s
+  let to_short_b58check s =
+    String.sub
+      (to_b58check s) 0
+      (10 + String.length (Base58.prefix b58check_encoding))
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "edsk" 54 ;
+    Base58.check_encoded_prefix secret_key_encoding "edsk" 98
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (Sign.unsafe_to_bytes a) (Sign.unsafe_to_bytes b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+type t = MBytes.t
+
+type watermark = MBytes.t
+
+let name = "Ed25519"
+let title = "An Ed25519 signature"
+
+let size = Sign.bytes
+
+let of_bytes_opt s =
+  if MBytes.length s = size then Some s else None
+let to_bytes x = x
+
+let to_string s = MBytes.to_string (to_bytes s)
+let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+type Base58.data +=
+  | Data of t
+
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.ed25519_signature
+    ~length: size
+    ~to_raw: MBytes.to_string
+    ~of_raw: (fun s -> Some (MBytes.of_string s))
+    ~wrap: (fun x -> Data x)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "edsig" 99
+
+include Helpers.MakeRaw(struct
+    type nonrec t = t
+    let name = name
+    let of_bytes_opt = of_bytes_opt
+    let of_string_opt = of_string_opt
+    let to_string = to_string
+  end)
+
+include Helpers.MakeB58(struct
+    type nonrec t = t
+    let title = title
+    let name = name
+    let b58check_encoding = b58check_encoding
+  end)
+
+include Helpers.MakeEncoder(struct
+    type nonrec t = t
+    let name = name
+    let title = title
+    let raw_encoding =
+      let open Data_encoding in
+      conv to_bytes of_bytes_exn (Fixed.bytes size)
+    let of_b58check = of_b58check
+    let of_b58check_opt = of_b58check_opt
+    let of_b58check_exn = of_b58check_exn
+    let to_b58check = to_b58check
+    let to_short_b58check = to_short_b58check
+  end)
+
+let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+let zero = MBytes.make size '\000'
+
+let sign ?watermark sk msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  let signature = MBytes.create Sign.bytes in
+  Sign.sign ~sk ~msg ~signature ;
+  signature
+
+let check ?watermark pk signature msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  Sign.verify ~pk ~signature ~msg
+
+let generate_key ?seed () =
+  match seed with
+  | None ->
+      let pk, sk = Sign.keypair () in
+      Public_key.hash pk, pk, sk
+  | Some seed ->
+      let seedlen = MBytes.length seed in
+      if seedlen < Sign.skbytes then
+        invalid_arg (Printf.sprintf "Ed25519.generate_key: seed must \
+                                     be at least %d bytes long (got %d)"
+                       Sign.skbytes seedlen) ;
+      let sk = MBytes.create Sign.skbytes in
+      MBytes.blit seed 0 sk 0 Sign.skbytes ;
+      let sk = Sign.unsafe_sk_of_bytes sk in
+      let pk = Sign.neuterize sk in
+      Public_key.hash pk, pk, sk
+
+
+let deterministic_nonce sk msg =
+  Hash.SHA256.HMAC.digest ~key: (Secret_key.to_bytes sk) ~msg
+
+let deterministic_nonce_hash sk msg =
+  Blake2B.to_bytes (Blake2B.hash_bytes [deterministic_nonce sk msg])
+
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = MBytes.compare
+  end)
diff --git a/vendors/tezos-modded/src/lib_crypto/ed25519.mli b/vendors/tezos-modded/src/lib_crypto/ed25519.mli
new file mode 100644
index 000000000..c49d56e74
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/ed25519.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Ed25519 cryptography *)
+
+include S.SIGNATURE with type watermark = MBytes.t
+include S.RAW_DATA with type t := t
diff --git a/vendors/tezos-modded/src/lib_crypto/helpers.ml b/vendors/tezos-modded/src/lib_crypto/helpers.ml
new file mode 100644
index 000000000..994c43e00
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/helpers.ml
@@ -0,0 +1,227 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+module MakeRaw(H : sig
+    type t
+    val name: string
+    val of_bytes_opt: MBytes.t -> t option
+    val to_string: t -> string
+    val of_string_opt: string -> t option
+  end) = struct
+
+  let of_bytes_exn s =
+    match H.of_bytes_opt s with
+    | None ->
+        Format.kasprintf invalid_arg "of_bytes_exn (%s)" H.name
+    | Some pk -> pk
+  let of_bytes s =
+    match H.of_bytes_opt s with
+    | None -> generic_error "of_bytes (%s)" H.name
+    | Some pk -> Ok pk
+
+  let of_string_exn s =
+    match H.of_string_opt s with
+    | None ->
+        Format.kasprintf invalid_arg "of_string_exn (%s)" H.name
+    | Some pk -> pk
+  let of_string s =
+    match H.of_string_opt s with
+    | None -> generic_error "of_string (%s)" H.name
+    | Some pk -> Ok pk
+
+  let to_hex s = Hex.of_string (H.to_string s)
+  let of_hex_opt s = H.of_string_opt (Hex.to_string s)
+  let of_hex_exn s =
+    match H.of_string_opt (Hex.to_string s) with
+    | Some x -> x
+    | None ->
+        Format.kasprintf invalid_arg "of_hex_exn (%s)" H.name
+  let of_hex s =
+    match of_hex_opt s with
+    | None -> generic_error "of_hex (%s)" H.name
+    | Some pk -> ok pk
+end
+
+module MakeB58(H : sig
+    type t
+    val title: string
+    val name: string
+    val b58check_encoding: t Base58.encoding
+  end) = struct
+
+  let of_b58check_opt s =
+    Base58.simple_decode H.b58check_encoding s
+  let of_b58check_exn s =
+    match of_b58check_opt s with
+    | Some x -> x
+    | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" H.name
+  let of_b58check s =
+    match of_b58check_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error
+          "Failed to read a b58check_encoding data (%s): %S"
+          H.name s
+
+  let to_b58check s = Base58.simple_encode H.b58check_encoding s
+  let to_short_b58check s =
+    String.sub
+      (to_b58check s) 0
+      (10 + String.length (Base58.prefix H.b58check_encoding))
+
+end
+
+module MakeEncoder(H : sig
+    type t
+    val title: string
+    val name: string
+    val to_b58check: t -> string
+    val to_short_b58check: t -> string
+    val of_b58check: string -> t tzresult
+    val of_b58check_exn: string -> t
+    val of_b58check_opt: string -> t option
+    val raw_encoding: t Data_encoding.t
+  end) = struct
+
+  let pp ppf t =
+    Format.pp_print_string ppf (H.to_b58check t)
+
+  let pp_short ppf t =
+    Format.pp_print_string ppf (H.to_short_b58check t)
+
+  let encoding =
+    let open Data_encoding in
+    splitted
+      ~binary:
+        (obj1 (req H.name H.raw_encoding))
+      ~json:
+        (def H.name
+           ~title: (H.title ^ " (Base58Check-encoded)") @@
+         conv
+           H.to_b58check
+           (Data_encoding.Json.wrap_error H.of_b58check_exn)
+           string)
+
+  let rpc_arg =
+    RPC_arg.make
+      ~name: H.name
+      ~descr: (Format.asprintf "%s (Base58Check-encoded)" H.name)
+      ~destruct:
+        (fun s ->
+           match H.of_b58check_opt s with
+           | None ->
+               Error (Format.asprintf
+                        "failed to decode Base58Check-encoded data (%s): %S"
+                        H.name s)
+           | Some v -> Ok v)
+      ~construct: H.to_b58check
+      ()
+
+  let param ?(name=H.name) ?(desc=H.title) t =
+    Clic.param ~name ~desc
+      (Clic.parameter (fun _ str -> Lwt.return (H.of_b58check str))) t
+
+end
+
+module MakeIterator(H : sig
+    type t
+    val encoding: t Data_encoding.t
+    val compare: t -> t -> int
+    val equal: t -> t -> bool
+    val hash: t -> int
+  end) = struct
+
+  module Set = struct
+    include Set.Make(struct type t = H.t let compare = H.compare end)
+    exception Found of elt
+    let random_elt s =
+      let n = Random.int (cardinal s) in
+      try
+        ignore
+          (fold (fun x i -> if i = n then raise (Found x) ; i+1) s 0 : int) ;
+        assert false
+      with Found x -> x
+    let encoding =
+      Data_encoding.conv
+        elements
+        (fun l -> List.fold_left (fun m x -> add x m) empty l)
+        Data_encoding.(list H.encoding)
+  end
+
+  module Table = struct
+    include Hashtbl.Make(struct
+        type t = H.t
+        let hash = H.hash
+        let equal = H.equal
+      end)
+    let encoding arg_encoding =
+      Data_encoding.conv
+        (fun h -> fold (fun k v l -> (k, v) :: l) h [])
+        (fun l ->
+           let h = create (List.length l) in
+           List.iter (fun (k,v) -> add h k v) l ;
+           h)
+        Data_encoding.(list (tup2 H.encoding arg_encoding))
+  end
+
+  module Map = struct
+    include Map.Make(struct type t = H.t let compare = H.compare end)
+    let encoding arg_encoding =
+      Data_encoding.conv
+        bindings
+        (fun l -> List.fold_left (fun m (k,v) -> add k v m) empty l)
+        Data_encoding.(list (tup2 H.encoding arg_encoding))
+  end
+
+end
+
+module Make(H : sig
+    type t
+    val title: string
+    val name: string
+    val b58check_encoding: t Base58.encoding
+    val raw_encoding: t Data_encoding.t
+    val compare: t -> t -> int
+    val equal: t -> t -> bool
+    val hash: t -> int
+  end) = struct
+
+  include MakeB58(H)
+  include MakeEncoder(struct
+      include H
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+    end)
+  include MakeIterator(struct
+      include H
+      let encoding = encoding
+    end)
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_hash.ml b/vendors/tezos-modded/src/lib_crypto/operation_hash.ml
new file mode 100644
index 000000000..b78975389
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_hash.ml
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Operation_hash"
+    let title = "A Tezos operation ID"
+    let b58check_prefix = Base58.Prefix.operation_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "o" 51
+
+module Logging = struct
+  let tag = Tag.def ~doc:title name pp
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_hash.mli b/vendors/tezos-modded/src/lib_crypto/operation_hash.mli
new file mode 100644
index 000000000..7f264b22d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_hash.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
+
+module Logging : sig
+  val tag : t Tag.def
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_list_hash.ml b/vendors/tezos-modded/src/lib_crypto/operation_list_hash.ml
new file mode 100644
index 000000000..f71b7c62f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_list_hash.ml
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make_merkle_tree (Base58) (struct
+    let name = "Operation_list_hash"
+    let title = "A list of operations"
+    let b58check_prefix = Base58.Prefix.operation_list_hash
+    let size = None
+  end) (Operation_hash)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "Lo" 52
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_list_hash.mli b/vendors/tezos-modded/src/lib_crypto/operation_list_hash.mli
new file mode 100644
index 000000000..46685205f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_list_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.MERKLE_TREE with type elt = Operation_hash.t
+
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.ml b/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.ml
new file mode 100644
index 000000000..6c2fbbbd5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.ml
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make_merkle_tree (Base58) (struct
+    let name = "Operation_list_list_hash"
+    let title = "A list of list of operations"
+    let b58check_prefix = Base58.Prefix.operation_list_list_hash
+    let size = None
+  end) (Operation_list_hash)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "LLo" 53 ;
diff --git a/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.mli b/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.mli
new file mode 100644
index 000000000..75ec10533
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/operation_list_list_hash.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.MERKLE_TREE with type elt = Operation_list_hash.t
diff --git a/vendors/tezos-modded/src/lib_crypto/p256.ml b/vendors/tezos-modded/src/lib_crypto/p256.ml
new file mode 100644
index 000000000..19fe0bb8d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/p256.ml
@@ -0,0 +1,295 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Public_key_hash = struct
+  include Blake2B.Make(Base58)(struct
+      let name  = "P256.Public_key_hash"
+      let title = "A P256 public key hash"
+      let b58check_prefix = Base58.Prefix.p256_public_key_hash
+      let size = Some 20
+    end)
+
+  module Logging = struct
+    let tag = Tag.def ~doc:title name pp
+  end
+end
+
+let () =
+  Base58.check_encoded_prefix Public_key_hash.b58check_encoding "tz3" 36
+
+open Uecc
+
+module Public_key = struct
+
+  type t = (secp256r1, public) key
+
+  let name  = "P256.Public_key"
+  let title = "A P256 public key"
+
+  let to_bytes = to_bytes ~compress:true
+  let of_bytes_opt = pk_of_bytes secp256r1
+
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let size = compressed_size secp256r1
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.p256_public_key
+      ~length: size
+      ~to_raw: to_string
+      ~of_raw: of_string_opt
+      ~wrap: (fun x -> Data x)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "p2pk" 55
+
+  let hash v =
+    Public_key_hash.hash_bytes [to_bytes v]
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (to_bytes a) (to_bytes b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+module Secret_key = struct
+
+  type t = (secp256r1, secret) key
+
+  let name = "P256.Secret_key"
+  let title = "A P256 secret key"
+
+  let size = sk_size secp256r1
+
+  let of_bytes_opt buf =
+    Option.map ~f:fst (sk_of_bytes secp256r1 buf)
+
+  let to_bytes = to_bytes ~compress:true
+
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let to_public_key = neuterize
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.p256_secret_key
+      ~length: size
+      ~to_raw: to_string
+      ~of_raw: of_string_opt
+      ~wrap: (fun x -> Data x)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "p2sk" 54
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (to_bytes a) (to_bytes b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+type t = MBytes.t
+
+type watermark = MBytes.t
+
+let name = "P256"
+let title = "A P256 signature"
+
+let size = pk_size secp256r1
+
+let of_bytes_opt s =
+  if MBytes.length s = size then Some s else None
+
+let to_bytes s = s
+
+let to_string s = MBytes.to_string (to_bytes s)
+let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+type Base58.data +=
+  | Data of t
+
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.p256_signature
+    ~length: size
+    ~to_raw: to_string
+    ~of_raw: of_string_opt
+    ~wrap: (fun x -> Data x)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "p2sig" 98
+
+include Helpers.MakeRaw(struct
+    type nonrec t = t
+    let name = name
+    let of_bytes_opt = of_bytes_opt
+    let of_string_opt = of_string_opt
+    let to_string = to_string
+  end)
+
+include Helpers.MakeB58(struct
+    type nonrec t = t
+    let title = title
+    let name = name
+    let b58check_encoding = b58check_encoding
+  end)
+
+include Helpers.MakeEncoder(struct
+    type nonrec t = t
+    let name = name
+    let title = title
+    let raw_encoding =
+      let open Data_encoding in
+      conv to_bytes of_bytes_exn (Fixed.bytes size)
+    let of_b58check = of_b58check
+    let of_b58check_opt = of_b58check_opt
+    let of_b58check_exn = of_b58check_exn
+    let to_b58check = to_b58check
+    let to_short_b58check = to_short_b58check
+  end)
+
+let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+let zero = of_bytes_exn (MBytes.make size '\000')
+
+let sign ?watermark sk msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  match sign sk msg with
+  | None ->
+      (* Will never happen in practice. This can only happen in case
+         of RNG error. *)
+      invalid_arg "P256.sign: internal error"
+  | Some signature -> signature
+
+let check ?watermark public_key signature msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  verify public_key ~msg ~signature
+
+let generate_key ?(seed=Rand.generate 32) () =
+  let seedlen = MBytes.length seed in
+  if seedlen < 32 then
+    invalid_arg (Printf.sprintf "P256.generate_key: seed must be at \
+                                 least 32 bytes long (was %d)" seedlen) ;
+  match sk_of_bytes secp256r1 seed with
+  | None -> invalid_arg "P256.generate_key: invalid seed (very rare!)"
+  | Some (sk, pk) ->
+      let pkh = Public_key.hash pk in
+      pkh, pk, sk
+
+let deterministic_nonce sk msg =
+  Hacl.Hash.SHA256.HMAC.digest ~key: (Secret_key.to_bytes sk) ~msg
+
+let deterministic_nonce_hash sk msg =
+  Blake2B.to_bytes (Blake2B.hash_bytes [deterministic_nonce sk msg])
+
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = MBytes.compare
+  end)
diff --git a/vendors/tezos-modded/src/lib_crypto/p256.mli b/vendors/tezos-modded/src/lib_crypto/p256.mli
new file mode 100644
index 000000000..b616d1543
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/p256.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - P256 cryptography *)
+
+include S.SIGNATURE with type watermark = MBytes.t
+include S.RAW_DATA with type t := t
diff --git a/vendors/tezos-modded/src/lib_crypto/protocol_hash.ml b/vendors/tezos-modded/src/lib_crypto/protocol_hash.ml
new file mode 100644
index 000000000..c1091e732
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/protocol_hash.ml
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Blake2B.Make (Base58) (struct
+    let name = "Protocol_hash"
+    let title = "A Tezos protocol ID"
+    let b58check_prefix = Base58.Prefix.protocol_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "P" 51
+
+module Logging = struct
+  let tag = Tag.def ~doc:title name pp
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/protocol_hash.mli b/vendors/tezos-modded/src/lib_crypto/protocol_hash.mli
new file mode 100644
index 000000000..7f264b22d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/protocol_hash.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
+
+module Logging : sig
+  val tag : t Tag.def
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/pvss.ml b/vendors/tezos-modded/src/lib_crypto/pvss.ml
new file mode 100644
index 000000000..44e5d4567
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/pvss.ml
@@ -0,0 +1,321 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module H = Blake2B
+
+(** Polynomial ring (ℤ/qℤ)[X] *)
+module PZ_q (Z_q : Znz.ZN)  : sig
+  type t
+  module Z_q  : Znz.ZN
+
+  (** Evaluates the polynomial p at point x *)
+  val eval  : p:t -> x:Z_q.t -> Z_q.t
+
+  (** Builds the polynomial from a list of coefficient, ordered by power.
+      That is, of_list [a₀; a₁; a₂; …] = a₀ + a₁ x + a₂ x² + … *)
+  val of_list : Z_q.t list -> t
+
+end with type Z_q.t = Z_q.t = struct
+  module Z_q = Z_q
+  type t  = Z_q.t list
+  let eval ~p ~x = List.fold_right (fun c y -> Z_q.(y * x + c)) p Z_q.zero
+  let of_list l = l
+end
+
+(** Functor type for an Cyclic group *)
+module type CYCLIC_GROUP = sig
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+  val name      : string
+  module Z_m    : Znz.ZN
+  val e         : t
+  val g1        : t
+  val g2        : t
+  val ( * )     : t -> t -> t
+  val (=)       : t -> t -> bool
+  val pow       : t -> Z_m.t -> t
+  val to_bits   : t -> String.t
+  val of_bits   : String.t -> t option
+end
+
+(** Type of a module that handles proofs for the discrete logarithm
+    equality equation. *)
+module type DLEQ = sig
+
+  (** A DLEQ equation. *)
+  type equation
+
+  (** A non-interactive zero-knowledge proof-of-knowledge of an
+      exponent solving the equation. *)
+  type proof
+
+  val proof_encoding : proof Data_encoding.t
+
+
+  (** Group element. *)
+  type element
+
+  (** Exponent, i.e. an integer modulo the group's order. *)
+  type exponent
+
+
+  (** Sets up a equation of the form
+      ∀ i, ∃ x(i), b₁ˣ⁽ⁱ⁾ = h₁ᵢ and b₂ᵢˣ⁽ⁱ⁾ = h₂ᵢ. The arguments
+      are given as b₁, h₁ᵢ, b₂ᵢ, h₂ᵢ *)
+  val setup_equation :
+    element -> element list -> element list -> element list -> equation
+
+  (** Creates a zero-knowledge proof of knowledge of the exponent list *)
+  val make_proof  : equation -> exponent list -> proof
+
+  (** Checkes the proof created by make_proof for a given equation *)
+  val check_proof : equation -> proof -> bool
+end
+
+(** Functor for creating a module handling proofs for the discrete logarithm
+    equality in cyclic group G *)
+module MakeDleq (G : CYCLIC_GROUP) :
+  DLEQ with type element = G.t and type exponent = G.Z_m.t =
+struct
+
+  type element = G.t
+  type exponent = G.Z_m.t
+  type equation = element * (element list) * (element list) * (element list)
+  type proof = exponent  * (exponent list)
+
+  let proof_encoding = Data_encoding.(
+      tup2 G.Z_m.encoding (list G.Z_m.encoding))
+
+  (* Fiat-Shamir heuristic to derive a random element of ℤ/mℤ from the
+       hash of a list of group elements *)
+  let fiat_shamir ?(exponents=[]) elements =
+    String.concat "||" (
+      "tezosftw" :: (List.map G.to_bits elements) @ (List.map G.Z_m.to_bits exponents)
+    ) |> (fun x -> H.hash_string [x]) |> H.to_string |> G.Z_m.of_bits_exn
+
+  let setup_equation b1 h1_n b2_n h2_n = (b1, h1_n, b2_n, h2_n)
+  let make_proof (b1, h1_n, b2_n, h2_n) x_n =
+    (* First, draw blinding factors. Normally these should be picked randomly. To maximize
+       reproducibility and avoid weak random number generation, we generate the blinding
+       factor deterministically from the problem parameters and the secret x_n.
+       TODO: review with cryptographer
+    *)
+    let
+      pseudo_seed = fiat_shamir (b1::(List.concat [h1_n; b2_n; h2_n])) ~exponents:x_n in
+    let
+      w_n  = List.mapi (fun i __ -> fiat_shamir [] ~exponents:[pseudo_seed; G.Z_m.of_int i]) h1_n in let
+      a1_n = List.map  (G.pow b1)   w_n and
+      a2_n = List.map2 G.pow b2_n w_n in let
+      (* Pick the challenge, c, following the Fiat-Shamir heuristic. *)
+      c = fiat_shamir (List.concat [h1_n; h2_n; a1_n; a2_n]) in let
+      (* rᵢ = wᵢ - c * xᵢ *)
+      r_n = List.map2 (fun w x -> G.Z_m.(w - c * x)) w_n x_n in
+    (c, r_n)
+
+  let check_proof (b1, h1_n, b2_n, h2_n) (c, r_n) =
+    (* First check that the lists have the same sizes. *)
+    let same_sizes = List.(
+        Compare.Int.((length h1_n) = (length b2_n) && (length b2_n) = (length h2_n) &&
+                     (length h2_n) = (length r_n))) in
+
+    if not same_sizes then false
+    else
+      let
+        a1_n = List.map2 G.( * )
+          (List.map (G.pow b1) r_n)
+          (List.map (fun h1 -> G.pow h1 c) h1_n)
+      and
+        a2_n = List.map2 G.( * )
+          (List.map2 G.pow b2_n r_n)
+          (List.map (fun h2 -> G.pow h2 c) h2_n)
+      in
+      G.Z_m.(c = fiat_shamir (List.concat [h1_n; h2_n; a1_n; a2_n]))
+end
+
+module type PVSS = sig
+
+  module type ENCODED = sig
+    type t
+    include S.B58_DATA with type t := t
+    include S.ENCODER with type t := t
+  end
+
+  module Commitment : ENCODED
+  module Encrypted_share : ENCODED
+  module Clear_share : ENCODED
+
+  module Public_key : ENCODED
+  module Secret_key : sig
+    include ENCODED
+    val to_public_key : t -> Public_key.t
+  end
+
+  type proof
+
+  val proof_encoding : proof Data_encoding.t
+
+  val dealer_shares_and_proof:
+    secret:Secret_key.t -> t:int -> public_keys:Public_key.t list ->
+    (Encrypted_share.t list * Commitment.t list * proof)
+
+  val check_dealer_proof:
+    Encrypted_share.t list -> Commitment.t list -> proof:proof ->
+    public_keys:Public_key.t list -> bool
+
+  val reveal_share : Encrypted_share.t -> secret_key:Secret_key.t
+    -> public_key:Public_key.t -> Clear_share.t * proof
+
+  val check_revealed_share:
+    Encrypted_share.t -> Clear_share.t -> public_key:Public_key.t -> proof
+    -> bool
+  val reconstruct: Clear_share.t list -> int list -> Public_key.t
+end
+
+module MakePvss (G : CYCLIC_GROUP) : PVSS = struct
+
+  module type ENCODED = sig
+    type t
+    include S.B58_DATA with type t := t
+    include S.ENCODER with type t := t
+  end
+
+  (* Module to make discrete logarithm equality proofs *)
+  module Dleq = MakeDleq (G)
+  type proof = Dleq.proof
+
+  (* Polynomials over ℤ/mℤ *)
+  module PZ_m = PZ_q (G.Z_m)
+
+  (* A public key is a group element *)
+  module Public_key = G
+
+  module Secret_key = struct
+    include G.Z_m
+    let to_public_key x = G.(pow g2 x)
+  end
+
+  module Encrypted_share = G
+  module Clear_share = G
+  module Commitment = G
+
+  let proof_encoding = Dleq.proof_encoding
+
+  (* generate a "random": polynomial of degree t to hide secret `secret` *)
+  let random_polynomial secret t =
+    (* the t-1 coefficients are computed deterministically from
+       the secret and mapped to G.Z_m *)
+
+    let nonce = [String.concat "||" [G.Z_m.to_bits secret]]
+                |> H.hash_string |> H.to_string in
+
+    (* TODO: guard against buffer overlow *)
+    let rec make_coefs = function
+      | 0 -> []
+      | k -> let h =
+               ( H.hash_string [string_of_int k; "||"; nonce])
+               |> H.to_string |> G.Z_m.of_bits_exn in
+          h :: make_coefs (k-1) in
+    let coefs = secret :: (make_coefs (t-1)) in
+
+    (*    let coefs = secret :: List_Utils.list_init ~f:G.Z_m.random ~n:(t-1) in *)
+    let poly = PZ_m.of_list coefs
+    in (coefs, poly)
+
+  (* Hides secret s in a random polynomial of degree t, publishes t commitments
+     to the polynomial coefficients and n encrypted shares for the holders of
+     the public keys *)
+  let dealer_shares_and_proof ~secret ~t ~public_keys =
+    let coefs, poly = random_polynomial secret t in
+    let
+      (*  Cⱼ represents the commitment to the coefficients of the polynomial
+          Cⱼ = g₁^(aⱼ) for j in 0 to t-1  *)
+
+      cC_j = List.map G.(pow g1) coefs and
+
+      (* pᵢ = p(i) for i in 1…n, with i ∈ ℤ/mℤ: points of the polynomial. *)
+      p_i = List.mapi (fun i _ ->
+        PZ_m.eval ~p:poly ~x:(i+1 |> G.Z_m.of_int)) public_keys in let
+
+      (* yᵢ = pkᵢᵖ⁽ⁱ⁾ for i ∈ 1…n: the value of p(i) encrypted with pkᵢ,
+         the public key of the party receiving the iᵗʰ party. The public
+         keys use the g₂ generator of G. Thus pkᵢ = g₂ˢᵏⁱ *)
+      y_i = List.map2 G.pow public_keys p_i and
+
+      (* xᵢ = g₁ᵖ⁽ⁱ⁾ for in in 1…n: commitment to polynomial points *)
+      x_i = List.map G.(pow g1) p_i in let
+
+      equation = Dleq.setup_equation G.g1 x_i public_keys y_i in let
+      proof = Dleq.make_proof equation p_i
+    in (y_i, cC_j, proof)
+
+  let check_dealer_proof y_i cC_j ~proof ~public_keys =
+
+    (* Reconstruct Xᵢ from Cⱼ *)
+    let x_i =
+      (* prod_C_j_to_the__i_to_the_j = i ↦ Πⱼ₌₀ᵗ⁻¹ Cⱼ^(iʲ) *)
+      let prod_C_j_to_the__i_to_the_j i =
+        List.mapi (fun j cC ->G.pow cC (G.Z_m.pow i (Z.of_int j)))
+          cC_j |> (List.fold_left G.( * ) G.e)
+      in
+      List.mapi (fun i _ ->
+          prod_C_j_to_the__i_to_the_j (i+1 |> G.Z_m.of_int)) y_i
+    in let
+      equation = Dleq.setup_equation G.g1 x_i public_keys y_i in
+    Dleq.check_proof equation proof
+
+  (* reveal a share *)
+  let reveal_share y ~secret_key ~public_key  =
+    match G.Z_m.inv secret_key with
+    | None -> failwith "Invalid secret key"
+    | Some inverse_key ->
+        let reveal = G.(pow y inverse_key) in
+        (* y = g₂^(private_key) and public_key = reveal^(private_key) *)
+        let equation = Dleq.setup_equation G.g2 [public_key] [reveal] [y] in
+        let proof = Dleq.make_proof equation [secret_key] in
+        (reveal, proof)
+
+  (* check the validity of a revealed share *)
+  let check_revealed_share share reveal ~public_key proof =
+    let equation = Dleq.setup_equation G.g2 [public_key] [reveal] [share] in
+    Dleq.check_proof equation proof
+
+  (* reconstruct the secret *)
+  let reconstruct reveals int_indices =
+    (* check that there enough reveals *)
+    let indices = List.map (fun x -> G.Z_m.of_int (1+x)) int_indices in
+    let lagrange i =
+      List.fold_left G.Z_m.( * ) G.Z_m.one (
+        List.map (
+          fun j ->
+            if G.Z_m.(j = i) then G.Z_m.one else
+              match G.Z_m.(inv (j - i)) with
+              | None -> failwith "Unexpected error inverting scalar."
+              | Some inverse -> G.Z_m.(j * inverse)
+        ) indices)
+    in let lagrange = List.map lagrange indices in
+    List.fold_left G.( * ) G.e (List.map2 G.pow reveals lagrange)
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/pvss.mli b/vendors/tezos-modded/src/lib_crypto/pvss.mli
new file mode 100644
index 000000000..7e98eccf9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/pvss.mli
@@ -0,0 +1,111 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** PVSS protocol, following
+
+    @see Schoenmakers, B., 1999:
+    A simple publicly verifiable secret sharing scheme
+    and its application to electronic voting. Lecture Notes in Computer Science,
+    pp.148-164.
+    @see https://www.win.tue.nl/~berry/papers/crypto99.pdf
+
+    The protocol is expressed as a functor parametrized by a cyclic group
+    of prime order. Algebraic properties are enforced at the type level,
+    whenever reasonably possible.
+
+*)
+
+module type CYCLIC_GROUP = sig
+
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+
+  val name      : string
+  module Z_m    : Znz.ZN
+  val e         : t
+  val g1        : t
+  val g2        : t
+  val ( * )     : t -> t -> t
+  val (=)       : t -> t -> bool
+  val pow       : t -> Z_m.t -> t
+
+  (** Binary representation *)
+  val to_bits   : t -> String.t
+  val of_bits   : String.t -> t option
+
+end
+
+(** PVSS construction, based on a cyclic group G of prime order *)
+module type PVSS = sig
+
+  module type ENCODED = sig
+    type t
+    include S.B58_DATA with type t := t
+    include S.ENCODER with type t := t
+  end
+
+  module Commitment : ENCODED
+  module Encrypted_share : ENCODED
+  module Clear_share : ENCODED
+
+  module Public_key : ENCODED
+  module Secret_key : sig
+    include ENCODED
+    val to_public_key : t -> Public_key.t
+  end
+
+  type proof
+  val proof_encoding : proof Data_encoding.t
+
+  val dealer_shares_and_proof:
+    secret:Secret_key.t -> t:int -> public_keys:Public_key.t list ->
+    (Encrypted_share.t list * Commitment.t list * proof)
+  (** Lets a dealer share a secret with a set of participant by breaking it into
+      pieces, encrypting it with the participant's public keys, and publishing
+      these encrypted shares. Any t participants can reconstruct the secret. A
+      zero-knowledge proof is produced showing that the  dealer correctly
+      followed the protocol, making the protocol publicly verifiable. *)
+
+  val check_dealer_proof:
+    Encrypted_share.t list -> Commitment.t list -> proof:proof ->
+    public_keys:Public_key.t list -> bool
+  (** Checks the proof produced by the dealer, given the encrypted shares,
+      the commitment list, the proof, and the participant's public keys. *)
+
+  val reveal_share : Encrypted_share.t -> secret_key:Secret_key.t
+    -> public_key:Public_key.t -> Clear_share.t * proof
+  (** Lets a participant provably decrypt an encrypted share. *)
+
+  val check_revealed_share:
+    Encrypted_share.t -> Clear_share.t -> public_key:Public_key.t -> proof
+    -> bool
+  (** Checks that the participant honestly decrypted its share. *)
+
+  val reconstruct: Clear_share.t list -> int list -> Public_key.t
+
+end
+
+module MakePvss : functor (G: CYCLIC_GROUP) -> PVSS
diff --git a/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.ml b/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.ml
new file mode 100644
index 000000000..5aa4d4c84
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.ml
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Secp256k1_group
+
+module G : Pvss.CYCLIC_GROUP = struct
+
+  module Z_m = struct
+    include Group.Scalar
+    let n = Group.order
+    let ( + )   = Group.Scalar.add
+    let ( * )   = Group.Scalar.mul
+    let ( - )   = Group.Scalar.sub
+    let ( = )   = Group.Scalar.equal
+    let inv     = Group.Scalar.inverse
+  end
+
+  include Group
+  let name = "secp256k1"
+
+  (* This pvss algorithm assumes the public keys of the participants receiving
+     shares are based on g2, so we set g2 to Group.g to match regular Secp256k1
+     public keys.
+  *)
+  let g1 = Group.h
+  let g2 = Group.g
+
+  (* We use a multiplicative notation in the pvss module, but
+     secp256k1 usually uses an additive notation. *)
+  let ( * ) = Group.(( + ))
+  let pow x n = Group.mul n x
+
+  let of_bits b =
+    try
+      Some (Group.of_bits_exn b)
+    with _ -> None
+
+end
+
+include Pvss.MakePvss (G)
diff --git a/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.mli b/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.mli
new file mode 100644
index 000000000..5006f2291
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/pvss_secp256k1.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Pvss.PVSS
diff --git a/vendors/tezos-modded/src/lib_crypto/rand.ml b/vendors/tezos-modded/src/lib_crypto/rand.ml
new file mode 100644
index 000000000..ba6c1f5dd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/rand.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 generate = Hacl.Rand.gen
+
+let generate_into ?(pos=0) ?len buf =
+  let buflen = MBytes.length buf in
+  let len = match len with
+    | Some len -> len
+    | None -> buflen - pos in
+  if pos < 0 || len < 0 || pos + len > buflen then
+    invalid_arg (Printf.sprintf "Rand.generate_into: \
+                                 invalid slice (pos=%d len=%d)" pos len) ;
+  let buf = MBytes.sub buf pos len in
+  Hacl.Rand.write buf
diff --git a/vendors/tezos-modded/src/lib_crypto/rand.mli b/vendors/tezos-modded/src/lib_crypto/rand.mli
new file mode 100644
index 000000000..f78f0dac6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/rand.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 generate : int -> Cstruct.buffer
+(** [generate len] is [len] random bytes. *)
+
+val generate_into : ?pos:int -> ?len:int -> Cstruct.buffer -> unit
+(** [generate_into ?pos ?len buf] writes [len] (default:
+    [MBytes.length buf]) bytes in [buf] starting at [pos] (default:
+    [0]). *)
diff --git a/vendors/tezos-modded/src/lib_crypto/s.ml b/vendors/tezos-modded/src/lib_crypto/s.ml
new file mode 100644
index 000000000..75c1722a0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/s.ml
@@ -0,0 +1,254 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+(** {2 Hash Types} ************************************************************)
+
+(** The signature of an abstract hash type, as produced by functor
+    {!Make_Blake2B}. The {!t} type is abstracted for separating the
+    various kinds of hashes in the system at typing time. Each type is
+    equipped with functions to use it as is of as keys in the database
+    or in memory sets and maps. *)
+
+module type MINIMAL_HASH = sig
+
+  type t
+
+  val name: string
+  val title: string
+
+  val pp: Format.formatter -> t -> unit
+  val pp_short: Format.formatter -> t -> unit
+
+  include Compare.S with type t := t
+
+  val hash_bytes: ?key:MBytes.t -> MBytes.t list -> t
+  val hash_string: ?key:string -> string list -> t
+
+  val zero: t
+
+end
+
+module type RAW_DATA = sig
+
+  type t
+
+  val size: int (* in bytes *)
+  val to_hex: t -> Hex.t
+  val of_hex: Hex.t -> t tzresult
+  val of_hex_opt: Hex.t -> t option
+  val of_hex_exn: Hex.t -> t
+
+  val to_string: t -> string
+  val of_string: string -> t tzresult
+  val of_string_opt: string -> t option
+  val of_string_exn: string -> t
+
+  val to_bytes: t -> MBytes.t
+
+  val of_bytes: MBytes.t -> t tzresult
+  val of_bytes_opt: MBytes.t -> t option
+  val of_bytes_exn: MBytes.t -> t
+
+end
+
+module type B58_DATA = sig
+
+  type t
+
+  val to_b58check: t -> string
+  val to_short_b58check: t -> string
+
+  val of_b58check: string -> t tzresult
+  val of_b58check_exn: string -> t
+  val of_b58check_opt: string -> t option
+
+  type Base58.data += Data of t
+  val b58check_encoding: t Base58.encoding
+
+end
+
+module type ENCODER = sig
+
+  type t
+
+  val encoding: t Data_encoding.t
+
+  val rpc_arg: t RPC_arg.t
+
+  val param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, 'arg) Clic.params ->
+    (t -> 'a, 'arg) Clic.params
+
+end
+
+module type PVSS = sig
+
+  type proof
+
+  module Clear_share : sig type t end
+  module Commitment : sig type t end
+  module Encrypted_share : sig type t end
+
+  module Public_key : sig
+    type t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+  end
+
+end
+
+module type INDEXES = sig
+
+  type t
+
+  val hash : t -> int
+
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  val of_path_exn: string list -> t
+
+  val prefix_path: string -> string list
+  val path_length: int
+
+  module Set : sig
+    include Set.S with type elt = t
+    val random_elt: t -> elt
+    val encoding: t Data_encoding.t
+  end
+
+  module Map : sig
+    include Map.S with type key = t
+    val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t
+  end
+
+  module Table : sig
+    include Hashtbl.S with type key = t
+    val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t
+  end
+
+end
+
+module type HASH = sig
+  include MINIMAL_HASH
+  include RAW_DATA with type t := t
+  include B58_DATA with type t := t
+  include ENCODER with type t := t
+  include INDEXES with type t := t
+end
+
+module type MERKLE_TREE = sig
+
+  type elt
+  val elt_bytes: elt -> MBytes.t
+
+  include HASH
+
+  val compute: elt list -> t
+  val empty: t
+
+  type path =
+    | Left of path * t
+    | Right of t * path
+    | Op
+
+  val path_encoding: path Data_encoding.t
+  val bounded_path_encoding: ?max_length:int -> unit -> path Data_encoding.t
+
+  val compute_path: elt list -> int -> path
+  val check_path: path -> elt -> t * int
+
+end
+
+module type SIGNATURE = sig
+
+  module Public_key_hash : sig
+
+    type t
+
+    val pp: Format.formatter -> t -> unit
+    val pp_short: Format.formatter -> t -> unit
+    include Compare.S with type t := t
+    include RAW_DATA with type t := t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+    include INDEXES with type t := t
+
+    val zero: t
+
+    module Logging : sig
+      val tag : t Tag.def
+    end
+  end
+
+  module Public_key : sig
+
+    type t
+
+    val pp: Format.formatter -> t -> unit
+    include Compare.S with type t := t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+
+    val hash: t -> Public_key_hash.t
+
+  end
+
+  module Secret_key : sig
+
+    type t
+
+    val pp: Format.formatter -> t -> unit
+    include Compare.S with type t := t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+
+    val to_public_key: t -> Public_key.t
+
+  end
+
+  type t
+
+  val pp: Format.formatter -> t -> unit
+  include Compare.S with type t := t
+  include B58_DATA with type t := t
+  include ENCODER with type t := t
+
+  val zero: t
+
+  type watermark
+  val sign: ?watermark:watermark -> Secret_key.t -> MBytes.t -> t
+  val check: ?watermark:watermark -> Public_key.t -> t -> MBytes.t -> bool
+
+  val generate_key: ?seed:MBytes.t -> unit -> (Public_key_hash.t * Public_key.t * Secret_key.t)
+
+  val deterministic_nonce: Secret_key.t -> MBytes.t -> MBytes.t
+
+  val deterministic_nonce_hash: Secret_key.t -> MBytes.t -> MBytes.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/secp256k1.ml b/vendors/tezos-modded/src/lib_crypto/secp256k1.ml
new file mode 100644
index 000000000..862af9bdf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/secp256k1.ml
@@ -0,0 +1,293 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Public_key_hash = struct
+  include Blake2B.Make(Base58)(struct
+      let name  = "Secp256k1.Public_key_hash"
+      let title = "A Secp256k1 public key hash"
+      let b58check_prefix = Base58.Prefix.secp256k1_public_key_hash
+      let size = Some 20
+    end)
+  module Logging = struct
+    let tag = Tag.def ~doc:title name pp
+  end
+end
+
+let () =
+  Base58.check_encoded_prefix Public_key_hash.b58check_encoding "tz2" 36
+
+open Libsecp256k1.External
+
+let context =
+  let ctx = Context.create () in
+  match Context.randomize ctx (Rand.generate 32) with
+  | false -> failwith "Secp256k1 context randomization failed. Aborting."
+  | true -> ctx
+
+module Public_key = struct
+
+  type t = Key.public Key.t
+
+  let name  = "Secp256k1.Public_key"
+  let title = "A Secp256k1 public key"
+
+  let to_bytes pk = Key.to_bytes context pk
+  let of_bytes_opt s =
+    try Some (Key.read_pk_exn context s)
+    with _ -> None
+
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let size = Key.compressed_pk_bytes
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.secp256k1_public_key
+      ~length: size
+      ~to_raw: to_string
+      ~of_raw: of_string_opt
+      ~wrap: (fun x -> Data x)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "sppk" 55
+
+  let hash v =
+    Public_key_hash.hash_bytes [to_bytes v]
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (to_bytes a) (to_bytes b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+module Secret_key = struct
+
+  type t = Key.secret Key.t
+
+  let name = "Secp256k1.Secret_key"
+  let title = "A Secp256k1 secret key"
+
+  let size = Key.secret_bytes
+
+  let of_bytes_opt s =
+    match Key.read_sk context s with
+    | Ok x -> Some x
+    | _ -> None
+  let to_bytes x = Key.to_bytes context x
+
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let to_public_key key = Key.neuterize_exn context key
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.secp256k1_secret_key
+      ~length: size
+      ~to_raw: to_string
+      ~of_raw: of_string_opt
+      ~wrap: (fun x -> Data x)
+
+  let () =
+    Base58.check_encoded_prefix b58check_encoding "spsk" 54
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        MBytes.compare (Key.buffer a) (Key.buffer b)
+    end)
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        conv to_bytes of_bytes_exn (Fixed.bytes size)
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+type t = Sign.plain Sign.t
+
+type watermark = MBytes.t
+
+let name = "Secp256k1"
+let title = "A Secp256k1 signature"
+
+let size = Sign.plain_bytes
+
+let of_bytes_opt s =
+  match Sign.read context s with Ok s -> Some s | Error _ -> None
+
+let to_bytes = Sign.to_bytes ~der:false context
+
+let to_string s = MBytes.to_string (to_bytes s)
+let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+type Base58.data +=
+  | Data of t
+
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.secp256k1_signature
+    ~length: size
+    ~to_raw: to_string
+    ~of_raw: of_string_opt
+    ~wrap: (fun x -> Data x)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "spsig1" 99
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare a b =
+      MBytes.compare (Sign.buffer a) (Sign.buffer b)
+  end)
+
+include Helpers.MakeRaw(struct
+    type nonrec t = t
+    let name = name
+    let of_bytes_opt = of_bytes_opt
+    let of_string_opt = of_string_opt
+    let to_string = to_string
+  end)
+
+include Helpers.MakeB58(struct
+    type nonrec t = t
+    let title = title
+    let name = name
+    let b58check_encoding = b58check_encoding
+  end)
+
+include Helpers.MakeEncoder(struct
+    type nonrec t = t
+    let name = name
+    let title = title
+    let raw_encoding =
+      let open Data_encoding in
+      conv to_bytes of_bytes_exn (Fixed.bytes size)
+    let of_b58check = of_b58check
+    let of_b58check_opt = of_b58check_opt
+    let of_b58check_exn = of_b58check_exn
+    let to_b58check = to_b58check
+    let to_short_b58check = to_short_b58check
+  end)
+
+let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+let zero = of_bytes_exn (MBytes.make size '\000')
+
+let sign ?watermark sk msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  Sign.sign_exn context ~sk msg
+
+let check ?watermark public_key signature msg =
+  let msg =
+    Blake2B.to_bytes @@
+    Blake2B.hash_bytes @@
+    match watermark with
+    | None -> [msg]
+    | Some prefix -> [ prefix ; msg ] in
+  Sign.verify_exn context ~pk:public_key ~msg ~signature
+
+let generate_key ?(seed=Rand.generate 32) () =
+  let sk = Key.read_sk_exn context seed in
+  let pk = Key.neuterize_exn context sk in
+  let pkh = Public_key.hash pk in
+  pkh, pk, sk
+
+let deterministic_nonce sk msg =
+  Hacl.Hash.SHA256.HMAC.digest ~key: (Secret_key.to_bytes sk) ~msg
+
+let deterministic_nonce_hash sk msg =
+  Blake2B.to_bytes (Blake2B.hash_bytes [deterministic_nonce sk msg])
diff --git a/vendors/tezos-modded/src/lib_crypto/secp256k1.mli b/vendors/tezos-modded/src/lib_crypto/secp256k1.mli
new file mode 100644
index 000000000..27759aa76
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/secp256k1.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Secp256k1 cryptography *)
+
+include S.SIGNATURE with type watermark = MBytes.t
+include S.RAW_DATA with type t := t
diff --git a/vendors/tezos-modded/src/lib_crypto/secp256k1_group.ml b/vendors/tezos-modded/src/lib_crypto/secp256k1_group.ml
new file mode 100644
index 000000000..cf54b37cd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/secp256k1_group.ml
@@ -0,0 +1,280 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Sp = Libsecp256k1.Internal
+
+module type SCALAR_SIG = sig
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+  val zero : t
+  val one : t
+  val of_Z : Z.t -> t
+  val to_Z : t -> Z.t
+  val of_int : int -> t
+  val add: t -> t -> t
+  val mul: t -> t -> t
+  val negate: t -> t
+  val sub : t -> t -> t
+  val of_bits_exn: string -> t
+  val to_bits: t -> string
+  val inverse: t -> t option
+  val pow: t -> Z.t -> t
+  val equal : t -> t -> bool
+end
+
+module Group : sig
+  val order: Z.t
+  module Scalar : SCALAR_SIG
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+  val e: t
+  val g: t
+  val h: t
+  val of_coordinates: x:Z.t -> y:Z.t -> t
+  val of_bits_exn: string -> t
+  val to_bits: t -> string
+  val mul: Scalar.t -> t -> t
+  val (+): t -> t -> t
+  val (-): t -> t -> t
+  val (=): t -> t -> bool
+end = struct
+
+  let order = Z.of_string_base 16 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141"
+
+  let string_rev s =
+    let len = String.length s in
+    String.init len (fun i -> s.[len - 1 - i])
+
+  let b32_of_Z z =
+    let cs = Cstruct.create 32 in
+    let bits = Z.to_bits z in
+    let length = (min 32 (String.length bits)) in
+    let bits =  String.sub bits 0 length in
+    let bits = string_rev bits in
+    Cstruct.blit_from_string bits 0 cs (32 - length) length;
+    cs
+
+  let z_of_b32 b =
+    b |> Cstruct.to_string |> string_rev |> Z.of_bits
+
+  module Scalar : SCALAR_SIG with type t = Sp.Scalar.t = struct
+    type t = Sp.Scalar.t
+
+    let zero = Sp.Scalar.zero ()
+    let one  = Sp.Scalar.one  ()
+    let equal x y = Sp.Scalar.equal x y
+
+
+    let of_Z z =
+      let z = Z.erem z order in
+      let r = Sp.Scalar.const () in
+      let cs = b32_of_Z z in
+      let _ = Sp.Scalar.set_b32 r cs in r
+
+    let to_Z s =
+      let cs = Cstruct.create 32 in
+      Sp.Scalar.get_b32 cs s; cs |> z_of_b32
+
+    let of_int i = i |> Z.of_int |> of_Z
+
+    let pow t n =
+      Z.powm (to_Z t) n order |> of_Z
+
+    let add x y =
+      let r = Sp.Scalar.const () in
+      let _ = Sp.Scalar.add r x y in r
+
+    let mul x y =
+      let r = Sp.Scalar.const () in
+      Sp.Scalar.mul r x y; r
+
+    let negate x =
+      let r = Sp.Scalar.const () in
+      Sp.Scalar.negate r x; r
+
+    let sub x y =
+      add x (negate y)
+
+    let of_bits_exn bits =
+      let r = Sp.Scalar.const () in
+      (* trim to 32 bytes *)
+      let cs = Cstruct.create 32 in
+      Cstruct.blit_from_string bits 0 cs 0 (min (String.length bits) 32);
+      (* ignore overflow condition, it's always 0 based on the c-code *)
+      let _ = Sp.Scalar.set_b32 r cs in r
+
+    (* TODO, check that we are less than the order *)
+
+    let to_bits x =
+      let c = Cstruct.create 32 in
+      Sp.Scalar.get_b32 c x; Cstruct.to_string c
+
+    let inverse x =
+      if x = zero then
+        None else
+        let r = Sp.Scalar.const () in
+        Sp.Scalar.inverse r x; Some r
+
+    type Base58.data +=
+      | Data of t
+
+    let b58check_encoding =
+      Base58.register_encoding
+        ~prefix: Base58.Prefix.secp256k1_scalar
+        ~length: 32
+        ~to_raw: to_bits
+        ~of_raw: (fun s -> try Some (of_bits_exn s) with _ -> None)
+        ~wrap: (fun x -> Data x)
+
+    let title = "Secp256k1_group.Scalar"
+    let name =  "Anscalar for the secp256k1 group"
+
+    include Helpers.MakeB58(struct
+        type nonrec t = t
+        let title = title
+        let name = name
+        let b58check_encoding = b58check_encoding
+      end)
+
+    include Helpers.MakeEncoder(struct
+        type nonrec t = t
+        let name = name
+        let title = title
+        let raw_encoding = Data_encoding.(conv to_bits of_bits_exn string)
+        let to_b58check = to_b58check
+        let to_short_b58check = to_short_b58check
+        let of_b58check = of_b58check
+        let of_b58check_opt = of_b58check_opt
+        let of_b58check_exn = of_b58check_exn
+      end)
+  end
+
+  type t = Sp.Group.Jacobian.t
+  (* type ge = Sp.Group.ge *)
+
+  let field_of_Z z =
+    let fe = Sp.Field.const () in
+    let cs = b32_of_Z z in
+    let _ = Sp.Field.set_b32 fe cs in fe
+
+  let group_of_jacobian j =
+    let r = Sp.Group.of_fields () in
+    Sp.Group.Jacobian.get_ge r j; r
+
+  let jacobian_of_group g =
+    let j = Sp.Group.Jacobian.of_fields () in
+    Sp.Group.Jacobian.set_ge j g; j
+
+
+  let of_coordinates ~x ~y =
+    Sp.Group.of_fields
+      ~x:(field_of_Z x) ~y:(field_of_Z y) () |> jacobian_of_group
+
+  let e =
+    Sp.Group.Jacobian.of_fields ~infinity:true ()
+
+  let g =
+    let gx = Z.of_string "55066263022277343669578718895168534326250603453777594175500187360389116729240"
+    and gy = Z.of_string "32670510020758816978083085130507043184471273380659243275938904335757337482424" in
+    of_coordinates ~x:gx ~y:gy
+
+  (* To obtain the second generator, take the sha256 hash of the decimal representation of g1_y
+       python -c "import hashlib;print int(hashlib.sha256('32670510020758816978083085130507043184471273380659243275938904335757337482424').hexdigest(),16)"
+  *)
+  let h =
+    let hx = Z.of_string "54850469061264194188802857211425616972714231399857248865148107587305936171824"
+    and hy = Z.of_string "6558914719042992724977242403721980463337660510165027616783569279181206179101" in
+    of_coordinates ~x:hx ~y:hy
+
+  let (+) x y =
+    let r = Sp.Group.Jacobian.of_fields () in
+    Sp.Group.Jacobian.add_var r x y; r
+
+  let (-) x y =
+    let neg_y = Sp.Group.Jacobian.of_fields () in
+    Sp.Group.Jacobian.neg neg_y y; x + neg_y
+
+  let (=) x y = Sp.Group.Jacobian.is_infinity (x - y)
+
+  let mul s g =
+    let r = Sp.Group.Jacobian.of_fields () in
+    Sp.Group.Jacobian.mul r (group_of_jacobian g) s; r
+
+  let to_bits j =
+    let x = group_of_jacobian j
+    and buf = Cstruct.create 33 in
+    let cs =  (Sp.Group.to_pubkey ~compress:true buf x) in
+    Cstruct.to_string cs
+
+  let of_bits_exn bits =
+    let buf = Cstruct.of_string bits
+    and x = Sp.Group.of_fields () in
+    Sp.Group.from_pubkey x buf;
+    x |> jacobian_of_group
+
+
+  module Encoding = struct
+    type Base58.data +=
+      | Data of t
+
+    let title = "Secp256k1_group.Group"
+    let name =  "An element of secp256k1"
+
+    let b58check_encoding =
+      Base58.register_encoding
+        ~prefix: Base58.Prefix.secp256k1_element
+        ~length: 33
+        ~to_raw: to_bits
+        ~of_raw: (fun s -> try Some (of_bits_exn s) with _ -> None)
+        ~wrap: (fun x -> Data x)
+
+    include Helpers.MakeB58(
+      struct
+        type nonrec t = t
+        let title = title
+        let name = name
+        let b58check_encoding = b58check_encoding
+      end)
+
+    include Helpers.MakeEncoder(
+      struct
+        type nonrec t = t
+        let name = name
+        let title = title
+        let raw_encoding = Data_encoding.(conv to_bits of_bits_exn string)
+        let to_b58check = to_b58check
+        let to_short_b58check = to_short_b58check
+        let of_b58check = of_b58check
+        let of_b58check_opt = of_b58check_opt
+        let of_b58check_exn = of_b58check_exn
+      end
+      )
+  end
+
+  include Encoding
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/secp256k1_group.mli b/vendors/tezos-modded/src/lib_crypto/secp256k1_group.mli
new file mode 100644
index 000000000..aa77d7da2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/secp256k1_group.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Type for the group of integers modulo the order of the curve ℤ/pℤ *)
+module type SCALAR_SIG = sig
+
+  (** Element of the scalar group *)
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+
+  val zero : t
+  val one : t
+  val of_Z : Z.t -> t
+  val to_Z : t -> Z.t
+  val of_int : int -> t
+  val add: t -> t -> t
+  val mul: t -> t -> t
+  val negate: t -> t
+  val sub: t -> t -> t
+  val of_bits_exn: string -> t
+  val to_bits: t -> string
+  val inverse: t -> t option
+
+  (** Modular exponentiation*)
+  val pow: t -> Z.t -> t
+  val equal: t -> t -> bool
+end
+
+module Group : sig
+
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+
+  val order: Z.t
+  module Scalar : SCALAR_SIG
+  val e: t
+  val g : t
+  val h : t
+  val of_coordinates: x:Z.t -> y:Z.t  -> t
+  val of_bits_exn: string -> t
+  val to_bits: t -> string
+
+  val mul: Scalar.t -> t -> t
+  val (+): t -> t -> t
+  val (-): t -> t -> t
+  val (=): t -> t -> bool
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/signature.ml b/vendors/tezos-modded/src/lib_crypto/signature.ml
new file mode 100644
index 000000000..2d1818652
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/signature.ml
@@ -0,0 +1,615 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+type public_key_hash =
+  | Ed25519 of Ed25519.Public_key_hash.t
+  | Secp256k1 of Secp256k1.Public_key_hash.t
+  | P256 of P256.Public_key_hash.t
+
+type public_key =
+  | Ed25519 of Ed25519.Public_key.t
+  | Secp256k1 of Secp256k1.Public_key.t
+  | P256 of P256.Public_key.t
+
+type secret_key =
+  | Ed25519 of Ed25519.Secret_key.t
+  | Secp256k1 of Secp256k1.Secret_key.t
+  | P256 of P256.Secret_key.t
+
+type watermark =
+  | Block_header of Chain_id.t
+  | Endorsement of Chain_id.t
+  | Generic_operation
+  | Custom of MBytes.t
+
+module Public_key_hash = struct
+
+  type t = public_key_hash =
+    | Ed25519 of Ed25519.Public_key_hash.t
+    | Secp256k1 of Secp256k1.Public_key_hash.t
+    | P256 of P256.Public_key_hash.t
+
+  let name = "Signature.Public_key_hash"
+  let title = "A Ed25519, Secp256k1, or P256 public key hash"
+
+  type Base58.data += Data of t (* unused *)
+  let b58check_encoding = (* unused *)
+    Base58.register_encoding
+      ~prefix: "\255\255"
+      ~length: 2
+      ~to_raw: (fun _ -> assert false)
+      ~of_raw: (fun _ -> assert false)
+      ~wrap: (fun x -> Data x)
+
+  let raw_encoding =
+    let open Data_encoding in
+    def "public_key_hash" ~description:title @@
+    union [
+      case (Tag 0) Ed25519.Public_key_hash.encoding
+        ~title:"Ed25519"
+        (function Ed25519 x -> Some x | _ -> None)
+        (function x -> Ed25519 x);
+      case (Tag 1) Secp256k1.Public_key_hash.encoding
+        ~title:"Secp256k1"
+        (function Secp256k1 x -> Some x | _ -> None)
+        (function x -> Secp256k1 x) ;
+      case (Tag 2)
+        ~title:"P256" P256.Public_key_hash.encoding
+        (function P256 x -> Some x | _ -> None)
+        (function x -> P256 x)
+    ]
+
+  let to_bytes s =
+    Data_encoding.Binary.to_bytes_exn raw_encoding s
+  let of_bytes_opt s =
+    Data_encoding.Binary.of_bytes raw_encoding s
+  let to_string s = MBytes.to_string (to_bytes s)
+  let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+  let size = 1 + Ed25519.size
+
+  let zero = Ed25519 Ed25519.Public_key_hash.zero
+
+  include Helpers.MakeRaw(struct
+      type nonrec t = t
+      let name = name
+      let of_bytes_opt = of_bytes_opt
+      let of_string_opt = of_string_opt
+      let to_string = to_string
+    end)
+
+  let of_b58check_opt s =
+    match Base58.decode s with
+    | Some Ed25519.Public_key_hash.Data pkh -> Some (Ed25519 pkh)
+    | Some Secp256k1.Public_key_hash.Data pkh -> Some (Secp256k1 pkh)
+    | Some P256.Public_key_hash.Data pkh -> Some (P256 pkh)
+    | _ -> None
+
+  let of_b58check_exn s =
+    match of_b58check_opt s with
+    | Some x -> x
+    | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" name
+  let of_b58check s =
+    match of_b58check_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error
+          "Failed to read a b58check_encoding data (%s): %S"
+          name s
+
+  let to_b58check = function
+    | Ed25519 pkh -> Ed25519.Public_key_hash.to_b58check pkh
+    | Secp256k1 pkh -> Secp256k1.Public_key_hash.to_b58check pkh
+    | P256 pkh -> P256.Public_key_hash.to_b58check pkh
+
+  let to_short_b58check = function
+    | Ed25519 pkh -> Ed25519.Public_key_hash.to_short_b58check pkh
+    | Secp256k1 pkh -> Secp256k1.Public_key_hash.to_short_b58check pkh
+    | P256 pkh -> P256.Public_key_hash.to_short_b58check pkh
+
+  let to_path key l = match key with
+    | Ed25519 h -> "ed25519" :: Ed25519.Public_key_hash.to_path h l
+    | Secp256k1 h -> "secp256k1" :: Secp256k1.Public_key_hash.to_path h l
+    | P256 h -> "p256" :: P256.Public_key_hash.to_path h l
+
+  let of_path = function
+    | "ed25519" :: q ->  begin
+        match Ed25519.Public_key_hash.of_path q with
+        | Some pkh -> Some (Ed25519 pkh)
+        | None -> None
+      end
+    | "secp256k1" :: q -> begin
+        match Secp256k1.Public_key_hash.of_path q with
+        | Some pkh -> Some (Secp256k1 pkh)
+        | None -> None
+      end
+    | "p256" :: q -> begin
+        match P256.Public_key_hash.of_path q with
+        | Some pkh -> Some (P256 pkh)
+        | None -> None
+      end
+    | _ -> assert false (* FIXME classification des erreurs *)
+
+  let of_path_exn = function
+    | "ed25519" :: q -> Ed25519 (Ed25519.Public_key_hash.of_path_exn q)
+    | "secp256k1" :: q -> Secp256k1 (Secp256k1.Public_key_hash.of_path_exn q)
+    | "p256" :: q -> P256 (P256.Public_key_hash.of_path_exn q)
+    | _ -> assert false (* FIXME classification des erreurs *)
+
+  let path_length =
+    let l1 = Ed25519.Public_key_hash.path_length
+    and l2 = Secp256k1.Public_key_hash.path_length
+    and l3 = P256.Public_key_hash.path_length in
+    assert Compare.Int.(l1 = l2) ;
+    assert Compare.Int.(l1 = l3) ;
+    1 + l1
+
+  let prefix_path _ = assert false (* unused *)
+
+  let hash = Hashtbl.hash
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b =
+        match (a, b) with
+        | Ed25519 x, Ed25519 y ->
+            Ed25519.Public_key_hash.compare x y
+        | Secp256k1 x, Secp256k1 y ->
+            Secp256k1.Public_key_hash.compare x y
+        | P256 x, P256 y ->
+            P256.Public_key_hash.compare x y
+        | _ -> Pervasives.compare a b
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding = raw_encoding
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  include Helpers.MakeIterator(struct
+      type nonrec t = t
+      let hash = hash
+      let compare = compare
+      let equal = equal
+      let encoding = encoding
+    end)
+
+  let rpc_arg =
+    RPC_arg.like
+      rpc_arg
+      ~descr:"A Secp256k1 of a Ed25519 public key hash (Base58Check-encoded)"
+      "pkh"
+
+  module Logging = struct
+    let tag = Tag.def ~doc:title name pp
+  end
+end
+
+module Public_key = struct
+
+  type t = public_key =
+    | Ed25519 of Ed25519.Public_key.t
+    | Secp256k1 of Secp256k1.Public_key.t
+    | P256 of P256.Public_key.t
+
+  let name = "Signature.Public_key"
+  let title = "A Ed25519, Secp256k1, or P256 public key"
+
+  let hash pk =
+    match pk with
+    | Ed25519 pk -> Public_key_hash.Ed25519 (Ed25519.Public_key.hash pk)
+    | Secp256k1 pk -> Public_key_hash.Secp256k1 (Secp256k1.Public_key.hash pk)
+    | P256 pk -> Public_key_hash.P256 (P256.Public_key.hash pk)
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b = match (a, b) with
+        | Ed25519 x, Ed25519 y -> Ed25519.Public_key.compare x y
+        | Secp256k1 x, Secp256k1 y -> Secp256k1.Public_key.compare x y
+        | P256 x, P256 y -> P256.Public_key.compare x y
+        | _ -> Pervasives.compare a b
+    end)
+
+  type Base58.data += Data of t (* unused *)
+  let b58check_encoding = (* unused *)
+    Base58.register_encoding
+      ~prefix: "\255\255"
+      ~length: 2
+      ~to_raw: (fun _ -> assert false)
+      ~of_raw: (fun _ -> assert false)
+      ~wrap: (fun x -> Data x)
+
+  let of_b58check_opt s =
+    match Base58.decode s with
+    | Some (Ed25519.Public_key.Data public_key) -> Some (Ed25519 public_key)
+    | Some (Secp256k1.Public_key.Data public_key) -> Some (Secp256k1 public_key)
+    | Some (P256.Public_key.Data public_key) -> Some (P256 public_key)
+    | _ -> None
+
+  let of_b58check_exn s =
+    match of_b58check_opt s with
+    | Some x -> x
+    | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" name
+  let of_b58check s =
+    match of_b58check_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error
+          "Failed to read a b58check_encoding data (%s): %S"
+          name s
+
+  let to_b58check = function
+    | Ed25519 pk -> Ed25519.Public_key.to_b58check pk
+    | Secp256k1 pk -> Secp256k1.Public_key.to_b58check pk
+    | P256 pk -> P256.Public_key.to_b58check pk
+
+  let to_short_b58check = function
+    | Ed25519 pk -> Ed25519.Public_key.to_short_b58check pk
+    | Secp256k1 pk -> Secp256k1.Public_key.to_short_b58check pk
+    | P256 pk -> P256.Public_key.to_short_b58check pk
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        def "public_key" ~description:title @@
+        union [
+          case (Tag 0) Ed25519.Public_key.encoding
+            ~title:"Ed25519"
+            (function Ed25519 x -> Some x | _ -> None)
+            (function x -> Ed25519 x);
+          case (Tag 1) Secp256k1.Public_key.encoding
+            ~title:"Secp256k1"
+            (function Secp256k1 x -> Some x | _ -> None)
+            (function x -> Secp256k1 x) ;
+          case
+            ~title:"P256" (Tag 2) P256.Public_key.encoding
+            (function P256 x -> Some x | _ -> None)
+            (function x -> P256 x)
+        ]
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+module Secret_key = struct
+
+  type t = secret_key =
+    | Ed25519 of Ed25519.Secret_key.t
+    | Secp256k1 of Secp256k1.Secret_key.t
+    | P256 of P256.Secret_key.t
+
+  let name = "Signature.Secret_key"
+  let title = "A Ed25519, Secp256k1 or P256 secret key"
+
+  let to_public_key = function
+    | Ed25519 sk -> Public_key.Ed25519 (Ed25519.Secret_key.to_public_key sk)
+    | Secp256k1 sk -> Public_key.Secp256k1 (Secp256k1.Secret_key.to_public_key sk)
+    | P256 sk -> Public_key.P256 (P256.Secret_key.to_public_key sk)
+
+  include Compare.Make(struct
+      type nonrec t = t
+      let compare a b = match (a, b) with
+        | Ed25519 x, Ed25519 y -> Ed25519.Secret_key.compare x y
+        | Secp256k1 x, Secp256k1 y -> Secp256k1.Secret_key.compare x y
+        | P256 x, P256 y -> P256.Secret_key.compare x y
+        | _ -> Pervasives.compare a b
+    end)
+
+  type Base58.data += Data of t (* unused *)
+  let b58check_encoding = (* unused *)
+    Base58.register_encoding
+      ~prefix: "\255\255"
+      ~length: 2
+      ~to_raw: (fun _ -> assert false)
+      ~of_raw: (fun _ -> assert false)
+      ~wrap: (fun x -> Data x)
+
+  let of_b58check_opt b =
+    match Base58.decode b with
+    | Some (Ed25519.Secret_key.Data sk) -> Some (Ed25519 sk)
+    | Some (Secp256k1.Secret_key.Data sk) -> Some (Secp256k1 sk)
+    | Some (P256.Secret_key.Data sk) -> Some (P256 sk)
+    | _ -> None
+
+  let of_b58check_exn s =
+    match of_b58check_opt s with
+    | Some x -> x
+    | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" name
+  let of_b58check s =
+    match of_b58check_opt s with
+    | Some x -> Ok x
+    | None ->
+        generic_error
+          "Failed to read a b58check_encoding data (%s): %S"
+          name s
+
+  let to_b58check = function
+    | Ed25519 sk -> Ed25519.Secret_key.to_b58check sk
+    | Secp256k1 sk -> Secp256k1.Secret_key.to_b58check sk
+    | P256 sk -> P256.Secret_key.to_b58check sk
+
+  let to_short_b58check = function
+    | Ed25519 sk -> Ed25519.Secret_key.to_short_b58check sk
+    | Secp256k1 sk -> Secp256k1.Secret_key.to_short_b58check sk
+    | P256 sk -> P256.Secret_key.to_short_b58check sk
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding =
+        let open Data_encoding in
+        def "secret_key" ~description:title @@
+        union [
+          case (Tag 0) Ed25519.Secret_key.encoding
+            ~title:"Ed25519"
+            (function Ed25519 x -> Some x | _ -> None)
+            (function x -> Ed25519 x);
+          case (Tag 1) Secp256k1.Secret_key.encoding
+            ~title:"Secp256k1"
+            (function Secp256k1 x -> Some x | _ -> None)
+            (function x -> Secp256k1 x) ;
+          case (Tag 2)
+            ~title:"P256" P256.Secret_key.encoding
+            (function P256 x -> Some x | _ -> None)
+            (function x -> P256 x)
+        ]
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+    end)
+
+  let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+end
+
+type t =
+  | Ed25519 of Ed25519.t
+  | Secp256k1 of Secp256k1.t
+  | P256 of P256.t
+  | Unknown of MBytes.t
+
+let name = "Signature"
+let title = "A Ed25519, Secp256k1 or P256 signature"
+
+let size =
+  assert (Ed25519.size = Secp256k1.size && Secp256k1.size = P256.size) ;
+  Ed25519.size
+
+let to_bytes = function
+  | Ed25519 b -> Ed25519.to_bytes b
+  | Secp256k1 b -> Secp256k1.to_bytes b
+  | P256 b -> P256.to_bytes b
+  | Unknown b -> b
+
+let of_bytes_opt s =
+  if MBytes.length s = size then Some (Unknown s) else None
+
+let to_string s = MBytes.to_string (to_bytes s)
+let of_string_opt s = of_bytes_opt (MBytes.of_string s)
+
+type Base58.data += Data of t
+let b58check_encoding =
+  Base58.register_encoding
+    ~prefix: Base58.Prefix.generic_signature
+    ~length: Ed25519.size
+    ~to_raw: to_string
+    ~of_raw: of_string_opt
+    ~wrap: (fun x -> Data x)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "sig" 96
+
+include Helpers.MakeRaw(struct
+    type nonrec t = t
+    let name = name
+    let of_bytes_opt = of_bytes_opt
+    let of_string_opt = of_string_opt
+    let to_string = to_string
+  end)
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare a b =
+      let a = to_bytes a
+      and b = to_bytes b in
+      MBytes.compare a b
+  end)
+
+let of_b58check_opt s =
+  if TzString.has_prefix ~prefix:Ed25519.b58check_encoding.encoded_prefix s then
+    Option.map
+      (Ed25519.of_b58check_opt s)
+      ~f: (fun x -> Ed25519 x)
+  else if TzString.has_prefix ~prefix:Secp256k1.b58check_encoding.encoded_prefix s then
+    Option.map
+      (Secp256k1.of_b58check_opt s)
+      ~f: (fun x -> Secp256k1 x)
+  else if TzString.has_prefix ~prefix:P256.b58check_encoding.encoded_prefix s then
+    Option.map
+      (P256.of_b58check_opt s)
+      ~f: (fun x -> P256 x)
+  else
+    Base58.simple_decode b58check_encoding s
+
+let of_b58check_exn s =
+  match of_b58check_opt s with
+  | Some x -> x
+  | None -> Format.kasprintf Pervasives.failwith "Unexpected data (%s)" name
+let of_b58check s =
+  match of_b58check_opt s with
+  | Some x -> Ok x
+  | None ->
+      generic_error
+        "Failed to read a b58check_encoding data (%s): %S"
+        name s
+
+let to_b58check = function
+  | Ed25519 b -> Ed25519.to_b58check b
+  | Secp256k1 b -> Secp256k1.to_b58check b
+  | P256 b -> P256.to_b58check b
+  | Unknown b -> Base58.simple_encode b58check_encoding (Unknown b)
+
+let to_short_b58check = function
+  | Ed25519 b -> Ed25519.to_short_b58check b
+  | Secp256k1 b -> Secp256k1.to_short_b58check b
+  | P256 b -> P256.to_short_b58check b
+  | Unknown b -> Base58.simple_encode b58check_encoding (Unknown b)
+
+include Helpers.MakeEncoder(struct
+    type nonrec t = t
+    let name = name
+    let title = title
+    let raw_encoding =
+      Data_encoding.conv
+        to_bytes
+        of_bytes_exn
+        (Data_encoding.Fixed.bytes size)
+    let of_b58check = of_b58check
+    let of_b58check_opt = of_b58check_opt
+    let of_b58check_exn = of_b58check_exn
+    let to_b58check = to_b58check
+    let to_short_b58check = to_short_b58check
+  end)
+
+let pp ppf t = Format.fprintf ppf "%s" (to_b58check t)
+
+let of_ed25519 s = Ed25519 s
+let of_secp256k1 s = Secp256k1 s
+let of_p256 s = P256 s
+
+let zero = of_ed25519 Ed25519.zero
+
+let bytes_of_watermark = function
+  | Block_header chain_id -> MBytes.concat "" [ MBytes.of_string "\x01" ; Chain_id.to_bytes chain_id ]
+  | Endorsement chain_id -> MBytes.concat "" [ MBytes.of_string "\x02" ; Chain_id.to_bytes chain_id ]
+  | Generic_operation -> MBytes.of_string "\x03"
+  | Custom bytes      -> bytes
+
+let sign ?watermark secret_key message =
+  let watermark = Option.map ~f:bytes_of_watermark watermark in
+  match secret_key with
+  | Secret_key.Ed25519 sk -> of_ed25519 (Ed25519.sign ?watermark sk message)
+  | Secp256k1 sk -> of_secp256k1 (Secp256k1.sign ?watermark sk message)
+  | P256 sk -> of_p256 (P256.sign ?watermark sk message)
+
+let check ?watermark public_key signature message =
+  let watermark = Option.map ~f:bytes_of_watermark watermark in
+  match public_key, signature with
+  | Public_key.Ed25519 pk, Unknown signature -> begin
+      match Ed25519.of_bytes_opt signature with
+      | Some s -> Ed25519.check ?watermark pk s message
+      | None -> false
+    end
+  | Public_key.Secp256k1 pk, Unknown signature -> begin
+      match Secp256k1.of_bytes_opt signature with
+      | Some s -> Secp256k1.check ?watermark pk s message
+      | None -> false
+    end
+  | Public_key.P256 pk, Unknown signature -> begin
+      match P256.of_bytes_opt signature with
+      | Some s -> P256.check ?watermark pk s message
+      | None -> false
+    end
+  | Public_key.Ed25519 pk, Ed25519 signature ->
+      Ed25519.check ?watermark pk signature message
+  | Public_key.Secp256k1 pk, Secp256k1 signature ->
+      Secp256k1.check ?watermark pk signature message
+  | Public_key.P256 pk, P256 signature ->
+      P256.check ?watermark pk signature message
+  | _ -> false
+
+let append ?watermark sk msg =
+  MBytes.concat "" [msg; (to_bytes (sign ?watermark sk msg))]
+
+let concat msg signature =
+  MBytes.concat "" [msg; (to_bytes signature)]
+
+type algo =
+  | Ed25519
+  | Secp256k1
+  | P256
+
+let algo_param () =
+  Clic.parameter
+    ~autocomplete:(fun _ -> return [ "ed25519" ; "secp256k1" ; "p256"])
+    begin fun _ name ->
+      match name with
+      | "ed25519" -> return Ed25519
+      | "secp256k1" -> return Secp256k1
+      | "p256" -> return P256
+      | name ->
+          failwith
+            "Unknown signature algorithm (%s). \
+             Available: 'ed25519', 'secp256k1' or 'p256'"
+            name
+    end
+
+let generate_key ?(algo = Ed25519) ?seed () =
+  match algo with
+  | Ed25519 ->
+      let pkh, pk, sk = Ed25519.generate_key ?seed () in
+      (Public_key_hash.Ed25519 pkh,
+       Public_key.Ed25519 pk, Secret_key.Ed25519 sk)
+  | Secp256k1 ->
+      let pkh, pk, sk = Secp256k1.generate_key ?seed () in
+      (Public_key_hash.Secp256k1 pkh,
+       Public_key.Secp256k1 pk, Secret_key.Secp256k1 sk)
+  | P256 ->
+      let pkh, pk, sk = P256.generate_key ?seed () in
+      (Public_key_hash.P256 pkh,
+       Public_key.P256 pk, Secret_key.P256 sk)
+
+let deterministic_nonce sk msg =
+  match sk with
+  | Secret_key.Ed25519 sk   -> Ed25519.deterministic_nonce sk msg
+  | Secret_key.Secp256k1 sk -> Secp256k1.deterministic_nonce sk msg
+  | Secret_key.P256 sk      -> P256.deterministic_nonce sk msg
+
+let deterministic_nonce_hash sk msg =
+  match sk with
+  | Secret_key.Ed25519 sk   -> Ed25519.deterministic_nonce_hash sk msg
+  | Secret_key.Secp256k1 sk -> Secp256k1.deterministic_nonce_hash sk msg
+  | Secret_key.P256 sk      -> P256.deterministic_nonce_hash sk msg
diff --git a/vendors/tezos-modded/src/lib_crypto/signature.mli b/vendors/tezos-modded/src/lib_crypto/signature.mli
new file mode 100644
index 000000000..8cac6dd2c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/signature.mli
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type public_key_hash =
+  | Ed25519 of Ed25519.Public_key_hash.t
+  | Secp256k1 of Secp256k1.Public_key_hash.t
+  | P256 of P256.Public_key_hash.t
+
+type public_key =
+  | Ed25519 of Ed25519.Public_key.t
+  | Secp256k1 of Secp256k1.Public_key.t
+  | P256 of P256.Public_key.t
+
+type secret_key =
+  | Ed25519 of Ed25519.Secret_key.t
+  | Secp256k1 of Secp256k1.Secret_key.t
+  | P256 of P256.Secret_key.t
+
+type watermark =
+  | Block_header of Chain_id.t
+  | Endorsement of Chain_id.t
+  | Generic_operation
+  | Custom of MBytes.t
+
+val bytes_of_watermark: watermark -> MBytes.t
+
+include S.SIGNATURE with type Public_key_hash.t = public_key_hash
+                     and type Public_key.t = public_key
+                     and type Secret_key.t = secret_key
+                     and type watermark := watermark
+
+val append : ?watermark:watermark -> secret_key -> MBytes.t -> MBytes.t
+(** [append sk buf] is the concatenation of [buf] and the
+    serialization of the signature of [buf] signed by [sk]. *)
+
+val concat : MBytes.t -> t -> MBytes.t
+(** [concat buf t] is the concatenation of [buf] and the serialization
+    of [t]. *)
+
+include S.RAW_DATA with type t := t
+
+val of_secp256k1 : Secp256k1.t -> t
+val of_ed25519 : Ed25519.t -> t
+val of_p256 : P256.t -> t
+
+type algo =
+  | Ed25519
+  | Secp256k1
+  | P256
+
+val algo_param: unit -> (algo, 'a) Clic.parameter
+
+val generate_key:
+  ?algo:algo ->
+  ?seed:MBytes.t ->
+  unit -> public_key_hash * public_key * secret_key
diff --git a/vendors/tezos-modded/src/lib_crypto/test/dune b/vendors/tezos-modded/src/lib_crypto/test/dune
new file mode 100644
index 000000000..48ce21e76
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/dune
@@ -0,0 +1,63 @@
+(executables
+ (names test_merkle
+        test_base58
+        test_ed25519
+        test_blake2b
+        test_pvss
+	test_deterministic_nonce)
+ (libraries tezos-stdlib
+            tezos-crypto
+            tezos-data-encoding
+            alcotest)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_stdlib
+                   -open Tezos_crypto
+                   -open Tezos_data_encoding)))
+
+(alias
+ (name buildtest)
+ (deps test_merkle.exe
+       test_base58.exe
+       test_ed25519.exe
+       test_blake2b.exe
+       test_pvss.exe
+       test_deterministic_nonce.exe))
+
+(alias
+ (name runtest_merkle)
+ (action (run %{exe:test_merkle.exe})))
+
+(alias
+ (name runtest_base58)
+ (action (run %{exe:test_base58.exe})))
+
+(alias
+ (name runtest_ed25519)
+ (action (run %{exe:test_ed25519.exe})))
+
+(alias
+ (name runtest_blake2b)
+ (action (run %{exe:test_blake2b.exe})))
+
+(alias
+ (name runtest_pvss)
+ (action (run %{exe:test_pvss.exe})))
+
+(alias
+ (name runtest_deterministic_nonce)
+ (action (run %{exe:test_deterministic_nonce.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_merkle)
+       (alias runtest_base58)
+       (alias runtest_ed25519)
+       (alias runtest_blake2b)
+       (alias runtest_pvss)
+	   (alias runtest_deterministic_nonce)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_crypto/test/roundtrips.ml b/vendors/tezos-modded/src/lib_crypto/test/roundtrips.ml
new file mode 100644
index 000000000..7d0cbcf0d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/roundtrips.ml
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 test_rt_opt name testable enc dec input =
+  try
+    let roundtripped = dec (enc input) in
+    Alcotest.check (Alcotest.option testable) name (Some input) roundtripped
+  with
+    exc ->
+      Alcotest.failf "%s failed for %a: exception whilst decoding: %s"
+        name (Alcotest.pp testable) input (Printexc.to_string exc)
+
+let test_decode_opt_safe name testable dec encoded =
+  match dec encoded with
+  | Some _ | None -> ()
+  | exception exc ->
+      Alcotest.failf "%s failed for %a: exception whilst decoding: %s"
+        name (Alcotest.pp testable) encoded (Printexc.to_string exc)
+
+let test_decode_opt_fail name testable dec encoded =
+  try
+    let decoded = dec encoded in
+    Alcotest.check (Alcotest.option testable) name None decoded
+  with
+    exc ->
+      Alcotest.failf "%s failed: exception whilst decoding: %s"
+        name (Printexc.to_string exc)
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_base58.ml b/vendors/tezos-modded/src/lib_crypto/test/test_base58.ml
new file mode 100644
index 000000000..50262e651
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_base58.ml
@@ -0,0 +1,91 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 test_roundtrip_safe input =
+  Roundtrips.test_rt_opt
+    "safe base58"
+    Alcotest.string
+    Base58.safe_encode Base58.safe_decode
+    input
+
+let test_roundtrip_raw input =
+  Roundtrips.test_rt_opt
+    "raw base58"
+    Alcotest.string
+    Base58.raw_encode Base58.raw_decode
+    input
+
+let inputs = [
+  "abc";
+  (string_of_int max_int);
+  "0";
+  "00";
+  "000";
+  "0000";
+  "0000000000000000";
+  (String.make 64 '0');
+  "1";
+  "11";
+  "111";
+  "1111";
+  (String.make 2048 '0');
+  "2";
+  "22";
+  "5";
+  "Z";
+  (String.make 2048 'Z');
+  "z";
+  "zz";
+  "zzzzzzzz";
+  (String.make 2048 'z');
+  (*loads of ascii characters: codes between 32 and 126 *)
+  (String.init 1000 (fun i -> (Char.chr (32 + (i mod (126 - 32))))));
+  "";
+]
+
+let test_roundtrip_safes () = List.iter test_roundtrip_safe inputs
+
+let test_roundtrip_raws () = List.iter test_roundtrip_raw inputs
+
+
+let test_safety input =
+  Roundtrips.test_decode_opt_safe
+    "safe base58"
+    Alcotest.string
+    Base58.safe_decode
+    input
+
+let test_safetys () = List.iter test_safety inputs
+
+let tests = [
+  "safe decoding", `Quick, test_safetys;
+  "safe encoding/decoding", `Quick, test_roundtrip_safes;
+  "raw encoding/decoding", `Quick, test_roundtrip_raws;
+]
+
+let () =
+  Alcotest.run "tezos-crypto" [
+    "base58", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_blake2b.ml b/vendors/tezos-modded/src/lib_crypto/test/test_blake2b.ml
new file mode 100644
index 000000000..78cea85c0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_blake2b.ml
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 test_hashed_roundtrip name enc dec input =
+  (* this wrapper to start with hashing *)
+  Roundtrips.test_rt_opt
+    name
+    (Alcotest.testable
+       (fun fmt (input, _) -> Format.fprintf fmt "%s" input)
+       (fun (_, hashed) (_, decoded) -> hashed = decoded)
+    )
+    (fun (_, hashed) -> enc hashed)
+    (fun encoded -> match dec encoded with
+       | None -> None
+       | Some decoded -> Some (input, decoded)
+    )
+    (input, Blake2B.hash_string [input])
+
+let test_roundtrip_hex input =
+  test_hashed_roundtrip "Hex" Blake2B.to_hex Blake2B.of_hex_opt input
+
+let test_roundtrip_string input =
+  test_hashed_roundtrip "String" Blake2B.to_string Blake2B.of_string_opt input
+
+let inputs = [
+  "abc";
+  (string_of_int max_int);
+  "0";
+  "00";
+  (String.make 64 '0');
+  (*loads of ascii characters: codes between 32 and 126 *)
+  (String.init 1000 (fun i -> (Char.chr (32 + (i mod (126 - 32))))));
+  "";
+]
+
+let test_roundtrip_hexs () = List.iter test_roundtrip_hex inputs
+
+let test_roundtrip_strings () = List.iter test_roundtrip_string inputs
+
+let tests = [
+  "hash hex/dehex", `Quick, test_roundtrip_hexs;
+  "hash print/parse", `Quick, test_roundtrip_strings;
+]
+
+let () =
+  Alcotest.run "tezos-crypto" [
+    "blake2b", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_deterministic_nonce.ml b/vendors/tezos-modded/src/lib_crypto/test/test_deterministic_nonce.ml
new file mode 100644
index 000000000..c430eb0b5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_deterministic_nonce.ml
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Nomadic Labs <contact@nomadic-labs.com>                *)
+(*                                                                           *)
+(* 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 test_hash_matches (module X : S.SIGNATURE) () =
+  let _, _, sk = X.generate_key () in
+  let data = MBytes.of_string "ce input sa pun eu aici oare?" in
+  let nonce = X.deterministic_nonce sk data in
+  let nonce_hash = X.deterministic_nonce_hash sk data in
+  let hashed_nonce = Blake2B.hash_bytes [nonce] in
+  if nonce_hash <> Blake2B.to_bytes hashed_nonce then
+    Alcotest.failf "the hash of deterministic_nonce is NOT deterministic_nonce_hash"
+
+
+let ed25519 = (module Ed25519 : S.SIGNATURE)
+let p256 = (module P256 : S.SIGNATURE)
+let secp256k1 = (module Secp256k1 : S.SIGNATURE)
+
+let tests = [
+  "hash_matches_ed25519", `Quick, (test_hash_matches ed25519);
+  "hash_matches_p256", `Quick, (test_hash_matches p256);
+  "hash_matches_secp256k1", `Quick, (test_hash_matches secp256k1);
+]
+
+let () =
+  Alcotest.run "tezos-crypto" [
+    "deterministic_nonce", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_ed25519.ml b/vendors/tezos-modded/src/lib_crypto/test/test_ed25519.ml
new file mode 100644
index 000000000..b26ef0a6b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_ed25519.ml
@@ -0,0 +1,75 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type B58CHECK = sig
+  type t
+  val pp: Format.formatter -> t -> unit
+  include S.B58_DATA with type t := t
+end
+
+let test_b58check_roundtrip
+  : type t. (module B58CHECK with type t = t) -> t -> unit
+  = fun m input ->
+    let module M = (val m) in
+    let testable = Alcotest.testable M.pp (=) in
+    Roundtrips.test_rt_opt
+      "b58check"
+      testable
+      M.to_b58check M.of_b58check_opt
+      input
+
+let test_b58check_roundtrips () =
+  let pubkey_hash, pubkey, seckey = Ed25519.generate_key () in
+  test_b58check_roundtrip (module Ed25519.Public_key_hash) pubkey_hash;
+  test_b58check_roundtrip (module Ed25519.Public_key) pubkey;
+  test_b58check_roundtrip (module Ed25519.Secret_key) seckey
+
+
+let test_b58check_invalid input =
+  Roundtrips.test_decode_opt_fail
+    "b58check"
+    (Alcotest.testable Ed25519.Public_key_hash.pp Ed25519.Public_key_hash.(=))
+    Ed25519.Public_key_hash.of_b58check_opt
+    input
+
+let test_b58check_invalids () =
+  List.iter test_b58check_invalid [
+    "ThisIsGarbageNotACheck";
+    "\x00";
+    (String.make 1000 '\x00');
+    (String.make 2048 'a');
+    (String.init 2048 (fun _ -> Char.chr (Random.int 256)));
+    "";
+  ]
+
+let tests = [
+  "b58check.roundtrip", `Quick, test_b58check_roundtrips;
+  "b58check.invalid", `Slow, test_b58check_invalids;
+]
+
+let () =
+  Alcotest.run "tezos-crypto" [
+    "ed25519", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_merkle.ml b/vendors/tezos-modded/src/lib_crypto/test/test_merkle.ml
new file mode 100644
index 000000000..abaac4959
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_merkle.ml
@@ -0,0 +1,97 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Utils.Infix
+
+type tree =
+  | Empty
+  | Leaf of int
+  | Node of tree * tree
+
+let rec list_of_tree = function
+  | Empty -> [], 0
+  | Leaf x -> [x], 1
+  | Node (x, y) ->
+      let x, sx = list_of_tree x
+      and y, sy = list_of_tree y in
+      assert (sx = sy) ;
+      x @ y, sx + sy
+
+module Merkle = Blake2B.Generic_Merkle_tree(struct
+    type t = tree
+    type elt = int
+    let empty = Empty
+    let leaf i = Leaf i
+    let node x y = Node (x, y)
+  end)
+
+let rec compare_list xs ys =
+  match xs, ys with
+  | [], [] -> true
+  | [x], y :: ys when x = y -> ys = [] || compare_list xs ys
+  | x :: xs, y :: ys when x = y -> compare_list xs ys
+  | _, _ -> false
+
+let check_size i =
+  let l = 0 -- i in
+  let l2, _ = list_of_tree (Merkle.compute l) in
+  if compare_list l l2 then
+    ()
+  else
+    Format.kasprintf failwith
+      "Failed for %d: %a"
+      i
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.pp_print_string ppf ";")
+         Format.pp_print_int)
+      l2
+
+let test_compute _ =
+  List.iter check_size (0--99)
+
+let check_path i =
+  let l = 0 -- i in
+  let orig = Merkle.compute l in
+  List.iter (fun j ->
+      let path = Merkle.compute_path l j in
+      let found, pos = Merkle.check_path path j in
+      if found = orig && j = pos then
+        ()
+      else
+        Format.kasprintf failwith "Failed for %d in %d." j i)
+    l
+
+let test_path _ =
+  List.iter check_path (0--128)
+
+let tests = [
+  "compute", `Quick, test_compute ;
+  "path", `Quick, test_path ;
+]
+
+let () =
+  Alcotest.run "tezos-crypto" [
+    "merkel", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/test/test_pvss.ml b/vendors/tezos-modded/src/lib_crypto/test/test_pvss.ml
new file mode 100644
index 000000000..724351443
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/test/test_pvss.ml
@@ -0,0 +1,168 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* pvss tests here *)
+
+module Pvss = Pvss_secp256k1
+module Sp = Secp256k1_group
+
+module Setup : sig
+
+  val shares : Pvss.Encrypted_share.t list
+  val commitments: Pvss.Commitment.t list
+  val proof: Pvss.proof
+
+  val secret_scalar : Sp.Group.Scalar.t
+  val secret: Pvss.Secret_key.t
+  val public_secret: Pvss.Public_key.t
+
+  val other_shares : Pvss.Encrypted_share.t list
+  val other_commitments: Pvss.Commitment.t list
+  val other_proof: Pvss.proof
+  val other_secret: Pvss.Secret_key.t
+
+  type keypair = {secret_key: Pvss.Secret_key.t; public_key: Pvss.Public_key.t}
+  val public_keys : Pvss.Public_key.t list
+  val keypairs : keypair list
+  val reveals : (Pvss.Encrypted_share.t * (Pvss.Clear_share.t * Pvss.proof)) list
+
+  val convert_encoding : 'a Data_encoding.t -> 'b Data_encoding.t -> 'a -> 'b
+  val group_encoding : Sp.Group.t Data_encoding.t
+
+end  = struct
+
+  type keypair = {secret_key: Pvss.Secret_key.t; public_key: Pvss.Public_key.t}
+
+  let group_encoding = Data_encoding.(conv Sp.Group.to_bits Sp.Group.of_bits_exn string)
+  let scalar_encoding = Data_encoding.(conv Sp.Group.Scalar.to_bits Sp.Group.Scalar.of_bits_exn string)
+
+  let convert_encoding de1 de2 x =
+    Data_encoding.Binary.of_bytes_exn de2
+      (Data_encoding.Binary.to_bytes_exn de1 x)
+
+
+  (** Random value of Z in the range [0,2^256] *)
+  let rand_Z () =
+    [Random.int64 Int64.max_int |> Z.of_int64 |> Z.to_bits]
+    |> Blake2B.hash_string |> Blake2B.to_string |> Z.of_bits
+
+  (** Generates n random keypairs *)
+  let random_keypairs n =
+    List.init n
+      (fun _ -> let s = Sp.Group.Scalar.of_Z (rand_Z ()) in
+        let secret_key = convert_encoding scalar_encoding Pvss.Secret_key.encoding s in
+        { secret_key ; public_key = Pvss.Secret_key.to_public_key secret_key })
+
+  (** Convert a secret_key to a public key *)
+  let public secret_key =
+    convert_encoding group_encoding Pvss.Public_key.encoding
+      (Sp.Group.mul secret_key Sp.Group.g)
+
+  let t = 5
+  let n = 8
+
+  let random_scalar () =
+    Sp.Group.Scalar.of_Z (rand_Z ())
+
+  let secret_of_scalar s =
+    convert_encoding scalar_encoding Pvss.Secret_key.encoding s
+
+  let secret_scalar = random_scalar ()
+  let secret = secret_of_scalar secret_scalar
+  let public_secret = Pvss.Secret_key.to_public_key secret
+  let other_secret= secret_of_scalar (random_scalar ())
+
+
+  let keypairs = random_keypairs n
+  let public_keys = List.map (fun {public_key} -> public_key) keypairs
+
+  let ((shares, commitments, proof),
+       (other_shares, other_commitments, other_proof)) =
+    (
+      Pvss.dealer_shares_and_proof ~secret ~t ~public_keys,
+      Pvss.dealer_shares_and_proof ~secret:other_secret ~t ~public_keys
+    )
+
+  let reveals = List.map2 (
+      fun share keypair ->
+        (share, Pvss.reveal_share share
+           ~secret_key:keypair.secret_key ~public_key:keypair.public_key))
+      shares keypairs
+end
+
+let test_dealer_proof () =
+  let shr = (Setup.shares, Setup.other_shares)
+  and cmt = (Setup.commitments, Setup.other_commitments)
+  and prf = (Setup.proof, Setup.other_proof) in
+
+  begin
+    for i = 0 to 1 do
+      for j = 0 to 1 do
+        for k = 0 to 1 do
+          let pick = function 0 -> fst | _ -> snd in
+          assert ((Pvss.check_dealer_proof
+                     (pick i shr)
+                     (pick j cmt)
+                     ~proof:(pick k prf) ~public_keys:Setup.public_keys) = (i = j && j = k))
+        done
+      done
+    done
+  end
+
+let test_share_reveal () =
+
+  (* check reveal shares *)
+  let shares_valid = List.map2 (fun (share, (reveal, proof)) public_key ->
+      Pvss.check_revealed_share share reveal ~public_key:public_key proof)
+      Setup.reveals Setup.public_keys in
+
+  List.iteri (fun i b -> print_endline (string_of_int i); assert b)
+    shares_valid
+
+let test_reconstruct () =
+  let indices = [0;1;2;3;4] in
+  let reconstructed =  Pvss.reconstruct
+      (List.map
+         (fun n -> let (_, (r, _)) = List.nth Setup.reveals n in r) indices
+      )
+      indices
+  in
+  assert (Sp.Group.((=))
+            (Setup.convert_encoding
+               Pvss.Public_key.encoding Setup.group_encoding reconstructed)
+            (Setup.convert_encoding
+               Pvss.Public_key.encoding Setup.group_encoding Setup.public_secret))
+
+
+let tests = [
+  "dealer_proof", `Quick, test_dealer_proof ;
+  "reveal", `Quick, test_share_reveal ;
+  "recontruct", `Quick, test_reconstruct
+]
+
+let () =
+  Alcotest.run "test-pvss" [
+    "pvss", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_crypto/tezos-crypto.opam b/vendors/tezos-modded/src/lib_crypto/tezos-crypto.opam
new file mode 100644
index 000000000..4051d4e1f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/tezos-crypto.opam
@@ -0,0 +1,29 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib"
+  "tezos-data-encoding"
+  "tezos-error-monad"
+  "tezos-rpc"
+  "tezos-clic"
+  "lwt"
+  "blake2"
+  "hacl"
+  "zarith"
+  "secp256k1"
+  "uecc"
+  "alcotest" { with-test & >= "0.8.3" }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_crypto/znz.ml b/vendors/tezos-modded/src/lib_crypto/znz.ml
new file mode 100644
index 000000000..12f1ffcc2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/znz.ml
@@ -0,0 +1,116 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type ZN = sig
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+  val zero : t
+  val one  : t
+  val n : Z.t
+  val (+)       : t -> t -> t
+  val ( * )     : t -> t -> t
+  val (-)       : t -> t -> t
+  val (=)       : t -> t -> bool
+  val of_int    : int -> t
+  val of_Z      : Z.t -> t
+  val to_Z      : t -> Z.t
+  val of_bits_exn : String.t -> t
+  val to_bits   : t -> String.t
+  val pow       : t -> Z.t -> t
+  val inv       : t -> t option
+end
+
+module type INT = sig
+  val n : Z.t
+end
+
+module MakeZn (N : INT) (B : sig val b58_prefix : string end) : ZN = struct
+
+  type t = Z.t
+  let n = N.n
+  let max_char_length = 2 * (Z.numbits n)
+  let zero = Z.zero
+  let one = Z.one
+  let of_Z r = Z.(erem r n)
+  let to_Z a = a
+  let of_int u = u |> Z.of_int |> of_Z
+
+  let to_bits h = h |> Zplus.serialize |> (fun s -> String.sub s 0 (String.length s - 1))
+  let of_bits_exn bits =
+    (* Do not process oversized inputs. *)
+    if Compare.Int.((String.length bits) > max_char_length) then
+      failwith "input too long"
+    else
+      (* Make sure the input is in the range [0, N.n-1]. Do not reduce modulo
+         N.n for free! *)
+      let x = Zplus.deserialize (bits) in
+      if Zplus.(x < zero || x >= N.n) then
+        failwith "out of range"
+      else
+        of_Z x
+
+  let pow a x = Z.powm a Z.(erem x (sub n one)) n
+  let (+) x y = Z.(erem (add x y)  n)
+  let ( * )  x y = Z.(erem (mul x y) n)
+  let (-) x y = Z.(erem (sub x y) n)
+  let (=) x y = Z.equal x y
+
+  let inv a = Zplus.invert a n
+
+  let title = Format.sprintf "Znz.Make(%s)" (Z.to_string N.n)
+  let name =  Format.sprintf "An element of Z/nZ for n = %s" (Z.to_string N.n)
+
+  type Base58.data +=
+    | Data of t
+
+  let b58check_encoding =
+    Base58.register_encoding
+      ~prefix: B.b58_prefix
+      ~length: 32
+      ~to_raw: to_bits
+      ~of_raw: (fun s -> try Some (of_bits_exn s) with _ -> None)
+      ~wrap: (fun x -> Data x)
+
+  include Helpers.MakeB58(struct
+      type nonrec t = t
+      let title = title
+      let name = name
+      let b58check_encoding = b58check_encoding
+    end)
+
+  include Helpers.MakeEncoder(struct
+      type nonrec t = t
+      let name = name
+      let title = title
+      let raw_encoding = Data_encoding.(conv to_bits of_bits_exn string)
+      let to_b58check = to_b58check
+      let to_short_b58check = to_short_b58check
+      let of_b58check = of_b58check
+      let of_b58check_opt = of_b58check_opt
+      let of_b58check_exn = of_b58check_exn
+    end)
+
+end
diff --git a/vendors/tezos-modded/src/lib_crypto/znz.mli b/vendors/tezos-modded/src/lib_crypto/znz.mli
new file mode 100644
index 000000000..a9757920b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/znz.mli
@@ -0,0 +1,73 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Type for a module representing the ℤ/nℤ ring*)
+module type ZN = sig
+
+  type t
+  include S.B58_DATA with type t := t
+  include S.ENCODER with type t := t
+
+  val zero : t
+  val one  : t
+  val n : Z.t
+  val (+)       : t -> t -> t
+  val ( * )     : t -> t -> t
+  val (-)       : t -> t -> t
+  val (=)    : t -> t -> bool
+
+  (** Converts an integer to a ring element *)
+  val of_int    : int -> t
+
+  (** Converts a Zarith integer to a ring element *)
+  val of_Z      : Z.t -> t
+
+  (** Provides an integer representation between 0 and n-1 of an element *)
+  val to_Z      : t -> Z.t
+
+  (** Converts a string of bytes to an integer modulo n, requires the string of
+      byte to represent an integer between 0 and n-1 and checks the length of
+      the string for sanity*)
+  val of_bits_exn   : String.t -> t
+
+  (** Converts a ring element to a byte representation *)
+  val to_bits : t -> String.t
+
+  (** Modular exponentiation *)
+  val pow       : t -> Z.t -> t
+
+  (** Returns the inverse of a in ℤ/nℤ, maybe *)
+  val inv       : t -> t option
+
+end
+
+
+(** Type of a module wrapping an integer. *)
+module type INT = sig
+  val n : Z.t
+end
+
+(** Functor to build the ℤ/nℤ ring given n*)
+module MakeZn : functor (N : INT) (B : sig val b58_prefix : string end) -> ZN
diff --git a/vendors/tezos-modded/src/lib_crypto/zplus.ml b/vendors/tezos-modded/src/lib_crypto/zplus.ml
new file mode 100644
index 000000000..7da8e3716
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/zplus.ml
@@ -0,0 +1,73 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 re_trailing_null =
+   Re_pcre.regexp "^(.*?)\000*$"
+
+   let remove_trailing_null s =
+   Re.get (Re.exec re_trailing_null s) 1 *)
+
+let remove_trailing_null s =
+  let n = String.length s in
+  let i = ref (n-1) in
+  while (!i >= 0) && (String.get s !i = '\000') do
+    i := !i - 1
+  done; String.sub s 0 (!i+1)
+
+let serialize z =
+  let n =
+    if Z.(lt z zero) then
+      Z.(neg (add (add z z) one))
+    else
+      Z.(add z z)
+  in
+  n |> Z.to_bits |> remove_trailing_null
+
+let deserialize z =
+  let n = Z.of_bits z in
+  let z = Z.shift_right_trunc n 1 in
+  if Z.(n land one = zero) then z else Z.neg z
+
+let leq a b = (Z.compare a b) <= 0
+
+let geq a b = (Z.compare a b) >= 0
+
+let lt  a b = (Z.compare a b) < 0
+
+let gt  a b = (Z.compare a b) > 0
+
+let (<) = lt
+let (>) = gt
+let (<=) = leq
+let (>=) = geq
+
+let zero = Z.zero
+let one = Z.one
+
+let invert a n =
+  try
+    Some (Z.invert a n)
+  with
+    Division_by_zero -> None
diff --git a/vendors/tezos-modded/src/lib_crypto/zplus.mli b/vendors/tezos-modded/src/lib_crypto/zplus.mli
new file mode 100644
index 000000000..b16dcadb7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_crypto/zplus.mli
@@ -0,0 +1,59 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 serialize: Z.t -> string
+val deserialize: string -> Z.t
+
+val leq: Z.t -> Z.t -> bool
+(** Less than or equal. *)
+
+val geq: Z.t -> Z.t -> bool
+(** Greater than or equal. *)
+
+val lt: Z.t -> Z.t -> bool
+(** Less than (and not equal). *)
+
+val gt: Z.t -> Z.t -> bool
+(** Greater than (and not equal). *)
+
+val (<=): Z.t -> Z.t -> bool
+(** Less than or equal. *)
+
+val (>=): Z.t -> Z.t -> bool
+(** Greater than or equal. *)
+
+val (<): Z.t -> Z.t -> bool
+(** Less than (and not equal). *)
+
+val (>): Z.t -> Z.t -> bool
+(** Greater than (and not equal). *)
+
+val zero: Z.t
+
+val one: Z.t
+
+val invert: Z.t -> Z.t -> Z.t option
+(** Invert the first argument modulo the second. Returns
+    none if there is no inverse *)
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_description.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_description.ml
new file mode 100644
index 000000000..6580c949c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_description.ml
@@ -0,0 +1,529 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 unopt_lazy func = function
+  | None -> func ()
+  | Some x -> x
+
+type recursives = string list
+type references = { descriptions : (string * Binary_schema.toplevel_encoding) list } [@@unwrapped]
+
+(* Simple Union find implementation, there are several optimizations
+   that give UF it's usual time complexity that could be added.
+   If this is a bottleneck, they're easy to add. *)
+module UF : sig
+  type t
+  val add : t -> Binary_schema.description -> unit
+  val find : t -> string -> Binary_schema.description
+  val union : t -> new_cannonical:Binary_schema.description -> existing:string -> unit
+  val empty : unit -> t
+  val pp : Format.formatter -> t -> unit
+end = struct
+  open Binary_schema
+  type ele = Ref of string | Root of description
+  type t = (string, ele) Hashtbl.t
+  let add t x = Hashtbl.replace t x.title (Root x)
+  let rec find tbl key =
+    match Hashtbl.find tbl key with
+    | Ref s -> find tbl s
+    | Root desc -> desc
+
+  let union tbl ~new_cannonical ~existing =
+    add tbl new_cannonical ;
+    let root = find tbl existing in
+    if root.title = new_cannonical.title
+    then ()
+    else Hashtbl.replace tbl root.title (Ref new_cannonical.title)
+
+  let empty () = Hashtbl.create 128
+
+  let pp ppf tbl =
+    Format.fprintf ppf "@[<v 2>UF:@,%a@]"
+      (fun ppf ->
+         (Hashtbl.iter (fun k v ->
+              Format.fprintf ppf "'%s' ---> %a@,"
+                k (fun ppf -> function
+                    | Root { title } -> Format.fprintf ppf "Root '%s'" title
+                    | Ref s -> Format.fprintf ppf "Ref '%s'" s) v))) tbl
+end
+
+let fixup_references uf =
+  let open Binary_schema in
+  let rec fixup_layout = function
+    | Ref s -> Ref (UF.find uf s).title
+    | Enum (i, name) -> Enum (i, (UF.find uf name).title)
+    | Seq (layout, len) -> Seq (fixup_layout layout, len)
+    | (Zero_width
+      | Int _
+      | Bool
+      | RangedInt (_, _)
+      | RangedFloat (_, _)
+      | Float
+      | Bytes
+      | String
+      | Padding) as enc -> enc in
+  let field = function
+    | Named_field (name, kind, layout) ->
+        Named_field (name, kind, fixup_layout layout)
+    | Anonymous_field (kind, layout) ->
+        Anonymous_field (kind, fixup_layout layout)
+    | (Dynamic_size_field _ | Optional_field _) as field -> field in
+  function
+  | Obj { fields } -> Obj { fields = List.map field fields }
+  | Cases ({ cases } as x) ->
+      Cases { x with
+              cases = List.map
+                  (fun (i, name, fields) ->
+                     (i, name, List.map field fields)) cases }
+  | (Int_enum _ as ie) -> ie
+
+let z_reference_name = "Z.t"
+
+let z_reference_description =
+  "A variable length sequence of bytes, encoding a Zarith number. \
+   Each byte has a running unary size bit: the most significant bit of \
+   each byte tells is this is the last byte in the sequence (0) or if \
+   there is more to read (1). The second most significant bit of the \
+   first byte is reserved for the sign (positive if zero). Size and \
+   sign bits ignored, data is then the binary representation of the \
+   absolute value of the number in little endian order."
+
+let z_encoding =
+  Binary_schema.Obj { fields = [ Named_field ("Z.t", `Dynamic, Bytes) ] }
+
+let add_z_reference uf { descriptions } =
+  UF.add uf { title = z_reference_name ;
+              description = Some z_reference_description } ;
+  { descriptions = (z_reference_name, z_encoding) :: descriptions }
+
+let n_reference_name = "N.t"
+
+let n_reference_description =
+  "A variable length sequence of bytes, encoding a Zarith number. \
+   Each byte has a running unary size bit: the most significant bit of \
+   each byte tells is this is the last byte in the sequence (0) or if \
+   there is more to read (1). Size bits ignored, data is then the binary \
+   representation of the absolute value of the number in little endian order."
+
+let n_encoding =
+  Binary_schema.Obj { fields = [ Named_field ("N.t", `Dynamic, Bytes) ] }
+
+let add_n_reference uf { descriptions } =
+  UF.add uf { title = n_reference_name ;
+              description = Some n_reference_description } ;
+  { descriptions = (n_reference_name, n_encoding) :: descriptions }
+
+let dedup_canonicalize uf =
+  let tbl : (Binary_schema.toplevel_encoding, Binary_schema.description) Hashtbl.t = Hashtbl.create 100 in
+  let rec help prev_len acc = function
+    | [] ->
+        let fixedup =
+          List.map
+            (fun (desc, layout) -> (desc, fixup_references uf layout))
+            acc in
+        if List.length fixedup = prev_len
+        then
+          List.map
+            (fun (name, layout) ->
+               (UF.find uf name, layout))
+            fixedup
+        else
+          begin
+            Hashtbl.clear tbl ;
+            help (List.length fixedup) [] fixedup
+          end
+    | (name, layout) :: tl ->
+        match Hashtbl.find_opt tbl layout with
+        | None ->
+            let desc = UF.find uf name in
+            begin
+              Hashtbl.add tbl layout desc ;
+              help prev_len ((desc.title, layout) :: acc) tl
+            end
+        | Some original_desc ->
+            begin
+              UF.union uf
+                ~new_cannonical:original_desc
+                ~existing:name ;
+              help prev_len acc tl
+            end
+  in
+  help 0 []
+
+
+type pdesc = P : 'x Encoding.desc -> pdesc
+let describe (type x) (encoding : x Encoding.t) =
+  let open Encoding in
+  let uf = UF.empty () in
+  let uf_add_name title =
+    UF.add uf { title ; description = None } in
+  let add_reference name description { descriptions } =
+    { descriptions = (name, description) :: descriptions } in
+  let new_reference =
+    let x = ref ~-1 in
+    fun () ->
+      x := !x + 1 ;
+      let name = "X_" ^ string_of_int !x in
+      uf_add_name name ;
+      name in
+  let may_new_reference = function
+    | None -> new_reference ()
+    | Some name ->
+        uf_add_name name ;
+        name in
+  let rec extract_dynamic :
+    type x. string option -> x Encoding.desc -> Binary_size.unsigned_integer option * string option * pdesc =
+    fun ref_name -> function
+      | Conv { encoding } -> extract_dynamic ref_name encoding.encoding
+      | Describe { id = ref_name ; encoding } -> extract_dynamic (Some ref_name) encoding.encoding
+      | Splitted { encoding } -> extract_dynamic ref_name encoding.encoding
+      | Delayed f -> extract_dynamic ref_name (f ()).encoding
+      | Dynamic_size { kind ; encoding } -> (Some kind, ref_name, P encoding.encoding)
+      | enc -> (None, ref_name, P enc) in
+  let rec field_descr :
+    type a. recursives -> references ->
+    a Encoding.field -> Binary_schema.field_descr list * references =
+    fun recursives references -> function
+      | Req { name ; encoding = { encoding } }
+      | Dft { name ; encoding = { encoding } } -> begin
+          let (dynamics, ref_name, P field) = extract_dynamic None encoding in
+          let (layout, references) = layout ref_name recursives references field in
+          if layout = Zero_width then
+            ([], references)
+          else
+            let field_descr =
+              Binary_schema.Named_field (name, classify_desc field, layout) in
+            match dynamics with
+            | Some kind ->
+                ([ Dynamic_size_field (ref_name, 1, kind) ; field_descr ], references)
+            | None ->
+                ([ field_descr], references)
+        end
+      | Opt { kind = `Variable ; name ; encoding = { encoding } } ->
+          let (layout, references) =
+            layout None recursives references encoding in
+          ([ Named_field (name, `Variable, layout) ], references)
+      | Opt { kind = `Dynamic ; name ; encoding = { encoding } } ->
+          let (layout, references) =
+            layout None recursives references encoding in
+          ([Binary_schema.Optional_field name ; Named_field (name, classify_desc encoding, layout) ], references)
+  and obj fields =
+    Binary_schema.Obj { fields }
+  and union :
+    type a. string option -> recursives -> references -> Kind.t -> Binary_size.tag_size -> a case list -> string * references=
+    fun ref_name recursives references kind size cases ->
+      let cases =
+        List.sort (fun (t1, _) (t2, _) -> Compare.Int.compare t1 t2) @@
+        TzList.filter_map
+          (function
+            | Case { tag = Json_only } -> None
+            | (Case { tag = Tag tag } as case) -> Some (tag, case))
+          cases in
+      let tag_field =
+        Binary_schema.Named_field ("Tag", `Fixed (Binary_size.tag_size size), Int (size :> Binary_schema.integer_extended)) in
+      let (cases, references) =
+        List.fold_right
+          (fun (tag, Case case) (cases, references) ->
+             let fields, references = fields None recursives references case.encoding.encoding in
+             ((tag, Some case.title, tag_field :: fields) :: cases, references))
+          cases
+          ([], references) in
+      let name = may_new_reference ref_name in
+      let references =
+        add_reference
+          name
+          (Cases { kind ;
+                   tag_size = size ;
+                   cases }) references in
+      (name, references)
+  and describe  : type b. ?description:string -> title:string ->
+    string -> recursives -> references -> b desc -> string * references =
+    fun ?description ~title name recursives references encoding ->
+      let new_cannonical = { Binary_schema.title ; description } in
+      UF.add uf new_cannonical ;
+      let layout, references = layout None recursives references encoding in
+      begin
+        match layout with
+        | Ref ref_name ->
+            UF.union uf ~existing:ref_name ~new_cannonical ;
+            (ref_name, references)
+        | layout ->
+            UF.add uf new_cannonical ;
+            (name,
+             add_reference name
+               (obj [ Anonymous_field (classify_desc encoding, layout) ])
+               references)
+      end
+  and enum : type a. (a, _) Hashtbl.t -> a array -> _ = fun tbl encoding_array ->
+    (Binary_size.range_to_size ~minimum:0 ~maximum:(Array.length encoding_array),
+     List.map
+       (fun i -> (i, fst @@ Hashtbl.find tbl encoding_array.(i)))
+       Utils.Infix.(0 -- ((Array.length encoding_array) - 1)))
+  and fields :
+    type b. string option -> recursives -> references ->
+    b Encoding.desc -> Binary_schema.fields * references =
+    fun ref_name recursives references -> function
+      | Obj field ->
+          field_descr recursives references field
+      | Objs { left ; right } ->
+          let (left_fields, references) =
+            fields None recursives references left.encoding in
+          let (right_fields, references) =
+            fields None recursives references right.encoding in
+          (left_fields @ right_fields, references)
+      | Null -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
+      | Empty -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
+      | Ignore -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
+      | Constant _ -> ([ Anonymous_field (`Fixed 0, Zero_width) ], references)
+      | Dynamic_size { kind ; encoding } ->
+          let (fields, refs) =
+            fields None recursives references encoding.encoding in
+          (Dynamic_size_field (None, List.length fields, kind) :: fields, refs)
+      | Check_size { encoding } ->
+          fields ref_name recursives references encoding.encoding
+      | Conv { encoding } ->
+          fields ref_name recursives references encoding.encoding
+      | Describe { id = name ; encoding } ->
+          fields (Some name) recursives references encoding.encoding
+      | Splitted { encoding } ->
+          fields ref_name recursives references encoding.encoding
+      | Delayed func ->
+          fields ref_name recursives references (func ()).encoding
+      | List (len, { encoding }) ->
+          let (layout, references) =
+            layout None recursives references encoding in
+          ([ Anonymous_field (`Variable, Seq (layout, len)) ],
+           references)
+      | Array (len, { encoding }) ->
+          let (layout, references) =
+            layout None recursives references encoding in
+          ([ Anonymous_field (`Variable, Seq (layout, len)) ],
+           references)
+      | Bytes kind ->
+          ([ Anonymous_field ((kind :> Kind.t), Bytes) ], references)
+      | String kind ->
+          ([ Anonymous_field ((kind :> Kind.t), String) ], references)
+      | Padded ({ encoding = e }, n) ->
+          let fields, references = fields ref_name recursives references e in
+          (fields @ [ Named_field ("padding", `Fixed n, Padding) ], references)
+      | (String_enum (tbl, encoding_array) as encoding) ->
+          let size, cases = enum tbl encoding_array in
+          let name = may_new_reference ref_name in
+          ([ Anonymous_field (classify_desc encoding, Ref name) ],
+           add_reference name (Int_enum { size ; cases }) references)
+      | Tup { encoding } ->
+          let (layout, references) =
+            layout ref_name recursives references encoding in
+          if layout = Zero_width then
+            ([], references)
+          else
+            ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Tups { left ; right } ->
+          let (fields1, references) =
+            fields None recursives references left.encoding in
+          let (fields2, references) =
+            fields None recursives references right.encoding in
+          (fields1 @ fields2, references)
+      | Union { kind ; tag_size ; cases } ->
+          let name, references = union None recursives references kind tag_size cases in
+          ([ Anonymous_field (kind, Ref name) ], references)
+      | (Mu { kind ; name ; title ; description ; fix } as encoding) ->
+          let kind = (kind :> Kind.t) in
+          let title = Option.unopt ~default:name title in
+          if List.mem name recursives
+          then ([ Anonymous_field (kind, Ref name) ], references)
+          else
+            let { encoding } = fix { encoding ; json_encoding = None } in
+            let (name, references) = describe ~title ?description name (name :: recursives) references encoding in
+            ([ Anonymous_field (kind, Ref name) ], references)
+      | Bool as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Int8 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Uint8 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Int16 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Uint16 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Int31 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Int32 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Int64 as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | N as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Z as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | RangedInt _ as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | RangedFloat _ as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+      | Float as encoding ->
+          let layout, references =
+            layout None recursives references encoding in
+          ([ Anonymous_field (classify_desc encoding, layout) ], references)
+  and layout :
+    type c. string option -> recursives -> references ->
+    c Encoding.desc -> Binary_schema.layout * references =
+    fun ref_name recursives references -> function
+      | Null -> (Zero_width, references)
+      | Empty -> (Zero_width, references)
+      | Ignore -> (Zero_width, references)
+      | Constant _ -> (Zero_width, references)
+      | Bool -> (Bool, references)
+      | Int8 -> (Int `Int8, references)
+      | Uint8 -> (Int `Uint8, references)
+      | Int16 -> (Int `Int16, references)
+      | Uint16 -> (Int `Uint16, references)
+      | Int31 -> (RangedInt (~-1073741824, 1073741823), references)
+      | Int32 -> (Int `Int32, references)
+      | Int64 -> (Int `Int64, references)
+      | N ->
+          (Ref n_reference_name,
+           add_n_reference uf references)
+      | Z ->
+          (Ref z_reference_name,
+           add_z_reference uf references)
+      | RangedInt { minimum ; maximum } ->
+          (RangedInt (minimum, maximum), references)
+      | RangedFloat { minimum ; maximum } ->
+          (RangedFloat (minimum, maximum), references)
+      | Float ->
+          (Float, references)
+      | Bytes _kind ->
+          (Bytes, references)
+      | String _kind ->
+          (String, references)
+      | Padded _ as enc ->
+          let name = may_new_reference ref_name in
+          let fields, references = fields None recursives references enc in
+          let references = add_reference name (obj fields) references in
+          (Ref name, references)
+      | String_enum (tbl, encoding_array) ->
+          let name = may_new_reference ref_name in
+          let size, cases = enum tbl encoding_array in
+          let references = add_reference name (Int_enum { size ; cases }) references in
+          (Enum (size, name), references)
+      | Array (len, data) ->
+          let (descr, references) =
+            layout None recursives references data.encoding in
+          (Seq (descr, len), references)
+      | List (len, data) ->
+          let layout, references =
+            layout None recursives references data.encoding in
+          (Seq (layout, len), references)
+      | Obj (Req { encoding =  { encoding } })
+      | Obj (Dft { encoding =  { encoding } }) ->
+          layout ref_name recursives references encoding
+      | Obj (Opt _) as enc ->
+          let name = may_new_reference ref_name in
+          let fields, references = fields None recursives references enc in
+          let references = add_reference name (obj fields) references in
+          (Ref name, references)
+      | Objs { left ; right } ->
+          let name = may_new_reference ref_name in
+          let fields1, references =
+            fields None recursives references left.encoding in
+          let fields2, references =
+            fields None recursives references right.encoding in
+          let references = add_reference name (obj (fields1 @ fields2)) references in
+          (Ref name, references)
+      | Tup { encoding } ->
+          layout ref_name recursives references encoding
+      | (Tups _ as descr) ->
+          let name = may_new_reference ref_name in
+          let fields, references = fields None recursives references descr in
+          let references = add_reference name (obj fields) references in
+          (Ref name, references)
+      | Union { kind ; tag_size ; cases } ->
+          let name, references = union ref_name recursives references kind tag_size cases in
+          (Ref name, references)
+      | Mu { name ; title ; description ; fix } as encoding ->
+          let title = Option.unopt ~default:name title in
+          if List.mem name recursives
+          then (Ref name, references)
+          else
+            let { encoding } = fix { encoding ; json_encoding = None } in
+            let (name, references) = describe name ~title ?description (name :: recursives) references encoding in
+            (Ref name, references)
+      | Conv { encoding } ->
+          layout ref_name recursives references encoding.encoding
+      | Describe { id = name ; encoding } ->
+          layout (Some name) recursives references encoding.encoding
+      | Splitted { encoding } ->
+          layout ref_name recursives references encoding.encoding
+      | (Dynamic_size _) as encoding ->
+          let name = may_new_reference ref_name in
+          let fields, references = fields None recursives references encoding in
+          UF.add uf { title = name ; description = None } ;
+          (Ref name, add_reference name (obj fields) references)
+      | Check_size { encoding } ->
+          layout ref_name recursives references encoding.encoding
+      | Delayed func ->
+          layout ref_name recursives references (func ()).encoding in
+  let fields, references =
+    fields None [] { descriptions = [] } encoding.encoding in
+  uf_add_name "" ;
+  let _, toplevel = List.hd (dedup_canonicalize uf ["", obj fields]) in
+  let filtered =
+    List.filter
+      (fun (name, encoding) ->
+         match encoding with
+         | Binary_schema.Obj { fields = [ Anonymous_field (_, Ref reference) ] } ->
+             UF.union uf ~new_cannonical:(UF.find uf name) ~existing:reference ;
+             false
+         | _ -> true)
+      references.descriptions in
+  let fields = List.rev (dedup_canonicalize uf filtered) in
+  { Binary_schema.toplevel ; fields }
+
+
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_description.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_description.mli
new file mode 100644
index 000000000..87abf7ffc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_description.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 describe: 'a Encoding.t -> Binary_schema.t
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_error.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_error.ml
new file mode 100644
index 000000000..dd94c34fe
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_error.ml
@@ -0,0 +1,100 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type read_error =
+  | Not_enough_data
+  | Extra_bytes
+  | No_case_matched
+  | Unexpected_tag of int
+  | Invalid_size of int
+  | Invalid_int of { min : int ; v : int ; max : int }
+  | Invalid_float of { min : float ; v : float ; max : float }
+  | Trailing_zero
+  | Size_limit_exceeded
+  | List_too_long
+  | Array_too_long
+
+let pp_read_error ppf = function
+  | Not_enough_data ->
+      Format.fprintf ppf "Not enough data"
+  | Extra_bytes ->
+      Format.fprintf ppf "Extra bytes"
+  | No_case_matched ->
+      Format.fprintf ppf "No case matched"
+  | Unexpected_tag tag ->
+      Format.fprintf ppf "Unexpected tag %d" tag
+  | Invalid_size sz ->
+      Format.fprintf ppf "Invalid size %d" sz
+  | Invalid_int { min ; v ; max}  ->
+      Format.fprintf ppf "Invalid int (%d <= %d <= %d) " min v max
+  | Invalid_float { min ; v ; max}  ->
+      Format.fprintf ppf "Invalid float (%f <= %f <= %f) " min v max
+  | Trailing_zero ->
+      Format.fprintf ppf "Trailing zero in Z"
+  | Size_limit_exceeded ->
+      Format.fprintf ppf "Size limit exceeded"
+  | List_too_long ->
+      Format.fprintf ppf "List length limit exceeded"
+  | Array_too_long ->
+      Format.fprintf ppf "Array length limit exceeded"
+
+exception Read_error of read_error
+
+type write_error =
+  | Size_limit_exceeded
+  | No_case_matched
+  | Invalid_int of { min : int ; v : int ; max : int }
+  | Invalid_float of { min : float ; v : float ; max : float }
+  | Invalid_bytes_length of { expected : int ; found : int }
+  | Invalid_string_length of { expected : int ; found : int }
+  | Invalid_natural
+  | List_too_long
+  | Array_too_long
+
+let pp_write_error ppf = function
+  | Size_limit_exceeded ->
+      Format.fprintf ppf "Size limit exceeded"
+  | No_case_matched ->
+      Format.fprintf ppf "No case matched"
+  | Invalid_int { min ; v ; max}  ->
+      Format.fprintf ppf "Invalid int (%d <= %d <= %d) " min v max
+  | Invalid_float { min ; v ; max}  ->
+      Format.fprintf ppf "Invalid float (%f <= %f <= %f) " min v max
+  | Invalid_bytes_length { expected ; found } ->
+      Format.fprintf ppf
+        "Invalid bytes length (expected: %d ; found %d)"
+        expected found
+  | Invalid_string_length { expected ; found } ->
+      Format.fprintf ppf
+        "Invalid string length (expected: %d ; found %d)"
+        expected found
+  | Invalid_natural ->
+      Format.fprintf ppf "Negative natural"
+  | List_too_long ->
+      Format.fprintf ppf "List length limit exceeded"
+  | Array_too_long ->
+      Format.fprintf ppf "Array length limit exceeded"
+
+exception Write_error of write_error
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_error.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_error.mli
new file mode 100644
index 000000000..a71f0aaa6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_error.mli
@@ -0,0 +1,57 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Binary}. *)
+
+type read_error =
+  | Not_enough_data
+  | Extra_bytes
+  | No_case_matched
+  | Unexpected_tag of int
+  | Invalid_size of int
+  | Invalid_int of { min : int ; v : int ; max : int }
+  | Invalid_float of { min : float ; v : float ; max : float }
+  | Trailing_zero
+  | Size_limit_exceeded
+  | List_too_long
+  | Array_too_long
+exception Read_error of read_error
+val pp_read_error: Format.formatter -> read_error -> unit
+
+type write_error =
+  | Size_limit_exceeded
+  | No_case_matched
+  | Invalid_int of { min : int ; v : int ; max : int }
+  | Invalid_float of { min : float ; v : float ; max : float }
+  | Invalid_bytes_length of { expected : int ; found : int }
+  | Invalid_string_length of { expected : int ; found : int }
+  | Invalid_natural
+  | List_too_long
+  | Array_too_long
+
+val pp_write_error : Format.formatter -> write_error -> unit
+
+exception Write_error of write_error
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_length.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_length.ml
new file mode 100644
index 000000000..ced57b741
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_length.ml
@@ -0,0 +1,148 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Binary_error
+
+let n_length value =
+  let bits = Z.numbits value in
+  if bits = 0 then 1 else (bits + 6) / 7
+let z_length value = (Z.numbits value + 1 + 6) / 7
+
+let rec length : type x. x Encoding.t -> x -> int =
+  fun e value ->
+    let open Encoding in
+    match e.encoding with
+    (* Fixed *)
+    | Null -> 0
+    | Empty -> 0
+    | Constant _ -> 0
+    | Bool -> Binary_size.bool
+    | Int8 -> Binary_size.int8
+    | Uint8 -> Binary_size.uint8
+    | Int16 -> Binary_size.int16
+    | Uint16 -> Binary_size.uint16
+    | Int31 -> Binary_size.int31
+    | Int32 -> Binary_size.int32
+    | Int64 -> Binary_size.int64
+    | N -> n_length value
+    | Z -> z_length value
+    | RangedInt { minimum ; maximum } ->
+        Binary_size.integer_to_size @@
+        Binary_size.range_to_size ~minimum ~maximum
+    | Float -> Binary_size.float
+    | RangedFloat _ -> Binary_size.float
+    | Bytes `Fixed n -> n
+    | String `Fixed n -> n
+    | Padded (e, n) -> length e value + n
+    | String_enum (_, arr) ->
+        Binary_size.integer_to_size @@ Binary_size.enum_size arr
+    | Objs { kind = `Fixed n } -> n
+    | Tups { kind = `Fixed n } -> n
+    | Union { kind = `Fixed n } -> n
+    (* Dynamic *)
+    | Objs { kind = `Dynamic ; left ; right } ->
+        let (v1, v2) = value in
+        length left v1 + length right v2
+    | Tups { kind = `Dynamic ; left ; right } ->
+        let (v1, v2) = value in
+        length left v1 + length right v2
+    | Union { kind = `Dynamic ; tag_size ; cases } ->
+        let rec length_case = function
+          | [] -> raise (Write_error No_case_matched)
+          | Case { tag = Json_only } :: tl -> length_case tl
+          | Case { encoding = e ; proj ; _ } :: tl ->
+              match proj value with
+              | None -> length_case tl
+              | Some value -> Binary_size.tag_size tag_size + length e value in
+        length_case cases
+    | Mu { kind = `Dynamic ; fix } -> length (fix e) value
+    | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin
+        match value with
+        | None -> 1
+        | Some value -> 1 + length e value
+      end
+    (* Variable *)
+    | Ignore -> 0
+    | Bytes `Variable -> MBytes.length value
+    | String `Variable -> String.length value
+    | Array (Some max_length, _e) when Array.length value > max_length ->
+        raise (Write_error Array_too_long)
+    | Array (_, e) ->
+        Array.fold_left
+          (fun acc v -> length e v + acc)
+          0 value
+    | List (Some max_length, _e) when List.length value > max_length ->
+        raise (Write_error List_too_long)
+    | List (_, e) ->
+        List.fold_left
+          (fun acc v -> length e v + acc)
+          0 value
+    | Objs { kind = `Variable ; left ; right } ->
+        let (v1, v2) = value in
+        length left v1 + length right v2
+    | Tups { kind = `Variable ; left ; right } ->
+        let (v1, v2) = value in
+        length left v1 + length right v2
+    | Obj (Opt { kind = `Variable ; encoding = e }) -> begin
+        match value with
+        | None -> 0
+        | Some value -> length e value
+      end
+    | Union { kind = `Variable ; tag_size ; cases } ->
+        let rec length_case = function
+          | [] -> raise (Write_error No_case_matched)
+          | Case { tag = Json_only } :: tl -> length_case tl
+          | Case { encoding = e ; proj ; _ } :: tl ->
+              match proj value with
+              | None -> length_case tl
+              | Some value -> Binary_size.tag_size tag_size + length e value in
+        length_case cases
+    | Mu { kind = `Variable ; fix } -> length (fix e) value
+    (* Recursive*)
+    | Obj (Req { encoding = e }) -> length e value
+    | Obj (Dft { encoding = e }) -> length e value
+    | Tup e -> length e value
+    | Conv  { encoding = e ; proj } ->
+        length e (proj value)
+    | Describe { encoding = e } -> length e value
+    | Splitted { encoding = e } -> length e value
+    | Dynamic_size { kind ; encoding = e } ->
+        let length = length e value in
+        Binary_size.integer_to_size kind + length
+    | Check_size { limit ; encoding = e } ->
+        let length = length e value in
+        if length > limit then raise (Write_error Size_limit_exceeded) ;
+        length
+    | Delayed f -> length (f ()) value
+
+let fixed_length e =
+  match Encoding.classify e with
+  | `Fixed n -> Some n
+  | `Dynamic | `Variable -> None
+let fixed_length_exn e =
+  match fixed_length e with
+  | Some n -> n
+  | None -> invalid_arg "Data_encoding.Binary.fixed_length_exn"
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_length.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_length.mli
new file mode 100644
index 000000000..284188556
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_length.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Binary}. *)
+
+val length : 'a Encoding.t -> 'a -> int
+val fixed_length : 'a Encoding.t -> int option
+val fixed_length_exn : 'a Encoding.t -> int
+
+val z_length : Z.t -> int
+val n_length : Z.t -> int
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_reader.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_reader.ml
new file mode 100644
index 000000000..d35e3e78c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_reader.ml
@@ -0,0 +1,358 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Binary_error
+
+let raise e = raise (Read_error e)
+
+type state = {
+  buffer : MBytes.t ;
+  mutable offset : int ;
+  mutable remaining_bytes : int ;
+  mutable allowed_bytes : int option ;
+}
+
+let check_allowed_bytes state size =
+  match state.allowed_bytes with
+  | Some len when len < size -> raise Size_limit_exceeded
+  | Some len -> Some (len - size)
+  | None -> None
+
+let check_remaining_bytes state size =
+  if state.remaining_bytes < size then
+    raise Not_enough_data ;
+  state.remaining_bytes - size
+
+let read_atom size conv state =
+  let offset = state.offset in
+  state.remaining_bytes <- check_remaining_bytes state size ;
+  state.allowed_bytes <- check_allowed_bytes state size ;
+  state.offset <- state.offset + size ;
+  conv state.buffer offset
+
+(** Reader for all the atomic types. *)
+module Atom = struct
+
+  let uint8 = read_atom Binary_size.uint8 MBytes.get_uint8
+  let uint16 = read_atom Binary_size.int16 MBytes.get_uint16
+
+  let int8 = read_atom Binary_size.int8 MBytes.get_int8
+  let int16 = read_atom Binary_size.int16 MBytes.get_int16
+  let int32 = read_atom Binary_size.int32 MBytes.get_int32
+  let int64 = read_atom Binary_size.int64 MBytes.get_int64
+
+  let float = read_atom Binary_size.float MBytes.get_double
+
+  let bool state = int8 state <> 0
+
+  let uint30 =
+    read_atom Binary_size.uint30 @@ fun buffer ofs ->
+    let v = Int32.to_int (MBytes.get_int32 buffer ofs) in
+    if v < 0 then
+      raise (Invalid_int { min = 0 ; v ; max = (1 lsl 30) - 1 }) ;
+    v
+
+  let int31 =
+    read_atom Binary_size.int31 @@ fun buffer ofs ->
+    Int32.to_int (MBytes.get_int32 buffer ofs)
+
+  let int = function
+    | `Int31 -> int31
+    | `Int16 -> int16
+    | `Int8 -> int8
+    | `Uint30 -> uint30
+    | `Uint16 -> uint16
+    | `Uint8 -> uint8
+
+  let ranged_int ~minimum ~maximum state =
+    let read_int =
+      match Binary_size.range_to_size ~minimum ~maximum with
+      | `Int8 -> int8
+      | `Int16 -> int16
+      | `Int31 -> int31
+      | `Uint8 -> uint8
+      | `Uint16 -> uint16
+      | `Uint30 -> uint30 in
+    let ranged = read_int state in
+    let ranged = if minimum > 0 then ranged + minimum else ranged in
+    if not (minimum <= ranged && ranged <= maximum) then
+      raise (Invalid_int { min = minimum ; v =ranged ; max = maximum }) ;
+    ranged
+
+  let ranged_float ~minimum ~maximum state =
+    let ranged = float state in
+    if not (minimum <= ranged && ranged <= maximum) then
+      raise (Invalid_float { min = minimum ; v = ranged ; max = maximum }) ;
+    ranged
+
+  let rec read_z res value bit_in_value state =
+    let byte = uint8 state in
+    let value = value lor ((byte land 0x7F) lsl bit_in_value) in
+    let bit_in_value = bit_in_value + 7 in
+    let bit_in_value, value =
+      if bit_in_value < 8 then
+        (bit_in_value, value)
+      else begin
+        Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ;
+        bit_in_value - 8, value lsr 8
+      end in
+    if byte land 0x80 = 0x80 then
+      read_z res value bit_in_value state
+    else begin
+      if bit_in_value > 0 then Buffer.add_char res (Char.unsafe_chr value) ;
+      if byte = 0x00 then raise Trailing_zero ;
+      Z.of_bits (Buffer.contents res)
+    end
+
+  let n state =
+    let first = uint8 state in
+    let first_value = first land 0x7F in
+    if first land 0x80 = 0x80 then
+      read_z (Buffer.create 100) first_value 7 state
+    else
+      Z.of_int first_value
+
+  let z state =
+    let first = uint8 state in
+    let first_value = first land 0x3F in
+    let sign = (first land 0x40) <> 0 in
+    if first land 0x80 = 0x80 then
+      let n = read_z (Buffer.create 100) first_value 6 state in
+      if sign then Z.neg n else n
+    else
+      let n = Z.of_int first_value in
+      if sign then Z.neg n else n
+
+  let string_enum arr state =
+    let read_index =
+      match Binary_size.enum_size arr with
+      | `Uint8 -> uint8
+      | `Uint16 -> uint16
+      | `Uint30 -> uint30 in
+    let index = read_index state in
+    if index >= Array.length arr then
+      raise No_case_matched ;
+    arr.(index)
+
+  let fixed_length_bytes length =
+    read_atom length @@ fun buf ofs ->
+    MBytes.sub buf ofs length
+
+  let fixed_length_string length =
+    read_atom length @@ fun buf ofs ->
+    MBytes.sub_string buf ofs length
+
+  let tag = function
+    | `Uint8 -> uint8
+    | `Uint16 -> uint16
+
+end
+
+(** Main recursive reading function, in continuation passing style. *)
+let rec read_rec : type ret. ret Encoding.t -> state -> ret
+  = fun e state ->
+    let open Encoding in
+    match e.encoding with
+    | Null -> ()
+    | Empty -> ()
+    | Constant _ -> ()
+    | Ignore -> ()
+    | Bool   -> Atom.bool state
+    | Int8   -> Atom.int8 state
+    | Uint8  -> Atom.uint8 state
+    | Int16  -> Atom.int16 state
+    | Uint16 -> Atom.uint16 state
+    | Int31  -> Atom.int31 state
+    | Int32  -> Atom.int32 state
+    | Int64  -> Atom.int64 state
+    | N -> Atom.n state
+    | Z -> Atom.z state
+    | Float -> Atom.float state
+    | Bytes (`Fixed n) -> Atom.fixed_length_bytes n state
+    | Bytes `Variable ->
+        Atom.fixed_length_bytes state.remaining_bytes state
+    | String (`Fixed n) -> Atom.fixed_length_string n state
+    | String `Variable ->
+        Atom.fixed_length_string state.remaining_bytes state
+    | Padded (e, n) ->
+        let v = read_rec e state in
+        ignore (Atom.fixed_length_string n state : string) ;
+        v
+    | RangedInt { minimum ; maximum }  ->
+        Atom.ranged_int ~minimum ~maximum state
+    | RangedFloat { minimum ; maximum } ->
+        Atom.ranged_float ~minimum ~maximum state
+    | String_enum (_, arr) ->
+        Atom.string_enum arr state
+    | Array (max_length, e) ->
+        let max_length = Option.unopt ~default:max_int max_length in
+        let l = read_list List_too_long max_length e state in
+        Array.of_list l
+    | List (max_length, e) ->
+        let max_length = Option.unopt ~default:max_int max_length in
+        read_list Array_too_long max_length e state
+    | (Obj (Req { encoding = e })) -> read_rec e state
+    | (Obj (Dft { encoding = e })) -> read_rec e state
+    | (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
+        let present = Atom.bool state in
+        if not present then
+          None
+        else
+          Some (read_rec e state)
+    | (Obj (Opt { kind = `Variable ; encoding = e })) ->
+        if state.remaining_bytes = 0 then
+          None
+        else
+          Some (read_rec e state)
+    | Objs { kind = `Fixed sz ; left ; right } ->
+        ignore (check_remaining_bytes state sz : int) ;
+        ignore (check_allowed_bytes state sz : int option) ;
+        let left = read_rec left state in
+        let right = read_rec right state in
+        (left, right)
+    | Objs { kind = `Dynamic ; left ; right } ->
+        let left = read_rec left state in
+        let right = read_rec right state in
+        (left, right)
+    | Objs { kind = `Variable ; left ; right } ->
+        read_variable_pair left right state
+    | Tup e -> read_rec e state
+    | Tups { kind = `Fixed sz ; left ; right } ->
+        ignore (check_remaining_bytes state sz : int) ;
+        ignore (check_allowed_bytes state sz : int option) ;
+        let left = read_rec left state in
+        let right = read_rec right state in
+        (left, right)
+    | Tups { kind = `Dynamic ; left ; right } ->
+        let left = read_rec left state in
+        let right = read_rec right state in
+        (left, right)
+    | Tups { kind = `Variable ; left ; right } ->
+        read_variable_pair left right state
+    | Conv { inj ; encoding } ->
+        inj (read_rec encoding state)
+    | Union { tag_size ; cases } ->
+        let ctag = Atom.tag tag_size state in
+        let Case { encoding ; inj } =
+          try
+            List.find
+              (function
+                | Case { tag = Tag tag } -> tag = ctag
+                | Case { tag = Json_only } -> false)
+              cases
+          with Not_found -> raise (Unexpected_tag ctag) in
+        inj (read_rec encoding state)
+    | Dynamic_size { kind ; encoding = e } ->
+        let sz = Atom.int kind state in
+        let remaining = check_remaining_bytes state sz in
+        state.remaining_bytes <- sz ;
+        ignore (check_allowed_bytes state sz : int option) ;
+        let v = read_rec e state in
+        if state.remaining_bytes <> 0 then raise Extra_bytes ;
+        state.remaining_bytes <- remaining ;
+        v
+    | Check_size { limit ; encoding = e } ->
+        let old_allowed_bytes = state.allowed_bytes in
+        let limit =
+          match state.allowed_bytes with
+          | None -> limit
+          | Some current_limit -> min current_limit limit in
+        state.allowed_bytes <- Some limit ;
+        let v = read_rec e state in
+        let allowed_bytes =
+          match old_allowed_bytes with
+          | None -> None
+          | Some old_limit ->
+              let remaining =
+                match state.allowed_bytes with
+                | None -> assert false
+                | Some remaining -> remaining in
+              let read = limit - remaining in
+              Some (old_limit - read) in
+        state.allowed_bytes <- allowed_bytes ;
+        v
+    | Describe { encoding = e } -> read_rec e state
+    | Splitted { encoding = e } -> read_rec e state
+    | Mu { fix } -> read_rec (fix e) state
+    | Delayed f -> read_rec (f ()) state
+
+
+and read_variable_pair
+  : type left right.
+    left Encoding.t -> right Encoding.t -> state -> (left * right)
+  = fun e1 e2 state ->
+    match Encoding.classify e1, Encoding.classify e2 with
+    | (`Dynamic | `Fixed _), `Variable ->
+        let left = read_rec e1 state in
+        let right = read_rec e2 state in
+        (left, right)
+    | `Variable, `Fixed n ->
+        if n > state.remaining_bytes then raise Not_enough_data ;
+        state.remaining_bytes <- state.remaining_bytes - n ;
+        let left = read_rec e1 state in
+        assert (state.remaining_bytes = 0) ;
+        state.remaining_bytes <- n ;
+        let right = read_rec e2 state in
+        assert (state.remaining_bytes = 0) ;
+        (left, right)
+    | _ -> assert false (* Should be rejected by [Encoding.Kind.combine] *)
+
+and read_list : type a. read_error -> int -> a Encoding.t -> state -> a list
+  = fun error max_length e state ->
+    let rec loop max_length acc =
+      if state.remaining_bytes = 0 then
+        List.rev acc
+      else if max_length = 0 then
+        raise error
+      else
+        let v = read_rec e state in
+        loop (max_length - 1) (v :: acc) in
+    loop max_length []
+
+
+
+(** ******************** *)
+(** Various entry points *)
+
+let read encoding buffer ofs len =
+  let state =
+    { buffer ; offset = ofs ;
+      remaining_bytes = len ; allowed_bytes = None } in
+  match read_rec encoding state with
+  | exception Read_error _ -> None
+  | v -> Some (state.offset, v)
+
+let of_bytes_exn encoding buffer =
+  let len = MBytes.length buffer in
+  let state =
+    { buffer ; offset = 0 ;
+      remaining_bytes = len ; allowed_bytes = None } in
+  let v = read_rec encoding state in
+  if state.offset <> len then raise Extra_bytes ;
+  v
+
+let of_bytes encoding buffer =
+  try Some (of_bytes_exn encoding buffer)
+  with Read_error _ -> None
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_reader.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_reader.mli
new file mode 100644
index 000000000..a7c0e40b3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_reader.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Binary}. *)
+
+val read: 'a Encoding.t -> MBytes.t -> int -> int -> (int * 'a) option
+val of_bytes: 'a Encoding.t -> MBytes.t -> 'a option
+val of_bytes_exn: 'a Encoding.t -> MBytes.t -> 'a
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_schema.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_schema.ml
new file mode 100644
index 000000000..9b51fdc5d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_schema.ml
@@ -0,0 +1,581 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Encoding
+
+type integer_extended = [ Binary_size.integer | `Int32 | `Int64 ]
+
+type field_descr =
+  | Named_field of string * Kind.t * layout
+  | Anonymous_field of Kind.t * layout
+  | Dynamic_size_field of string option * int * Binary_size.unsigned_integer
+  | Optional_field of string
+
+and layout =
+  | Zero_width
+  | Int of integer_extended
+  | Bool
+  | RangedInt of int * int
+  | RangedFloat of float * float
+  | Float
+  | Bytes
+  | String
+  | Enum of Binary_size.integer * string
+  | Seq of layout * int option (* For arrays and lists *)
+  | Ref of string
+  | Padding
+
+and fields = field_descr list
+
+and toplevel_encoding =
+  | Obj of { fields : fields }
+  | Cases of { kind : Kind.t ;
+               tag_size : Binary_size.tag_size ;
+               cases : (int * string option * fields) list }
+  | Int_enum of { size : Binary_size.integer ;
+                  cases : (int * string) list }
+
+and description =
+  { title : string ;
+    description : string option }
+
+type t = {
+  toplevel: toplevel_encoding ;
+  fields: (description * toplevel_encoding) list ;
+}
+
+module Printer_ast = struct
+
+  type table =
+    { headers : string list ;
+      body : string list list }
+
+  type t =
+    | Table of table
+    | Union of Binary_size.tag_size * (description * table) list
+
+  let pp_size ppf = function
+    | `Fixed size ->
+        Format.fprintf ppf  "%d byte%s" size (if size = 1 then "" else "s")
+    | `Variable ->
+        Format.fprintf ppf "Variable"
+    | `Dynamic ->
+        Format.fprintf ppf "Determined from data"
+
+  let pp_int ppf (int : integer_extended) =
+    Format.fprintf ppf "%s"
+      begin
+        match int with
+        | `Int16 -> "signed 16-bit integer"
+        | `Int31 -> "signed 31-bit integer"
+        | `Uint30 -> "unsigned 30-bit integer"
+        | `Int32 -> "signed 32-bit integer"
+        | `Int64 -> "signed 64-bit integer"
+        | `Int8 -> "signed 8-bit integer"
+        | `Uint16 -> "unsigned 16-bit integer"
+        | `Uint8 -> "unsigned 8-bit integer"
+      end
+
+  let rec pp_layout ppf = function
+    | Zero_width ->
+        Format.fprintf ppf "placeholder (not actually present in the encoding)"
+    | Int integer ->
+        Format.fprintf ppf "%a" pp_int integer
+    | Bool ->
+        Format.fprintf ppf "boolean (0 for false, 255 for true)"
+    | RangedInt (minimum, maximum) when minimum <= 0 ->
+        Format.fprintf ppf "%a in the range %d to %d"
+          pp_int ((Binary_size.range_to_size ~minimum ~maximum) :> integer_extended)
+          minimum maximum
+    | RangedInt (minimum, maximum) (* when minimum > 0 *) ->
+        Format.fprintf ppf "%a in the range %d to %d (shifted by %d)"
+          pp_int ((Binary_size.range_to_size ~minimum ~maximum) :> integer_extended)
+          minimum maximum minimum
+    | RangedFloat (minimum, maximum) ->
+        Format.fprintf ppf
+          "double-precision floating-point number, in the range %f to %f"
+          minimum maximum
+    | Float ->
+        Format.fprintf ppf "double-precision floating-point number"
+    | Bytes ->
+        Format.fprintf ppf "bytes"
+    | String ->
+        Format.fprintf ppf "bytes"
+    | Ref reference ->
+        Format.fprintf ppf "$%s" reference
+    | Padding ->
+        Format.fprintf ppf "padding"
+    | Enum (size, reference) ->
+        Format.fprintf ppf "%a encoding an enumeration (see %s)"
+          pp_int (size :> integer_extended)
+          reference
+    | Seq (data, len) ->
+        Format.fprintf ppf "sequence of " ;
+        begin match len with
+          | None -> ()
+          | Some len -> Format.fprintf ppf "at most %d " len
+        end ;
+        begin match data with
+          | Ref reference -> Format.fprintf ppf "$%s" reference
+          | _ -> pp_layout ppf data
+        end
+
+
+  let pp_tag_size ppf tag =
+    Format.fprintf ppf "%s" @@
+    match tag with
+    | `Uint8 -> "8-bit"
+    | `Uint16 -> "16-bit"
+
+  let field_descr () =
+    let reference = ref 0 in
+    let string_of_layout = Format.asprintf "%a" pp_layout  in
+    let anon_num () =
+      let value = !reference in
+      reference := value + 1;
+      string_of_int value in
+    function
+    | Named_field (name, kind, desc) ->
+        [ name ; Format.asprintf "%a" pp_size kind ; string_of_layout desc ]
+    | Dynamic_size_field (Some name, 1, size) ->
+        [ Format.asprintf "# bytes in field \"%s\"" name ;
+          Format.asprintf "%a"
+            pp_size (`Fixed (Binary_size.integer_to_size size)) ;
+          string_of_layout (Int (size :> integer_extended)) ]
+    | Dynamic_size_field (None, 1, size) ->
+        [ Format.asprintf "# bytes in next field" ;
+          Format.asprintf "%a"
+            pp_size (`Fixed (Binary_size.integer_to_size size)) ;
+          string_of_layout (Int (size :> integer_extended)) ]
+    | Dynamic_size_field (_, i, size) ->
+        [ Format.asprintf "# bytes in next %d fields" i ;
+          Format.asprintf "%a"
+            pp_size (`Fixed (Binary_size.integer_to_size size)) ;
+          string_of_layout (Int (size :> integer_extended)) ]
+    | Anonymous_field (kind, desc) ->
+        [ "Unnamed field " ^ anon_num () ;
+          Format.asprintf "%a" pp_size kind ;
+          string_of_layout desc ]
+    | Optional_field name ->
+        [ Format.asprintf "? presence of field \"%s\"" name ;
+          Format.asprintf "%a" pp_size (`Fixed 1) ;
+          string_of_layout Bool ]
+
+  let binary_table_headers = [ "Name" ; "Size" ; "Contents" ]
+  let enum_headers = [ "Case number" ; "Encoded string" ]
+
+  let toplevel (descr, encoding) =
+    match encoding with
+    | Obj { fields } ->
+        descr,
+        Table { headers = binary_table_headers ;
+                body = List.map (field_descr ()) fields }
+    | Cases { kind ; tag_size ; cases } ->
+        { title =
+            Format.asprintf "%s (%a, %a tag)"
+              descr.title pp_size kind pp_tag_size tag_size ;
+          description = descr.description},
+        Union (tag_size,
+               List.map
+                 (fun (tag, name, fields) ->
+                    { title =
+                        begin
+                          match name with
+                          | Some name -> Format.asprintf "%s (tag %d)" name tag
+                          | None -> Format.asprintf "Tag %d" tag
+                        end;
+                      description = None },
+                    { headers = binary_table_headers ;
+                      body = List.map (field_descr ()) fields })
+                 cases)
+    | Int_enum { size ; cases } ->
+        { title =
+            Format.asprintf "%s (Enumeration: %a):"
+              descr.title pp_int (size :> integer_extended) ;
+          description = descr.description },
+        Table
+          { headers = enum_headers ;
+            body = List.map (fun (num, str) -> [ string_of_int num ; str ]) cases }
+
+end
+
+module Printer = struct
+
+  let rec pad char ppf = function
+    | 0 -> ()
+    | n ->
+        Format.pp_print_char ppf char ;
+        pad char ppf (n - 1)
+
+  let pp_title level ppf title =
+    let char =
+      if level = 1 then '*' else
+      if level = 2 then '=' else
+        '`' in
+    let sub = String.map (fun _ -> char) title in
+    Format.fprintf ppf "%s@ %s@\n@\n" title sub
+
+  let pp_table ppf { Printer_ast.headers ; body } =
+    let max_widths =
+      List.fold_left (List.map2 (fun len str -> max (String.length str) len))
+        (List.map String.length headers)
+        body in
+    let pp_row pad_char ppf =
+      Format.fprintf ppf "|%a"
+        (fun ppf ->
+           List.iter2
+             (fun width str -> Format.fprintf ppf " %s%a |" str (pad pad_char) (width - (String.length str)))
+             max_widths) in
+    let pp_line c ppf =
+      Format.fprintf ppf "+%a"
+        (fun ppf ->
+           List.iter2
+             (fun width _str -> Format.fprintf ppf "%a+" (pad c) (width + 2))
+             max_widths) in
+    Format.fprintf ppf "%a@\n%a@\n%a@\n%a@\n@\n"
+      (pp_line '-') headers
+      (pp_row ' ') headers
+      (pp_line '=') headers
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
+         (fun ppf s ->
+            Format.fprintf ppf "%a@\n%a"
+              (pp_row ' ') s
+              (pp_line '-') s))
+      body
+
+  let pp_option_nl ppf =
+    Option.iter ~f:(Format.fprintf ppf "%s@\n@\n")
+
+  let pp_toplevel ppf = function
+    | Printer_ast.Table table -> pp_table ppf table
+    | Union (_tag_size, tables) ->
+        Format.fprintf ppf
+          "%a"
+          (fun ppf ->
+             Format.pp_print_list
+               ~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
+               (fun ppf (descr, table) ->
+                  Format.fprintf ppf
+                    "%a%a%a"
+                    (pp_title 2) descr.title
+                    pp_option_nl descr.description
+                    pp_table table)
+               ppf)
+          tables
+
+  let pp ppf { toplevel; fields } =
+    let _, toplevel =
+      Printer_ast.toplevel ({ title = "" ; description = None}, toplevel) in
+    Format.fprintf ppf "%a@\n%a"
+      pp_toplevel toplevel
+      (Format.pp_print_list
+         ~pp_sep:(fun ppf () -> Format.fprintf ppf "@\n")
+         (fun ppf (descr, toplevel) ->
+            Format.fprintf ppf
+              "%a%a%a"
+              (pp_title 1) descr.title
+              pp_option_nl descr.description
+              pp_toplevel toplevel))
+      (List.map Printer_ast.toplevel fields)
+
+end
+
+module Encoding = struct
+
+  let description_encoding =
+    conv
+      (fun { title ; description } -> (title, description))
+      (fun (title, description) -> { title ; description })
+      (obj2
+         (req "title" string)
+         (opt "description" string))
+
+
+  let integer_cases =
+    [ ("Int16", `Int16) ;
+      ("Int8", `Int8) ;
+      ("Uint16", `Uint16) ;
+      ("Uint8", `Uint8) ]
+
+  let integer_encoding : Binary_size.integer encoding =
+    string_enum integer_cases
+
+  let integer_extended_encoding =
+    string_enum
+      (("Int64", `Int64) ::
+       ("Int32", `Int32) ::
+       integer_cases)
+
+  let layout_encoding =
+    mu "layout"
+      (fun layout ->
+         union [
+           case
+             ~title:"Zero_width"
+             (Tag 0)
+             (obj1
+                (req "kind" (constant "Zero_width")))
+             (function
+               | Zero_width -> Some ()
+               | _ -> None)
+             (fun () -> Zero_width) ;
+           case ~title:"Int"
+             (Tag 1)
+             (obj2
+                (req "size" integer_extended_encoding)
+                (req "kind" (constant "Int")))
+             (function
+               | Int integer -> Some (integer, ())
+               | _ -> None)
+             (fun (integer, _)-> Int integer) ;
+           case ~title:"Bool"
+             (Tag 2)
+             (obj1 (req "kind" (constant "Bool")))
+             (function
+               | Bool -> Some ()
+               | _ -> None)
+             (fun () -> Bool) ;
+           case ~title:"RangedInt"
+             (Tag 3)
+             (obj3
+                (req "min" int31)
+                (req "max" int31)
+                (req "kind" (constant "RangedInt")))
+             (function
+               | RangedInt (min, max) -> Some (min, max, ())
+               | _ -> None)
+             (fun (min, max, _) -> RangedInt (min, max)) ;
+           case ~title:"RangedFloat"
+             (Tag 4)
+             (obj3
+                (req "min" float)
+                (req "max" float)
+                (req "kind" (constant "RangedFloat")))
+             (function
+               | RangedFloat (min, max) -> Some (min, max, ())
+               | _ -> None)
+             (fun (min, max, ()) -> RangedFloat (min, max)) ;
+           case ~title:"Float"
+             (Tag 5)
+             (obj1 (req "kind" (constant "Float")))
+             (function
+               | Float -> Some ()
+               | _ -> None)
+             (fun () -> Float) ;
+           case ~title:"Bytes"
+             (Tag 6)
+             (obj1 (req "kind" (constant "Bytes")))
+             (function
+               | Bytes -> Some ()
+               | _ -> None)
+             (fun () -> Bytes) ;
+           case ~title:"String"
+             (Tag 7)
+             (obj1 (req "kind" (constant "String")))
+             (function
+               | String -> Some ()
+               | _ -> None)
+             (fun () -> String) ;
+           case ~title:"Enum"
+             (Tag 8)
+             (obj3
+                (req "size" integer_encoding)
+                (req "reference" string)
+                (req "kind" (constant "Enum")))
+             (function
+               | Enum (size, cases) -> Some (size, cases, ())
+               | _ -> None)
+             (fun (size, cases, _) -> Enum (size, cases)) ;
+           case ~title:"Seq"
+             (Tag 9)
+             (obj3
+                (req "layout" layout)
+                (req "kind" (constant "Seq"))
+                (opt "max_length" int31))
+             (function
+               | Seq (layout, len) -> Some (layout, (), len)
+               | _ -> None)
+             (fun (layout, (), len) -> Seq (layout, len)) ;
+           case ~title:"Ref"
+             (Tag 10)
+             (obj2
+                (req "name" string)
+                (req "kind" (constant "Ref")))
+             (function
+               | Ref layout -> Some (layout, ())
+               | _ -> None)
+             (fun (name, ()) -> Ref name) ;
+           case ~title:"Padding"
+             (Tag 11)
+             (obj1
+                (req "kind" (constant "Padding")))
+             (function
+               | Padding -> Some ()
+               | _ -> None)
+             (fun () -> Padding) ;
+         ])
+
+  let kind_enum_cases =
+    (fun () ->
+       [ case ~title:"Dynamic"
+           (Tag 0)
+           (obj1 (req "kind" (constant "Dynamic")))
+           (function `Dynamic -> Some ()
+                   | _ -> None)
+           (fun () -> `Dynamic) ;
+         case ~title:"Variable"
+           (Tag 1)
+           (obj1 (req "kind" (constant "Variable")))
+           (function `Variable -> Some ()
+                   | _ -> None)
+           (fun () -> `Variable) ])
+
+  let kind_enum_encoding =
+    def "schema.kind.enum" @@ union (kind_enum_cases ())
+
+  let kind_t_encoding =
+    def "schema.kind" @@
+    union
+      ((case ~title:"Fixed"
+          (Tag 2)
+          (obj2
+             (req "size" int31)
+             (req "kind" (constant "Float")))
+          (function `Fixed n -> Some (n, ())
+                  | _ -> None)
+          (fun (n, _) -> `Fixed n)) :: (kind_enum_cases ()))
+
+  let unsigned_integer_encoding =
+    string_enum
+      [("Uint30", `Uint30) ;
+       ("Uint16", `Uint16) ;
+       ("Uint8", `Uint8) ]
+
+  let field_descr_encoding =
+    let dynamic_layout_encoding = dynamic_size layout_encoding in
+    def "schema.field" @@
+    union [
+      case ~title:"Named_field"
+        (Tag 0)
+        (obj4
+           (req "name" string)
+           (req "layout" dynamic_layout_encoding)
+           (req "data_kind" kind_t_encoding)
+           (req "kind" (constant "named")))
+        (function Named_field (name, kind, layout) -> Some (name, layout, kind, ())
+                | _ -> None)
+        (fun (name, kind, layout, _) -> Named_field (name, layout, kind)) ;
+      case ~title:"Anonymous_field"
+        (Tag 1)
+        (obj3
+           (req "layout" dynamic_layout_encoding)
+           (req "kind" (constant "anon"))
+           (req "data_kind" kind_t_encoding))
+        (function Anonymous_field (kind, layout) -> Some (layout, (), kind)
+                | _ -> None)
+        (fun (kind, _, layout) -> Anonymous_field (layout, kind)) ;
+      case ~title:"Dynamic_field"
+        (Tag 2)
+        (obj4
+           (req "kind" (constant "dyn"))
+           (opt "name" string)
+           (req "num_fields" int31)
+           (req "size" unsigned_integer_encoding))
+        (function Dynamic_size_field (name, i, size) -> Some ((), name, i, size)
+                | _ -> None)
+        (fun ((), name, i, size) -> Dynamic_size_field (name, i, size)) ;
+      case ~title:"Optional_field"
+        (Tag 3)
+        (obj2
+           (req "kind" (constant "option_indicator"))
+           (req "name" string))
+        (function Optional_field s -> Some ((), s)
+                | _ -> None)
+        (fun ((), s) -> Optional_field s)
+    ]
+
+  let tag_size_encoding =
+    string_enum
+      [("Uint16", `Uint16) ;
+       ("Uint8", `Uint8) ]
+
+  let binary_description_encoding =
+    union [
+      case ~title:"Obj"
+        (Tag 0)
+        (obj1
+           (req "fields" (list (dynamic_size field_descr_encoding))))
+        (function
+          | Obj { fields } -> Some (fields)
+          | _ -> None)
+        (fun (fields) -> Obj { fields }) ;
+      case ~title:"Cases"
+        (Tag 1)
+        (obj3
+           (req "tag_size" tag_size_encoding)
+           (req "kind" (dynamic_size kind_t_encoding))
+           (req "cases"
+              (list
+                 (def "union case" @@
+                  conv
+                    (fun (tag, name, fields) -> (tag, fields, name))
+                    (fun (tag, fields, name) -> (tag, name, fields)) @@
+                  obj3
+                    (req "tag" int31)
+                    (req "fields" (list (dynamic_size field_descr_encoding)))
+                    (opt "name" string)))))
+        (function
+          | Cases { kind ; tag_size ; cases } ->
+              Some (tag_size, kind, cases)
+          | _ -> None)
+        (fun (tag_size, kind, cases) ->
+           Cases { kind ; tag_size ; cases }) ;
+      case ~title:"Int_enum"
+        (Tag 2)
+        (obj2
+           (req "size" integer_encoding)
+           (req "cases" (list (tup2 int31 string))))
+        (function Int_enum { size ; cases } -> Some (size, cases)
+                | _ -> None)
+        (fun (size, cases) -> Int_enum { size ; cases })
+    ]
+
+  let encoding =
+    conv
+      (fun { toplevel ; fields } -> (toplevel, fields))
+      (fun (toplevel, fields) -> { toplevel ; fields }) @@
+    obj2
+      (req "toplevel" binary_description_encoding)
+      (req "fields"
+         (list
+            (obj2
+               (req "description" description_encoding)
+               (req "encoding" binary_description_encoding))))
+
+end
+
+let encoding = Encoding.encoding
+let pp = Printer.pp
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_schema.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_schema.mli
new file mode 100644
index 000000000..768402a96
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_schema.mli
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. *)
+
+type integer_extended = [ Binary_size.integer | `Int32 | `Int64 ]
+
+type field_descr =
+  | Named_field of string * Encoding.Kind.t * layout
+  | Anonymous_field of Encoding.Kind.t * layout
+  | Dynamic_size_field of string option * int * Binary_size.unsigned_integer
+  | Optional_field of string
+
+and layout =
+  | Zero_width
+  | Int of integer_extended
+  | Bool
+  | RangedInt of int * int
+  | RangedFloat of float * float
+  | Float
+  | Bytes
+  | String
+  | Enum of Binary_size.integer * string
+  | Seq of layout * int option (* For arrays and lists *)
+  | Ref of string
+  | Padding
+
+and fields = field_descr list
+
+and toplevel_encoding =
+  | Obj of { fields : fields }
+  | Cases of { kind : Encoding.Kind.t ;
+               tag_size : Binary_size.tag_size ;
+               cases : (int * string option * fields) list }
+  | Int_enum of { size : Binary_size.integer ;
+                  cases : (int * string) list }
+
+and description =
+  { title : string ;
+    description : string option }
+
+type t = {
+  toplevel: toplevel_encoding ;
+  fields: (description * toplevel_encoding) list ;
+}
+
+val pp: Format.formatter -> t -> unit
+val encoding: t Encoding.t
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_size.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_size.ml
new file mode 100644
index 000000000..b11c8b476
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_size.ml
@@ -0,0 +1,93 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 bool = 1
+let int8 = 1
+let uint8 = 1
+let char = 1
+let int16 = 2
+let uint16 = 2
+let uint30 = 4
+let uint32 = 4
+let uint64 = 8
+let int31 = 4
+let int32 = 4
+let int64 = 8
+let float = 8
+
+type tag_size = [ `Uint8 | `Uint16 ]
+
+let tag_size = function
+  | `Uint8 -> uint8
+  | `Uint16 -> uint16
+
+type signed_integer = [ `Int31 | `Int16 | `Int8 ]
+type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
+type integer = [ signed_integer | unsigned_integer ]
+
+let signed_range_to_size min max : [> signed_integer ] =
+  if min >= ~-128 && max <= 127
+  then `Int8
+  else if min >= ~-32_768 && max <= 32_767
+  then `Int16
+  else `Int31
+
+(* max should be centered at zero *)
+let unsigned_range_to_size max : [> unsigned_integer ] =
+  assert (max >= 0) ;
+  if max <= 255
+  then `Uint8
+  else if max <= 65535
+  then `Uint16
+  else `Uint30
+
+let integer_to_size = function
+  | `Int31 -> int31
+  | `Int16 -> int16
+  | `Int8 -> int8
+  | `Uint30 -> uint30
+  | `Uint16 -> uint16
+  | `Uint8 -> uint8
+
+let max_int = function
+  | `Uint30 | `Int31 -> (1 lsl 30) - 1
+  | `Int16 -> 1 lsl 15 - 1
+  | `Int8 -> 1 lsl 7 - 1
+  | `Uint16 -> 1 lsl 16 - 1
+  | `Uint8 -> 1 lsl 8 - 1
+
+let min_int = function
+  | `Uint8 | `Uint16 | `Uint30 -> 0
+  | `Int31 -> - (1 lsl 30)
+  | `Int16 -> - (1 lsl 15)
+  | `Int8 -> - (1 lsl 7)
+
+let range_to_size ~minimum ~maximum : integer =
+  if minimum < 0
+  then signed_range_to_size minimum maximum
+  else unsigned_range_to_size (maximum - minimum)
+
+let enum_size arr =
+  unsigned_range_to_size (Array.length arr)
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_size.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_size.mli
new file mode 100644
index 000000000..ae8d0d002
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_size.mli
@@ -0,0 +1,58 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. *)
+
+val bool: int
+val int8: int
+val uint8: int
+val char: int
+val int16: int
+val uint16: int
+val uint30: int
+val uint32: int
+val uint64: int
+val int31: int
+val int32: int
+val int64: int
+val float: int
+
+type tag_size = [ `Uint8 | `Uint16 ]
+
+val tag_size: tag_size -> int
+
+type signed_integer = [ `Int31 | `Int16 | `Int8 ]
+type unsigned_integer = [ `Uint30 | `Uint16 | `Uint8 ]
+type integer = [ signed_integer | unsigned_integer ]
+
+val integer_to_size: [< integer ] -> int
+
+val min_int: [< integer ] -> int
+val max_int: [< integer ] -> int
+
+val range_to_size: minimum:int -> maximum:int -> integer
+val unsigned_range_to_size: int -> unsigned_integer
+
+val enum_size: 'a array -> [> unsigned_integer ]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.ml
new file mode 100644
index 000000000..46b0d6a1c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.ml
@@ -0,0 +1,450 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Binary_error
+
+let raise e = raise (Read_error e)
+
+(** Persistent state of the binary reader. *)
+type state = {
+
+  stream : Binary_stream.t ;
+  (** All the remaining data to be read. *)
+
+  remaining_bytes : int option ;
+  (** Total number of bytes that should be from 'stream' (None =
+      illimited). Reading less bytes should raise [Extra_bytes] and
+      trying to read more bytes should raise [Not_enough_data]. *)
+
+  allowed_bytes : int option ;
+  (** Maximum number of bytes that are allowed to be read from 'stream'
+      before to fail (None = illimited). *)
+
+  total_read : int ;
+  (** Total number of bytes that has been read from [stream] since the
+      beginning. *)
+
+}
+
+(** Return type for the function [read_rec]. See [Data_encoding] for its
+    description. *)
+type 'ret status =
+  | Success of { result : 'ret ; size : int ; stream : Binary_stream.t }
+  | Await of (MBytes.t -> 'ret status)
+  | Error of read_error
+
+let check_remaining_bytes state size =
+  match state.remaining_bytes with
+  | Some len when len < size -> raise Not_enough_data
+  | Some len -> Some (len - size)
+  | None -> None
+
+let check_allowed_bytes state size =
+  match state.allowed_bytes with
+  | Some len when len < size -> raise Size_limit_exceeded
+  | Some len -> Some (len - size)
+  | None -> None
+
+(** [read_atom resume size conv state k] reads [size] bytes from [state],
+    pass it to [conv] to be decoded, and finally call the continuation [k]
+    with the decoded value and the updated state.
+
+    The function [conv] is also allowed to raise [Read_error err].
+    In that case the exception is catched and [Error err] is returned.
+
+    If there is not enough [remaining_bytes] to be read in [state], the
+    function returns [Error Not_enough_data] instead of calling
+    the continuation.
+
+    If there is not enough [allowed_bytes] to be read in [state], the
+    function returns [Error Size_limit_exceeded] instead of calling
+    the continuation.
+
+    If there is not enough bytes to be read in [state], the function
+    returns [Await resume] instead of calling the continuation. *)
+let read_atom resume size conv state k =
+  match
+    let remaining_bytes = check_remaining_bytes state size in
+    let allowed_bytes = check_allowed_bytes state size in
+    let res, stream = Binary_stream.read state.stream size in
+    conv res.buffer res.ofs,
+    { remaining_bytes ; allowed_bytes ; stream ;
+      total_read = state.total_read + size }
+  with
+  | exception (Read_error error) -> Error error
+  | exception Binary_stream.Need_more_data -> Await resume
+  | v -> k v (* tail call *)
+
+(** Reader for all the atomic types. *)
+module Atom = struct
+
+  let uint8 r = read_atom r Binary_size.uint8 MBytes.get_uint8
+  let uint16 r = read_atom r Binary_size.int16 MBytes.get_uint16
+
+  let int8 r = read_atom r Binary_size.int8 MBytes.get_int8
+  let int16 r = read_atom r Binary_size.int16 MBytes.get_int16
+  let int32 r = read_atom r Binary_size.int32 MBytes.get_int32
+  let int64 r = read_atom r Binary_size.int64 MBytes.get_int64
+
+  let float r = read_atom r Binary_size.float MBytes.get_double
+
+  let bool resume state k =
+    int8 resume state @@ fun (v, state) ->
+    k (v <> 0, state)
+
+  let uint30 r =
+    read_atom r Binary_size.uint30 @@ fun buffer ofs ->
+    let v = Int32.to_int (MBytes.get_int32 buffer ofs) in
+    if v < 0 then
+      raise (Invalid_int { min = 0 ; v ; max = (1 lsl 30) - 1 }) ;
+    v
+
+  let int31 r =
+    read_atom r Binary_size.int31 @@ fun buffer ofs ->
+    Int32.to_int (MBytes.get_int32 buffer ofs)
+
+  let int = function
+    | `Int31 -> int31
+    | `Int16 -> int16
+    | `Int8 -> int8
+    | `Uint30 -> uint30
+    | `Uint16 -> uint16
+    | `Uint8 -> uint8
+
+  let ranged_int ~minimum ~maximum resume state k =
+    let read_int =
+      match Binary_size.range_to_size ~minimum ~maximum with
+      | `Int8 -> int8
+      | `Int16 -> int16
+      | `Int31 -> int31
+      | `Uint8 -> uint8
+      | `Uint16 -> uint16
+      | `Uint30 -> uint30 in
+    read_int resume state @@ fun (ranged, state) ->
+    let ranged = if minimum > 0 then ranged + minimum else ranged in
+    if not (minimum <= ranged && ranged <= maximum) then
+      Error (Invalid_int { min = minimum ; v =ranged ; max = maximum })
+    else
+      k (ranged, state)
+
+  let ranged_float ~minimum ~maximum resume state k =
+    float resume state @@ fun (ranged, state) ->
+    if not (minimum <= ranged && ranged <= maximum) then
+      Error (Invalid_float { min = minimum ; v = ranged ; max = maximum })
+    else
+      k (ranged, state)
+
+  let rec read_z res value bit_in_value state k =
+    let resume buffer =
+      let stream = Binary_stream.push buffer state.stream in
+      read_z res value bit_in_value { state with stream } k in
+    uint8 resume state @@ fun (byte, state) ->
+    let value = value lor ((byte land 0x7F) lsl bit_in_value) in
+    let bit_in_value = bit_in_value + 7 in
+    let bit_in_value, value =
+      if bit_in_value < 8 then
+        (bit_in_value, value)
+      else begin
+        Buffer.add_char res (Char.unsafe_chr (value land 0xFF)) ;
+        bit_in_value - 8, value lsr 8
+      end in
+    if byte land 0x80 = 0x80 then
+      read_z res value bit_in_value state k
+    else begin
+      if bit_in_value > 0 then Buffer.add_char res (Char.unsafe_chr value) ;
+      if byte = 0x00 then raise Trailing_zero ;
+      k (Z.of_bits (Buffer.contents res), state)
+    end
+
+  let n resume state k =
+    uint8 resume state @@ fun (first, state) ->
+    let first_value = first land 0x7F in
+    if first land 0x80 = 0x80 then
+      read_z (Buffer.create 100) first_value 7 state k
+    else
+      k (Z.of_int first_value, state)
+
+  let z resume state k =
+    uint8 resume state @@ fun (first, state) ->
+    let first_value = first land 0x3F in
+    let sign = (first land 0x40) <> 0 in
+    if first land 0x80 = 0x80 then
+      read_z (Buffer.create 100) first_value 6 state @@ fun (n, state) ->
+      k ((if sign then Z.neg n else n), state)
+    else
+      let n = Z.of_int first_value in
+      k ((if sign then Z.neg n else n), state)
+
+  let string_enum arr resume state k =
+    let read_index =
+      match Binary_size.enum_size arr with
+      | `Uint8 -> uint8
+      | `Uint16 -> uint16
+      | `Uint30 -> uint30 in
+    read_index resume state @@ fun (index, state) ->
+    if index >= Array.length arr then
+      Error No_case_matched
+    else
+      k (arr.(index), state)
+
+  let fixed_length_bytes length r =
+    read_atom r length @@ fun buf ofs ->
+    MBytes.sub buf ofs length
+
+  let fixed_length_string length r =
+    read_atom r length @@ fun buf ofs ->
+    MBytes.sub_string buf ofs length
+
+  let tag = function
+    | `Uint8 -> uint8
+    | `Uint16 -> uint16
+
+end
+
+let rec skip n state k =
+  let resume buffer =
+    let stream = Binary_stream.push buffer state.stream in
+    try skip n { state with stream } k
+    with Read_error err -> Error err in
+  Atom.fixed_length_string n resume state @@ fun (_, state : string * _) ->
+  k state
+
+(** Main recursive reading function, in continuation passing style. *)
+let rec read_rec
+  : type next ret.
+    bool -> next Encoding.t -> state -> ((next * state) -> ret status) -> ret status
+  = fun whole e state k ->
+    let resume buffer =
+      let stream = Binary_stream.push buffer state.stream in
+      try read_rec whole e { state with stream }k
+      with Read_error err -> Error err in
+    let open Encoding in
+    assert (Encoding.classify e <> `Variable || state.remaining_bytes <> None) ;
+    match e.encoding with
+    | Null -> k ((), state)
+    | Empty -> k ((), state)
+    | Constant _ -> k ((), state)
+    | Ignore -> k ((), state)
+    | Bool   -> Atom.bool resume state k
+    | Int8   -> Atom.int8 resume state k
+    | Uint8  -> Atom.uint8 resume state k
+    | Int16  -> Atom.int16 resume state k
+    | Uint16 -> Atom.uint16 resume state k
+    | Int31  -> Atom.int31 resume state k
+    | Int32  -> Atom.int32 resume state k
+    | Int64  -> Atom.int64 resume state k
+    | N -> Atom.n resume state k
+    | Z -> Atom.z resume state k
+    | Float -> Atom.float resume state k
+    | Bytes (`Fixed n) -> Atom.fixed_length_bytes n resume state k
+    | Bytes `Variable ->
+        let size = remaining_bytes state in
+        Atom.fixed_length_bytes size resume state k
+    | String (`Fixed n) -> Atom.fixed_length_string n resume state k
+    | String `Variable ->
+        let size = remaining_bytes state in
+        Atom.fixed_length_string size resume state k
+    | Padded (e, n) ->
+        read_rec false e state @@ fun (v, state) ->
+        skip n state @@ (fun state -> k (v, state))
+    | RangedInt { minimum ; maximum }  ->
+        Atom.ranged_int ~minimum ~maximum resume state k
+    | RangedFloat { minimum ; maximum } ->
+        Atom.ranged_float ~minimum ~maximum resume state k
+    | String_enum (_, arr) ->
+        Atom.string_enum arr resume state k
+    | Array (max_length, e) ->
+        let max_length = Option.unopt ~default:max_int max_length in
+        read_list Array_too_long max_length e state @@ fun (l, state) ->
+        k (Array.of_list l, state)
+    | List (max_length, e) ->
+        let max_length = Option.unopt ~default:max_int max_length in
+        read_list List_too_long max_length e state k
+    | (Obj (Req { encoding = e })) -> read_rec whole e state k
+    | (Obj (Dft { encoding = e })) -> read_rec whole e state k
+    | (Obj (Opt { kind = `Dynamic ; encoding = e })) ->
+        Atom.bool resume state @@ fun (present, state) ->
+        if not present then
+          k (None, state)
+        else
+          read_rec whole e state @@ fun (v, state) ->
+          k (Some v, state)
+    | (Obj (Opt { kind = `Variable ; encoding = e })) ->
+        let size = remaining_bytes state in
+        if size = 0 then
+          k (None, state)
+        else
+          read_rec whole e state @@ fun (v, state) ->
+          k (Some v, state)
+    | Objs { kind = `Fixed sz ; left ; right } ->
+        ignore (check_remaining_bytes state sz : int option) ;
+        ignore (check_allowed_bytes state sz : int option) ;
+        read_rec false left state @@ fun (left, state) ->
+        read_rec whole right state @@ fun (right, state) ->
+        k ((left, right), state)
+    | Objs { kind = `Dynamic ; left ; right } ->
+        read_rec false left state @@ fun (left, state) ->
+        read_rec whole right state @@ fun (right, state) ->
+        k ((left, right), state)
+    | Objs { kind = `Variable ; left ; right } ->
+        read_variable_pair left right state k
+    | Tup e -> read_rec whole e state k
+    | Tups { kind = `Fixed sz ; left ; right } ->
+        ignore (check_remaining_bytes state sz : int option) ;
+        ignore (check_allowed_bytes state sz : int option) ;
+        read_rec false left state @@ fun (left, state) ->
+        read_rec whole right state @@ fun (right, state) ->
+        k ((left, right), state)
+    | Tups { kind = `Dynamic ; left ; right } ->
+        read_rec false left state @@ fun (left, state) ->
+        read_rec whole right state @@ fun (right, state) ->
+        k ((left, right), state)
+    | Tups { kind = `Variable ; left ; right } ->
+        read_variable_pair left right state k
+    | Conv { inj ; encoding } ->
+        read_rec whole encoding state @@ fun (v, state) ->
+        k (inj v, state)
+    | Union { tag_size ; cases } -> begin
+        Atom.tag tag_size resume state @@ fun (ctag, state) ->
+        match
+          List.find_opt
+            (function
+              | Case { tag = Tag tag } -> tag = ctag
+              | Case { tag = Json_only } -> false)
+            cases
+        with
+        | None -> Error (Unexpected_tag ctag)
+        | Some (Case { encoding ; inj }) ->
+            read_rec whole encoding state @@ fun (v, state) ->
+            k (inj v, state)
+      end
+    | Dynamic_size { kind ; encoding = e } ->
+        Atom.int kind resume state @@ fun (sz, state) ->
+        let remaining = check_remaining_bytes state sz in
+        let state = { state with remaining_bytes = Some sz } in
+        ignore (check_allowed_bytes state sz : int option) ;
+        read_rec true e state @@ fun (v, state) ->
+        if state.remaining_bytes <> Some 0 then
+          Error Extra_bytes
+        else
+          k (v, { state with remaining_bytes = remaining })
+    | Check_size { limit ; encoding = e } ->
+        let old_allowed_bytes = state.allowed_bytes in
+        let limit =
+          match state.allowed_bytes with
+          | None -> limit
+          | Some current_limit -> min current_limit limit in
+        begin
+          match state.remaining_bytes with
+          | Some remaining when whole && limit < remaining ->
+              raise Size_limit_exceeded
+          | _ -> ()
+        end ;
+        let state = { state with allowed_bytes = Some limit } in
+        read_rec whole e state @@ fun (v, state) ->
+        let allowed_bytes =
+          match old_allowed_bytes with
+          | None -> None
+          | Some old_limit ->
+              let remaining =
+                match state.allowed_bytes with
+                | None -> assert false
+                | Some remaining -> remaining in
+              let read = limit - remaining in
+              Some (old_limit - read) in
+        k (v, { state with allowed_bytes })
+    | Describe { encoding = e } -> read_rec whole e state k
+    | Splitted { encoding = e } -> read_rec whole e state k
+    | Mu { fix } -> read_rec whole (fix e) state k
+    | Delayed f -> read_rec whole (f ()) state k
+
+and remaining_bytes { remaining_bytes } =
+  match remaining_bytes with
+  | None ->
+      (* This function should only be called with a variable encoding,
+         for which the `remaining_bytes` should never be `None`. *)
+      assert false
+  | Some len -> len
+
+and read_variable_pair
+  : type left right ret.
+    left Encoding.t -> right Encoding.t -> state ->
+    (((left * right) * state) -> ret status) -> ret status
+  = fun e1 e2 state k ->
+    let size = remaining_bytes state in
+    match Encoding.classify e1, Encoding.classify e2 with
+    | (`Dynamic | `Fixed _), `Variable ->
+        read_rec false e1 state @@ fun (left, state) ->
+        read_rec true e2 state @@ fun (right, state) ->
+        k ((left, right), state)
+    | `Variable, `Fixed n ->
+        if n > size then
+          Error Not_enough_data
+        else
+          let state = { state with remaining_bytes = Some (size - n) } in
+          read_rec true e1 state @@ fun (left, state) ->
+          assert (state.remaining_bytes = Some 0) ;
+          let state = { state with remaining_bytes = Some n } in
+          read_rec true e2 state @@ fun (right, state) ->
+          assert (state.remaining_bytes = Some 0) ;
+          k ((left, right), state)
+    | _ -> assert false (* Should be rejected by [Encoding.Kind.combine] *)
+
+and read_list
+  : type a ret.
+    read_error -> int -> a Encoding.t -> state -> ((a list * state) -> ret status) -> ret status
+  = fun error max_length e state k ->
+    let rec loop state acc max_length =
+      let size = remaining_bytes state in
+      if size = 0 then
+        k (List.rev acc, state)
+      else if max_length = 0 then
+        raise error
+      else
+        read_rec false e state @@ fun (v, state) ->
+        loop state (v :: acc) (max_length - 1) in
+    loop state [] max_length
+
+let read_rec e state k =
+  try read_rec false e state k
+  with Read_error err -> Error err
+
+
+
+(** ******************** *)
+(** Various entry points *)
+
+let success (v, state) =
+  Success { result = v ; size = state.total_read ; stream = state.stream }
+
+let read_stream ?(init = Binary_stream.empty) encoding =
+  match Encoding.classify encoding with
+  | `Variable ->
+      invalid_arg "Data_encoding.Binary.read_stream: variable encoding"
+  | `Dynamic | `Fixed _ ->
+      (* No hardcoded read limit in a stream. *)
+      let state = { remaining_bytes = None ; allowed_bytes = None ;
+                    stream = init ; total_read = 0 } in
+      read_rec encoding state success
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.mli
new file mode 100644
index 000000000..71cc779e2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_stream_reader.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Binary}. *)
+
+type 'ret status =
+  | Success of { result : 'ret ; size : int ; stream : Binary_stream.t }
+  | Await of (MBytes.t -> 'ret status)
+  | Error of Binary_error.read_error
+
+val read_stream: ?init:Binary_stream.t -> 'a Encoding.t -> 'a status
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_writer.ml b/vendors/tezos-modded/src/lib_data_encoding/binary_writer.ml
new file mode 100644
index 000000000..a62e312ac
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_writer.ml
@@ -0,0 +1,357 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Binary_error
+
+let raise error = raise (Write_error error)
+
+(** Imperative state of the binary writer. *)
+type state = {
+
+  mutable buffer : MBytes.t ;
+  (** The buffer where to write. *)
+
+  mutable offset : int ;
+  (** The offset of the next byte to be written in [buffer]. *)
+
+  mutable allowed_bytes : int option ;
+  (** Maximum number of bytes that are allowed to be write in [buffer]
+      (after [offset]) before to fail (None = illimited). *)
+
+}
+
+let check_allowed_bytes state size =
+  match state.allowed_bytes with
+  | Some len when len < size -> raise Size_limit_exceeded
+  | Some len -> state.allowed_bytes <- Some (len - size)
+  | None -> ()
+
+(** [may_resize state size] will first ensure there is enough
+    space in [state.buffer] for writing [size] bytes (starting at
+    [state.offset]).
+
+    When the buffer does not have enough space for writing [size] bytes,
+    but still has enough [allowed_bytes], it will replace the buffer
+    with a buffer large enough.
+
+    @raise [Binary_error.Write_error Size_limit_exceeded] when there is
+           not enough allowed bytes to write [size] bytes. *)
+let may_resize state size =
+  check_allowed_bytes state size ;
+  let buffer_len = MBytes.length state.buffer in
+  if buffer_len - state.offset < size then begin
+    let new_buffer =
+      MBytes.create (max (2 * buffer_len) (buffer_len + size)) in
+    MBytes.blit state.buffer 0 new_buffer 0 state.offset ;
+    state.buffer <- new_buffer
+  end ;
+  state.offset <- state.offset + size
+
+(** Writer for all the atomic types. *)
+module Atom = struct
+
+  let check_int_range min v max =
+    if (v < min || max < v) then
+      raise (Invalid_int { min ; v ; max })
+
+  let check_float_range min v max =
+    if (v < min || max < v) then
+      raise (Invalid_float { min ; v ; max })
+
+  let set_int kind buffer ofs v =
+    match kind with
+    | `Int31 | `Uint30 -> MBytes.set_int32 buffer ofs (Int32.of_int v)
+    | `Int16 | `Uint16 -> MBytes.set_int16 buffer ofs v
+    | `Int8 | `Uint8 -> MBytes.set_int8 buffer ofs v
+
+  let int kind state v =
+    check_int_range (Binary_size.min_int kind) v (Binary_size.max_int kind) ;
+    let ofs = state.offset in
+    may_resize state (Binary_size.integer_to_size kind) ;
+    set_int kind state.buffer ofs v
+
+  let int8 = int `Int8
+  let uint8 = int `Uint8
+  let int16 = int `Int16
+  let uint16 = int `Uint16
+  let uint30 = int `Uint30
+  let int31 = int `Int31
+
+  let char state v = int8 state (int_of_char v)
+  let bool state v = uint8 state (if v then 255 else 0)
+
+  let int32 state v =
+    let ofs = state.offset in
+    may_resize state Binary_size.int32 ;
+    MBytes.set_int32 state.buffer ofs v
+
+  let int64 state v =
+    let ofs = state.offset in
+    may_resize state Binary_size.int64 ;
+    MBytes.set_int64 state.buffer ofs v
+
+  let ranged_int ~minimum ~maximum state v =
+    check_int_range minimum v maximum ;
+    let v = if minimum >= 0 then v - minimum else v in
+    match Binary_size.range_to_size ~minimum ~maximum with
+    | `Uint8 -> uint8 state v
+    | `Uint16 -> uint16 state v
+    | `Uint30 -> uint30 state v
+    | `Int8 -> int8 state v
+    | `Int16 -> int16 state v
+    | `Int31 -> int31 state v
+
+  let n state v =
+    if (Z.sign v < 0) then raise Invalid_natural ;
+    if Z.equal v Z.zero then
+      uint8 state 0x00
+    else
+      let bits = Z.numbits v in
+      let get_chunk pos len = Z.to_int (Z.extract v pos len) in
+      let length = Binary_length.n_length v in
+      let offset = state.offset in
+      may_resize state length ;
+      for i = 0 to length - 1 do
+        let pos = i * 7 in
+        let chunk_len = if i = length - 1 then bits - pos else 7 in
+        MBytes.set_int8 state.buffer (offset + i)
+          ((if i = length - 1 then 0x00 else 0x80)
+           lor (get_chunk pos chunk_len))
+      done
+
+  let z state v =
+    let sign = Z.sign v < 0 in
+    let bits = Z.numbits v in
+    if Z.equal v Z.zero then
+      uint8 state 0x00
+    else
+      let v = Z.abs v in
+      let get_chunk pos len = Z.to_int (Z.extract v pos len) in
+      let length = Binary_length.z_length v in
+      let offset = state.offset in
+      may_resize state length ;
+      MBytes.set_int8 state.buffer offset
+        ((if sign then 0x40 else 0x00)
+         lor (if bits > 6 then 0x80 else 0x00)
+         lor (get_chunk 0 6)) ;
+      for i = 1 to length - 1 do
+        let pos = 6 + (i - 1) * 7 in
+        let chunk_len = if i = length - 1 then bits - pos else 7 in
+        MBytes.set_int8 state.buffer (offset + i)
+          ((if i = length - 1 then 0x00 else 0x80)
+           lor (get_chunk pos chunk_len))
+      done
+
+  let float state v =
+    let ofs = state.offset in
+    may_resize state Binary_size.float ;
+    MBytes.set_double state.buffer ofs v
+
+  let ranged_float ~minimum ~maximum state v =
+    check_float_range minimum v maximum ;
+    float state v
+
+  let string_enum tbl arr state v =
+    let value =
+      try snd (Hashtbl.find tbl v)
+      with Not_found -> raise No_case_matched in
+    match Binary_size.enum_size arr with
+    | `Uint30 -> uint30 state value
+    | `Uint16 -> uint16 state value
+    | `Uint8 -> uint8 state value
+
+  let fixed_kind_bytes length state s =
+    if MBytes.length s <> length then
+      raise (Invalid_bytes_length { expected = length ;
+                                    found = MBytes.length s }) ;
+    let ofs = state.offset in
+    may_resize state length ;
+    MBytes.blit s 0 state.buffer ofs length
+
+  let fixed_kind_string length state s =
+    if String.length s <> length then
+      raise (Invalid_string_length { expected = length ;
+                                     found = String.length s }) ;
+    let ofs = state.offset in
+    may_resize state length ;
+    MBytes.blit_of_string s 0 state.buffer ofs length
+
+  let tag = function
+    | `Uint8 -> uint8
+    | `Uint16 -> uint16
+
+end
+
+(** Main recursive writing function. *)
+let rec write_rec : type a. a Encoding.t -> state -> a -> unit =
+  fun e state value ->
+    let open Encoding in
+    match e.encoding with
+    | Null -> ()
+    | Empty -> ()
+    | Constant _ -> ()
+    | Ignore -> ()
+    | Bool -> Atom.bool state value
+    | Int8 -> Atom.int8 state value
+    | Uint8 -> Atom.uint8 state value
+    | Int16 -> Atom.int16 state value
+    | Uint16 -> Atom.uint16 state value
+    | Int31 -> Atom.int31 state value
+    | Int32 -> Atom.int32 state value
+    | Int64 -> Atom.int64 state value
+    | N -> Atom.n state value
+    | Z -> Atom.z state value
+    | Float -> Atom.float state value
+    | Bytes (`Fixed n) -> Atom.fixed_kind_bytes n state value
+    | Bytes `Variable ->
+        let length = MBytes.length value in
+        Atom.fixed_kind_bytes length state value
+    | String (`Fixed n) -> Atom.fixed_kind_string n state value
+    | String `Variable ->
+        let length = String.length value in
+        Atom.fixed_kind_string length state value
+    | Padded (e, n) ->
+        write_rec e state value ;
+        Atom.fixed_kind_string n state (String.make n '\000')
+    | RangedInt { minimum ; maximum } ->
+        Atom.ranged_int ~minimum ~maximum state value
+    | RangedFloat { minimum ; maximum } ->
+        Atom.ranged_float ~minimum ~maximum state value
+    | String_enum (tbl, arr) ->
+        Atom.string_enum tbl arr state value
+    | Array (Some max_length, _e) when Array.length value > max_length ->
+        raise Array_too_long
+    | Array (_, e) ->
+        Array.iter (write_rec e state) value
+    | List (Some max_length, _e) when List.length value > max_length ->
+        raise List_too_long
+    | List (_, e) ->
+        List.iter (write_rec e state) value
+    | Obj (Req { encoding = e }) -> write_rec e state value
+    | Obj (Opt { kind = `Dynamic ; encoding = e }) -> begin
+        match value with
+        | None -> Atom.bool state false
+        | Some value -> Atom.bool state true ; write_rec e state value
+      end
+    | Obj (Opt { kind = `Variable ; encoding = e }) -> begin
+        match value with
+        | None -> ()
+        | Some value -> write_rec e state value
+      end
+    | Obj (Dft { encoding = e }) -> write_rec e state value
+    | Objs { left ; right } ->
+        let (v1, v2) = value in
+        write_rec left state v1 ;
+        write_rec right state v2
+    | Tup e -> write_rec e state value
+    | Tups { left ; right } ->
+        let (v1, v2) = value in
+        write_rec left state v1 ;
+        write_rec right state v2
+    | Conv { encoding = e ; proj } ->
+        write_rec e state (proj value)
+    | Union { tag_size ; cases } ->
+        let rec write_case = function
+          | [] -> raise No_case_matched
+          | Case { tag = Json_only } :: tl -> write_case tl
+          | Case { encoding = e ; proj ; tag = Tag tag } :: tl ->
+              match proj value with
+              | None -> write_case tl
+              | Some value ->
+                  Atom.tag tag_size state tag ;
+                  write_rec e state value in
+        write_case cases
+    | Dynamic_size { kind ; encoding = e }  ->
+        let initial_offset = state.offset in
+        Atom.int kind state 0 ; (* place holder for [size] *)
+        write_with_limit (Binary_size.max_int kind) e state value ;
+        (* patch the written [size] *)
+        Atom.set_int kind
+          state.buffer
+          initial_offset
+          (state.offset - initial_offset - Binary_size.integer_to_size kind)
+    | Check_size { limit ; encoding = e } ->
+        write_with_limit limit e state value
+    | Describe { encoding = e } -> write_rec e state value
+    | Splitted { encoding = e } -> write_rec e state value
+    | Mu { fix } -> write_rec (fix e) state value
+    | Delayed f -> write_rec (f ()) state value
+
+and write_with_limit : type a. int -> a Encoding.t -> state -> a -> unit =
+  fun limit e state value ->
+    (* backup the current limit *)
+    let old_limit = state.allowed_bytes in
+    (* install the new limit (only if smaller than the current limit) *)
+    let limit =
+      match state.allowed_bytes with
+      | None -> limit
+      | Some old_limit -> min old_limit limit in
+    state.allowed_bytes <- Some limit ;
+    write_rec e state value ;
+    (* restore the previous limit (minus the read bytes) *)
+    match old_limit with
+    | None ->
+        state.allowed_bytes <- None
+    | Some old_limit ->
+        let remaining =
+          match state.allowed_bytes with
+          | None -> assert false
+          | Some len -> len in
+        let read = limit - remaining in
+        state.allowed_bytes <- Some (old_limit - read)
+
+
+(** ******************** *)
+(** Various entry points *)
+
+let write e v buffer offset len =
+  (* By harcoding [allowed_bytes] with the buffer length,
+       we ensure that [write] will never reallocate the buffer. *)
+  let state = { buffer ; offset ; allowed_bytes = Some len } in
+  try
+    write_rec e state v ;
+    Some state.offset
+  with Write_error _ -> None
+
+let to_bytes_exn e v =
+  match Encoding.classify e with
+  | `Fixed n -> begin
+      (* Preallocate the complete buffer *)
+      let state = { buffer = MBytes.create n ;
+                    offset = 0 ; allowed_bytes = Some n } in
+      write_rec e state v ;
+      state.buffer
+    end
+  | `Dynamic | `Variable ->
+      (* Preallocate a minimal buffer and let's not hardcode a
+         limit to its extension. *)
+      let state = { buffer = MBytes.create 4096 ;
+                    offset = 0 ; allowed_bytes = None } in
+      write_rec e state v ;
+      MBytes.sub state.buffer 0 state.offset
+
+let to_bytes e v =
+  try Some (to_bytes_exn e v)
+  with Write_error _ -> None
diff --git a/vendors/tezos-modded/src/lib_data_encoding/binary_writer.mli b/vendors/tezos-modded/src/lib_data_encoding/binary_writer.mli
new file mode 100644
index 000000000..2c623285d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/binary_writer.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Binary}. *)
+
+val write : 'a Encoding.t -> 'a -> MBytes.t -> int -> int -> int option
+val to_bytes_exn : 'a Encoding.t -> 'a -> MBytes.t
+val to_bytes : 'a Encoding.t -> 'a -> MBytes.t option
diff --git a/vendors/tezos-modded/src/lib_data_encoding/bson.ml b/vendors/tezos-modded/src/lib_data_encoding/bson.ml
new file mode 100644
index 000000000..1fc017dc1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/bson.ml
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type bson = Json_repr_bson.bson
+type t = bson
+
+let construct e v = Json_repr_bson.Json_encoding.construct (Json.convert e) v
+let destruct e v = Json_repr_bson.Json_encoding.destruct (Json.convert e) v
diff --git a/vendors/tezos-modded/src/lib_data_encoding/bson.mli b/vendors/tezos-modded/src/lib_data_encoding/bson.mli
new file mode 100644
index 000000000..7093b2c41
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/bson.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Bson}. *)
+
+type bson = Json_repr_bson.bson
+type t = bson
+val construct : 't Encoding.t -> 't -> bson
+val destruct : 't Encoding.t -> bson -> 't
diff --git a/vendors/tezos-modded/src/lib_data_encoding/data_encoding.ml b/vendors/tezos-modded/src/lib_data_encoding/data_encoding.ml
new file mode 100644
index 000000000..f212170bb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/data_encoding.ml
@@ -0,0 +1,147 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Encoding =
+struct
+  include Encoding
+  let splitted ~json ~binary = raw_splitted ~json:(Json.convert json) ~binary
+  let assoc enc =
+    let json = Json_encoding.assoc (Json.convert enc) in
+    let binary = list (tup2 string enc) in
+    raw_splitted ~json ~binary
+
+  module Bounded = struct
+
+    let string length =
+      raw_splitted
+        ~binary: begin
+          let kind = Binary_size.unsigned_range_to_size length in
+          check_size (length + Binary_size.integer_to_size kind) @@
+          dynamic_size ~kind Variable.string
+        end
+        ~json: begin
+          let open Json_encoding in
+          conv
+            (fun s ->
+               if String.length s > length then invalid_arg "oversized string" ;
+               s)
+            (fun s ->
+               if String.length s > length then
+                 raise (Cannot_destruct ([], Invalid_argument "oversized string")) ;
+               s)
+            string
+        end
+
+    let bytes length =
+      raw_splitted
+        ~binary: begin
+          let kind = Binary_size.unsigned_range_to_size length in
+          check_size (length + Binary_size.integer_to_size kind) @@
+          dynamic_size ~kind Variable.bytes
+        end
+        ~json: begin
+          let open Json_encoding in
+          conv
+            (fun s ->
+               if MBytes.length s > length then invalid_arg "oversized string" ;
+               s)
+            (fun s ->
+               if MBytes.length s > length then
+                 raise (Cannot_destruct ([], Invalid_argument "oversized string")) ;
+               s)
+            Json.bytes_jsont
+        end
+
+  end
+
+  type 'a lazy_state =
+    | Value of 'a
+    | Bytes of MBytes.t
+    | Both of MBytes.t * 'a
+  type 'a lazy_t =
+    { mutable state : 'a lazy_state ;
+      encoding : 'a t }
+  let force_decode le =
+    match le.state with
+    | Value value -> Some value
+    | Both (_, value) -> Some value
+    | Bytes bytes ->
+        match Binary_reader.of_bytes le.encoding bytes with
+        | Some expr -> le.state <- Both (bytes, expr) ; Some expr
+        | None -> None
+  let force_bytes le =
+    match le.state with
+    | Bytes bytes -> bytes
+    | Both (bytes, _) -> bytes
+    | Value value ->
+        let bytes = Binary_writer.to_bytes_exn le.encoding value in
+        le.state <- Both (bytes, value) ;
+        bytes
+  let lazy_encoding encoding =
+    let binary =
+      Encoding.conv
+        force_bytes
+        (fun bytes -> { state = Bytes bytes ; encoding })
+        Encoding.bytes in
+    let json =
+      Encoding.conv
+        (fun le ->
+           match force_decode le with
+           | Some r -> r
+           | None -> raise Exit)
+        (fun value -> { state = Value value ; encoding })
+        encoding in
+    splitted ~json ~binary
+  let make_lazy encoding value =
+    { encoding ; state = Value value }
+  let apply_lazy ~fun_value ~fun_bytes ~fun_combine le =
+    match le.state with
+    | Value value -> fun_value value
+    | Bytes bytes -> fun_bytes bytes
+    | Both (bytes, value) -> fun_combine (fun_value value) (fun_bytes bytes)
+
+end
+
+include Encoding
+
+
+
+module Json = Json
+module Bson = Bson
+module Binary_schema = Binary_schema
+module Binary = struct
+  include Binary_error
+  include Binary_length
+  include Binary_writer
+  include Binary_reader
+  include Binary_stream_reader
+  let describe = Binary_description.describe
+end
+
+type json = Json.t
+let json = Json.encoding
+type json_schema = Json.schema
+let json_schema = Json.schema_encoding
+type bson = Bson.t
diff --git a/vendors/tezos-modded/src/lib_data_encoding/data_encoding.mli b/vendors/tezos-modded/src/lib_data_encoding/data_encoding.mli
new file mode 100644
index 000000000..1b28409b3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/data_encoding.mli
@@ -0,0 +1,743 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Type-safe serialization and deserialization of data structures. *)
+
+(** {1 Data Encoding} *)
+
+(** {2 Overview}
+
+    This module provides type-safe serialization and deserialization of
+    data structures. Backends are provided to both /ad hoc/ binary, JSON
+    and BSON.
+
+    This works by writing type descriptors by hand, using the provided
+    combinators. These combinators can fine-tune the binary
+    representation to be compact and efficient, but also provide
+    proper field names and meta information, so the API of Tezos can
+    be automatically introspected and documented.
+
+    Here is an example encoding for type [(int * string)].
+
+    [let enc = obj2 (req "code" uint16) (req "message" string)]
+
+    In JSON, this encoding maps values of type [int * string] to JSON
+    objects with a field [code] whose value is a number and a field
+    [message] whose value is a string.
+
+    In binary, this encoding maps to two raw bytes for the [int]
+    followed by the size of the string in bytes, and finally the raw
+    contents of the string. This binary format is mostly tagless,
+    meaning that serialized data cannot be interpreted without the
+    encoding that was used for serialization.
+
+    Regarding binary serialization, encodings are classified as either:
+    - fixed size (booleans, integers, numbers)
+      data is always the same size for that type ;
+    - dynamically sized (arbitrary strings and bytes)
+      data is of unknown size and requires an explicit length field ;
+    - variable size (special case of strings, bytes, and arrays)
+      data makes up the remainder of an object of known size,
+      thus its size is given by the context, and does not
+      have to be serialized.
+
+    JSON operations are delegated to [ocplib-json-typed]. *)
+
+(** {2 Module structure}
+
+    This [Data_encoding] module provides multiple submodules:
+    - [Encoding] contains the necessary types and constructors for making the
+    type descriptors.
+    - [Json], [Bson], and [Binary] contain functions to serialize and
+    deserialize values.
+
+*)
+
+module Encoding: sig
+
+  (** The type descriptors for values of type ['a]. *)
+  type 'a t
+  type 'a encoding = 'a t
+
+  (** {3 Ground descriptors} *)
+
+  (** Special value [null] in JSON, nothing in binary. *)
+  val null : unit encoding
+
+  (** Empty object (not included in binary, encoded as empty object in JSON). *)
+  val empty : unit encoding
+
+  (** Unit value, omitted in binary.
+      Serialized as an empty object in JSON, accepts any object when deserializing. *)
+  val unit : unit encoding
+
+  (** Constant string (data is not included in the binary data). *)
+  val constant : string -> unit encoding
+
+  (** Signed 8 bit integer
+      (data is encoded as a byte in binary and an integer in JSON). *)
+  val int8 : int encoding
+
+  (** Unsigned 8 bit integer
+      (data is encoded as a byte in binary and an integer in JSON). *)
+  val uint8 : int encoding
+
+  (** Signed 16 bit integer
+      (data is encoded as a short in binary and an integer in JSON). *)
+  val int16 : int encoding
+
+  (** Unsigned 16 bit integer
+      (data is encoded as a short in binary and an integer in JSON). *)
+  val uint16 : int encoding
+
+  (** Signed 31 bit integer, which corresponds to type int on 32-bit OCaml systems
+      (data is encoded as a 32 bit int in binary and an integer in JSON). *)
+  val int31 : int encoding
+
+  (** Signed 32 bit integer
+      (data is encoded as a 32-bit int in binary and an integer in JSON). *)
+  val int32 : int32 encoding
+
+  (** Signed 64 bit integer
+      (data is encoded as a 64-bit int in binary and a decimal string in JSON). *)
+  val int64 : int64 encoding
+
+  (** Integer with bounds in a given range. Both bounds are inclusive.
+
+      @raise Invalid_argument if the bounds are beyond the interval
+      [-2^30; 2^30-1]. These bounds are chosen to be compatible with all versions
+      of OCaml.
+  *)
+  val ranged_int : int -> int -> int encoding
+
+  (** Big number
+      In JSON, data is encoded as a decimal string.
+      In binary, data is encoded as a variable length sequence of
+      bytes, with a running unary size bit: the most significant bit of
+      each byte tells is this is the last byte in the sequence (0) or if
+      there is more to read (1). The second most significant bit of the
+      first byte is reserved for the sign (positive if zero). Binary_size and
+      sign bits ignored, data is then the binary representation of the
+      absolute value of the number in little-endian order. *)
+  val z : Z.t encoding
+
+  (** Positive big number, see [z]. *)
+  val n : Z.t encoding
+
+  (** Encoding of floating point number
+      (encoded as a floating point number in JSON and a double in binary). *)
+  val float : float encoding
+
+  (** Float with bounds in a given range. Both bounds are inclusive *)
+  val ranged_float : float -> float -> float encoding
+
+  (** Encoding of a boolean
+      (data is encoded as a byte in binary and a boolean in JSON). *)
+  val bool : bool encoding
+
+  (** Encoding of a string
+      - encoded as a byte sequence in binary prefixed by the length
+        of the string
+      - encoded as a string in JSON. *)
+  val string : string encoding
+
+  (** Encoding of arbitrary bytes
+      (encoded via hex in JSON and directly as a sequence byte in binary). *)
+  val bytes : MBytes.t encoding
+
+  (** {3 Descriptor combinators} *)
+
+  (** Combinator to make an optional value
+      (represented as a 1-byte tag followed by the data (or nothing) in binary
+       and either the raw value or an empty object in JSON). *)
+  val option : 'a encoding -> 'a option encoding
+
+  (** Combinator to make a {!result} value
+      (represented as a 1-byte tag followed by the data of either type in binary,
+       and either unwrapped value in JSON (the caller must ensure that both
+       encodings do not collide)). *)
+  val result : 'a encoding -> 'b encoding -> ('a, 'b) result encoding
+
+  (** Array combinator.
+      - encoded as an array in JSON
+      - encoded as the concatenation of all the element in binary
+       prefixed its length in bytes
+
+      If [max_length] is passed and the encoding of elements has fixed
+      size, a {!check_size} is automatically added for earlier rejection.
+
+      @raise Invalid_argument if the inner encoding is variable. *)
+  val array : ?max_length:int -> 'a encoding -> 'a array encoding
+
+  (** List combinator.
+      - encoded as an array in JSON
+      - encoded as the concatenation of all the element in binary
+       prefixed its length in bytes
+
+      If [max_length] is passed and the encoding of elements has fixed
+      size, a {!check_size} is automatically added for earlier rejection.
+
+      @raise Invalid_argument if the inner encoding is also variable. *)
+  val list : ?max_length:int -> 'a encoding -> 'a list encoding
+
+  (** Provide a transformer from one encoding to a different one.
+
+      Used to simplify nested encodings or to change the generic tuples
+      built by {obj1}, {tup1} and the like into proper records.
+
+      A schema may optionally be provided as documentation of the new encoding. *)
+  val conv :
+    ('a -> 'b) -> ('b -> 'a) ->
+    ?schema:Json_schema.schema ->
+    'b encoding -> 'a encoding
+
+  (** Association list.
+      An object in JSON, a list of pairs in binary. *)
+  val assoc : 'a encoding -> (string * 'a) list encoding
+
+  (** {3 Product descriptors} *)
+
+  (** An enriched encoding to represent a component in a structured
+      type, augmenting the encoding with a name and whether it is a
+      required or optional. Fields are used to encode OCaml tuples as
+      objects in JSON, and as sequences in binary, using combinator
+      {!obj1} and the like. *)
+  type 'a field
+
+  (** Required field. *)
+  val req :
+    ?title:string -> ?description:string ->
+    string -> 't encoding -> 't field
+
+  (** Optional field. Omitted entirely in JSON encoding if None.
+      Omitted in binary if the only optional field in a [`Variable]
+      encoding, otherwise a 1-byte prefix (`0` or `255`) tells if the
+      field is present or not. *)
+  val opt :
+    ?title:string -> ?description:string ->
+    string -> 't encoding -> 't option field
+
+  (** Optional field of variable length.
+      Only one can be present in a given object. *)
+  val varopt :
+    ?title:string -> ?description:string ->
+    string -> 't encoding -> 't option field
+
+  (** Required field with a default value.
+      If the default value is passed, the field is omitted in JSON.
+      The value is always serialized in binary. *)
+  val dft :
+    ?title:string -> ?description:string ->
+    string -> 't encoding -> 't -> 't field
+
+  (** {4 Constructors for objects with N fields} *)
+
+  (** These are serialized to binary by converting each internal
+      object to binary and placing them in the order of the original
+      object. These are serialized to JSON as a JSON object with the
+      field names. An object might only contains one 'variable'
+      field, typically the last one. If the encoding of more than one
+      field are 'variable', the first ones should be wrapped with
+      [dynamic_size].
+
+      @raise Invalid_argument if more than one field is a variable one. *)
+
+  val obj1 :
+    'f1 field -> 'f1 encoding
+  val obj2 :
+    'f1 field -> 'f2 field -> ('f1 * 'f2) encoding
+  val obj3 :
+    'f1 field -> 'f2 field -> 'f3 field -> ('f1 * 'f2 * 'f3) encoding
+  val obj4 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field ->
+    ('f1 * 'f2 * 'f3 * 'f4) encoding
+  val obj5 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+  val obj6 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    'f6 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+  val obj7 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    'f6 field -> 'f7 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+  val obj8 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    'f6 field -> 'f7 field -> 'f8 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+  val obj9 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    'f6 field -> 'f7 field -> 'f8 field -> 'f9 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+  val obj10 :
+    'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+    'f6 field -> 'f7 field -> 'f8 field -> 'f9 field -> 'f10 field ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+  (** Create a larger object from the encodings of two smaller ones.
+      @raise Invalid_argument if both arguments are not objects  or if both
+      tuples contains a variable field.. *)
+  val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding
+
+  (** {4 Constructors for tuples with N fields} *)
+
+  (** These are serialized to binary by converting each internal
+      object to binary and placing them in the order of the original
+      object. These are serialized to JSON as JSON arrays/lists.  Like
+      objects, a tuple might only contains one 'variable' field,
+      typically the last one. If the encoding of more than one field
+      are 'variable', the first ones should be wrapped with
+      [dynamic_size].
+
+      @raise Invalid_argument if more than one field is a variable one. *)
+
+  val tup1 :
+    'f1 encoding ->
+    'f1 encoding
+  val tup2 :
+    'f1 encoding -> 'f2 encoding ->
+    ('f1 * 'f2) encoding
+  val tup3 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding ->
+    ('f1 * 'f2 * 'f3) encoding
+  val tup4 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4) encoding
+  val tup5 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+  val tup6 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding -> 'f6 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+  val tup7 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding -> 'f6 encoding -> 'f7 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+  val tup8 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+  val tup9 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+    'f9 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+  val tup10 :
+    'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+    'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+    'f9 encoding -> 'f10 encoding ->
+    ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+
+  (** Create a large tuple encoding from two smaller ones.
+      @raise Invalid_argument if both values are not tuples or if both
+      tuples contains a variable field. *)
+  val merge_tups : 'a1 encoding -> 'a2 encoding -> ('a1 * 'a2) encoding
+
+  (** {3 Sum descriptors} *)
+
+  (** A partial encoding to represent a case in a variant type.  Hides
+      the (existentially bound) type of the parameter to the specific
+      case, providing its encoder, and converter functions to and from
+      the union type. *)
+  type 't case
+  type case_tag = Tag of int | Json_only
+
+  (** Encodes a variant constructor. Takes the encoding for the specific
+      parameters, a recognizer function that will extract the parameters
+      in case the expected case of the variant is being serialized, and
+      a constructor function for deserialization.
+
+      The tag must be less than the tag size of the union in which you use the case.
+      An optional tag gives a name to a case and should be used to maintain
+      compatibility.
+
+      An optional name for the case can be provided,
+      which is used in the binary documentation. *)
+  val case :
+    title:string ->
+    ?description:string ->
+    case_tag ->
+    'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
+
+  (** Create a single encoding from a series of cases.
+
+      In JSON, all cases are tried one after the other. The caller must
+      check for collisions.
+
+      In binary, a prefix tag is added to discriminate quickly between
+      cases. The default is [`Uint8] and you must use a [`Uint16] if you are
+      going to have more than 256 cases.
+
+      @raise Invalid_argument if it is given the empty list
+      or if there are more cases than can fit in the tag size. *)
+  val union :
+    ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
+
+  (** {3 Predicates over descriptors} *)
+
+
+  (** Is the given encoding serialized as a JSON object? *)
+  val is_obj : 'a encoding -> bool
+
+  (** Does the given encoding encode a tuple? *)
+  val is_tup : 'a encoding -> bool
+
+  (** Classify the binary serialization of an encoding as explained in the
+      preamble. *)
+  val classify : 'a encoding -> [ `Fixed of int | `Dynamic | `Variable ]
+
+  (** {3 Specialized descriptors} *)
+
+  (** Encode enumeration via association list
+      - represented as a string in JSON and
+      - represented as an integer representing the element's position
+        in the list in binary. The integer size depends on the list size.*)
+  val string_enum : (string * 'a) list -> 'a encoding
+
+  (** Create encodings that produce data of a fixed length when binary encoded.
+      See the preamble for an explanation. *)
+  module Fixed : sig
+
+    (** @raises Invalid_argument if the argument is less or equal to zero. *)
+    val string : int -> string encoding
+
+    (** @raises Invalid_argument if the argument is less or equal to zero. *)
+    val bytes : int -> MBytes.t encoding
+
+    (** [add_padding e n] is a padded version of the encoding [e]. In Binary,
+        there are [n] null bytes ([\000]) added after the value encoded by [e].
+        In JSON, padding is ignored.
+
+        @raises Invalid_argument if [n <= 0]. *)
+    val add_padding : 'a encoding -> int -> 'a encoding
+  end
+
+  (** Create encodings that produce data of a variable length when binary encoded.
+      See the preamble for an explanation. *)
+  module Variable : sig
+
+    val string : string encoding
+    val bytes : MBytes.t encoding
+
+    (** @raises Invalid_argument if the encoding argument is variable length
+        or may lead to zero-width representation in binary. *)
+    val array : ?max_length:int -> 'a encoding -> 'a array encoding
+
+    (** @raises Invalid_argument if the encoding argument is variable length
+        or may lead to zero-width representation in binary. *)
+    val list : ?max_length:int -> 'a encoding -> 'a list encoding
+
+  end
+
+  module Bounded : sig
+    (** Encoding of a string whose length does not exceed the specified length.
+        The size field uses the smallest integer that can accommodate the
+        maximum size - e.g, [`Uint8] for very short strings, [`Uint16] for
+        longer strings, etc.
+
+        Attempting to construct a string with a length that is too long causes
+        an [Invalid_argument] exception. *)
+    val string : int -> string encoding
+
+    (** See [string] above. *)
+    val bytes : int -> MBytes.t encoding
+  end
+
+  (** Mark an encoding as being of dynamic size.
+      Forces the size to be stored alongside content when needed.
+      Typically used to combine two variable encodings in a same
+      objects or tuple, or to use a variable encoding in an array or a list. *)
+  val dynamic_size :
+    ?kind: [ `Uint30 | `Uint16 | `Uint8 ] ->
+    'a encoding -> 'a encoding
+
+  (** [check_size size encoding] ensures that the binary encoding
+      of a value will not be allowed to exceed [size] bytes. The reader
+      and the writer fails otherwise. This function do not modify
+      the JSON encoding. *)
+  val check_size : int -> 'a encoding -> 'a encoding
+
+  (** Recompute the encoding definition each time it is used.
+      Useful for dynamically updating the encoding of values of an extensible
+      type via a global reference (e.g. exceptions). *)
+  val delayed : (unit -> 'a encoding) -> 'a encoding
+
+  (** Define different encodings for JSON and binary serialization. *)
+  val splitted : json:'a encoding -> binary:'a encoding -> 'a encoding
+
+  (** Combinator for recursive encodings. *)
+  val mu :
+    string ->
+    ?title: string ->
+    ?description: string ->
+    ('a encoding -> 'a encoding) -> 'a encoding
+
+  (** {3 Documenting descriptors} *)
+
+  (** Give a name to an encoding and optionally
+      add documentation to an encoding. *)
+  val def :
+    string ->
+    ?title:string -> ?description:string ->
+    't encoding ->'t encoding
+
+  (** See {!lazy_encoding} below.*)
+  type 'a lazy_t
+
+  (** Combinator to have a part of the binary encoding lazily deserialized.
+      This is transparent on the JSON side. *)
+  val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+
+  (** Force the decoding (memoized for later calls), and return the
+      value if successful. *)
+  val force_decode : 'a lazy_t -> 'a option
+
+  (** Obtain the bytes without actually deserializing.  Will serialize
+      and memoize the result if the value is not the result of a lazy
+      deserialization. *)
+  val force_bytes : 'a lazy_t -> MBytes.t
+
+  (** Make a lazy value from an immediate one. *)
+  val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+
+  (** Apply on structure of lazy value, and combine results *)
+  val apply_lazy :
+    fun_value:('a -> 'b) -> fun_bytes:(MBytes.t -> 'b) -> fun_combine:('b -> 'b -> 'b) ->
+    'a lazy_t -> 'b
+
+end
+
+include module type of Encoding with type 'a t = 'a Encoding.t
+
+module Json: sig
+
+  (** In memory JSON data, compatible with [Ezjsonm]. *)
+  type json =
+    [ `O of (string * json) list
+    | `Bool of bool
+    | `Float of float
+    | `A of json list
+    | `Null
+    | `String of string ]
+  type t = json
+  type schema = Json_schema.schema
+
+
+  (** Encodes raw JSON data (BSON is used for binary). *)
+  val encoding : json Encoding.t
+
+  (** Encodes a JSON schema (BSON encoded for binary). *)
+  val schema_encoding : schema Encoding.t
+
+  (** Create a {!Json_encoding.encoding} from an {encoding}. *)
+  val convert : 'a Encoding.t -> 'a Json_encoding.encoding
+
+  (** Generate a schema from an {!encoding}. *)
+  val schema : ?definitions_path:string -> 'a Encoding.t -> schema
+
+  (** Construct a JSON object from an encoding. *)
+  val construct : 't Encoding.t -> 't -> json
+
+  (** Destruct a JSON object into a value.
+      Fail with an exception if the JSON object and encoding do not match.. *)
+  val destruct : 't Encoding.t -> json -> 't
+
+  (** JSON Error. *)
+
+  type path = path_item list
+
+  (** A set of accessors that point to a location in a JSON object. *)
+  and path_item =
+    [ `Field of string
+    (** A field in an object. *)
+    | `Index of int
+    (** An index in an array. *)
+    | `Star
+    (** Any / every field or index. *)
+    | `Next
+      (** The next element after an array. *)
+    ]
+
+  (** Exception raised by destructors, with the location in the original
+      JSON structure and the specific error. *)
+  exception Cannot_destruct of (path * exn)
+
+  (** Unexpected kind of data encountered, with the expectation. *)
+  exception Unexpected of string * string
+
+  (** Some {!union} couldn't be destructed, with the reasons for each {!case}. *)
+  exception No_case_matched of exn list
+
+  (** Array of unexpected size encountered, with the expectation. *)
+  exception Bad_array_size of int * int
+
+  (** Missing field in an object. *)
+  exception Missing_field of string
+
+  (** Supernumerary field in an object. *)
+  exception Unexpected_field of string
+
+  val print_error :
+    ?print_unknown: (Format.formatter -> exn -> unit) ->
+    Format.formatter -> exn -> unit
+
+  (** Helpers for writing encoders. *)
+  val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a
+  val wrap_error : ('a -> 'b) -> 'a -> 'b
+
+  (** Read a JSON document from a string. *)
+  val from_string : string -> (json, string) result
+
+  (** Read a stream of JSON documents from a stream of strings.
+      A single JSON document may be represented in multiple consecutive
+      strings. But only the first document of a string is considered. *)
+  val from_stream : string Lwt_stream.t -> (json, string) result Lwt_stream.t
+
+  (** Write a JSON document to a string. This goes via an intermediate
+      buffer and so may be slow on large documents. *)
+  val to_string : ?newline:bool -> ?minify:bool -> json -> string
+
+  val pp : Format.formatter -> json -> unit
+
+end
+
+module Bson: sig
+
+  type bson = Json_repr_bson.bson
+  type t = bson
+
+  (** Construct a BSON object from an encoding. *)
+  val construct : 't Encoding.t -> 't -> bson
+
+  (** Destruct a BSON object into a value.
+      Fail with an exception if the JSON object and encoding do not match.. *)
+  val destruct : 't Encoding.t -> bson -> 't
+
+end
+
+module Binary_schema : sig
+  type t
+  val pp: Format.formatter -> t -> unit
+  val encoding: t Encoding.t
+end
+
+module Binary: sig
+
+  (** All the errors that might be returned while reading a binary value *)
+  type read_error =
+    | Not_enough_data
+    | Extra_bytes
+    | No_case_matched
+    | Unexpected_tag of int
+    | Invalid_size of int
+    | Invalid_int of { min : int ; v : int ; max : int }
+    | Invalid_float of { min : float ; v : float ; max : float }
+    | Trailing_zero
+    | Size_limit_exceeded
+    | List_too_long
+    | Array_too_long
+  exception Read_error of read_error
+  val pp_read_error: Format.formatter -> read_error -> unit
+
+  (** All the errors that might be returned while writing a binary value *)
+  type write_error =
+    | Size_limit_exceeded
+    | No_case_matched
+    | Invalid_int of { min : int ; v : int ; max : int }
+    | Invalid_float of { min : float ; v : float ; max : float }
+    | Invalid_bytes_length of { expected : int ; found : int }
+    | Invalid_string_length of { expected : int ; found : int }
+    | Invalid_natural
+    | List_too_long
+    | Array_too_long
+  val pp_write_error : Format.formatter -> write_error -> unit
+  exception Write_error of write_error
+
+  (** Compute the expected length of the binary representation of a value *)
+  val length : 'a Encoding.t -> 'a -> int
+
+  (** Returns the size of the binary representation that the given
+      encoding might produce, only when the size of the representation
+      does not depends of the value itself. *)
+  val fixed_length : 'a Encoding.t -> int option
+  val fixed_length_exn : 'a Encoding.t -> int
+
+  (** [read enc buf ofs len] tries to reconstruct a value from the
+      bytes in [buf] starting at offset [ofs] and reading at most
+      [len] bytes. This function also returns the offset of the first
+      unread bytes in the [buf]. *)
+  val read : 'a Encoding.t -> MBytes.t -> int ->  int -> (int * 'a) option
+
+  (** Return type for the function [read_stream]. *)
+  type 'ret status =
+    | Success of { result : 'ret ; size : int ; stream : Binary_stream.t }
+    (** Fully decoded value, together with the total amount of bytes reads,
+        and the remaining unread stream. *)
+    | Await of (MBytes.t -> 'ret status)
+    (** Partially decoded value.*)
+    | Error of read_error
+    (** Failure. The stream is garbled and it should be dropped. *)
+
+  (** Streamed equivalent of [read]. This variant cannot be called on
+      variable-size encodings. *)
+  val read_stream : ?init:Binary_stream.t -> 'a Encoding.t -> 'a status
+
+  (** [write enc v buf ofs len] writes the binary representation of [v]
+      as described by to [enc], in  [buf] starting at the offset [ofs]
+      and writing at most [len] bytes. The function returns the offset
+      of first unwritten bytes, or returns [None] in case of failure.
+      In the latter case, some data might have been written on the buffer. *)
+  val write : 'a Encoding.t -> 'a -> MBytes.t -> int -> int -> int option
+
+  (** [of_bytes enc buf] is equivalent to [read enc buf 0 (length buf)].
+      The function fails if the buffer is not fully read. *)
+  val of_bytes : 'a Encoding.t -> MBytes.t -> 'a option
+
+  (** [of_bytes_exn enc buf] is equivalent to [to_bytes], except
+      it raises [Read_error] instead of returning [None] in case of error. *)
+  val of_bytes_exn : 'a Encoding.t -> MBytes.t -> 'a
+
+  (** [to_bytes enc v] is the equivalent of [write env buf 0 len]
+      where [buf] is a newly allocated buffer of the expected
+      length [len] (see [length env v]). *)
+  val to_bytes : 'a Encoding.t -> 'a -> MBytes.t option
+
+  (** [to_bytes_exn enc v] is equivalent to [to_bytes enc v], except
+      it raises [Write_error] instead of returning [None] in case of error. *)
+  val to_bytes_exn : 'a Encoding.t -> 'a -> MBytes.t
+
+  val describe : 'a Encoding.t -> Binary_schema.t
+
+end
+
+type json = Json.t
+val json: json Encoding.t
+type json_schema = Json.schema
+val json_schema: json_schema Encoding.t
+type bson = Bson.t
diff --git a/vendors/tezos-modded/src/lib_data_encoding/dune b/vendors/tezos-modded/src/lib_data_encoding/dune
new file mode 100644
index 000000000..914f0ab58
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/dune
@@ -0,0 +1,16 @@
+(library
+ (name tezos_data_encoding)
+ (public_name tezos-data-encoding)
+ (libraries tezos-stdlib
+            ocplib-json-typed
+            ocplib-json-typed-bson
+            zarith
+            ezjsonm)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_stdlib)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_data_encoding/encoding.ml b/vendors/tezos-modded/src/lib_data_encoding/encoding.ml
new file mode 100644
index 000000000..abedf1430
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/encoding.ml
@@ -0,0 +1,687 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Kind = struct
+
+  type t =
+    [ `Fixed of int
+    | `Dynamic
+    | `Variable ]
+
+  type length =
+    [ `Fixed of int
+    | `Variable ]
+
+  type enum =
+    [ `Dynamic
+    | `Variable ]
+
+  let combine name : t -> t -> t = fun k1 k2 ->
+    match k1, k2 with
+    | `Fixed n1, `Fixed n2 -> `Fixed (n1 + n2)
+    | `Dynamic, `Dynamic | `Fixed _, `Dynamic
+    | `Dynamic, `Fixed _ -> `Dynamic
+    | `Variable, `Fixed _
+    | (`Dynamic | `Fixed _), `Variable -> `Variable
+    | `Variable, `Dynamic ->
+        Printf.ksprintf invalid_arg
+          "Cannot merge two %s when the left element is of variable length \
+           and the right one of dynamic length. \
+           You should use the reverse order, or wrap the second one \
+           with Data_encoding.dynamic_size."
+          name
+    | `Variable, `Variable ->
+        Printf.ksprintf invalid_arg
+          "Cannot merge two %s with variable length. \
+           You should wrap one of them with Data_encoding.dynamic_size."
+          name
+
+  let merge : t -> t -> t = fun k1 k2 ->
+    match k1, k2 with
+    | `Fixed n1, `Fixed n2 when n1 = n2 -> `Fixed n1
+    | `Fixed _, `Fixed _ -> `Dynamic
+    | `Dynamic, `Dynamic | `Fixed _, `Dynamic
+    | `Dynamic, `Fixed _ -> `Dynamic
+    | `Variable, (`Dynamic | `Fixed _)
+    | (`Dynamic | `Fixed _), `Variable
+    | `Variable, `Variable -> `Variable
+
+  let merge_list sz : t list -> t = function
+    | [] -> assert false (* should be rejected by Data_encoding.union *)
+    | k :: ks ->
+        match List.fold_left merge k ks with
+        | `Fixed n -> `Fixed (n + Binary_size.tag_size sz)
+        | k -> k
+
+end
+
+type case_tag = Tag of int | Json_only
+
+type 'a desc =
+  | Null : unit desc
+  | Empty : unit desc
+  | Ignore : unit desc
+  | Constant : string -> unit desc
+  | Bool : bool desc
+  | Int8 : int desc
+  | Uint8 : int desc
+  | Int16 : int desc
+  | Uint16 : int desc
+  | Int31 : int desc
+  | Int32 : Int32.t desc
+  | Int64 : Int64.t desc
+  | N : Z.t desc
+  | Z : Z.t desc
+  | RangedInt : { minimum : int ; maximum : int } -> int desc
+  | RangedFloat : { minimum : float ; maximum : float } -> float desc
+  | Float : float desc
+  | Bytes : Kind.length -> MBytes.t desc
+  | String : Kind.length -> string desc
+  | Padded : 'a t * int -> 'a desc
+  | String_enum : ('a, string * int) Hashtbl.t * 'a array -> 'a desc
+  | Array : int option * 'a t -> 'a array desc
+  | List : int option * 'a t -> 'a list desc
+  | Obj : 'a field -> 'a desc
+  | Objs : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc
+  | Tup : 'a t -> 'a desc
+  | Tups : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc
+  | Union :
+      { kind: Kind.t ;
+        tag_size: Binary_size.tag_size ;
+        cases: 'a case list ;
+      } -> 'a desc
+  | Mu :
+      { kind: Kind.enum ;
+        name: string ;
+        title: string option ;
+        description: string option ;
+        fix: 'a t -> 'a t ;
+      } -> 'a desc
+  | Conv :
+      { proj : ('a -> 'b) ;
+        inj : ('b -> 'a) ;
+        encoding : 'b t ;
+        schema : Json_schema.schema option ;
+      } -> 'a desc
+  | Describe :
+      { id : string ;
+        title : string option ;
+        description : string option ;
+        encoding : 'a t ;
+      } -> 'a desc
+  | Splitted :
+      { encoding : 'a t ;
+        json_encoding : 'a Json_encoding.encoding ;
+        is_obj : bool ;
+        is_tup : bool ;
+      } -> 'a desc
+  | Dynamic_size :
+      { kind : Binary_size.unsigned_integer ;
+        encoding : 'a t ;
+      } -> 'a desc
+  | Check_size : { limit : int ; encoding : 'a t } -> 'a desc
+  | Delayed : (unit -> 'a t) -> 'a desc
+
+and _ field =
+  | Req : { name: string ;
+            encoding: 'a t ;
+            title: string option ;
+            description: string option ;
+          } -> 'a field
+  | Opt : { name: string ;
+            kind: Kind.enum ;
+            encoding: 'a t ;
+            title: string option ;
+            description: string option ;
+          } -> 'a option field
+  | Dft : { name: string ;
+            encoding: 'a t ;
+            default: 'a ;
+            title: string option ;
+            description: string option ;
+          } -> 'a field
+
+and 'a case =
+  | Case : { title : string ;
+             description : string option ;
+             encoding : 'a t ;
+             proj : ('t -> 'a option) ;
+             inj : ('a -> 't) ;
+             tag : case_tag ;
+           } -> 't case
+
+and 'a t = {
+  encoding: 'a desc ;
+  mutable json_encoding: 'a Json_encoding.encoding option ;
+}
+
+type 'a encoding = 'a t
+
+let rec classify : type a. a t -> Kind.t = fun e ->
+  classify_desc e.encoding
+and classify_desc : type a. a desc -> Kind.t = fun e ->
+  match e with
+  (* Fixed *)
+  | Null -> `Fixed 0
+  | Empty -> `Fixed 0
+  | Constant _ -> `Fixed 0
+  | Bool -> `Fixed Binary_size.bool
+  | Int8 -> `Fixed Binary_size.int8
+  | Uint8 -> `Fixed Binary_size.uint8
+  | Int16 -> `Fixed Binary_size.int16
+  | Uint16 -> `Fixed Binary_size.uint16
+  | Int31 -> `Fixed Binary_size.int31
+  | Int32 -> `Fixed Binary_size.int32
+  | Int64 -> `Fixed Binary_size.int64
+  | N -> `Dynamic
+  | Z -> `Dynamic
+  | RangedInt { minimum ; maximum } ->
+      `Fixed Binary_size.(integer_to_size @@ range_to_size ~minimum ~maximum)
+  | Float -> `Fixed Binary_size.float
+  | RangedFloat _ -> `Fixed Binary_size.float
+  (* Tagged *)
+  | Bytes kind -> (kind :> Kind.t)
+  | String kind -> (kind :> Kind.t)
+  | Padded ({ encoding }, n) -> begin
+      match classify_desc encoding with
+      | `Fixed m -> `Fixed (n+m)
+      | _ -> assert false (* by construction (see [Fixed.padded]) *)
+    end
+  | String_enum (_, cases) ->
+      `Fixed Binary_size.(integer_to_size @@ enum_size cases)
+  | Obj (Opt { kind }) -> (kind :> Kind.t)
+  | Objs { kind } -> kind
+  | Tups { kind } -> kind
+  | Union { kind } -> (kind :> Kind.t)
+  | Mu { kind } -> (kind :> Kind.t)
+  (* Variable *)
+  | Ignore -> `Fixed 0
+  | Array _ -> `Variable
+  | List _ -> `Variable
+  (* Recursive *)
+  | Obj (Req { encoding }) -> classify encoding
+  | Obj (Dft { encoding }) -> classify encoding
+  | Tup encoding -> classify encoding
+  | Conv { encoding } -> classify encoding
+  | Describe { encoding } -> classify encoding
+  | Splitted { encoding } -> classify encoding
+  | Dynamic_size _ -> `Dynamic
+  | Check_size { encoding } -> classify encoding
+  | Delayed f -> classify (f ())
+
+let make ?json_encoding encoding = { encoding ; json_encoding }
+
+module Fixed = struct
+  let string n =
+    if n <= 0 then
+      invalid_arg "Cannot create a string encoding of negative or null fixed length." ;
+    make @@ String (`Fixed n)
+  let bytes n =
+    if n <= 0 then
+      invalid_arg "Cannot create a byte encoding of negative or null fixed length." ;
+    make @@ Bytes (`Fixed n)
+  let add_padding e n =
+    if n <= 0 then
+      invalid_arg "Cannot create a padding of negative or null fixed length." ;
+    match classify e with
+    | `Fixed _ ->
+        make @@ Padded (e, n)
+    | _ -> invalid_arg "Cannot pad non-fixed size encoding"
+end
+
+let rec is_zeroable: type t. t encoding -> bool = fun e ->
+  (* Whether an encoding can ever produce zero-byte of encoding. It is dnagerous
+     to place zero-size elements in a collection (list/array) because
+     they are indistinguishable from the abscence of elements. *)
+  match e.encoding with
+  (* trivially true *)
+  | Null -> true (* always true *)
+  | Empty -> true (* always true *)
+  | Ignore -> true (* always true *)
+  | Constant _ -> true (* always true *)
+  (* trivially false *)
+  | Bool -> false
+  | Int8 -> false
+  | Uint8 -> false
+  | Int16 -> false
+  | Uint16 -> false
+  | Int31 -> false
+  | Int32 -> false
+  | Int64 -> false
+  | N -> false
+  | Z -> false
+  | RangedInt _ -> false
+  | RangedFloat _ -> false
+  | Float -> false
+  | Bytes _ -> false
+  | String _ -> false
+  | Padded _ -> false
+  | String_enum _ -> false
+  (* true in some cases, but in practice always protected by Dynamic *)
+  | Array _ -> true (* 0-element array *)
+  | List _ -> true (* 0-element list *)
+  (* represented as whatever is inside: truth mostly propagates *)
+  | Obj (Req { encoding = e }) -> is_zeroable e (* represented as-is *)
+  | Obj (Opt { kind = `Variable }) -> true (* optional field ommited *)
+  | Obj (Dft { encoding = e }) -> is_zeroable e (* represented as-is *)
+  | Obj _ -> false
+  | Objs { left ; right } -> is_zeroable left && is_zeroable right
+  | Tup e -> is_zeroable e
+  | Tups { left ; right } -> is_zeroable left && is_zeroable right
+  | Union _ -> false (* includes a tag *)
+  (* other recursive cases: truth propagates *)
+  | Mu { kind = `Dynamic } -> false (* size prefix *)
+  | Mu { kind = `Variable ; fix } -> is_zeroable (fix e)
+  | Conv { encoding } -> is_zeroable encoding
+  | Describe { encoding } -> is_zeroable encoding
+  | Splitted { encoding } -> is_zeroable encoding
+  | Check_size { encoding } -> is_zeroable encoding
+  (* Unscrutable: true by default *)
+  | Delayed f -> is_zeroable (f ())
+  (* Protected against zeroable *)
+  | Dynamic_size _ -> false (* always some data for size *)
+
+module Variable = struct
+  let string = make @@ String `Variable
+  let bytes = make @@ Bytes `Variable
+  let check_not_variable name e =
+    match classify e with
+    | `Variable ->
+        Printf.ksprintf invalid_arg
+          "Cannot insert variable length element in %s. \
+           You should wrap the contents using Data_encoding.dynamic_size." name
+    | `Dynamic | `Fixed _ -> ()
+  let check_not_zeroable name e =
+    if is_zeroable e then
+      Printf.ksprintf invalid_arg
+        "Cannot insert potentially zero-sized element in %s." name
+    else
+      ()
+  let array ?max_length e =
+    check_not_variable "an array" e ;
+    check_not_zeroable "an array" e ;
+    let encoding = make @@ Array (max_length, e) in
+    match classify e, max_length with
+    | `Fixed n, Some max_length ->
+        let limit = n * max_length in
+        make @@ Check_size { limit ; encoding }
+    | _, _ -> encoding
+  let list ?max_length e =
+    check_not_variable "a list" e ;
+    check_not_zeroable "a list" e ;
+    let encoding = make @@ List (max_length, e) in
+    match classify e, max_length with
+    | `Fixed n, Some max_length ->
+        let limit = n * max_length in
+        make @@ Check_size { limit ; encoding }
+    | _, _ -> encoding
+end
+
+let dynamic_size ?(kind = `Uint30) e =
+  make @@ Dynamic_size { kind ; encoding = e }
+
+let check_size limit encoding =
+  make @@ Check_size { limit ; encoding }
+
+let delayed f =
+  make @@ Delayed f
+
+let null = make @@ Null
+let empty = make @@ Empty
+let unit = make @@ Ignore
+let constant s = make @@ Constant s
+let bool = make @@ Bool
+let int8 = make @@ Int8
+let uint8 = make @@ Uint8
+let int16 = make @@ Int16
+let uint16 = make @@ Uint16
+let int31 = make @@ Int31
+let int32 = make @@ Int32
+let ranged_int minimum maximum =
+  let minimum = min minimum maximum
+  and maximum = max minimum maximum in
+  if minimum < -(1 lsl 30) || (1 lsl 30) - 1 < maximum then
+    invalid_arg "Data_encoding.ranged_int" ;
+  make @@ RangedInt { minimum ; maximum  }
+let ranged_float minimum maximum =
+  let minimum = min minimum maximum
+  and maximum = max minimum maximum in
+  make @@ RangedFloat { minimum ; maximum }
+let int64 = make @@ Int64
+let n = make @@ N
+let z = make @@ Z
+let float = make @@ Float
+
+let string = dynamic_size Variable.string
+let bytes = dynamic_size Variable.bytes
+let array ?max_length e = dynamic_size (Variable.array ?max_length e)
+let list ?max_length e = dynamic_size (Variable.list ?max_length e)
+
+let string_enum = function
+  | [] -> invalid_arg "data_encoding.string_enum: cannot have zero cases"
+  | [ _case ] -> invalid_arg "data_encoding.string_enum: cannot have a single case, use constant instead"
+  | _ :: _ as cases ->
+      let arr = Array.of_list (List.map snd cases) in
+      let tbl = Hashtbl.create (Array.length arr) in
+      List.iteri (fun ind (str, a) -> Hashtbl.add tbl a (str, ind)) cases ;
+      make @@ String_enum (tbl, arr)
+
+let conv proj inj ?schema encoding =
+  make @@ Conv { proj ; inj ; encoding ; schema }
+
+let def id ?title ?description encoding =
+  make @@ Describe { id ; title ; description ; encoding }
+
+let req ?title ?description n t =
+  Req { name = n ; encoding = t ; title ; description }
+let opt ?title ?description n encoding =
+  let kind =
+    match classify encoding with
+    | `Variable -> `Variable
+    | `Fixed _ | `Dynamic -> `Dynamic in
+  Opt { name = n ; kind ; encoding ; title ; description }
+let varopt ?title ?description n encoding =
+  Opt { name = n ; kind = `Variable ; encoding ; title ; description }
+let dft ?title ?description n t d =
+  Dft { name = n ; encoding = t ; default = d ; title ; description }
+
+let raw_splitted ~json ~binary =
+  make @@ Splitted { encoding = binary ;
+                     json_encoding = json ;
+                     is_obj = false ;
+                     is_tup = false }
+
+let rec is_obj : type a. a t -> bool = fun e ->
+  match e.encoding with
+  | Obj _ -> true
+  | Objs _ (* by construction *) -> true
+  | Conv { encoding = e } -> is_obj e
+  | Dynamic_size { encoding = e } -> is_obj e
+  | Union { cases } ->
+      List.for_all (fun (Case { encoding = e }) -> is_obj e) cases
+  | Empty -> true
+  | Ignore -> true
+  | Mu { fix } -> is_obj (fix e)
+  | Splitted { is_obj } -> is_obj
+  | Delayed f -> is_obj (f ())
+  | Describe { encoding } -> is_obj encoding
+  | _ -> false
+
+let rec is_tup : type a. a t -> bool = fun e ->
+  match e.encoding with
+  | Tup _ -> true
+  | Tups _ (* by construction *) -> true
+  | Conv { encoding = e } -> is_tup e
+  | Dynamic_size { encoding = e } -> is_tup e
+  | Union { cases } ->
+      List.for_all (function Case { encoding = e} -> is_tup e) cases
+  | Mu { fix } -> is_tup (fix e)
+  | Splitted { is_tup } -> is_tup
+  | Delayed f -> is_tup (f ())
+  | Describe { encoding } -> is_tup encoding
+  | _ -> false
+
+let raw_merge_objs left right =
+  let kind = Kind.combine "objects" (classify left) (classify right) in
+  make @@ Objs { kind ; left ; right }
+
+let obj1 f1 = make @@ Obj f1
+let obj2 f2 f1 =
+  raw_merge_objs (obj1 f2) (obj1 f1)
+let obj3 f3 f2 f1 =
+  raw_merge_objs (obj1 f3) (obj2 f2 f1)
+let obj4 f4 f3 f2 f1 =
+  raw_merge_objs (obj2 f4 f3) (obj2 f2 f1)
+let obj5 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj1 f5) (obj4 f4 f3 f2 f1)
+let obj6 f6 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj2 f6 f5) (obj4 f4 f3 f2 f1)
+let obj7 f7 f6 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj3 f7 f6 f5) (obj4 f4 f3 f2 f1)
+let obj8 f8 f7 f6 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj4 f8 f7 f6 f5) (obj4 f4 f3 f2 f1)
+let obj9 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj1 f9) (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
+let obj10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  raw_merge_objs (obj2 f10 f9) (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
+
+let merge_objs o1 o2 =
+  if is_obj o1 && is_obj o2 then
+    raw_merge_objs o1 o2
+  else
+    invalid_arg "Json_encoding.merge_objs"
+
+let raw_merge_tups left right =
+  let kind = Kind.combine "tuples" (classify left) (classify right) in
+  make @@ Tups { kind ; left ; right }
+
+let tup1 e1 = make @@ Tup e1
+let tup2 e2 e1 =
+  raw_merge_tups (tup1 e2) (tup1 e1)
+let tup3 e3 e2 e1 =
+  raw_merge_tups (tup1 e3) (tup2 e2 e1)
+let tup4 e4 e3 e2 e1 =
+  raw_merge_tups (tup2 e4 e3) (tup2 e2 e1)
+let tup5 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup1 e5) (tup4 e4 e3 e2 e1)
+let tup6 e6 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup2 e6 e5) (tup4 e4 e3 e2 e1)
+let tup7 e7 e6 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup3 e7 e6 e5) (tup4 e4 e3 e2 e1)
+let tup8 e8 e7 e6 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup4 e8 e7 e6 e5) (tup4 e4 e3 e2 e1)
+let tup9 e9 e8 e7 e6 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup1 e9) (tup8 e8 e7 e6 e5 e4 e3 e2 e1)
+let tup10 e10 e9 e8 e7 e6 e5 e4 e3 e2 e1 =
+  raw_merge_tups (tup2 e10 e9) (tup8 e8 e7 e6 e5 e4 e3 e2 e1)
+
+let merge_tups t1 t2 =
+  if is_tup t1 && is_tup t2 then
+    raw_merge_tups t1 t2
+  else
+    invalid_arg "Tezos_serial.Encoding.merge_tups"
+
+let conv3 ty =
+  conv
+    (fun (c, b, a) -> (c, (b, a)))
+    (fun (c, (b, a)) -> (c, b, a))
+    ty
+let obj3 f3 f2 f1 = conv3 (obj3 f3 f2 f1)
+let tup3 f3 f2 f1 = conv3 (tup3 f3 f2 f1)
+let conv4 ty =
+  conv
+    (fun (d, c, b, a) -> ((d, c), (b, a)))
+    (fun ((d, c), (b, a)) -> (d, c, b, a))
+    ty
+let obj4 f4 f3 f2 f1 = conv4 (obj4 f4 f3 f2 f1)
+let tup4 f4 f3 f2 f1 = conv4 (tup4 f4 f3 f2 f1)
+let conv5 ty =
+  conv
+    (fun (e, d, c, b, a) -> (e, ((d, c), (b, a))))
+    (fun (e, ((d, c), (b, a))) -> (e, d, c, b, a))
+    ty
+let obj5 f5 f4 f3 f2 f1 = conv5 (obj5 f5 f4 f3 f2 f1)
+let tup5 f5 f4 f3 f2 f1 = conv5 (tup5 f5 f4 f3 f2 f1)
+let conv6 ty =
+  conv
+    (fun (f, e, d, c, b, a) -> ((f, e), ((d, c), (b, a))))
+    (fun ((f, e), ((d, c), (b, a))) -> (f, e, d, c, b, a))
+    ty
+let obj6 f6 f5 f4 f3 f2 f1 = conv6 (obj6 f6 f5 f4 f3 f2 f1)
+let tup6 f6 f5 f4 f3 f2 f1 = conv6 (tup6 f6 f5 f4 f3 f2 f1)
+let conv7 ty =
+  conv
+    (fun (g, f, e, d, c, b, a) -> ((g, (f, e)), ((d, c), (b, a))))
+    (fun ((g, (f, e)), ((d, c), (b, a))) -> (g, f, e, d, c, b, a))
+    ty
+let obj7 f7 f6 f5 f4 f3 f2 f1 = conv7 (obj7 f7 f6 f5 f4 f3 f2 f1)
+let tup7 f7 f6 f5 f4 f3 f2 f1 = conv7 (tup7 f7 f6 f5 f4 f3 f2 f1)
+let conv8 ty =
+  conv (fun (h, g, f, e, d, c, b, a) ->
+      (((h, g), (f, e)), ((d, c), (b, a))))
+    (fun (((h, g), (f, e)), ((d, c), (b, a))) ->
+       (h, g, f, e, d, c, b, a))
+    ty
+let obj8 f8 f7 f6 f5 f4 f3 f2 f1 = conv8 (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
+let tup8 f8 f7 f6 f5 f4 f3 f2 f1 = conv8 (tup8 f8 f7 f6 f5 f4 f3 f2 f1)
+let conv9 ty =
+  conv
+    (fun (i, h, g, f, e, d, c, b, a) ->
+       (i, (((h, g), (f, e)), ((d, c), (b, a)))))
+    (fun (i, (((h, g), (f, e)), ((d, c), (b, a)))) ->
+       (i, h, g, f, e, d, c, b, a))
+    ty
+let obj9 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  conv9 (obj9 f9 f8 f7 f6 f5 f4 f3 f2 f1)
+let tup9 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  conv9 (tup9 f9 f8 f7 f6 f5 f4 f3 f2 f1)
+let conv10 ty =
+  conv
+    (fun (j, i, h, g, f, e, d, c, b, a) ->
+       ((j, i), (((h, g), (f, e)), ((d, c), (b, a)))))
+    (fun ((j, i), (((h, g), (f, e)), ((d, c), (b, a)))) ->
+       (j, i, h, g, f, e, d, c, b, a))
+    ty
+let obj10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  conv10 (obj10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1)
+let tup10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
+  conv10 (tup10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1)
+
+let check_cases tag_size cases =
+  if cases = [] then
+    invalid_arg "Data_encoding.union: empty list of cases." ;
+  let max_tag =
+    match tag_size with
+    | `Uint8 -> 256
+    | `Uint16 -> 256 * 256 in
+  ignore @@
+  List.fold_left
+    (fun others (Case { tag }) ->
+       match tag with
+       | Json_only -> others
+       | Tag tag ->
+           if List.mem tag others then
+             Format.kasprintf invalid_arg
+               "The tag %d appears twice in an union."
+               tag ;
+           if tag < 0 || max_tag <= tag then
+             Format.kasprintf invalid_arg "The tag %d is invalid." tag ;
+           tag :: others
+    )
+    [] cases
+
+let union ?(tag_size = `Uint8) cases =
+  check_cases tag_size cases ;
+  let kinds =
+    List.map (fun (Case { encoding }) -> classify encoding) cases in
+  let kind = Kind.merge_list tag_size kinds in
+  make @@ Union { kind ; tag_size ; cases }
+let case ~title ?description tag encoding proj inj =
+  Case { title ; description ; encoding ; proj ; inj ; tag }
+
+let rec is_nullable: type t. t encoding -> bool = fun e ->
+  match e.encoding with
+  | Null -> true
+  | Empty -> false
+  | Ignore -> true
+  | Constant _ -> false
+  | Bool -> false
+  | Int8 -> false
+  | Uint8 -> false
+  | Int16 -> false
+  | Uint16 -> false
+  | Int31 -> false
+  | Int32 -> false
+  | Int64 -> false
+  | N -> false
+  | Z -> false
+  | RangedInt _ -> false
+  | RangedFloat _ -> false
+  | Float -> false
+  | Bytes _ -> false
+  | String _ -> false
+  | Padded (e, _) -> is_nullable e
+  | String_enum _ -> false
+  | Array _ -> false
+  | List _ -> false
+  | Obj _ -> false
+  | Objs _ -> false
+  | Tup _ -> false
+  | Tups _ -> false
+  | Union { cases } ->
+      List.exists (fun (Case { encoding = e }) -> is_nullable e) cases
+  | Mu { fix } -> is_nullable (fix e)
+  | Conv { encoding = e } -> is_nullable e
+  | Describe { encoding = e } -> is_nullable e
+  | Splitted { json_encoding } -> Json_encoding.is_nullable json_encoding
+  | Dynamic_size { encoding = e } -> is_nullable e
+  | Check_size { encoding = e } -> is_nullable e
+  | Delayed _ -> true
+
+let option ty =
+  if is_nullable ty then
+    invalid_arg "Data_encoding.option: cannot nest nullable encodings" ;
+  (* TODO add a special construct `Option` in the GADT *)
+  union
+    ~tag_size:`Uint8
+    [ case
+        (Tag 1) ty
+        ~title:"Some"
+        (fun x -> x)
+        (fun x -> Some x) ;
+      case
+        (Tag 0) null
+        ~title:"None"
+        (function None -> Some () | Some _ -> None)
+        (fun () -> None) ;
+    ]
+let mu name ?title ?description fix =
+  let kind =
+    try
+      let precursor =
+        make @@ Mu { kind = `Dynamic ; name ; title ; description ; fix } in
+      match classify @@ fix precursor with
+      | `Fixed _ | `Dynamic -> `Dynamic
+      | `Variable -> raise Exit
+    with Exit | _ (* TODO variability error *) ->
+      let precursor =
+        make @@ Mu { kind = `Variable ; name ; title ; description ; fix } in
+      ignore (classify @@ fix precursor) ;
+      `Variable in
+  make @@ Mu { kind ; name ; title ; description ; fix }
+
+let result ok_enc error_enc =
+  union
+    ~tag_size:`Uint8
+    [ case (Tag 1) ok_enc
+        ~title:"Ok"
+        (function Ok x -> Some x | Error _ -> None)
+        (fun x -> Ok x) ;
+      case (Tag 0) error_enc
+        ~title:"Result"
+        (function Ok _ -> None | Error x -> Some x)
+        (fun x -> Error x) ;
+    ]
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/encoding.mli b/vendors/tezos-modded/src/lib_data_encoding/encoding.mli
new file mode 100644
index 000000000..f8d974d4c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/encoding.mli
@@ -0,0 +1,295 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Encoding}. *)
+
+module Kind: sig
+  type t = [ `Fixed of int | `Dynamic | `Variable ]
+  type length = [ `Fixed of int | `Variable ]
+  type enum = [ `Dynamic | `Variable ]
+  val combine: string -> t -> t -> t
+  val merge : t -> t -> t
+  val merge_list: Binary_size.tag_size -> t list -> t
+end
+
+type case_tag = Tag of int | Json_only
+
+type 'a desc =
+  | Null : unit desc
+  | Empty : unit desc
+  | Ignore : unit desc
+  | Constant : string -> unit desc
+  | Bool : bool desc
+  | Int8 : int desc
+  | Uint8 : int desc
+  | Int16 : int desc
+  | Uint16 : int desc
+  | Int31 : int desc
+  | Int32 : Int32.t desc
+  | Int64 : Int64.t desc
+  | N : Z.t desc
+  | Z : Z.t desc
+  | RangedInt : { minimum : int ; maximum : int } -> int desc
+  | RangedFloat : { minimum : float ; maximum : float } -> float desc
+  | Float : float desc
+  | Bytes : Kind.length -> MBytes.t desc
+  | String : Kind.length -> string desc
+  | Padded : 'a t * int -> 'a desc
+  | String_enum : ('a, string * int) Hashtbl.t * 'a array -> 'a desc
+  | Array : int option * 'a t -> 'a array desc
+  | List : int option * 'a t -> 'a list desc
+  | Obj : 'a field -> 'a desc
+  | Objs : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc
+  | Tup : 'a t -> 'a desc
+  | Tups : { kind: Kind.t ; left: 'a t ; right: 'b t } -> ('a * 'b) desc
+  | Union :
+      { kind: Kind.t ;
+        tag_size: Binary_size.tag_size ;
+        cases: 'a case list ;
+      } -> 'a desc
+  | Mu :
+      { kind: Kind.enum ;
+        name: string ;
+        title: string option ;
+        description: string option ;
+        fix: 'a t -> 'a t ;
+      } -> 'a desc
+  | Conv :
+      { proj : ('a -> 'b) ;
+        inj : ('b -> 'a) ;
+        encoding : 'b t ;
+        schema : Json_schema.schema option ;
+      } -> 'a desc
+  | Describe :
+      { id : string ;
+        title : string option ;
+        description : string option ;
+        encoding : 'a t ;
+      } -> 'a desc
+  | Splitted :
+      { encoding : 'a t ;
+        json_encoding : 'a Json_encoding.encoding ;
+        is_obj : bool ;
+        is_tup : bool ;
+      } -> 'a desc
+  | Dynamic_size :
+      { kind : Binary_size.unsigned_integer ;
+        encoding : 'a t ;
+      } -> 'a desc
+  | Check_size : { limit : int ; encoding : 'a t } -> 'a desc
+  | Delayed : (unit -> 'a t) -> 'a desc
+
+and _ field =
+  | Req : { name: string ;
+            encoding: 'a t ;
+            title: string option ;
+            description: string option ;
+          } -> 'a field
+  | Opt : { name: string ;
+            kind: Kind.enum ;
+            encoding: 'a t ;
+            title: string option ;
+            description: string option ;
+          } -> 'a option field
+  | Dft : { name: string ;
+            encoding: 'a t ;
+            default: 'a ;
+            title: string option ;
+            description: string option ;
+          } -> 'a field
+
+and 'a case =
+  | Case : { title : string ;
+             description : string option ;
+             encoding : 'a t ;
+             proj : ('t -> 'a option) ;
+             inj : ('a -> 't) ;
+             tag : case_tag ;
+           } -> 't case
+
+and 'a t = {
+  encoding: 'a desc ;
+  mutable json_encoding: 'a Json_encoding.encoding option ;
+}
+type 'a encoding = 'a t
+
+val make: ?json_encoding: 'a Json_encoding.encoding -> 'a desc -> 'a t
+
+val null : unit encoding
+val empty : unit encoding
+val unit : unit encoding
+val constant : string -> unit encoding
+val int8 : int encoding
+val uint8 : int encoding
+val int16 : int encoding
+val uint16 : int encoding
+val int31 : int encoding
+val int32 : int32 encoding
+val int64 : int64 encoding
+val n : Z.t encoding
+val z : Z.t encoding
+val ranged_int : int -> int -> int encoding
+val ranged_float : float -> float -> float encoding
+val bool : bool encoding
+val string : string encoding
+val bytes : MBytes.t encoding
+val float : float encoding
+val option : 'a encoding -> 'a option encoding
+val result : 'a encoding -> 'b encoding -> ('a, 'b) result encoding
+val string_enum : (string * 'a) list -> 'a encoding
+val is_obj : 'a encoding -> bool
+val is_tup : 'a encoding -> bool
+module Fixed : sig
+  val string : int -> string encoding
+  val bytes : int -> MBytes.t encoding
+  val add_padding : 'a encoding -> int -> 'a encoding
+end
+module Variable : sig
+  val string : string encoding
+  val bytes : MBytes.t encoding
+  val array : ?max_length:int -> 'a encoding -> 'a array encoding
+  val list : ?max_length:int -> 'a encoding -> 'a list encoding
+end
+val dynamic_size :
+  ?kind:Binary_size.unsigned_integer -> 'a encoding -> 'a encoding
+val check_size : int -> 'a encoding -> 'a encoding
+val delayed : (unit -> 'a encoding) -> 'a encoding
+val req :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't field
+val opt :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't option field
+val varopt :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't option field
+val dft :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't -> 't field
+
+val obj1 :
+  'f1 field -> 'f1 encoding
+val obj2 :
+  'f1 field -> 'f2 field -> ('f1 * 'f2) encoding
+val obj3 :
+  'f1 field -> 'f2 field -> 'f3 field -> ('f1 * 'f2 * 'f3) encoding
+val obj4 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+val obj5 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+val obj6 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+val obj7 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+val obj8 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+val obj9 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+val obj10 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field -> 'f10 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+val tup1 :
+  'f1 encoding ->
+  'f1 encoding
+val tup2 :
+  'f1 encoding -> 'f2 encoding ->
+  ('f1 * 'f2) encoding
+val tup3 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding ->
+  ('f1 * 'f2 * 'f3) encoding
+val tup4 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+val tup5 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+val tup6 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+val tup7 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+val tup8 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+val tup9 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  'f9 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+val tup10 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  'f9 encoding -> 'f10 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding
+val merge_tups : 'a1 encoding -> 'a2 encoding -> ('a1 * 'a2) encoding
+val array : ?max_length:int -> 'a encoding -> 'a array encoding
+val list : ?max_length:int -> 'a encoding -> 'a list encoding
+
+val case :
+  title:string ->
+  ?description: string ->
+  case_tag ->
+  'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
+val union :
+  ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
+
+val def :
+  string ->
+  ?title:string -> ?description:string ->
+  'a encoding -> 'a encoding
+
+val conv :
+  ('a -> 'b) -> ('b -> 'a) ->
+  ?schema:Json_schema.schema ->
+  'b encoding -> 'a encoding
+val mu :
+  string ->
+  ?title:string ->
+  ?description: string ->
+  ('a encoding -> 'a encoding) -> 'a encoding
+
+val classify : 'a encoding -> [ `Fixed of int | `Dynamic | `Variable ]
+val classify_desc : 'a desc -> [ `Fixed of int | `Dynamic | `Variable ]
+val raw_splitted : json:'a Json_encoding.encoding -> binary:'a encoding -> 'a encoding
diff --git a/vendors/tezos-modded/src/lib_data_encoding/json.ml b/vendors/tezos-modded/src/lib_data_encoding/json.ml
new file mode 100644
index 000000000..e605bf797
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/json.ml
@@ -0,0 +1,369 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+type json =
+  [ `O of (string * json) list
+  | `Bool of bool
+  | `Float of float
+  | `A of json list
+  | `Null
+  | `String of string ]
+
+type schema = Json_schema.schema
+
+type pair_builder = {
+  build: 'a 'b. Encoding.Kind.t -> 'a Encoding.t -> 'b Encoding.t -> ('a * 'b) Encoding.t
+}
+
+exception Parse_error of string
+
+let wrap_error f =
+  fun str ->
+    try f str
+    with exn -> raise (Json_encoding.Cannot_destruct ([], exn))
+
+let int64_encoding =
+  let open Json_encoding in
+  def "int64"
+    ~title: "64 bit integers"
+    ~description: "Decimal representation of 64 bit integers" @@
+  conv
+    Int64.to_string
+    (wrap_error Int64.of_string)
+    string
+
+let n_encoding =
+  let open Json_encoding in
+  def "positive_bignum"
+    ~title: "Positive big number"
+    ~description: "Decimal representation of a positive big number" @@
+  conv
+    (fun z ->
+       if Z.sign z < 0 then invalid_arg "negative natural" ;
+       Z.to_string z)
+    (fun s ->
+       let n = Z.of_string s in
+       if Z.sign n < 0 then
+         raise (Json_encoding.Cannot_destruct ([], Failure "negative natural")) ;
+       n)
+    string
+
+let z_encoding =
+  let open Json_encoding in
+  def "bignum"
+    ~title: "Big number"
+    ~description: "Decimal representation of a big number" @@
+  conv Z.to_string Z.of_string string
+
+let bytes_jsont =
+  let open Json_encoding in
+  let schema =
+    let open Json_schema in
+    create
+      { title = None ;
+        description = None ;
+        default = None ;
+        enum = None ;
+        kind = String {
+            pattern = Some "^[a-zA-Z0-9]+$" ;
+            min_length = 0 ;
+            max_length = None ;
+          } ;
+        format = None ;
+        id = None } in
+  conv ~schema
+    MBytes.to_hex
+    (wrap_error MBytes.of_hex)
+    (conv
+       (fun (`Hex h) -> h)
+       (fun h -> `Hex h)
+       string)
+
+let check_utf8 s =
+  Uutf.String.fold_utf_8 (fun valid _pos -> function
+      | `Uchar _ -> valid
+      | `Malformed _ -> false)
+    true s
+
+let raw_string_encoding =
+  let open Json_encoding in
+  let utf8_case =
+    case string (fun s -> if check_utf8 s then Some s else None) (fun s -> s)
+  in
+  let obj_case =
+    case
+      (obj1 (req "invalid_utf8_string" (array (ranged_int ~minimum:0 ~maximum:255 "byte"))))
+      (fun s -> Some (Array.init (String.length s) (fun i -> Char.code s.[i])))
+      (fun a -> String.init (Array.length a) (fun i -> Char.chr a.(i)))
+  in
+  def
+    "unistring"
+    ~title:"Universal string representation"
+    ~description:"Either a plain UTF8 string, or a sequence of bytes for strings \
+                  that contain invalid byte sequences."
+    (union [ utf8_case ; obj_case ])
+
+let rec lift_union : type a. a Encoding.t -> a Encoding.t = fun e ->
+  let open Encoding in
+  match e.encoding with
+  | Conv { proj ; inj ; encoding = e ; schema } -> begin
+      match lift_union e with
+      | { encoding = Union { kind ; tag_size ; cases } } ->
+          make @@
+          Union { kind ; tag_size ;
+                  cases = List.map
+                      (fun (Case { title ; description ; encoding ; proj = proj' ; inj = inj' ; tag }) ->
+                         Case { encoding ;
+                                title ;
+                                description ;
+                                proj = (fun x -> proj' (proj x));
+                                inj = (fun x -> inj (inj' x)) ;
+                                tag })
+                      cases }
+      | e -> make @@ Conv { proj ; inj ; encoding = e ; schema }
+    end
+  | Objs { kind ; left ; right } ->
+      lift_union_in_pair
+        { build = fun kind left right -> make @@ Objs { kind ; left ; right } }
+        kind left right
+  | Tups { kind ; left ; right } ->
+      lift_union_in_pair
+        { build = fun kind left right -> make @@ Tups { kind ; left ; right } }
+        kind left right
+  | _ -> e
+
+and lift_union_in_pair
+  : type a b. pair_builder -> Encoding.Kind.t -> a Encoding.t -> b Encoding.t -> (a * b) Encoding.t
+  = fun b p e1 e2 ->
+    let open Encoding in
+    match lift_union e1, lift_union e2 with
+    | e1, { encoding = Union { tag_size ; cases } } ->
+        make @@
+        Union { kind = `Dynamic (* ignored *) ; tag_size ;
+                cases =
+                  List.map
+                    (fun (Case { title ; description ; encoding = e2 ; proj ; inj ; tag }) ->
+                       Case { encoding = lift_union_in_pair b p e1 e2 ;
+                              title ;
+                              description ;
+                              proj = (fun (x, y) ->
+                                  match proj y with
+                                  | None -> None
+                                  | Some y -> Some (x, y)) ;
+                              inj = (fun (x, y) -> (x, inj y)) ;
+                              tag })
+                    cases }
+    | { encoding = Union { tag_size ; cases } }, e2 ->
+        make @@
+        Union { kind = `Dynamic (* ignored *) ; tag_size ;
+                cases =
+                  List.map
+                    (fun (Case { title ; description ; encoding = e1 ; proj ; inj ; tag }) ->
+                       Case { encoding = lift_union_in_pair b p e1 e2 ;
+                              title ;
+                              description ;
+                              proj = (fun (x, y) ->
+                                  match proj x with
+                                  | None -> None
+                                  | Some x -> Some (x, y)) ;
+                              inj = (fun (x, y) -> (inj x, y)) ;
+                              tag })
+                    cases }
+    | e1, e2 -> b.build p e1 e2
+
+let rec json : type a. a Encoding.desc -> a Json_encoding.encoding =
+  let open Encoding in
+  let open Json_encoding in
+  function
+  | Null -> null
+  | Empty -> empty
+  | Constant s -> constant s
+  | Ignore -> unit
+  | Int8 -> ranged_int ~minimum:~-(1 lsl 7) ~maximum:((1 lsl 7) - 1) "int8"
+  | Uint8 -> ranged_int ~minimum:0 ~maximum:((1 lsl 8) - 1) "uint8"
+  | Int16 -> ranged_int ~minimum:~-(1 lsl 15) ~maximum:((1 lsl 15) - 1) "int16"
+  | Uint16 -> ranged_int ~minimum:0 ~maximum:((1 lsl 16) - 1) "uint16"
+  | RangedInt { minimum ; maximum } -> ranged_int ~minimum ~maximum "rangedInt"
+  | Int31 -> int
+  | Int32 -> int32
+  | Int64 -> int64_encoding
+  | N -> n_encoding
+  | Z -> z_encoding
+  | Bool -> bool
+  | Float -> float
+  | RangedFloat { minimum ; maximum } -> ranged_float ~minimum ~maximum "rangedFloat"
+  | String (`Fixed expected) ->
+      let check s =
+        let found = String.length s in
+        if found <> expected then
+          raise (Cannot_destruct
+                   ([] ,
+                    Unexpected (Format.asprintf "string (len %d)" found,
+                                Format.asprintf "string (len %d)" expected))) ;
+        s in
+      conv check check raw_string_encoding
+  | String _ -> raw_string_encoding
+  | Padded (e, _) -> get_json e
+  | Bytes (`Fixed expected) ->
+      let check s =
+        let found = MBytes.length s in
+        if found <> expected then
+          raise (Cannot_destruct
+                   ([] ,
+                    Unexpected (Format.asprintf "string (len %d)" found,
+                                Format.asprintf "string (len %d)" expected))) ;
+        s in
+      conv check check bytes_jsont
+  | Bytes _ -> bytes_jsont
+  | String_enum (tbl, _) -> string_enum (Hashtbl.fold (fun a (str, _) acc -> (str, a) :: acc) tbl [])
+  | Array (_, e) -> array (get_json e) (* FIXME TODO enforce max_length *)
+  | List (_, e) -> list (get_json e)
+  | Obj f -> obj1 (field_json f)
+  | Objs { left ; right } ->
+      merge_objs (get_json left) (get_json right)
+  | Tup e -> tup1 (get_json e)
+  | Tups { left ; right } ->
+      merge_tups (get_json left) (get_json right)
+  | Conv { proj ; inj ; encoding = e ; schema } -> conv ?schema proj inj (get_json e)
+  | Describe { id ; title ; description ; encoding = e } ->
+      def id ?title ?description (get_json e)
+  | Mu { name ; fix } as ty ->
+      mu name (fun json_encoding -> get_json @@ fix (make ~json_encoding ty))
+  | Union { cases } -> union (List.map case_json cases)
+  | Splitted { json_encoding } -> json_encoding
+  | Dynamic_size { encoding = e } -> get_json e
+  | Check_size { encoding } -> get_json encoding
+  | Delayed f -> get_json (f ())
+
+and field_json
+  : type a. a Encoding.field -> a Json_encoding.field =
+  let open Json_encoding in
+  function
+  | Encoding.Req { name ; encoding = e } -> req name (get_json e)
+  | Encoding.Opt { name ; encoding = e } -> opt name (get_json e)
+  | Encoding.Dft { name ; encoding = e ; default = d} -> dft name (get_json e) d
+
+and case_json : type a. a Encoding.case -> a Json_encoding.case =
+  let open Json_encoding in
+  function
+  | Encoding.Case { encoding = e ; proj ; inj ; _ } -> case (get_json e) proj inj
+
+and get_json : type a. a Encoding.t -> a Json_encoding.encoding = fun e ->
+  match e.json_encoding with
+  | None ->
+      let json_encoding = json (lift_union e).encoding in
+      e.json_encoding <- Some json_encoding ;
+      json_encoding
+  | Some json_encoding -> json_encoding
+
+let convert = get_json
+
+type path = path_item list
+and path_item =
+  [ `Field of string
+  (** A field in an object. *)
+  | `Index of int
+  (** An index in an array. *)
+  | `Star
+  (** Any / every field or index. *)
+  | `Next
+    (** The next element after an array. *) ]
+
+include Json_encoding
+
+let construct e v = construct (get_json e) v
+let destruct e v = destruct (get_json e) v
+let schema ?definitions_path e = schema ?definitions_path (get_json e)
+
+let cannot_destruct fmt =
+  Format.kasprintf
+    (fun msg -> raise (Cannot_destruct ([], Failure msg)))
+    fmt
+
+type t = json
+
+let to_root = function
+  | `O ctns -> `O ctns
+  | `A ctns -> `A ctns
+  | `Null -> `O []
+  | oth -> `A [ oth ]
+
+let to_string ?(newline = false) ?minify j =
+  Format.asprintf "%a%s"
+    Json_repr.(pp ?compact:minify (module Ezjsonm)) j
+    (if newline then "\n" else "")
+
+let pp = Json_repr.(pp (module Ezjsonm))
+
+let from_string s =
+  match Ezjsonm.from_string ("[" ^ s ^ "]") with
+  | exception Ezjsonm.Parse_error (_, msg) -> Error msg
+  | `A [ json ] -> Ok json
+  | _ -> Error "Malformed value"
+
+let from_stream (stream: string Lwt_stream.t) =
+  let buffer = ref "" in
+  Lwt_stream.filter_map
+    (fun str ->
+       buffer := !buffer ^ str ;
+       try
+         let json = Ezjsonm.from_string !buffer in
+         buffer := "" ;
+         Some (Ok json)
+       with Ezjsonm.Parse_error _ ->
+         None)
+    stream
+
+let encoding =
+  let binary : Json_repr.ezjsonm Encoding.t =
+    Encoding.conv
+      (fun json ->
+         Json_repr.convert
+           (module Json_repr.Ezjsonm)
+           (module Json_repr_bson.Repr)
+           json |>
+         Json_repr_bson.bson_to_bytes |>
+         Bytes.to_string)
+      (fun s -> try
+          Bytes.of_string s |>
+          Json_repr_bson.bytes_to_bson ~copy:false |>
+          Json_repr.convert
+            (module Json_repr_bson.Repr)
+            (module Json_repr.Ezjsonm)
+        with
+        | Json_repr_bson.Bson_decoding_error (msg, _, _) ->
+            raise (Parse_error msg))
+      Encoding.string in
+  let json =
+    Json_encoding.any_ezjson_value in
+  Encoding.raw_splitted ~binary ~json
+
+let schema_encoding =
+  Encoding.conv
+    Json_schema.to_json
+    Json_schema.of_json
+    encoding
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/json.mli b/vendors/tezos-modded/src/lib_data_encoding/json.mli
new file mode 100644
index 000000000..8ba9a80b7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/json.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This is for use *within* the data encoding library only. Instead, you should
+    use the corresponding module intended for use: {Data_encoding.Json}. *)
+
+type json =
+  [ `O of (string * json) list
+  | `Bool of bool
+  | `Float of float
+  | `A of json list
+  | `Null
+  | `String of string ]
+type t = json
+type schema = Json_schema.schema
+
+val convert : 'a Encoding.t -> 'a Json_encoding.encoding
+val schema : ?definitions_path:string -> 'a Encoding.t -> schema
+val encoding: json Encoding.t
+val schema_encoding: schema Encoding.t
+val construct : 't Encoding.t -> 't -> json
+val destruct : 't Encoding.t -> json -> 't
+
+type path = path_item list
+and path_item =
+  [ `Field of string
+  | `Index of int
+  | `Star
+  | `Next
+  ]
+exception Cannot_destruct of (path * exn)
+exception Unexpected of string * string
+exception No_case_matched of exn list
+exception Bad_array_size of int * int
+exception Missing_field of string
+exception Unexpected_field of string
+
+val print_error :
+  ?print_unknown: (Format.formatter -> exn -> unit) ->
+  Format.formatter -> exn -> unit
+
+val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a
+val wrap_error : ('a -> 'b) -> 'a -> 'b
+
+val from_string : string -> (json, string) result
+val from_stream : string Lwt_stream.t -> (json, string) result Lwt_stream.t
+val to_string : ?newline:bool -> ?minify:bool -> json -> string
+val pp : Format.formatter -> json -> unit
+
+val bytes_jsont: MBytes.t Json_encoding.encoding
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/bench_data_encoding.ml b/vendors/tezos-modded/src/lib_data_encoding/test/bench_data_encoding.ml
new file mode 100644
index 000000000..d54374951
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/bench_data_encoding.ml
@@ -0,0 +1,136 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 bench ?(num_iterations=1000) name thunk =
+  Gc.full_major () ;
+  Gc.compact () ;
+  let start_time = Sys.time () in
+  for _i = 0 to (num_iterations - 1) do
+    thunk ()
+  done ;
+  let end_time = Sys.time () in
+  Format.printf
+    "Benchmark: %s took %f for %d iterations.@."
+    name
+    (end_time -. start_time)
+    num_iterations
+
+let read_stream encoding bytes =
+  let rec loop bytes status =
+    match bytes, status with
+    | [], Data_encoding.Binary.Success _ -> ()
+    | bytes :: bytess, Await f -> loop bytess (f bytes)
+    | _, _ -> assert false in
+  loop bytes (Data_encoding.Binary.read_stream encoding)
+
+let bench_all ?(num_iterations=1000) name encoding value =
+  bench ~num_iterations ("writing " ^ name ^ " json")
+    (fun () -> ignore @@ Data_encoding.Json.to_string @@ Data_encoding.Json.construct encoding value) ;
+  bench ~num_iterations ("writing " ^ name ^ " binary")
+    (fun () -> ignore @@ Data_encoding.Binary.to_bytes_exn encoding value) ;
+  let encoded_json = Data_encoding.Json.to_string @@ Data_encoding.Json.construct encoding value in
+  bench ~num_iterations ("reading " ^ name ^ " json")
+    (fun () -> ignore (Data_encoding.Json.destruct encoding (Ezjsonm.from_string encoded_json))) ;
+  let encoded_binary =  Data_encoding.Binary.to_bytes_exn encoding value in
+  bench ~num_iterations ("reading " ^ name ^ " binary")
+    (fun () -> ignore @@ Data_encoding.Binary.of_bytes encoding encoded_binary ) ;
+  bench ~num_iterations ("reading " ^ name ^ " streamed binary (one chunk)")
+    (fun () -> read_stream encoding [encoded_binary]) ;
+  bench ~num_iterations
+    ("reading " ^ name ^ " streamed binary (small chunks)")
+    (fun () -> read_stream encoding (MBytes.cut 1 encoded_binary)) ;
+  ()
+
+type t =
+  | A of string
+  | B of bool
+  | I of int
+  | F of float
+  | R of t * t
+
+let cases_encoding : t Data_encoding.t =
+  let open Data_encoding in
+  mu "recursive"
+    (fun recursive -> union [
+         case (Tag 0)
+           ~title:"A"
+           string
+           (function A s -> Some s
+                   | _ -> None)
+           (fun s -> A s) ;
+         case (Tag 1)
+           ~title:"B"
+           bool
+           (function B bool -> Some bool
+                   | _ -> None)
+           (fun bool -> B bool) ;
+         case (Tag 2)
+           ~title:"I"
+           int31
+           (function I int -> Some int
+                   | _ -> None)
+           (fun int -> I int) ;
+         case (Tag 3)
+           ~title:"F"
+           float
+           (function F float -> Some float
+                   | _ -> None)
+           (fun float -> F float) ;
+         case (Tag 4)
+           ~title:"R"
+           (obj2
+              (req "field1" recursive)
+              (req "field2" recursive))
+           (function R (a, b) -> Some (a, b)
+                   | _ -> None)
+           (fun (a, b) -> R (a, b))
+       ])
+
+let () =
+
+  bench_all
+    "10000_element_int_list"
+    Data_encoding.(list int31)
+    ~num_iterations:1000
+    (Array.to_list (Array.make 10000 0)) ;
+
+  bench_all
+    "option_element_int_list"
+    Data_encoding.(list (option int31))
+    (Array.to_list (Array.make 10000 (Some 0))) ;
+
+  let encoding = Data_encoding.(list (result (option int31) string)) in
+  let value = (Array.to_list (Array.make 10000 (Error "hello"))) in
+  bench_all "option_result_element_list" encoding value;
+
+  let encoding = Data_encoding.(list cases_encoding) in
+  let value = Array.to_list (Array.make 1000 (R (R (A "asdf", B true), F 1.0))) in
+  bench ~num_iterations:1000 "binary_encoding"
+    (fun () -> ignore @@ Data_encoding.Binary.to_bytes encoding value) ;
+
+  bench_all "binary_encoding_large_list"
+    Data_encoding.(list cases_encoding)
+    (Array.to_list (Array.make 2000 (R (R (A "asdf", B true), F 1.0))))
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/dune b/vendors/tezos-modded/src/lib_data_encoding/test/dune
new file mode 100644
index 000000000..cbe268eab
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/dune
@@ -0,0 +1,41 @@
+(executables
+ (names test
+        test_generated
+        bench_data_encoding
+        )
+ (libraries tezos-stdlib
+            tezos_data_encoding
+            alcotest
+            crowbar)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_stdlib
+                   -open Tezos_data_encoding)))
+
+(alias
+ (name buildtest)
+ (deps test.exe
+       test_generated.exe
+       bench_data_encoding.exe
+       ))
+
+(alias
+ (name runtest_test)
+ (action (run %{exe:test.exe})))
+
+(alias
+ (name runtest_test_generated)
+ (action (run %{exe:test_generated.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_test)
+       (alias runtest_test_generated)))
+
+(alias
+ (name run_bench)
+ (action (run %{exe:bench_data_encoding.exe})))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/helpers.ml b/vendors/tezos-modded/src/lib_data_encoding/test/helpers.ml
new file mode 100644
index 000000000..b3306abb4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/helpers.ml
@@ -0,0 +1,79 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+let no_exception f =
+  try f ()
+  with
+  | Json_encoding.Cannot_destruct _
+  | Json_encoding.Unexpected _
+  | Json_encoding.No_case_matched _
+  | Json_encoding.Bad_array_size _
+  | Json_encoding.Missing_field _
+  | Json_encoding.Unexpected_field _
+  | Json_encoding.Bad_schema _ as exn ->
+      Alcotest.failf
+        "@[v 2>json failed:@ %a@]"
+        (fun ppf -> Json_encoding.print_error ppf) exn
+  | Binary.Read_error error ->
+      Alcotest.failf
+        "@[v 2>bytes reading failed:@ %a@]"
+        Binary.pp_read_error error
+  | Binary.Write_error error ->
+      Alcotest.failf
+        "@[v 2>bytes writing failed:@ %a@]"
+        Binary.pp_write_error error
+
+let check_raises expected f =
+  match f () with
+  | exception exn when expected exn -> ()
+  | exception exn ->
+      Alcotest.failf "Unexpected exception: %s." (Printexc.to_string exn)
+  | _ -> Alcotest.failf "Expecting exception, got success."
+
+let chunked_read sz encoding bytes =
+  let status =
+    List.fold_left
+      (fun status chunk ->
+         match status with
+         | Binary.Await f -> f chunk
+         | Success _ when MBytes.length chunk <> 0 -> Error Extra_bytes
+         | Success _ | Error _ -> status)
+      (Binary.read_stream encoding)
+      (MBytes.cut sz bytes) in
+  match status with
+  | Success { stream ; _ } when not (Binary_stream.is_empty stream) ->
+      Binary.Error Extra_bytes
+  | _ -> status
+
+let streamed_read encoding bytes =
+  List.fold_left
+    (fun (status, count as acc) chunk ->
+       match status with
+       | Binary.Await f -> (f chunk, succ count)
+       | Success _ | Error _ -> acc)
+    (Binary.read_stream encoding, 0)
+    (MBytes.cut 1 bytes)
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/invalid_encoding.ml b/vendors/tezos-modded/src/lib_data_encoding/test/invalid_encoding.ml
new file mode 100644
index 000000000..cc5e7f7d7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/invalid_encoding.ml
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+open Helpers
+
+let test ?(expected = fun _ -> true) name f =
+  name, `Quick, fun () -> check_raises expected f
+
+let tests = [
+  test "multi_variable_tup" (fun () -> tup2 Variable.string Variable.string) ;
+  test "variable_in_list" (fun () -> list Variable.string) ;
+  test "nested_option" (fun () -> option (option int8)) ;
+  test "merge_non_objs" (fun () -> merge_objs int8 string) ;
+  test "empty_union" (fun () -> union []) ;
+  test "duplicated_tag" (fun () ->
+      union [ case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ;
+              case (Tag 0) ~title:"" empty (fun () -> None) (fun () -> ()) ]) ;
+  test "fixed_negative_size" (fun () -> Fixed.string (~- 1)) ;
+  test "fixed_null_size" (fun () -> Fixed.bytes 0) ;
+  test "array_null_size" (fun () -> Variable.list empty) ;
+  test "list_null_size" (fun () -> Variable.list null) ;
+  test "zeroable_in_list" (fun () -> list (obj1 (varopt "x" int8))) ;
+]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/randomized.ml b/vendors/tezos-modded/src/lib_data_encoding/test/randomized.ml
new file mode 100644
index 000000000..b622a700d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/randomized.ml
@@ -0,0 +1,75 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Various randomly generated data. *)
+
+open Data_encoding
+
+(** Generate encodings of the encoding and the randomized generator *)
+let test_generator ?(iterations=50) ty encoding generator =
+  for _ = 0 to iterations - 1 do
+    let value = generator () in
+    Success.json ty encoding value () ;
+    Success.bson ty encoding value () ;
+    Success.binary ty encoding value () ;
+    Success.stream ty encoding value () ;
+  done
+
+let rec make_int_list acc len () =
+  if len = 0 then
+    acc
+  else
+    make_int_list (Random.int64 Int64.max_int :: acc) (len - 1) ()
+
+let test_randomized_int_list () =
+  test_generator
+    Alcotest.(list int64)
+    (list int64)
+    (make_int_list [] 100)
+
+let test_randomized_string_list () =
+  test_generator
+    Alcotest.(list string)
+    (list string)
+    (fun () -> List.map Int64.to_string (make_int_list [] 20 ()))
+
+let test_randomized_variant_list () =
+  test_generator
+    Alcotest.(list (result (option string) string))
+    (list (result (option string) (obj1 (req "failure" string))))
+    (fun () ->
+       List.map
+         (fun x ->
+            let str = Int64.to_string x in
+            if Random.bool ()
+            then if Random.bool () then Ok (Some str) else Ok None
+            else Error str)
+         (make_int_list [] 20 ()))
+
+let tests = [
+  "int_list", `Quick, test_randomized_int_list ;
+  "string_list", `Quick, test_randomized_string_list ;
+  "variant_list", `Quick, test_randomized_variant_list ;
+]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/read_failure.ml b/vendors/tezos-modded/src/lib_data_encoding/test/read_failure.ml
new file mode 100644
index 000000000..4d3bfb989
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/read_failure.ml
@@ -0,0 +1,229 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Test expected errors while deserializing data. *)
+
+open Data_encoding
+open Helpers
+open Types
+
+let not_enough_data = function
+  | Binary.Read_error Not_enough_data -> true
+  | _ -> false
+
+let extra_bytes = function
+  | Binary.Read_error Extra_bytes -> true
+  | _ -> false
+
+let trailing_zero = function
+  | Binary.Read_error Trailing_zero -> true
+  | _ -> false
+
+let invalid_int = function
+  | Binary.Read_error (Invalid_int _) -> true
+  | Json_encoding.Cannot_destruct ([] , Failure _) -> true
+  | _ -> false
+
+let invalid_string_length = function
+  | Json_encoding.Cannot_destruct
+      ([], Json_encoding.Unexpected ("string (len 9)", "string (len 4)")) -> true
+  | Json_encoding.Cannot_destruct
+      ([], Json_encoding.Unexpected ("bytes (len 9)", "bytes (len 4)")) -> true
+  | Binary.Read_error Extra_bytes -> true
+  | _ -> false
+
+let missing_case = function
+  | Json_encoding.Cannot_destruct ([], Json_encoding.No_case_matched _ ) -> true
+  | Binary.Read_error (Unexpected_tag _) -> true
+  | _ -> false
+
+let missing_enum = function
+  | Json_encoding.Cannot_destruct ([], Json_encoding.Unexpected _ ) -> true
+  | Binary.Read_error No_case_matched -> true
+  | _ -> false
+
+let json ?(expected = fun _ -> true) read_encoding json () =
+  check_raises expected begin fun () ->
+    ignore (Json.destruct read_encoding json)
+  end
+
+let bson ?(expected = fun _ -> true) read_encoding bson () =
+  check_raises expected begin fun () ->
+    ignore (Bson.destruct read_encoding bson)
+  end
+
+let binary ?(expected = fun _ -> true) read_encoding bytes () =
+  check_raises expected begin fun () ->
+    ignore (Binary.of_bytes_exn read_encoding bytes) ;
+  end
+
+let stream ?(expected = fun _ -> true) read_encoding bytes () =
+  let len_data = MBytes.length bytes in
+  for sz = 1 to max 1 len_data do
+    let name = Format.asprintf "stream (%d)" sz in
+    match chunked_read sz read_encoding bytes with
+    | Binary.Success _ ->
+        Alcotest.failf "%s failed: expecting exception, got success." name
+    | Binary.Await _ ->
+        Alcotest.failf "%s failed: not enough data" name
+    | Binary.Error error when expected (Binary.Read_error error) ->
+        ()
+    | Binary.Error error ->
+        Alcotest.failf
+          "@[<v 2>%s failed: read error@ %a@]"
+          name
+          Binary.pp_read_error error
+  done
+
+let minimal_stream ?(expected = fun _ -> true) expected_read read_encoding bytes () =
+  let name = "minimal_stream" in
+  match streamed_read read_encoding bytes with
+  | Binary.Success _, _ ->
+      Alcotest.failf "%s failed: expecting exception, got success." name
+  | Binary.Await _, _ ->
+      Alcotest.failf "%s failed: not enough data" name
+  | Binary.Error error, count when expected (Binary.Read_error error) && count = expected_read ->
+      ()
+  | Binary.Error error, count ->
+      Alcotest.failf
+        "@[<v 2>%s failed: read error after reading %d. @ %a@]"
+        name count
+        Binary.pp_read_error error
+
+
+let all ?expected name write_encoding read_encoding value =
+  let json_value = Json.construct write_encoding value in
+  let bson_value = Bson.construct write_encoding value in
+  let bytes_value = Binary.to_bytes_exn write_encoding value in
+  [ name ^ ".json", `Quick, json ?expected read_encoding json_value ;
+    name ^ ".bson", `Quick, bson ?expected read_encoding bson_value ;
+    name ^ ".bytes", `Quick, binary ?expected read_encoding bytes_value ;
+    name ^ ".stream", `Quick, stream ?expected read_encoding bytes_value ;
+  ]
+
+let all_ranged_int minimum maximum =
+  let encoding = ranged_int minimum maximum in
+  let signed =
+    match Binary_size.range_to_size ~minimum ~maximum with
+    | `Int31 | `Int8 | `Int16 -> true
+    | `Uint8 | `Uint16 | `Uint30 -> false in
+  let write_encoding =
+    splitted
+      ~json:(ranged_int (minimum - 1) (maximum + 1))
+      ~binary:
+        (if signed then
+           (ranged_int (minimum - 1) (maximum + 1))
+         else
+           ranged_int minimum (maximum + 1)) in
+  let name = Format.asprintf "ranged_int.%d" minimum in
+  all ~expected:invalid_int (name ^ ".max") write_encoding encoding (maximum + 1) @
+  if signed then
+    all ~expected:invalid_int (name ^ ".min") write_encoding encoding (minimum - 1)
+  else
+    let json_value = Json.construct write_encoding (minimum - 1) in
+    let bson_value = Bson.construct write_encoding (minimum - 1) in
+    [ name ^ "min.json", `Quick, json ~expected:invalid_int encoding json_value ;
+      name ^ "min..bson", `Quick, bson ~expected:invalid_int encoding bson_value ]
+
+let all_ranged_float minimum maximum =
+  let encoding = ranged_float minimum maximum in
+  let name = Format.asprintf "ranged_float.%f" minimum in
+  all (name ^ ".min") float encoding (minimum -. 1.) @
+  all (name ^ ".max") float encoding (maximum +. 1.)
+
+let test_bounded_string_list =
+  let expected = function
+    | Binary_error.Read_error Size_limit_exceeded -> true
+    | _ -> false in
+  let test name ~total ~elements v expected_read expected_read' =
+    let bytes = Binary.to_bytes_exn (Variable.list string) v in
+    let vbytes = Binary.to_bytes_exn (list string) v in
+    [ "bounded_string_list." ^ name, `Quick,
+      binary ~expected (bounded_list ~total ~elements string) bytes ;
+      "bounded_string_list_stream." ^ name, `Quick,
+      stream ~expected
+        (dynamic_size (bounded_list ~total:total ~elements string)) vbytes ;
+      "bounded_string_list_minimal_stream." ^ name, `Quick,
+      minimal_stream ~expected expected_read
+        (dynamic_size (bounded_list ~total:total ~elements string)) vbytes ;
+      "bounded_string_list_minimal_stream." ^ name, `Quick,
+      minimal_stream ~expected expected_read'
+        (check_size (total + 4)
+           (dynamic_size (Variable.list (check_size elements string)))) vbytes ;
+
+    ] in
+  test "a" ~total:0 ~elements:0 [""] 4 4 @
+  test "b1" ~total:3 ~elements:4 [""] 4 4 @
+  test "b2" ~total:4 ~elements:3 [""] 4 4 @
+  test "c1" ~total:19 ~elements:4 ["";"";"";"";""] 4 4 @
+  test "c2" ~total:20 ~elements:3 ["";"";"";"";""] 4 4 @
+  test "d1" ~total:20 ~elements:5 ["";"";"";"";"a"] 4 4 @
+  test "d2" ~total:21 ~elements:4 ["";"";"";"";"a"] 24 24 @
+  test "e" ~total:30 ~elements:10 ["ab";"c";"def";"gh";"ijk"] 4 4
+
+let tests =
+  all_ranged_int 100 400 @
+  all_ranged_int 19000 19253 @
+  all_ranged_int ~-100 300 @
+  all_ranged_int ~-300_000_000 300_000_000 @
+  all_ranged_float ~-. 100. 300. @
+  all "string.fixed" ~expected:invalid_string_length
+    string (Fixed.string 4) "turlututu" @
+  all "string.bounded" string (Bounded.string 4) "turlututu" @
+  all "bytes.fixed"  ~expected:invalid_string_length
+    bytes (Fixed.bytes 4) (MBytes.of_string "turlututu") @
+  all "bytes.bounded" bytes (Bounded.bytes 4) (MBytes.of_string "turlututu") @
+  all "unknown_case.B" ~expected:missing_case union_enc mini_union_enc (B "2") @
+  all "unknown_case.E" ~expected:missing_case union_enc mini_union_enc E @
+  all "enum.missing" ~expected:missing_enum enum_enc mini_enum_enc 4 @
+  test_bounded_string_list @
+  [ "n.truncated", `Quick,
+    binary ~expected:not_enough_data n (MBytes.of_string "\x83") ;
+    "n.trailing_zero", `Quick,
+    binary ~expected:trailing_zero n (MBytes.of_string "\x83\x00") ;
+    "n.trailing_zero2", `Quick,
+    binary ~expected:trailing_zero n (MBytes.of_string "\x83\x00") ;
+    "z.truncated", `Quick,
+    binary ~expected:not_enough_data z (MBytes.of_string "\x83") ;
+    "z.trailing_zero", `Quick,
+    binary ~expected:trailing_zero z (MBytes.of_string "\x83\x00") ;
+    "z.trailing_zero2", `Quick,
+    binary ~expected:trailing_zero z (MBytes.of_string "\x83\x80\x00") ;
+    "dynamic_size.empty", `Quick,
+    binary ~expected:not_enough_data (dynamic_size Variable.string)
+      (MBytes.of_string "") ;
+    "dynamic_size.partial_size", `Quick,
+    binary ~expected:not_enough_data (dynamic_size Variable.string)
+      (MBytes.of_string "\x00\x00") ;
+    "dynamic_size.incomplete_data", `Quick,
+    binary ~expected:not_enough_data (dynamic_size Variable.string)
+      (MBytes.of_string "\x00\x00\x00\x04\x00\x00") ;
+    "dynamic_size.outer-garbage", `Quick,
+    binary ~expected:extra_bytes (dynamic_size Variable.string)
+      (MBytes.of_string "\x00\x00\x00\x01\x00\x00") ;
+    "dynamic_size.inner-garbage", `Quick,
+    binary ~expected:extra_bytes (dynamic_size uint8)
+      (MBytes.of_string "\x00\x00\x00\x02\x00\x00") ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/success.ml b/vendors/tezos-modded/src/lib_data_encoding/test/success.ml
new file mode 100644
index 000000000..aeeae2756
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/success.ml
@@ -0,0 +1,282 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Trivial back-and-forth test: a value is serialized, then
+    unserialized and compared to the original value. All backend
+    (json, bson, binary, and streamed binary) are tested for each of
+    the basic encoding described here. No serialization or
+    deserialization failure are expected in these tests. *)
+
+(* TODO `varopt` ; `assoc` ; `Data_encoding.json` *)
+
+open Data_encoding
+open Helpers
+open Types
+open Utils.Infix
+
+let json ty encoding value () =
+  no_exception begin fun () ->
+    let json = Json.construct encoding value in
+    let result = Json.destruct encoding json in
+    Alcotest.check ty "json" value result
+  end
+
+let bson ty encoding value () =
+  no_exception begin fun () ->
+    let json = Bson.construct encoding value in
+    let result = Bson.destruct encoding json in
+    Alcotest.check ty "bson" value result
+  end
+
+let binary ty encoding value () =
+  no_exception begin fun () ->
+    let bytes = Binary.to_bytes_exn encoding value in
+    let result = Binary.of_bytes_exn encoding bytes in
+    Alcotest.check ty "binary" value result
+  end
+
+let stream ty encoding value () =
+  no_exception begin fun () ->
+    let bytes = Binary.to_bytes_exn encoding value in
+    let len_data = MBytes.length bytes in
+    for sz = 1 to max 1 len_data do
+      let name = Format.asprintf "stream (%d)" sz in
+      match chunked_read sz encoding bytes with
+      | Binary.Success { result ; size ; stream } ->
+          if size <> MBytes.length bytes ||
+             not (Binary_stream.is_empty stream) then
+            Alcotest.failf "%s failed: remaining data" name ;
+          Alcotest.check ty name value result
+      | Binary.Await _ ->
+          Alcotest.failf "%s failed: not enough data" name
+      | Binary.Error error ->
+          Alcotest.failf
+            "@[<v 2>%s failed: read error@ %a@]"
+            name
+            Binary.pp_read_error error
+    done ;
+  end
+
+let all name ty encoding value =
+  let stream_encoding =
+    match Data_encoding.classify encoding with
+    | `Variable -> dynamic_size encoding
+    | `Dynamic | `Fixed _ -> encoding in
+  [ name ^ ".json", `Quick, json ty encoding value ;
+    name ^ ".bson", `Quick, bson ty encoding value ;
+    name ^ ".binary", `Quick, binary ty encoding value ;
+    name ^ ".binary_stream", `Quick, stream ty stream_encoding value ]
+
+let all_int encoding size =
+  let name = Format.asprintf "int%d" size in
+  all (name ^ ".min") Alcotest.int encoding ~- (1 lsl (size - 1)) @
+  all (name ^ ".mean") Alcotest.int encoding 0 @
+  all (name ^ ".max") Alcotest.int encoding ((1 lsl (size - 1)) - 1)
+
+let all_uint encoding size =
+  let name = Format.asprintf "uint%d" size in
+  all (name ^ ".min") Alcotest.int encoding 0 @
+  all (name ^ ".mean") Alcotest.int encoding (1 lsl (size - 1)) @
+  all (name ^ ".max") Alcotest.int encoding ((1 lsl size) - 1)
+
+let all_ranged_int minimum maximum =
+  let encoding = ranged_int minimum maximum in
+  let name = Format.asprintf "ranged_int.%d" minimum in
+  all (name ^ ".min") Alcotest.int encoding minimum @
+  all (name ^ ".mean") Alcotest.int encoding ((minimum + maximum) / 2) @
+  all (name ^ ".max") Alcotest.int encoding maximum
+
+let all_ranged_float minimum maximum =
+  let encoding = ranged_float minimum maximum in
+  let name = Format.asprintf "ranged_float.%f" minimum in
+  all (name ^ ".min") Alcotest.float encoding minimum @
+  all (name ^ ".mean") Alcotest.float encoding ((minimum +. maximum) /. 2.) @
+  all (name ^ ".max") Alcotest.float encoding maximum
+
+let test_n_sequence () =
+  let test i =
+    binary Alcotest.z z i () ;
+    stream Alcotest.z z i () in
+  for i = 0 to 10_000 do test (Z.of_int i) done ;
+  for i = 100_000_000 to 100_010_000 do test (Z.of_int i) done
+
+let test_z_sequence () =
+  let test i =
+    binary Alcotest.z z i () ;
+    stream Alcotest.z z i () in
+  for i = -10_000 to 10_000 do test (Z.of_int i) done ;
+  for i = 100_000_000 to 100_010_000 do test (Z.of_int i) done ;
+  for i = -100_000_000 downto -100_010_000 do test (Z.of_int i) done
+
+let test_string_enum_boundary () =
+  let entries = List.rev_map (fun x -> string_of_int x, x) (0 -- 254) in
+  let run_test cases =
+    List.iter (fun (_, num)  ->
+        let enc = string_enum cases in
+        json Alcotest.int enc num () ;
+        bson Alcotest.int enc num () ;
+        binary Alcotest.int enc num () ;
+        stream Alcotest.int enc num ())
+      cases in
+  run_test entries ;
+  let entries2 = (("255", 255) :: entries) in
+  run_test entries2 ;
+  run_test (("256", 256) :: entries2)
+
+let test_bounded_string_list =
+  let test name ~total ~elements v =
+    "bounded_string_list." ^ name, `Quick,
+    binary Alcotest.(list string)
+      (bounded_list ~total ~elements string) v in
+  [ test "a" ~total:0 ~elements:0 [] ;
+    test "b" ~total:4 ~elements:4 [""] ;
+    test "c" ~total:20 ~elements:4 ["";"";"";"";""] ;
+    test "d" ~total:21 ~elements:5 ["";"";"";"";"a"] ;
+    test "e" ~total:31 ~elements:10 ["ab";"c";"def";"gh";"ijk"] ;
+  ]
+
+let tests =
+  all "null" Alcotest.pass null () @
+  all "empty" Alcotest.pass empty () @
+  all "constant" Alcotest.pass (constant "toto") () @
+  all_int int8 8 @
+  all_uint uint8 8 @
+  all_int int16 16 @
+  all_uint uint16 16 @
+  all_int int31 31 @
+  all "int32.min" Alcotest.int32 int32 Int32.min_int @
+  all "int32.max" Alcotest.int32 int32 Int32.max_int @
+  all "int64.min" Alcotest.int64 int64 Int64.min_int @
+  all "int64.max" Alcotest.int64 int64 Int64.max_int @
+  all_ranged_int 100 400 @
+  all_ranged_int 19000 19254 @
+  all_ranged_int ~-100 300 @
+  all_ranged_int ~-300_000_000 300_000_000 @
+  all "bool.true" Alcotest.bool bool true @
+  all "bool.false" Alcotest.bool bool false @
+  all "string" Alcotest.string string "tutu" @
+  all "string.fixed" Alcotest.string (Fixed.string 4) "tutu" @
+  all "string.variable" Alcotest.string Variable.string "tutu" @
+  all "string.bounded1" Alcotest.string (Bounded.string 4) "tu" @
+  all "string.bounded2" Alcotest.string (Bounded.string 4) "tutu" @
+  all "bytes" Alcotest.bytes bytes (MBytes.of_string "titi") @
+  all "bytes.fixed" Alcotest.bytes (Fixed.bytes 4)
+    (MBytes.of_string "titi") @
+  all "bytes.variable" Alcotest.bytes Variable.bytes
+    (MBytes.of_string "titi") @
+  all "bytes.bounded1" Alcotest.bytes (Bounded.bytes 4) (MBytes.of_string "tu") @
+  all "bytes.bounded2" Alcotest.bytes (Bounded.bytes 4) (MBytes.of_string "tutu") @
+  all "float" Alcotest.float float 42. @
+  all "float.max" Alcotest.float float max_float @
+  all "float.min" Alcotest.float float min_float @
+  all "float.neg_zero" Alcotest.float float (-. 0.) @
+  all "float.zero" Alcotest.float float (+. 0.) @
+  all "float.infinity" Alcotest.float float infinity @
+  all "float.neg_infity" Alcotest.float float neg_infinity @
+  all "float.epsilon" Alcotest.float float epsilon_float @
+  all "float.nan" Alcotest.float float nan @
+  all_ranged_float ~-. 100. 300. @
+  all "n.zero" Alcotest.n n (Z.zero) @
+  all "n.one" Alcotest.n n (Z.one) @
+  [ "n.sequence", `Quick, test_n_sequence ] @
+  let rec fact i l =
+    if i < 1 then
+      []
+    else
+      let l = Z.mul l (Z.of_int i) in
+      fact (i - 1) l @
+      all (Format.asprintf "n.fact.%d" i) Alcotest.n n l in
+  fact 35 Z.one @
+  all "n.a" Alcotest.n n
+    (Z.of_string "123574503164821730218493275982143254986574985328") @
+  all "n.b" Alcotest.n n
+    (Z.of_string "8493275982143254986574985328") @
+  all "n.c" Alcotest.n n
+    (Z.of_string "123574503164821730218474985328") @
+  all "n.d" Alcotest.n n
+    (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") @
+  all "z.zero" Alcotest.z z (Z.zero) @
+  all "z.one" Alcotest.z z (Z.one) @
+  [ "z.sequence", `Quick, test_z_sequence ] @
+  let rec fact n l =
+    if n < 1 then
+      []
+    else
+      let l = Z.mul l (Z.of_int n) in
+      fact (n - 1) l @
+      all (Format.asprintf "z.fact.%d" n) Alcotest.z z l in
+  fact 35 Z.one @
+  all "z.a" Alcotest.z z
+    (Z.of_string "123574503164821730218493275982143254986574985328") @
+  all "z.b" Alcotest.z z
+    (Z.of_string "8493275982143254986574985328") @
+  all "z.c" Alcotest.z z
+    (Z.of_string "123574503164821730218474985328") @
+  all "z.d" Alcotest.z z
+    (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") @
+  all "z.e" Alcotest.z z
+    (Z.of_string "-123574503164821730218493275982143254986574985328") @
+  all "z.f" Alcotest.z z
+    (Z.of_string "-8493275982143254986574985328") @
+  all "z.g" Alcotest.z z
+    (Z.of_string "-123574503164821730218474985328") @
+  all "z.h" Alcotest.z z
+    (Z.of_string "-10000000000100000000001000003050000000060600000000000777000008") @
+  all "none" Alcotest.(option string) (option string) None @
+  all "some.string" Alcotest.(option string) (option string)
+    (Some "thing") @
+  all "enum" Alcotest.int enum_enc 4 @
+  all "obj" Alcotest.record record_obj_enc default_record @
+  all "obj.dft" Alcotest.record record_obj_enc
+    { default_record with b = false } @
+  all "obj.req" Alcotest.record record_obj_enc
+    { default_record with c = None } @
+  all "tup" Alcotest.record record_tup_enc default_record @
+  all "obj.variable" Alcotest.variable_record variable_record_obj_enc
+    default_variable_record @
+  all "tup.variable" Alcotest.variable_record variable_record_tup_enc
+    default_variable_record @
+  all "obj.variable_left" Alcotest.variable_left_record variable_left_record_obj_enc
+    default_variable_left_record @
+  all "tup.variable_left" Alcotest.variable_left_record variable_left_record_tup_enc
+    default_variable_left_record @
+  all "union.A" Alcotest.union union_enc (A 1) @
+  all "union.B" Alcotest.union union_enc (B "2") @
+  all "union.C" Alcotest.union union_enc (C 3) @
+  all "union.D" Alcotest.union union_enc (D "4") @
+  all "union.E" Alcotest.union union_enc E @
+  all "variable_list.empty" Alcotest.(list int) (Variable.list int31) [] @
+  all "variable_list" Alcotest.(list int) (Variable.list int31) [1;2;3;4;5] @
+  all "variable_array.empty" Alcotest.(array int) (Variable.array int31) [||] @
+  all "variable_array" Alcotest.(array int) (Variable.array int31) [|1;2;3;4;5|] @
+  all "list.empty" Alcotest.(list int) (list int31) [] @
+  all "list" Alcotest.(list int) (list int31) [1;2;3;4;5] @
+  all "array.empty" Alcotest.(array int) (array int31) [||] @
+  all "array" Alcotest.(array int) (array int31) [|1;2;3;4;5|] @
+  all "mu_list.empty" Alcotest.(list int) (mu_list_enc int31) [] @
+  all "mu_list" Alcotest.(list int) (mu_list_enc int31) [1;2;3;4;5] @
+  test_bounded_string_list @
+  [ "string_enum_boundary", `Quick, test_string_enum_boundary ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/test.ml b/vendors/tezos-modded/src/lib_data_encoding/test/test.ml
new file mode 100644
index 000000000..c3dadd6d9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/test.ml
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Random.init 100 ;
+  Alcotest.run "tezos-data-encoding" [
+    "success", Success.tests ;
+    "invalid_encoding", Invalid_encoding.tests ;
+    "read_failure", Read_failure.tests ;
+    "write_failure", Write_failure.tests ;
+    "randomized", Randomized.tests ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/test_generated.ml b/vendors/tezos-modded/src/lib_data_encoding/test/test_generated.ml
new file mode 100644
index 000000000..3ba4886bf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/test_generated.ml
@@ -0,0 +1,746 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* NOTE: the current release of Crowbar, v0.1, is quite limited. Several
+ * improvements have been made to the dev version which will make it possible to
+ * simplify this file and increase coverage.
+ * For now, this is a limited test-suite. *)
+
+let char = Crowbar.map [Crowbar.uint8] Char.chr
+
+let string = Crowbar.bytes
+(* The v0.1 of Crowbar doesn't have fixed-size string generation. When we
+ * update Crowbar, we can improve this generator. *)
+let short_string =
+  let open Crowbar in
+  choose [
+    const "";
+    map [char] (fun c -> String.make 1 c);
+    map [char; char; char; char] (fun c1 c2 c3 c4 ->
+        let s = Bytes.make 4 c1 in
+        Bytes.set s 1 c2;
+        Bytes.set s 2 c3;
+        Bytes.set s 3 c4;
+        Bytes.to_string s
+      );
+  ]
+let short_string1 =
+  let open Crowbar in
+  choose [
+    map [char] (fun c -> String.make 1 c);
+    map [char; char; char; char] (fun c1 c2 c3 c4 ->
+        let s = Bytes.make 4 c1 in
+        Bytes.set s 1 c2;
+        Bytes.set s 2 c3;
+        Bytes.set s 3 c4;
+        Bytes.to_string s
+      );
+  ]
+let mbytes = Crowbar.map [Crowbar.bytes] MBytes.of_string
+let short_mbytes = Crowbar.map [short_string] MBytes.of_string
+let short_mbytes1 = Crowbar.map [short_string1] MBytes.of_string
+
+
+
+(* We need to hide the type parameter of `Encoding.t` to avoid the generator
+ * combinator `choose` from complaining about different types. We use first
+ * level modules (for now) to encode existentials.
+ *
+ * An alternative is used in https://gitlab.com/gasche/fuzz-data-encoding *)
+
+module type TESTABLE = sig
+  type t
+  val v: t
+  val ding: t Data_encoding.t
+  val pp: t Crowbar.printer
+end
+type testable = (module TESTABLE)
+
+let null : testable =
+  (module struct
+    type t = unit
+    let v = ()
+    let ding = Data_encoding.null
+    let pp ppf () = Crowbar.pp ppf "(null)"
+  end)
+let empty : testable =
+  (module struct
+    type t = unit
+    let v = ()
+    let ding = Data_encoding.empty
+    let pp ppf () = Crowbar.pp ppf "(empty)"
+  end)
+let unit : testable =
+  (module struct
+    type t = unit
+    let v = ()
+    let ding = Data_encoding.unit
+    let pp ppf () = Crowbar.pp ppf "(unit)"
+  end)
+let map_constant (s: string) : testable =
+  (module struct
+    type t = unit
+    let v = ()
+    let ding = Data_encoding.constant s
+    let pp ppf () = Crowbar.pp ppf "\"%s\"" s
+  end)
+let map_int8 (i: int) : testable =
+  (module struct
+    type t = int
+    let v = i
+    let ding = Data_encoding.int8
+    let pp = Crowbar.pp_int
+  end)
+let map_uint8 (i: int) : testable =
+  (module struct
+    type t = int
+    let v = i
+    let ding = Data_encoding.uint8
+    let pp = Crowbar.pp_int
+  end)
+let map_int16 (i: int) : testable =
+  (module struct
+    type t = int
+    let v = i
+    let ding = Data_encoding.int16
+    let pp = Crowbar.pp_int
+  end)
+let map_uint16 (i: int) : testable =
+  (module struct
+    type t = int
+    let v = i
+    let ding = Data_encoding.uint16
+    let pp = Crowbar.pp_int
+  end)
+let map_int32 (i: int32) : testable =
+  (module struct
+    type t = int32
+    let v = i
+    let ding = Data_encoding.int32
+    let pp = Crowbar.pp_int32
+  end)
+let map_int64 (i: int64) : testable =
+  (module struct
+    type t = int64
+    let v = i
+    let ding = Data_encoding.int64
+    let pp = Crowbar.pp_int64
+  end)
+let map_range_int a b c : testable =
+  let (small, middle, big) =
+    match List.sort compare [a; b; c] with
+    | [small; middle; big] ->
+        assert (small <= middle);
+        assert (middle <= big);
+        (small, middle, big)
+    | _ -> assert false
+  in
+  (module struct
+    type t = int
+    let v = middle
+    let ding = Data_encoding.ranged_int small big
+    let pp ppf i = Crowbar.pp ppf "(%d :[%d;%d])" i small big
+  end)
+let map_range_float a b c : testable =
+  if compare a nan = 0 || compare b nan = 0 || compare c nan = 0 then
+    (* copout *)
+    null
+  else
+    let (small, middle, big) =
+      match List.sort compare [a; b; c] with
+      | [small; middle; big] ->
+          assert (small <= middle);
+          assert (middle <= big);
+          (small, middle, big)
+      | _ -> assert false
+    in
+    (module struct
+      type t = float
+      let v = middle
+      let ding = Data_encoding.ranged_float small big
+      let pp ppf i = Crowbar.pp ppf "(%f :[%f;%f])" i small big
+    end)
+let map_bool b : testable =
+  (module struct
+    type t = bool
+    let v = b
+    let ding = Data_encoding.bool
+    let pp = Crowbar.pp_bool
+  end)
+let map_string s : testable =
+  (module struct
+    type t = string
+    let v = s
+    let ding = Data_encoding.string
+    let pp = Crowbar.pp_string
+  end)
+let map_bytes s : testable =
+  (module struct
+    type t = MBytes.t
+    let v = s
+    let ding = Data_encoding.bytes
+    let pp ppf m =
+      if MBytes.length m > 40 then
+        Crowbar.pp ppf "@[<hv 1>%a … (%d more bytes)@]"
+          MBytes.pp_hex (MBytes.sub m 1 30)
+          (MBytes.length m)
+      else
+        MBytes.pp_hex ppf m
+  end)
+let map_float f : testable =
+  (module struct
+    type t = float
+    let v = f
+    let ding = Data_encoding.float
+    let pp = Crowbar.pp_float
+  end)
+let map_fixed_string s : testable =
+  (module struct
+    type t = string
+    let v = s
+    let ding = Data_encoding.Fixed.string (String.length s)
+    let pp ppf s = Crowbar.pp ppf "\"%s\"" s
+  end)
+let map_fixed_bytes s : testable =
+  (module struct
+    type t = MBytes.t
+    let v = s
+    let ding = Data_encoding.Fixed.bytes (MBytes.length s)
+    let pp = MBytes.pp_hex
+  end)
+let map_variable_string s : testable =
+  (module struct
+    type t = string
+    let v = s
+    let ding = Data_encoding.Variable.string
+    let pp ppf s = Crowbar.pp ppf "\"%s\"" s
+  end)
+let map_variable_bytes s : testable =
+  (module struct
+    type t = MBytes.t
+    let v = s
+    let ding = Data_encoding.Variable.bytes
+    let pp = MBytes.pp_hex
+  end)
+
+(* And now combinators *)
+
+let dyn_if_not ding =
+  match Data_encoding.classify ding with
+  | `Fixed _ | `Dynamic -> ding
+  | `Variable -> Data_encoding.dynamic_size ding
+
+let map_some (t: testable) : testable =
+  let module T = (val t) in
+  (module struct
+    type t = T.t option
+    let v = Some T.v
+    let ding =
+      try
+        Data_encoding.option T.ding
+      with
+      | Invalid_argument _ ->
+          Crowbar.bad_test ()
+    let pp ppf o =
+      Crowbar.pp ppf "@[<hv 1>%a@]"
+        (fun fmt v -> match v with
+           | None -> Format.fprintf fmt "None"
+           | Some v -> Format.fprintf fmt "Some(%a)" T.pp v
+        ) o
+  end)
+let map_none (t: testable) : testable =
+  let module T = (val t) in
+  (module struct
+    type t = T.t option
+    let v = None
+    let ding =
+      try
+        Data_encoding.option T.ding
+      with
+      | Invalid_argument _ ->
+          Crowbar.bad_test ()
+    let pp ppf o =
+      Crowbar.pp ppf "@[<hv 1>%a@]"
+        (fun fmt v -> match v with
+           | None -> Format.fprintf fmt "None"
+           | Some v -> Format.fprintf fmt "Some(%a)" T.pp v
+        ) o
+  end)
+let map_ok (t_o: testable) (t_e: testable) : testable =
+  let module T_O = (val t_o) in
+  let module T_E = (val t_e) in
+  (module struct
+    type t = (T_O.t, T_E.t) result
+    let v = Ok T_O.v
+    let ding = Data_encoding.result T_O.ding T_E.ding
+    let pp ppf r =
+      Crowbar.pp ppf "@[<hv 1>%a@]"
+        (fun fmt r -> match r with
+           | Ok o -> Format.fprintf fmt "Ok(%a)" T_O.pp o
+           | Error e -> Format.fprintf fmt "Error(%a)" T_E.pp e
+        ) r
+  end)
+let map_error (t_o: testable) (t_e: testable) : testable =
+  let module T_O = (val t_o) in
+  let module T_E = (val t_e) in
+  (module struct
+    type t = (T_O.t, T_E.t) result
+    let v = Error T_E.v
+    let ding = Data_encoding.result T_O.ding T_E.ding
+    let pp ppf r =
+      Crowbar.pp ppf "@[<hv 1>%a@]"
+        (fun fmt r -> match r with
+           | Ok o -> Format.fprintf fmt "Ok(%a)" T_O.pp o
+           | Error e -> Format.fprintf fmt "Error(%a)" T_E.pp e
+        ) r
+  end)
+let map_variable_list (t: testable) (ts: testable list) : testable =
+  let module T = (val t) in
+  (module struct
+    type t = T.t list
+    let ding = Data_encoding.Variable.list (dyn_if_not T.ding)
+    let v =
+      List.fold_left (fun acc (t: testable) ->
+          let module T = (val t) in
+          (* We can get rid of this Obj when we update Crowbar *)
+          (Obj.magic T.v) :: acc
+        )
+        []
+        ts
+    let pp = Crowbar.pp_list T.pp
+  end)
+let map_variable_array (t: testable) (ts: testable array) : testable =
+  let module T = (val t) in
+  (module struct
+    type t = T.t array
+    let ding = Data_encoding.Variable.array (dyn_if_not T.ding)
+    let v =
+      Array.of_list (
+        Array.fold_left (fun acc (t: testable) ->
+            let module T = (val t) in
+            (Obj.magic T.v) :: acc
+          )
+          []
+          ts
+      )
+    let pp ppf a =
+      if Array.length a > 40 then
+        Crowbar.pp ppf "@[<hv 1>[|%a … (%d more elements)|]@]"
+          (Format.pp_print_list
+             ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+             T.pp)
+          (Array.to_list (Array.sub a 0 30))
+          (Array.length a)
+      else
+        Crowbar.pp ppf "@[<hv 1>[|%a|]@]"
+          (Format.pp_print_list
+             ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+             T.pp)
+          (Array.to_list a)
+  end)
+let map_dynamic_size (t: testable) : testable =
+  let module T = (val t) in
+  (module struct
+    include T
+    let ding = Data_encoding.dynamic_size T.ding
+  end)
+
+let map_tup1 (t1: testable) : testable =
+  let module T1 = (val t1) in
+  (module struct
+    include T1
+    let ding = Data_encoding.tup1 T1.ding
+    let pp ppf (v1) =
+      Crowbar.pp ppf "@[<hv 1>(%a)@]"
+        T1.pp v1
+  end)
+let map_tup2 (t1: testable) (t2: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  (module struct
+    type t = T1.t * T2.t
+    let ding = Data_encoding.tup2 (dyn_if_not T1.ding) T2.ding
+    let v = (T1.v, T2.v)
+    let pp ppf (v1, v2) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+  end)
+let map_tup3 (t1: testable) (t2: testable) (t3: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  (module struct
+    type t = T1.t * T2.t * T3.t
+    let ding = Data_encoding.tup3 (dyn_if_not T1.ding) (dyn_if_not T2.ding) T3.ding
+    let v = (T1.v, T2.v, T3.v)
+    let pp ppf (v1, v2, v3) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+  end)
+let map_tup4 (t1: testable) (t2: testable) (t3: testable) (t4: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t
+    let ding = Data_encoding.tup4 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) T4.ding
+    let v = (T1.v, T2.v, T3.v, T4.v)
+    let pp ppf (v1, v2, v3, v4) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+  end)
+let map_tup5 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t
+    let ding = Data_encoding.tup5 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) T5.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v)
+    let pp ppf (v1, v2, v3, v4, v5) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+  end)
+let map_tup6 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) (t6: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  let module T6 = (val t6) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t * T6.t
+    let ding = Data_encoding.tup6 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) (dyn_if_not T5.ding) T6.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v, T6.v)
+    let pp ppf (v1, v2, v3, v4, v5, v6) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+        T6.pp v6
+  end)
+let map_tup7 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) (t6: testable) (t7: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  let module T6 = (val t6) in
+  let module T7 = (val t7) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t * T6.t * T7.t
+    let ding = Data_encoding.tup7 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) (dyn_if_not T5.ding) (dyn_if_not T6.ding) T7.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v, T6.v, T7.v)
+    let pp ppf (v1, v2, v3, v4, v5, v6, v7) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+        T6.pp v6
+        T7.pp v7
+  end)
+let map_tup8 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) (t6: testable) (t7: testable) (t8: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  let module T6 = (val t6) in
+  let module T7 = (val t7) in
+  let module T8 = (val t8) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t * T6.t * T7.t * T8.t
+    let ding = Data_encoding.tup8 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) (dyn_if_not T5.ding) (dyn_if_not T6.ding) (dyn_if_not T7.ding) T8.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v, T6.v, T7.v, T8.v)
+    let pp ppf (v1, v2, v3, v4, v5, v6, v7, v8) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+        T6.pp v6
+        T7.pp v7
+        T8.pp v8
+  end)
+let map_tup9 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) (t6: testable) (t7: testable) (t8: testable) (t9: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  let module T6 = (val t6) in
+  let module T7 = (val t7) in
+  let module T8 = (val t8) in
+  let module T9 = (val t9) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t * T6.t * T7.t * T8.t * T9.t
+    let ding = Data_encoding.tup9 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) (dyn_if_not T5.ding) (dyn_if_not T6.ding) (dyn_if_not T7.ding) (dyn_if_not T8.ding) T9.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v, T6.v, T7.v, T8.v, T9.v)
+    let pp ppf (v1, v2, v3, v4, v5, v6, v7, v8, v9) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+        T6.pp v6
+        T7.pp v7
+        T8.pp v8
+        T9.pp v9
+  end)
+let map_tup10 (t1: testable) (t2: testable) (t3: testable) (t4: testable) (t5: testable) (t6: testable) (t7: testable) (t8: testable) (t9: testable) (t10: testable) : testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  let module T3 = (val t3) in
+  let module T4 = (val t4) in
+  let module T5 = (val t5) in
+  let module T6 = (val t6) in
+  let module T7 = (val t7) in
+  let module T8 = (val t8) in
+  let module T9 = (val t9) in
+  let module T10 = (val t10) in
+  (module struct
+    type t = T1.t * T2.t * T3.t * T4.t * T5.t * T6.t * T7.t * T8.t * T9.t * T10.t
+    let ding = Data_encoding.tup10 (dyn_if_not T1.ding) (dyn_if_not T2.ding) (dyn_if_not T3.ding) (dyn_if_not T4.ding) (dyn_if_not T5.ding) (dyn_if_not T6.ding) (dyn_if_not T7.ding) (dyn_if_not T8.ding) (dyn_if_not T9.ding) T10.ding
+    let v = (T1.v, T2.v, T3.v, T4.v, T5.v, T6.v, T7.v, T8.v, T9.v, T10.v)
+    let pp ppf (v1, v2, v3, v4, v5, v6, v7, v8, v9, v10) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a, %a, %a, %a, %a, %a, %a, %a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+        T3.pp v3
+        T4.pp v4
+        T5.pp v5
+        T6.pp v6
+        T7.pp v7
+        T8.pp v8
+        T9.pp v9
+        T10.pp v10
+  end)
+
+let map_merge_tups (t1: testable) (t2: testable): testable =
+  let module T1 = (val t1) in
+  let module T2 = (val t2) in
+  (module struct
+    type t = T1.t * T2.t
+    let ding = Data_encoding.merge_tups (dyn_if_not T1.ding) (dyn_if_not T2.ding)
+    let v = (T1.v, T2.v)
+    let pp ppf (v1, v2) =
+      Crowbar.pp ppf "@[<hv 1>(%a, %a)@]"
+        T1.pp v1
+        T2.pp v2
+  end)
+
+
+let testable_printer: testable Crowbar.printer = fun ppf (t: testable) ->
+  let module T = (val t) in
+  T.pp ppf T.v
+
+
+(* helpers to construct values tester values *)
+
+
+(* Generator for testable values *)
+
+let tup_gen (tgen: testable Crowbar.gen): testable Crowbar.gen =
+  let open Crowbar in
+  (* Stack overflow if there are more levels *)
+  with_printer testable_printer @@
+  choose [
+    map [tgen] map_tup1;
+    map [tgen; tgen] map_tup2;
+    map [tgen; tgen; tgen] map_tup3;
+    map [tgen; tgen; tgen; tgen] map_tup4;
+    map [tgen; tgen; tgen; tgen; tgen] map_tup5;
+    map [tgen; tgen; tgen; tgen; tgen; tgen] map_tup6;
+  ]
+let gen =
+  let open Crowbar in
+  let g: testable Crowbar.gen = fix (fun g ->
+      choose [
+        const null;
+        const empty;
+        const unit;
+        map [short_string] map_constant;
+        map [int8] map_int8;
+        map [uint8] map_uint8;
+        (* TODO: use newer version of crowbar to get these generators
+              map [int16] map_int16;
+              map [uint16] map_uint16;
+        *)
+        map [int32] map_int32;
+        map [int64] map_int64;
+        (* NOTE: the int encoding require ranges to be 30-bit compatible *)
+        map [int8; int8; int8] map_range_int;
+        map [float; float; float] map_range_float;
+        map [bool] map_bool;
+        map [short_string] map_string;
+        map [short_mbytes] map_bytes;
+        map [float] map_float;
+        map [short_string1] map_fixed_string;
+        map [short_mbytes1] map_fixed_bytes;
+        map [short_string] map_variable_string;
+        map [short_mbytes] map_variable_bytes;
+
+        map [g] map_some;
+        map [g] map_none;
+
+        map [g] map_dynamic_size;
+
+        map [g] map_tup1;
+        map [g; g] map_tup2;
+        map [g; g; g] map_tup3;
+        map [g; g; g; g] map_tup4;
+        map [g; g; g; g; g] map_tup5;
+        map [g; g; g; g; g; g] map_tup6;
+        map [g; g] (fun t1 t2 -> map_merge_tups (map_tup1 t1) (map_tup1 t2));
+        map [g; g; g] (fun t1 t2 t3 -> map_merge_tups (map_tup2 t1 t2) (map_tup1 t3));
+        map [g; g; g] (fun t1 t2 t3 -> map_merge_tups (map_tup1 t1) (map_tup2 t2 t3));
+
+        (* NOTE: we cannot use lists/arrays for now. They require the
+           data-inside to be homogeneous (e.g., same rangedness of ranged
+           numbers) which we cannot guarantee right now. This can be fixed once
+           we update Crowbar and get access to the new `dynamic_bind` generator
+           combinator.
+
+           map [g; list g] map_variable_list;
+           map [g; list g] (fun t ts -> map_variable_array t (Array.of_list ts));
+        *)
+      ])
+  in
+  with_printer testable_printer g
+
+(* TODO: The following features are not yet tested
+   val string_enum : (string * 'a) list -> 'a encoding
+   val delayed : (unit -> 'a encoding) -> 'a encoding
+   val json : json encoding
+   val json_schema : json_schema encoding
+   type 'a field
+   val req :
+   ?title:string -> ?description:string ->
+   string -> 't encoding -> 't field
+   val opt :
+   ?title:string -> ?description:string ->
+   string -> 't encoding -> 't option field
+   val varopt :
+   ?title:string -> ?description:string ->
+   string -> 't encoding -> 't option field
+   val dft :
+   ?title:string -> ?description:string ->
+   string -> 't encoding -> 't -> 't field
+   val obj1 : 'f1 field -> 'f1 encoding
+   val obj2 : 'f1 field -> 'f2 field -> ('f1 * 'f2) encoding
+   val obj3 : 'f1 field -> 'f2 field -> 'f3 field -> ('f1 * 'f2 * 'f3) encoding
+   val obj4 :
+   val obj5 :
+   val obj6 :
+   val obj7 :
+   val obj8 :
+   val obj9 :
+   val obj10 :
+   val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding
+   val array : 'a encoding -> 'a array encoding
+   val list : 'a encoding -> 'a list encoding
+   val assoc : 'a encoding -> (string * 'a) list encoding
+   type 't case
+   type case_tag = Tag of int | Json_only
+   val case : case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
+   val union : ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
+
+*)
+
+
+(* Basic functions for executing tests on a given input *)
+let roundtrip_json pp ding v =
+  let json =
+    try
+      Data_encoding.Json.construct ding v
+    with
+      Invalid_argument m ->
+        Crowbar.fail (Format.asprintf "Cannot construct: %a (%s)" pp v m)
+  in
+  let vv =
+    try
+      Data_encoding.Json.destruct ding json
+    with
+      Data_encoding.Json.Cannot_destruct (_, _) ->
+        Crowbar.fail "Cannot destruct"
+  in
+  Crowbar.check_eq ~pp v vv
+
+let roundtrip_binary pp ding v =
+  let bin =
+    try
+      Data_encoding.Binary.to_bytes_exn ding v
+    with
+    | Data_encoding.Binary.Write_error we ->
+        Format.kasprintf Crowbar.fail
+          "Cannot construct: %a (%a)"
+          pp v
+          Data_encoding.Binary.pp_write_error we
+  in
+  let vv =
+    try
+      Data_encoding.Binary.of_bytes_exn ding bin
+    with
+    | Data_encoding.Binary.Read_error re ->
+        Format.kasprintf Crowbar.fail
+          "Cannot destruct: %a (%a)"
+          pp v
+          Data_encoding.Binary.pp_read_error re
+  in
+  Crowbar.check_eq ~pp v vv
+
+
+
+(* Setting up the actual tests *)
+let test_testable_json (testable: testable) =
+  let module T = (val testable) in
+  roundtrip_json T.pp T.ding T.v
+let test_testable_binary (testable: testable) =
+  let module T = (val testable) in
+  roundtrip_binary T.pp T.ding T.v
+let () =
+  Crowbar.add_test ~name:("binary roundtrips") [gen] test_testable_binary;
+  Crowbar.add_test ~name:("json roundtrips") [gen] test_testable_json;
+  ()
+
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/types.ml b/vendors/tezos-modded/src/lib_data_encoding/test/types.ml
new file mode 100644
index 000000000..03af661b6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/types.ml
@@ -0,0 +1,226 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+type record = {
+  a : int ;
+  b : bool ;
+  c : Z.t option ;
+  d : float ;
+}
+
+let default_record = { a = 32 ; b = true ; c = Some Z.one ; d = 12.34 }
+
+let record_obj_enc =
+  conv
+    (fun { a ; b ; c ; d } -> ((a, b), (c, d)))
+    (fun ((a, b), (c, d)) -> { a ; b ; c ; d })
+    (merge_objs
+       (obj2
+          (req "a" int31)
+          (dft "b" bool false))
+       (obj2
+          (opt "c" z)
+          (req "d" float)))
+
+let record_tup_enc =
+  conv
+    (fun { a ; b ; c ; d } -> ((a, b, c), d))
+    (fun ((a, b, c), d) -> { a ; b ; c ; d })
+    (merge_tups
+       (tup3 int31 bool (option z))
+       (tup1 float))
+
+let record_to_string { a ; b ; c ; d } =
+  let c =
+    match c with
+    | None -> "none"
+    | Some c -> Z.to_string c in
+  Format.asprintf "(%d, %B, %s, %f)" a b c d
+
+type variable_record = {
+  p : int ;
+  q : MBytes.t ;
+}
+
+let default_variable_record = { p = 23 ; q = MBytes.of_string "wwwxxyyzzz" }
+
+let variable_record_obj_enc =
+  conv
+    (fun { p ; q } -> (p, q))
+    (fun (p, q) -> { p ; q })
+    (obj2
+       (req "p" int31)
+       (req "q" Variable.bytes))
+
+let variable_record_tup_enc =
+  conv
+    (fun { p ; q } -> (p, q))
+    (fun (p, q) -> { p ; q })
+    (tup2 int31 Variable.bytes)
+
+let variable_record_to_string { p ; q } =
+  Format.asprintf "(%d, %a)" p MBytes.pp_hex q
+
+type variable_left_record = {
+  x : int ;
+  y : MBytes.t ;
+  z : int ;
+}
+
+let default_variable_left_record =
+  { x = 98 ; y = MBytes.of_string "765" ; z = 4321 }
+
+let variable_left_record_obj_enc =
+  conv
+    (fun { x ; y ; z } -> (x, y, z))
+    (fun (x, y, z) -> { x ; y ; z })
+    (obj3
+       (req "x" int31)
+       (req "y" Variable.bytes)
+       (req "z" int31))
+
+let variable_left_record_tup_enc =
+  conv
+    (fun { x ; y ; z } -> (x, y, z))
+    (fun (x, y, z) -> { x ; y ; z })
+    (tup3 int31 Variable.bytes int31)
+
+let variable_left_record_to_string { x ; y ; z } =
+  Format.asprintf "(%d, %a, %d)" x MBytes.pp_hex y z
+
+type union = A of int | B of string | C of int | D of string | E
+
+let union_enc =
+  union [
+    case (Tag 1)
+      ~title:"A"
+      int8
+      (function A i -> Some i | _ -> None)
+      (fun i -> A i) ;
+    case (Tag 2)
+      ~title:"B"
+      string
+      (function B s -> Some s | _ -> None)
+      (fun s -> B s) ;
+    case (Tag 3)
+      ~title:"C"
+      (obj1 (req "C" int8))
+      (function C i -> Some i | _ -> None)
+      (fun i -> C i) ;
+    case (Tag 4)
+      ~title:"D"
+      (obj2
+         (req "kind" (constant "D"))
+         (req "data" (string)))
+      (function D s -> Some ((), s) | _ -> None)
+      (fun ((), s) -> D s) ;
+    case (Tag 5)
+      ~title:"E"
+      empty
+      (function E -> Some () | _ -> None)
+      (fun () -> E) ;
+  ]
+
+let mini_union_enc =
+  union [
+    case (Tag 1)
+      ~title:"A"
+      int8
+      (function A i -> Some i | _ -> None)
+      (fun i -> A i) ;
+  ]
+
+let union_to_string = function
+  | A i -> Printf.sprintf "A %d" i
+  | B s -> Printf.sprintf "B %s" s
+  | C i -> Printf.sprintf "C %d" i
+  | D s -> Printf.sprintf "D %s" s
+  | E -> "E"
+
+let enum_enc =
+  string_enum
+    [ "one", 1 ; "two", 2 ; "three", 3 ; "four", 4 ; "five", 5 ; "six", 6 ]
+
+let mini_enum_enc =
+  string_enum
+    [ "one", 1 ; "two", 2 ]
+
+let mu_list_enc enc =
+  mu "list" @@ fun mu_list_enc ->
+  union [
+    case (Tag 0)
+      ~title:"Nil"
+      empty
+      (function [] -> Some () | _ :: _ -> None)
+      (fun () -> []) ;
+    case (Tag 1)
+      ~title:"Cons"
+      (obj2
+         (req "value" enc)
+         (req "next" mu_list_enc))
+      (function x :: xs -> Some (x, xs) | [] -> None)
+      (fun (x, xs) -> x :: xs) ;
+  ]
+
+let bounded_list ~total ~elements enc =
+  check_size total (Variable.list (check_size elements enc))
+
+module Alcotest = struct
+  include Alcotest
+  let float =
+    testable
+      Fmt.float
+      (fun f1 f2 ->
+         match classify_float f1, classify_float f2 with
+         | FP_nan, FP_nan -> true
+         | _ -> f1 = f2)
+  let bytes =
+    testable
+      (Fmt.of_to_string (fun s -> let `Hex s = MBytes.to_hex s in s))
+      MBytes.equal
+  let z =
+    testable
+      (Fmt.of_to_string Z.to_string)
+      Z.equal
+  let n = z
+  let record =
+    testable
+      (Fmt.of_to_string record_to_string)
+      (=)
+  let variable_record =
+    testable
+      (Fmt.of_to_string variable_record_to_string)
+      (=)
+  let variable_left_record =
+    testable
+      (Fmt.of_to_string variable_left_record_to_string)
+      (=)
+  let union =
+    testable
+      (Fmt.of_to_string union_to_string)
+      (=)
+end
diff --git a/vendors/tezos-modded/src/lib_data_encoding/test/write_failure.ml b/vendors/tezos-modded/src/lib_data_encoding/test/write_failure.ml
new file mode 100644
index 000000000..69178b85c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/test/write_failure.ml
@@ -0,0 +1,101 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Test expected errors while serializing data. *)
+
+open Data_encoding
+open Types
+
+let check_raises expected f =
+  match f () with
+  | exception exn when expected exn -> ()
+  | exception exn ->
+      Alcotest.failf "Unexpected exception: %s." (Printexc.to_string exn)
+  | _ -> Alcotest.failf "Expecting exception, got success."
+
+let json ?(expected = fun _ -> true) encoding value () =
+  check_raises expected begin fun () ->
+    ignore (Json.construct encoding value : Json.t) ;
+  end
+
+let bson ?(expected = fun _ -> true) encoding value () =
+  check_raises expected begin fun () ->
+    ignore (Bson.construct encoding value : Bson.t) ;
+  end
+
+let binary ?(expected = fun _ -> true) encoding value () =
+  check_raises expected begin fun () ->
+    ignore (Binary.to_bytes_exn encoding value : MBytes.t) ;
+  end
+
+let all name encoding value =
+  [ name ^ ".json", `Quick, json encoding value ;
+    name ^ ".bson", `Quick, bson encoding value ;
+    name ^ ".bytes", `Quick, binary encoding value ]
+
+let all_ranged_int minimum maximum =
+  let encoding = ranged_int minimum maximum in
+  let name = Format.asprintf "ranged_int.%d" minimum in
+  all (name ^ ".min") encoding (minimum - 1) @
+  all (name ^ ".max") encoding (maximum + 1)
+
+let all_ranged_float minimum maximum =
+  let encoding = ranged_float minimum maximum in
+  let name = Format.asprintf "ranged_float.%f" minimum in
+  all (name ^ ".min") encoding (minimum -. 1.) @
+  all (name ^ ".max") encoding (maximum +. 1.)
+
+let test_bounded_string_list =
+  let expected = function
+    | Binary_error.Write_error Size_limit_exceeded -> true
+    | _ -> false in
+  let test name ~total ~elements v =
+    "bounded_string_list." ^ name, `Quick,
+    binary ~expected (bounded_list ~total ~elements string) v in
+  [ test "a" ~total:0 ~elements:0 [""] ;
+    test "b1" ~total:3 ~elements:4 [""] ;
+    test "b2" ~total:4 ~elements:3 [""] ;
+    test "c1" ~total:19 ~elements:4 ["";"";"";"";""] ;
+    test "c2" ~total:20 ~elements:3 ["";"";"";"";""] ;
+    test "d1" ~total:20 ~elements:5 ["";"";"";"";"a"] ;
+    test "d2" ~total:21 ~elements:4 ["";"";"";"";"a"] ;
+    test "e" ~total:30 ~elements:10 ["ab";"c";"def";"gh";"ijk"] ;
+  ]
+
+let tests =
+  all_ranged_int 100 400 @
+  all_ranged_int 19000 19254 @
+  all_ranged_int ~-100 300 @
+  all_ranged_int ~-300_000_000 300_000_000 @
+  all_ranged_float ~-. 100. 300. @
+  all "string.fixed" (Fixed.string 4) "turlututu" @
+  all "string.bounded" (Bounded.string 4) "turlututu" @
+  all "bytes.fixed" (Fixed.bytes 4) (MBytes.of_string "turlututu") @
+  all "bytes.bounded" (Bounded.bytes 4) (MBytes.of_string "turlututu") @
+  all "unknown_case.B" mini_union_enc (B "2") @
+  all "unknown_case.E" mini_union_enc E @
+  test_bounded_string_list @
+  all "n" n (Z.of_string "-12") @
+  []
diff --git a/vendors/tezos-modded/src/lib_data_encoding/tezos-data-encoding.opam b/vendors/tezos-modded/src/lib_data_encoding/tezos-data-encoding.opam
new file mode 100644
index 000000000..fd585a55d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_data_encoding/tezos-data-encoding.opam
@@ -0,0 +1,24 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib"
+  "ezjsonm"
+  "ocplib-json-typed"
+  "ocplib-json-typed-bson"
+  "ocplib-endian"
+  "alcotest" { with-test }
+  "crowbar" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_error_monad/dune b/vendors/tezos-modded/src/lib_error_monad/dune
new file mode 100644
index 000000000..edb4cccdf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_error_monad/dune
@@ -0,0 +1,14 @@
+(library
+ (name tezos_error_monad)
+ (public_name tezos-error-monad)
+ (flags (:standard -open Tezos_stdlib
+                   -open Tezos_data_encoding
+                   -safe-string))
+ (libraries tezos-stdlib
+            tezos-data-encoding
+            lwt))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_error_monad/error_monad.ml b/vendors/tezos-modded/src/lib_error_monad/error_monad.ml
new file mode 100644
index 000000000..08e3fd437
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_error_monad/error_monad.ml
@@ -0,0 +1,745 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Error Monad *)
+
+(*-- Error classification ----------------------------------------------------*)
+
+type error_category = [ `Branch | `Temporary | `Permanent ]
+
+(* hack: forward reference from [Data_encoding_ezjsonm] *)
+let json_to_string = ref (fun _ -> "")
+
+let json_pp id encoding ppf x =
+  Format.pp_print_string ppf @@
+  !json_to_string @@
+  let encoding =
+    Data_encoding.(merge_objs (obj1 (req "id" string)) encoding) in
+  Data_encoding.Json.construct encoding (id, x)
+
+let set_error_encoding_cache_dirty = ref (fun () -> ())
+
+module Make(Prefix : sig val id : string end) = struct
+
+  type error = ..
+
+  module type Wrapped_error_monad = sig
+    type unwrapped = ..
+    include Error_monad_sig.S with type error := unwrapped
+    val unwrap : error -> unwrapped option
+    val wrap : unwrapped -> error
+  end
+
+  type full_error_category =
+    | Main of error_category
+    | Wrapped of (module Wrapped_error_monad)
+
+  (* the toplevel store for error kinds *)
+  type error_kind =
+      Error_kind :
+        { id: string ;
+          title: string ;
+          description: string ;
+          from_error: error -> 'err option ;
+          category: full_error_category ;
+          encoding_case: error Data_encoding.case ;
+          pp: Format.formatter -> 'err -> unit ; } ->
+      error_kind
+
+  type error_info =
+    { category : error_category ;
+      id: string ;
+      title : string ;
+      description : string ;
+      schema : Data_encoding.json_schema }
+
+  let error_kinds
+    : error_kind list ref
+    = ref []
+
+  let get_registered_errors () : error_info list =
+    List.flatten
+      (List.map
+         (function
+           | Error_kind { id = "" ; _ } -> []
+           | Error_kind { id ; title ; description ; category = Main category ; encoding_case ; _ } ->
+               [ { id ; title ; description ; category ;
+                   schema = Data_encoding.Json.schema (Data_encoding.union [ encoding_case ]) } ]
+           | Error_kind { category = Wrapped (module WEM) ; _ } ->
+               List.map
+                 (fun { WEM.id ; title ; description ; category ; schema } ->
+                    { id ; title ; description ; category ; schema })
+                 (WEM.get_registered_errors ()))
+         !error_kinds)
+
+  let error_encoding_cache = ref None
+  let () =
+    let cont = !set_error_encoding_cache_dirty in
+    set_error_encoding_cache_dirty := fun () ->
+      cont () ;
+      error_encoding_cache := None
+
+  let string_of_category = function
+    | `Permanent -> "permanent"
+    | `Temporary -> "temporary"
+    | `Branch -> "branch"
+
+  let pp_info
+      ppf
+      { category; id; title; description; schema } =
+    Format.fprintf
+      ppf
+      "@[<v 2>category : %s\nid : %s\ntitle : %s\ndescription : %s\nschema : %a@]"
+      (string_of_category category)
+      id title description
+      (Json_repr.pp (module Json_repr.Ezjsonm))
+      (Json_schema.to_json schema)
+
+  (* Catch all error when 'serializing' an error. *)
+  type error += Unclassified of string
+
+  let () =
+    let id = "" in
+    let category = Main `Temporary in
+    let to_error msg = Unclassified msg in
+    let from_error = function
+      | Unclassified msg -> Some msg
+      | error ->
+          let msg = Obj.(extension_name @@ extension_constructor error) in
+          Some ("Unclassified error: " ^ msg ^ ". Was the error registered?") in
+    let title = "Generic error" in
+    let description =  "An unclassified error" in
+    let encoding_case =
+      let open Data_encoding in
+      case Json_only
+        ~title:"Generic error"
+        (def "generic_error" ~title ~description @@
+         conv (fun x -> ((), x)) (fun ((), x) -> x) @@
+         (obj2
+            (req "kind" (constant "generic"))
+            (req "error" string)))
+        from_error to_error in
+    let pp ppf s = Format.fprintf ppf "@[<h 0>%a@]" Format.pp_print_text s in
+    error_kinds :=
+      Error_kind { id ; title ; description ;
+                   from_error ; category ; encoding_case ; pp } :: !error_kinds
+
+  (* Catch all error when 'deserializing' an error. *)
+  type error += Unregistred_error of Data_encoding.json
+
+  let () =
+    let id = "" in
+    let category = Main `Temporary in
+    let to_error msg = Unregistred_error msg in
+    let from_error = function
+      | Unregistred_error json -> Some json
+      | _ -> None in
+    let encoding_case =
+      let open Data_encoding in
+      case Json_only
+        ~title:"Unregistred error"
+        json from_error to_error in
+    let pp ppf json =
+      Format.fprintf ppf "@[<v 2>Unregistred error:@ %a@]"
+        Data_encoding.Json.pp json in
+    error_kinds :=
+      Error_kind { id ; title = "" ; description = "" ;
+                   from_error ; category ; encoding_case ; pp } :: !error_kinds
+
+  let raw_register_error_kind
+      category ~id:name ~title ~description ?pp
+      encoding from_error to_error =
+    let name = Prefix.id ^ name in
+    if List.exists
+        (fun (Error_kind { id ; _ }) -> name = id)
+        !error_kinds then
+      invalid_arg
+        (Printf.sprintf
+           "register_error_kind: duplicate error name: %s" name) ;
+    let encoding_case =
+      let open Data_encoding in
+      match category with
+      | Wrapped (module WEM) ->
+          let unwrap err =
+            match WEM.unwrap err with
+            | Some (WEM.Unclassified _) -> None
+            | Some (WEM.Unregistred_error _) ->
+                Format.eprintf "What %s@." name ;
+                None
+            | res -> res in
+          let wrap err =
+            match err with
+            | WEM.Unclassified _ ->
+                failwith "ignore wrapped error when serializing"
+            | WEM.Unregistred_error _ ->
+                failwith "ignore wrapped error when deserializing"
+            | res -> WEM.wrap res in
+          case Json_only
+            ~title:name
+            WEM.error_encoding unwrap wrap
+      | Main category ->
+          let with_id_and_kind_encoding =
+            merge_objs
+              (obj2
+                 (req "kind" (constant (string_of_category category)))
+                 (req "id" (constant name)))
+              encoding in
+          case Json_only
+            ~title
+            ~description
+            (conv
+               (fun x -> (((), ()), x))
+               (fun (((),()), x) -> x)
+               with_id_and_kind_encoding)
+            from_error to_error in
+    !set_error_encoding_cache_dirty () ;
+    error_kinds :=
+      Error_kind
+        { id = name ;
+          category ;
+          title ;
+          description ;
+          from_error ;
+          encoding_case ;
+          pp = Option.unopt ~default:(json_pp name encoding) pp }
+      :: !error_kinds
+
+  let register_wrapped_error_kind
+      (module WEM : Wrapped_error_monad) ~id ~title ~description =
+    raw_register_error_kind
+      (Wrapped (module WEM))
+      ~id ~title ~description
+      ~pp:WEM.pp WEM.error_encoding WEM.unwrap WEM.wrap
+
+  let register_error_kind
+      category ~id ~title ~description ?pp
+      encoding from_error to_error =
+    if not (Data_encoding.is_obj encoding)
+    then invalid_arg
+        (Printf.sprintf
+           "Specified encoding for \"%s%s\" is not an object, but error encodings must be objects."
+           Prefix.id id) ;
+    raw_register_error_kind
+      (Main category)
+      ~id ~title ~description ?pp
+      encoding from_error to_error
+
+  let error_encoding () =
+    match !error_encoding_cache with
+    | None ->
+        let cases =
+          List.map
+            (fun (Error_kind { encoding_case ; _ }) -> encoding_case)
+            !error_kinds in
+        let json_encoding = Data_encoding.union cases in
+        let encoding =
+          Data_encoding.dynamic_size @@
+          Data_encoding.splitted
+            ~json:json_encoding
+            ~binary:
+              (Data_encoding.conv
+                 (Data_encoding.Json.construct json_encoding)
+                 (Data_encoding.Json.destruct json_encoding)
+                 Data_encoding.json) in
+        error_encoding_cache := Some encoding ;
+        encoding
+    | Some encoding -> encoding
+
+  let error_encoding = Data_encoding.delayed error_encoding
+
+  let json_of_error error =
+    Data_encoding.Json.construct error_encoding error
+  let error_of_json json =
+    Data_encoding.Json.destruct error_encoding json
+
+  let classify_error error =
+    let rec find e = function
+      | [] -> `Temporary
+      (* assert false (\* See "Generic error" *\) *)
+      | Error_kind { from_error ; category ; _ } :: rest ->
+          match from_error e with
+          | Some _ -> begin
+              match category with
+              | Main error_category -> error_category
+              | Wrapped (module WEM) ->
+                  match WEM.unwrap e with
+                  | Some e -> WEM.classify_errors [ e ]
+                  | None -> find e rest
+            end
+          | None -> find e rest in
+    find error !error_kinds
+
+  let classify_errors errors =
+    List.fold_left
+      (fun r e -> match r, classify_error e with
+         | `Permanent, _ | _, `Permanent -> `Permanent
+         | `Branch, _ | _, `Branch -> `Branch
+         | `Temporary, `Temporary -> `Temporary)
+      `Temporary errors
+
+  let pp ppf error =
+    let rec find = function
+      | [] -> assert false (* See "Generic error" *)
+      | Error_kind { from_error ; pp ; _ } :: errors ->
+          match from_error error with
+          | None -> find errors
+          | Some x -> pp ppf x in
+    find !error_kinds
+
+  (*-- Monad definition --------------------------------------------------------*)
+
+  let (>>=) = Lwt.(>>=)
+
+  type 'a tzresult = ('a, error list) result
+
+  let result_encoding t_encoding =
+    let open Data_encoding in
+    let errors_encoding =
+      obj1 (req "error" (list error_encoding)) in
+    let t_encoding =
+      obj1 (req "result" t_encoding) in
+    union
+      ~tag_size:`Uint8
+      [ case (Tag 0) t_encoding
+          ~title:"Ok"
+          (function Ok x -> Some x | _ -> None)
+          (function res -> Ok res) ;
+        case (Tag 1) errors_encoding
+          ~title:"Error"
+          (function Error x -> Some x | _ -> None)
+          (fun errs -> Error errs) ]
+
+  let return v = Lwt.return (Ok v)
+
+  let return_unit = Lwt.return (Ok ())
+
+  let return_none = Lwt.return (Ok None)
+
+  let return_some x = Lwt.return (Ok (Some x))
+
+  let return_nil = Lwt.return (Ok [])
+
+  let return_true = Lwt.return (Ok true)
+
+  let return_false = Lwt.return (Ok false)
+
+  let error s = Error [ s ]
+
+  let ok v = Ok v
+
+  let fail s = Lwt.return (Error [ s ])
+
+  let (>>?) v f =
+    match v with
+    | Error _ as err -> err
+    | Ok v -> f v
+
+  let (>>=?) v f =
+    v >>= function
+    | Error _ as err -> Lwt.return err
+    | Ok v -> f v
+
+  let (>>|?) v f = v >>=? fun v -> Lwt.return (Ok (f v))
+  let (>|=) = Lwt.(>|=)
+
+  let (>|?) v f = v >>? fun v -> Ok (f v)
+
+  let rec map_s f l =
+    match l with
+    | [] -> return_nil
+    | h :: t ->
+        f h >>=? fun rh ->
+        map_s f t >>=? fun rt ->
+        return (rh :: rt)
+
+  let mapi_s f l =
+    let rec mapi_s f i l =
+      match l with
+      | [] -> return_nil
+      | h :: t ->
+          f i h >>=? fun rh ->
+          mapi_s f (i+1) t >>=? fun rt ->
+          return (rh :: rt)
+    in
+    mapi_s f 0 l
+
+  let rec map_p f l =
+    match l with
+    | [] ->
+        return_nil
+    | x :: l ->
+        let tx = f x and tl = map_p f l in
+        tx >>= fun x ->
+        tl >>= fun l ->
+        match x, l with
+        | Ok x, Ok l -> Lwt.return (Ok (x :: l))
+        | Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
+        | Ok _, Error exn
+        | Error exn, Ok _ -> Lwt.return (Error exn)
+
+  let mapi_p f l =
+    let rec mapi_p f i l =
+      match l with
+      | [] ->
+          return_nil
+      | x :: l ->
+          let tx = f i x and tl = mapi_p f (i+1) l in
+          tx >>= fun x ->
+          tl >>= fun l ->
+          match x, l with
+          | Ok x, Ok l -> Lwt.return (Ok (x :: l))
+          | Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
+          | Ok _, Error exn
+          | Error exn, Ok _ -> Lwt.return (Error exn) in
+    mapi_p f 0 l
+
+  let rec map2_s f l1 l2 =
+    match l1, l2 with
+    | [], [] -> return_nil
+    | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.map2_s"
+    | h1 :: t1, h2 :: t2 ->
+        f h1 h2 >>=? fun rh ->
+        map2_s f t1 t2 >>=? fun rt ->
+        return (rh :: rt)
+
+  let mapi2_s f l1 l2 =
+    let rec mapi2_s i f l1 l2 =
+      match l1, l2 with
+      | [], [] -> return_nil
+      | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.mapi2_s"
+      | h1 :: t1, h2 :: t2 ->
+          f i h1 h2 >>=? fun rh ->
+          mapi2_s (i+1) f t1 t2 >>=? fun rt ->
+          return (rh :: rt) in
+    mapi2_s 0 f l1 l2
+
+  let rec map2 f l1 l2 =
+    match l1, l2 with
+    | [], [] -> Ok []
+    | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.map2"
+    | h1 :: t1, h2 :: t2 ->
+        f h1 h2 >>? fun rh ->
+        map2 f t1 t2 >>? fun rt ->
+        Ok (rh :: rt)
+
+  let rec filter_map_s f l =
+    match l with
+    | [] -> return_nil
+    | h :: t ->
+        f h >>=? function
+        | None -> filter_map_s f t
+        | Some rh ->
+            filter_map_s f t >>=? fun rt ->
+            return (rh :: rt)
+
+  let rec filter_map_p f l =
+    match l with
+    | [] -> return_nil
+    | h :: t ->
+        let th = f h
+        and tt = filter_map_p f t in
+        th >>=? function
+        | None -> tt
+        | Some rh ->
+            tt >>=? fun rt ->
+            return (rh :: rt)
+
+  let rec filter_s f l =
+    match l with
+    | [] -> return_nil
+    | h :: t ->
+        f h >>=? function
+        | false -> filter_s f t
+        | true ->
+            filter_s f t >>=? fun t ->
+            return (h :: t)
+
+  let rec filter_p f l =
+    match l with
+    | [] -> return_nil
+    | h :: t ->
+        let jh = f h
+        and t = filter_p f t in
+        jh >>=? function
+        | false -> t
+        | true ->
+            t >>=? fun t ->
+            return (h :: t)
+
+  let rec iter_s f l =
+    match l with
+    | [] -> return_unit
+    | h :: t ->
+        f h >>=? fun () ->
+        iter_s f t
+
+  let rec iter_p f l =
+    match l with
+    | [] -> return_unit
+    | x :: l ->
+        let tx = f x and tl = iter_p f l in
+        tx >>= fun tx_res ->
+        tl >>= fun tl_res ->
+        match tx_res, tl_res with
+        | Ok (), Ok () -> Lwt.return (Ok ())
+        | Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
+        | Ok (), Error exn
+        | Error exn, Ok () -> Lwt.return (Error exn)
+
+  let rec iter2_p f l1 l2 =
+    match l1, l2 with
+    | [], [] -> return_unit
+    | [], _ | _, [] -> invalid_arg "Error_monad.iter2_p"
+    | x1 :: l1 , x2 :: l2 ->
+        let tx = f x1 x2 and tl = iter2_p f l1 l2 in
+        tx >>= fun tx_res ->
+        tl >>= fun tl_res ->
+        match tx_res, tl_res with
+        | Ok (), Ok () -> Lwt.return (Ok ())
+        | Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
+        | Ok (), Error exn
+        | Error exn, Ok () -> Lwt.return (Error exn)
+
+  let iteri2_p f l1 l2 =
+    let rec iteri2_p i f l1 l2 =
+      match l1, l2 with
+      | [], [] -> return_unit
+      | [], _ | _, [] -> invalid_arg "Error_monad.iteri2_p"
+      | x1 :: l1 , x2 :: l2 ->
+          let tx = f i x1 x2 and tl = iteri2_p (i+1) f l1 l2 in
+          tx >>= fun tx_res ->
+          tl >>= fun tl_res ->
+          match tx_res, tl_res with
+          | Ok (), Ok () -> Lwt.return (Ok ())
+          | Error exn1, Error exn2 -> Lwt.return (Error (exn1 @ exn2))
+          | Ok (), Error exn
+          | Error exn, Ok () -> Lwt.return (Error exn)
+    in
+    iteri2_p 0 f l1 l2
+
+  let rec fold_left_s f init l =
+    match l with
+    | [] -> return init
+    | h :: t ->
+        f init h >>=? fun acc ->
+        fold_left_s f acc t
+
+  let rec fold_right_s f l init =
+    match l with
+    | [] -> return init
+    | h :: t ->
+        fold_right_s f t init >>=? fun acc ->
+        f h acc
+
+  let rec join = function
+    | [] -> return_unit
+    | t :: ts ->
+        t >>= function
+        | Error _ as err ->
+            join ts >>=? fun () ->
+            Lwt.return err
+        | Ok () ->
+            join ts
+
+  let record_trace err result =
+    match result with
+    | Ok _ as res -> res
+    | Error errs -> Error (err :: errs)
+
+  let trace err f =
+    f >>= function
+    | Error errs -> Lwt.return (Error (err :: errs))
+    | ok -> Lwt.return ok
+
+  let record_trace_eval mk_err result =
+    match result with
+    | Ok _ as res -> res
+    | Error errs ->
+        mk_err () >>? fun err ->
+        Error (err :: errs)
+
+  let trace_eval mk_err f =
+    f >>= function
+    | Error errs ->
+        mk_err () >>=? fun err ->
+        Lwt.return (Error (err :: errs))
+    | ok -> Lwt.return ok
+
+  let fail_unless cond exn =
+    if cond then return_unit else fail exn
+
+  let fail_when cond exn =
+    if cond then fail exn else return_unit
+
+  let unless cond f =
+    if cond then return_unit else f ()
+
+  let _when cond f =
+    if cond then f () else return_unit
+
+  let pp_print_error ppf errors =
+    match errors with
+    | [] ->
+        Format.fprintf ppf "Unknown error@."
+    | [error] ->
+        Format.fprintf ppf "@[<v 2>Error:@ %a@]@." pp error
+    | errors ->
+        Format.fprintf ppf "@[<v 2>Error, dumping error stack:@,%a@]@."
+          (Format.pp_print_list pp)
+          (List.rev errors)
+
+  type error += Assert_error of string * string
+
+  let () =
+    let id = "" in
+    let category = Main `Permanent in
+    let to_error (loc, msg) = Assert_error (loc, msg) in
+    let from_error = function
+      | Assert_error (loc, msg) -> Some (loc, msg)
+      | _ -> None in
+    let title = "Assertion error" in
+    let description =  "An fatal assertion" in
+    let encoding_case =
+      let open Data_encoding in
+      case Json_only ~title ~description
+        (conv (fun (x, y) -> ((), x, y)) (fun ((), x, y) -> (x, y))
+           ((obj3
+               (req "kind" (constant "assertion"))
+               (req "location" string)
+               (req "error" string))))
+        from_error to_error in
+    let pp ppf (loc, msg) =
+      Format.fprintf ppf
+        "Assert failure (%s)%s"
+        loc
+        (if msg = "" then "." else ": " ^ msg) in
+    error_kinds :=
+      Error_kind { id ; title ; description ;
+                   from_error ; category ; encoding_case ; pp } :: !error_kinds
+
+  let _assert b loc fmt =
+    if b then
+      Format.ikfprintf (fun _ -> return_unit) Format.str_formatter fmt
+    else
+      Format.kasprintf (fun msg -> fail (Assert_error (loc, msg))) fmt
+
+
+  type 'a tzlazy_state =
+    | Remembered of 'a
+    | Not_yet_known of (unit -> 'a tzresult Lwt.t)
+  type 'a tzlazy = { mutable tzcontents: 'a tzlazy_state }
+  let tzlazy c = { tzcontents = Not_yet_known c }
+  let tzforce v = match v.tzcontents with
+    | Remembered v -> return v
+    | Not_yet_known c ->
+        c () >>=? fun w ->
+        v.tzcontents <- Remembered w;
+        return w
+
+
+end
+
+include Make(struct let id = "" end)
+
+let generic_error fmt =
+  Format.kasprintf (fun s -> error (Unclassified s)) fmt
+
+let failwith fmt =
+  Format.kasprintf (fun s -> fail (Unclassified s)) fmt
+
+type error += Exn of exn
+let error s = Error [ s ]
+let error_exn s = Error [ Exn s ]
+let trace_exn exn f = trace (Exn exn) f
+let generic_trace fmt =
+  Format.kasprintf (fun str -> trace_exn (Failure str)) fmt
+let record_trace_exn exn f = record_trace (Exn exn) f
+
+let failure fmt =
+  Format.kasprintf (fun str -> Exn (Failure str)) fmt
+
+let pp_exn ppf exn = pp ppf (Exn exn)
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"failure"
+    ~title:"Generic error"
+    ~description:"Unclassified error"
+    ~pp:(fun ppf s -> Format.fprintf ppf "@[<h 0>%a@]" Format.pp_print_text s)
+    Data_encoding.(obj1 (req "msg" string))
+    (function
+      | Exn (Failure msg) -> Some msg
+      | Exn exn -> Some (Printexc.to_string exn)
+      | _ -> None)
+    (fun msg -> Exn (Failure msg))
+
+type error += Canceled
+
+let protect ?on_error ?canceler t =
+  let cancelation =
+    match canceler with
+    | None -> Lwt_utils.never_ending ()
+    | Some canceler ->
+        (Lwt_canceler.cancelation canceler >>= fun () ->
+         fail Canceled ) in
+  let res =
+    Lwt.pick [ cancelation ;
+               Lwt.catch t (fun exn -> fail (Exn exn)) ] in
+  res >>= function
+  | Ok _ -> res
+  | Error err ->
+      let canceled =
+        Option.unopt_map canceler ~default:false ~f:Lwt_canceler.canceled in
+      let err = if canceled then [Canceled] else err in
+      match on_error with
+      | None -> Lwt.return (Error err)
+      | Some on_error ->
+          Lwt.catch (fun () -> on_error err) (fun exn -> fail (Exn exn))
+
+type error += Timeout
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"utils.Timeout"
+    ~title:"Timeout"
+    ~description:"Timeout"
+    Data_encoding.unit
+    (function Timeout -> Some () | _ -> None)
+    (fun () -> Timeout)
+
+let with_timeout ?(canceler = Lwt_canceler.create ()) timeout f =
+  let target = f canceler in
+  Lwt.choose [ timeout ; (target >|= fun _ -> ()) ] >>= fun () ->
+  if Lwt.state target <> Lwt.Sleep then begin
+    Lwt.cancel timeout ;
+    target
+  end else begin
+    Lwt_canceler.cancel canceler >>= fun () ->
+    fail Timeout
+  end
+
+let errs_tag = Tag.def ~doc:"Errors" "errs" pp_print_error
diff --git a/vendors/tezos-modded/src/lib_error_monad/error_monad.mli b/vendors/tezos-modded/src/lib_error_monad/error_monad.mli
new file mode 100644
index 000000000..1a73f5f46
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_error_monad/error_monad.mli
@@ -0,0 +1,101 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Error Monad *)
+
+(** Categories of error *)
+type error_category =
+  [ `Branch (** Errors that may not happen in another context *)
+  | `Temporary (** Errors that may not happen in a later context *)
+  | `Permanent (** Errors that will happen no matter the context *)
+  ]
+
+include Error_monad_sig.S
+
+module type Wrapped_error_monad = sig
+  type unwrapped = ..
+  include Error_monad_sig.S with type error := unwrapped
+  val unwrap : error -> unwrapped option
+  val wrap : unwrapped -> error
+end
+
+val register_wrapped_error_kind :
+  (module Wrapped_error_monad) ->
+  id:string -> title:string -> description:string ->
+  unit
+
+(** Erroneous result (shortcut for generic errors) *)
+val generic_error :
+  ('a, Format.formatter, unit, 'b tzresult) format4 ->
+  'a
+
+(** Erroneous return (shortcut for generic errors) *)
+val failwith :
+  ('a, Format.formatter, unit, 'b tzresult Lwt.t) format4 ->
+  'a
+
+val error_exn : exn -> 'a tzresult
+val record_trace_exn : exn -> 'a tzresult -> 'a tzresult
+val trace_exn : exn -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
+val generic_trace :
+  ('a, Format.formatter, unit,
+   ('b, error list) result Lwt.t -> ('b, error list) result Lwt.t) format4 -> 'a
+val pp_exn : Format.formatter -> exn -> unit
+
+val failure : ('a, Format.formatter, unit, error) format4 -> 'a
+
+(** Wrapped OCaml/Lwt exception *)
+type error += Exn of exn
+
+type error += Canceled
+
+(** [protect] is a wrapper around [Lwt.catch] where the error handler operates
+    over `error list` instead of `exn`. Besides, [protect ~on_error ~canceler ~f]
+    may *cancel* [f] via a [Lwt_canceler.t].
+
+    More precisely, [protect ~on_error ~canceler f] runs [f ()]. An Lwt failure
+    triggered by [f ()] is wrapped into an [Exn]. If a [canceler] is given and
+    [Lwt_canceler.cancelation canceler] is determined before [f ()],
+    a [Canceled] error is returned.
+
+    Errors are caught by [~on_error] (if given), otherwise the previous value
+    is returned. An Lwt failure triggered by [~on_error] is wrapped into an
+    [Exn] *)
+val protect :
+  ?on_error:(error list -> 'a tzresult Lwt.t) ->
+  ?canceler:Lwt_canceler.t ->
+  (unit -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
+
+type error += Timeout
+val with_timeout:
+  ?canceler:Lwt_canceler.t ->
+  unit Lwt.t -> (Lwt_canceler.t -> 'a tzresult Lwt.t) -> 'a tzresult Lwt.t
+
+module Make(Prefix : sig val id : string end) : Error_monad_sig.S
+
+(**/**)
+val json_to_string : (Data_encoding.json -> string) ref
+
+val errs_tag : error list Tag.def
diff --git a/vendors/tezos-modded/src/lib_error_monad/error_monad_sig.ml b/vendors/tezos-modded/src/lib_error_monad/error_monad_sig.ml
new file mode 100644
index 000000000..63f788cce
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_error_monad/error_monad_sig.ml
@@ -0,0 +1,235 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Categories of error *)
+type error_category =
+  [ `Branch (** Errors that may not happen in another context *)
+  | `Temporary (** Errors that may not happen in a later context *)
+  | `Permanent (** Errors that will happen no matter the context *)
+  ]
+
+module type S = sig
+
+  type error = ..
+
+  (** Catch all error when 'serializing' an error. *)
+  type error += private Unclassified of string
+  (** Catch all error when 'deserializing' an error. *)
+  type error += private Unregistred_error of Data_encoding.json
+
+  val pp: Format.formatter -> error -> unit
+  val pp_print_error: Format.formatter -> error list -> unit
+
+  (** An error serializer *)
+  val error_encoding : error Data_encoding.t
+  val json_of_error : error -> Data_encoding.json
+  val error_of_json : Data_encoding.json -> error
+
+  (** {2 Error documentation} ************************************************)
+
+  (** Error information *)
+  type error_info =
+    { category : error_category ;
+      id : string ;
+      title : string ;
+      description : string ;
+      schema : Data_encoding.json_schema }
+
+  val pp_info: Format.formatter -> error_info -> unit
+
+  (** Retrieves information of registered errors *)
+  val get_registered_errors : unit -> error_info list
+
+  (** {2 Error classification} ***********************************************)
+
+  (** The error data type is extensible. Each module can register specialized
+      error serializers
+      [id] unique name of this error. Ex.: overflow_time_counter
+      [title] more readable name. Ex.: Overflow of time counter
+      [description] human readable description. Ex.: The time counter overflowed while computing delta increase
+      [pp] formatter used to pretty print additional arguments. Ex.: The time counter overflowed while computing delta increase. Previous value %d. Delta: %d
+      [encoder] [decoder] data encoding for this error. If the error has no value, specify Data_encoding.empty
+  *)
+  val register_error_kind :
+    error_category ->
+    id:string ->
+    title:string ->
+    description:string ->
+    ?pp:(Format.formatter -> 'err -> unit) ->
+    'err Data_encoding.t ->
+    (error -> 'err option) ->
+    ('err -> error) ->
+    unit
+
+  (** Classify an error using the registered kinds *)
+  val classify_errors : error list -> error_category
+
+  (** {2 Monad definition} ***************************************************)
+
+  (** The error monad wrapper type, the error case holds a stack of
+      error, initialized by the first call to {!fail} and completed by
+      each call to {!trace} as the stack is rewinded. The most general
+      error is thus at the top of the error stack, going down to the
+      specific error that actually caused the failure. *)
+  type 'a tzresult = ('a, error list) result
+
+  (** A serializer for result of a given type *)
+  val result_encoding :
+    'a Data_encoding.t ->
+    'a tzresult Data_encoding.t
+
+  (** Sucessful result *)
+  val ok : 'a -> 'a tzresult
+
+  (** Sucessful return *)
+  val return : 'a -> 'a tzresult Lwt.t
+
+  (** Sucessful return of [()] *)
+  val return_unit : unit tzresult Lwt.t
+
+  (** Sucessful return of [None] *)
+  val return_none : 'a option tzresult Lwt.t
+
+  (** [return_some x] is a sucessful return of [Some x] *)
+  val return_some : 'a -> 'a option tzresult Lwt.t
+
+  (** Sucessful return of [[]] *)
+  val return_nil : 'a list tzresult Lwt.t
+
+  (** Sucessful return of [true] *)
+  val return_true : bool tzresult Lwt.t
+
+  (** Sucessful return of [false] *)
+  val return_false : bool tzresult Lwt.t
+
+  (** Erroneous result *)
+  val error : error -> 'a tzresult
+
+  (** Erroneous return *)
+  val fail : error -> 'a tzresult Lwt.t
+
+  (** Non-Lwt bind operator *)
+  val (>>?) : 'a tzresult -> ('a -> 'b tzresult) -> 'b tzresult
+
+  (** Bind operator *)
+  val (>>=?) :
+    'a tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
+
+  (** Lwt's bind reexported *)
+  val (>>=) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t
+  val (>|=) : 'a Lwt.t -> ('a -> 'b) -> 'b Lwt.t
+
+  (** To operator *)
+  val (>>|?) : 'a tzresult Lwt.t -> ('a -> 'b) -> 'b tzresult Lwt.t
+
+  (** Non-Lwt to operator *)
+  val (>|?) : 'a tzresult -> ('a -> 'b) -> 'b tzresult
+
+  (** Enrich an error report (or do nothing on a successful result) manually *)
+  val record_trace : error -> 'a tzresult -> 'a tzresult
+
+  (** Automatically enrich error reporting on stack rewind *)
+  val trace : error -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
+
+  (** Same as record_trace, for unevaluated error *)
+  val record_trace_eval : (unit -> error tzresult) -> 'a tzresult -> 'a tzresult
+
+  (** Same as trace, for unevaluated Lwt error *)
+  val trace_eval : (unit -> error tzresult Lwt.t) -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
+
+  (** Erroneous return on failed assertion *)
+  val fail_unless : bool -> error -> unit tzresult Lwt.t
+  val fail_when : bool -> error -> unit tzresult Lwt.t
+
+  val unless : bool -> (unit -> unit tzresult Lwt.t) -> unit tzresult Lwt.t
+  val _when : bool -> (unit -> unit tzresult Lwt.t) -> unit tzresult Lwt.t
+
+  (* Usage: [_assert cond __LOC__ "<fmt>" ...] *)
+  val _assert :
+    bool -> string ->
+    ('a, Format.formatter, unit, unit tzresult Lwt.t) format4 -> 'a
+
+  (** {2 In-monad list iterators} ********************************************)
+
+  (** A {!List.iter} in the monad *)
+  val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
+  val iter_p : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
+  val iter2_p : ('a -> 'b -> unit tzresult Lwt.t) -> 'a list -> 'b list -> unit tzresult Lwt.t
+  val iteri2_p : (int -> 'a -> 'b -> unit tzresult Lwt.t) -> 'a list -> 'b list -> unit tzresult Lwt.t
+
+  (** A {!List.map} in the monad *)
+  val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+  val map_p : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+  val mapi_s : (int -> 'a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+  val mapi_p : (int -> 'a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+
+  (** A {!List.map2} in the monad *)
+  val map2 :
+    ('a -> 'b -> 'c tzresult) -> 'a list -> 'b list -> 'c list tzresult
+  val map2_s :
+    ('a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
+    'c list tzresult Lwt.t
+  val mapi2_s :
+    (int -> 'a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
+    'c list tzresult Lwt.t
+
+  (** A {!List.filter_map} in the monad *)
+  val filter_map_s :
+    ('a -> 'b option tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+  val filter_map_p :
+    ('a -> 'b option tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+
+  (** A {!List.filter} in the monad *)
+  val filter_s :
+    ('a -> bool tzresult Lwt.t) -> 'a list -> 'a list tzresult Lwt.t
+  val filter_p :
+    ('a -> bool tzresult Lwt.t) -> 'a list -> 'a list tzresult Lwt.t
+
+  (** A {!List.fold_left} in the monad *)
+  val fold_left_s :
+    ('a -> 'b -> 'a tzresult Lwt.t) -> 'a -> 'b list -> 'a tzresult Lwt.t
+
+  (** A {!List.fold_right} in the monad *)
+  val fold_right_s :
+    ('a -> 'b -> 'b tzresult Lwt.t) -> 'a list -> 'b -> 'b tzresult Lwt.t
+
+  (** A {!Lwt.join} in the monad *)
+  val join : unit tzresult Lwt.t list -> unit tzresult Lwt.t
+
+  (** Lazy values with retry-until success semantics *)
+  type 'a tzlazy
+
+  (** Create a {!tzlazy} value. *)
+  val tzlazy: (unit -> 'a tzresult Lwt.t) -> 'a tzlazy
+
+  (** [tzforce tzl] is either
+      (a) the remembered value carried by [tzl] if available
+      (b) the result of the callback/closure used to create [tzl] if successful,
+      in which case the value is remembered, or
+      (c) an error if the callback/closure used to create [tzl] is unsuccessful.
+  *)
+  val tzforce: 'a tzlazy -> 'a tzresult Lwt.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_error_monad/tezos-error-monad.opam b/vendors/tezos-modded/src/lib_error_monad/tezos-error-monad.opam
new file mode 100644
index 000000000..dba13879f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_error_monad/tezos-error-monad.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib"
+  "tezos-data-encoding"
+  "lwt"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/dune b/vendors/tezos-modded/src/lib_memory_protocol_alpha/dune
new file mode 100644
index 000000000..0197e50c3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_memory_protocol_alpha/dune
@@ -0,0 +1,8 @@
+(library
+  (name memory_proto_alpha)
+  (public_name tezos-memory-proto-alpha)
+  (libraries
+    tezos-protocol-environment
+    tezos-protocol-alpha
+  )
+)
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml b/vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml
new file mode 100644
index 000000000..b830e7b7d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_memory_protocol_alpha/memory_proto_alpha.ml
@@ -0,0 +1,8 @@
+module Name = struct let name = "alpha" end
+module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)()
+
+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)
+include Proto
diff --git a/vendors/tezos-modded/src/lib_memory_protocol_alpha/tezos-memory-proto-alpha.opam b/vendors/tezos-modded/src/lib_memory_protocol_alpha/tezos-memory-proto-alpha.opam
new file mode 100644
index 000000000..08031e2ec
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_memory_protocol_alpha/tezos-memory-proto-alpha.opam
@@ -0,0 +1,18 @@
+opam-version: "2.0"
+name: "memory-proto-alpha"
+version: "1.0"
+synopsis: "Tezos Protocol Alpha in memory"
+maintainer: "Galfour <ligolang@gmail.com>"
+authors: "Galfour <ligolang@gmail.com>"
+license: "MIT"
+homepage: "https://gitlab.com/ligolang/tezos"
+bug-reports: "https://gitlab.com/ligolang/tezos/issues"
+depends: [
+  "dune"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+]
+build: [
+  ["dune" "build" "-p" name]
+]
+dev-repo: "git+https://gitlab.com/ligolang/tezos"
diff --git a/vendors/tezos-modded/src/lib_micheline/dune b/vendors/tezos-modded/src/lib_micheline/dune
new file mode 100644
index 000000000..3435082e3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/dune
@@ -0,0 +1,23 @@
+(library
+ (name tezos_micheline)
+ (public_name tezos-micheline)
+ (libraries
+  
+  ;; External
+  uutf
+  zarith
+  ;; Internal
+  tezos-stdlib
+  tezos-error-monad
+  tezos-data-encoding
+  )
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_stdlib
+                   -open Tezos_error_monad
+                   -open Tezos_data_encoding)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline.ml b/vendors/tezos-modded/src/lib_micheline/micheline.ml
new file mode 100644
index 000000000..0127bdd88
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline.ml
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Micheline_main
+module Michelson_primitives = Michelson_primitives
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline.mli b/vendors/tezos-modded/src/lib_micheline/micheline.mli
new file mode 100644
index 000000000..172aab55c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include module type of Micheline_main
+module Michelson_primitives = Michelson_primitives
+
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_main.ml b/vendors/tezos-modded/src/lib_micheline/micheline_main.ml
new file mode 100644
index 000000000..0cff3eabd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_main.ml
@@ -0,0 +1,301 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type annot = string list
+
+type ('l, 'p) node =
+  | Int of 'l * Z.t
+  | String of 'l * string
+  | Bytes of 'l * MBytes.t
+  | Prim of 'l * 'p * ('l, 'p) node list * annot
+  | Seq of 'l * ('l, 'p) node list
+
+type canonical_location = int
+
+type 'p canonical = Canonical of (canonical_location, 'p) node
+
+let canonical_location_encoding =
+  let open Data_encoding in
+  def
+    "micheline.location"
+    ~title:
+      "Canonical location in a Micheline expression"
+    ~description:
+      "The location of a node in a Micheline expression tree \
+       in prefix order, with zero being the root and adding one \
+       for every basic node, sequence and primitive application." @@
+  int31
+
+let location = function
+  | Int (loc, _) -> loc
+  | String (loc, _) -> loc
+  | Bytes (loc, _) -> loc
+  | Seq (loc, _) -> loc
+  | Prim (loc, _, _, _) -> loc
+
+let annotations = function
+  | Int (_, _) -> []
+  | String (_, _) -> []
+  | Bytes (_, _) -> []
+  | Seq (_, _) -> []
+  | Prim (_, _, _, annots) -> annots
+
+let root (Canonical expr) = expr
+
+let strip_locations root =
+  let id = let id = ref (-1) in fun () -> incr id ; !id in
+  let rec strip_locations l =
+    let id = id () in
+    match l with
+    | Int (_, v) ->
+        Int (id, v)
+    | String (_, v) ->
+        String (id, v)
+    | Bytes (_, v) ->
+        Bytes (id, v)
+    | Seq (_, seq) ->
+        Seq (id, List.map strip_locations seq)
+    | Prim (_, name, seq, annots) ->
+        Prim (id, name, List.map strip_locations seq, annots) in
+  Canonical (strip_locations root)
+
+let extract_locations root =
+  let id = let id = ref (-1) in fun () -> incr id ; !id in
+  let loc_table = ref [] in
+  let rec strip_locations l =
+    let id = id () in
+    match l with
+    | Int (loc, v) ->
+        loc_table := (id, loc) :: !loc_table ;
+        Int (id, v)
+    | String (loc, v) ->
+        loc_table := (id, loc) :: !loc_table ;
+        String (id, v)
+    | Bytes (loc, v) ->
+        loc_table := (id, loc) :: !loc_table ;
+        Bytes (id, v)
+    | Seq (loc, seq) ->
+        loc_table := (id, loc) :: !loc_table ;
+        Seq (id, List.map strip_locations seq)
+    | Prim (loc, name, seq, annots) ->
+        loc_table := (id, loc) :: !loc_table ;
+        Prim (id, name, List.map strip_locations seq, annots) in
+  let stripped = strip_locations root in
+  Canonical stripped, List.rev !loc_table
+
+let inject_locations lookup (Canonical root) =
+  let rec inject_locations l =
+    match l with
+    | Int (loc, v) ->
+        Int (lookup loc, v)
+    | String (loc, v) ->
+        String (lookup loc, v)
+    | Bytes (loc, v) ->
+        Bytes (lookup loc, v)
+    | Seq (loc, seq) ->
+        Seq (lookup loc, List.map inject_locations seq)
+    | Prim (loc, name, seq, annots) ->
+        Prim (lookup loc, name, List.map inject_locations seq, annots) in
+  inject_locations root
+
+let map f (Canonical expr) =
+  let rec map_node f = function
+    | Int _ | String _ | Bytes _ as node -> node
+    | Seq (loc, seq) ->
+        Seq (loc, List.map (map_node f) seq)
+    | Prim (loc, name, seq, annots) ->
+        Prim (loc, f name, List.map (map_node f) seq, annots) in
+  Canonical (map_node f expr)
+
+let rec map_node fl fp = function
+  | Int (loc, v) ->
+      Int (fl loc, v)
+  | String (loc, v) ->
+      String (fl loc, v)
+  | Bytes (loc, v) ->
+      Bytes (fl loc, v)
+  | Seq (loc, seq) ->
+      Seq (fl loc, List.map (map_node fl fp) seq)
+  | Prim (loc, name, seq, annots) ->
+      Prim (fl loc, fp name, List.map (map_node fl fp) seq, annots)
+
+type semantics = V0 | V1
+
+let internal_canonical_encoding ~semantics ~variant prim_encoding =
+  let open Data_encoding in
+  let int_encoding =
+    obj1 (req "int" z) in
+  let string_encoding =
+    obj1 (req "string" string) in
+  let bytes_encoding =
+    obj1 (req "bytes" bytes) in
+  let int_encoding tag =
+    case tag int_encoding
+      ~title:"Int"
+      (function Int (_, v) -> Some v | _ -> None)
+      (fun v -> Int (0, v)) in
+  let string_encoding tag =
+    case tag string_encoding
+      ~title:"String"
+      (function String (_, v) -> Some v | _ -> None)
+      (fun v -> String (0, v)) in
+  let bytes_encoding tag =
+    case tag bytes_encoding
+      ~title:"Bytes"
+      (function Bytes (_, v) -> Some v | _ -> None)
+      (fun v -> Bytes (0, v)) in
+  let seq_encoding tag expr_encoding =
+    case tag (list expr_encoding)
+      ~title:"Sequence"
+      (function Seq (_, v) -> Some v | _ -> None)
+      (fun args -> Seq (0, args)) in
+  let annots_encoding =
+    let split s =
+      if s = "" && semantics <> V0 then []
+      else
+        let annots = String.split_on_char ' ' s in
+        List.iter (fun a ->
+            if String.length a > 255 then failwith "Oversized annotation"
+          ) annots;
+        if String.concat " " annots <> s then
+          failwith "Invalid annotation string, \
+                    must be a sequence of valid annotations with spaces" ;
+        annots in
+    splitted
+      ~json:(list (Bounded.string 255))
+      ~binary:(conv (String.concat " ") split string) in
+  let application_encoding tag expr_encoding =
+    case tag
+      ~title:"Generic prim (any number of args with or without annot)"
+      (obj3 (req "prim" prim_encoding)
+         (dft "args" (list expr_encoding) [])
+         (dft "annots" annots_encoding []))
+      (function Prim (_, prim, args, annots) -> Some (prim, args, annots)
+              | _ -> None)
+      (fun (prim, args, annots) -> Prim (0, prim, args, annots)) in
+  let node_encoding = mu ("micheline." ^ variant ^ ".expression") (fun expr_encoding ->
+      splitted
+        ~json:(union ~tag_size:`Uint8
+                 [ int_encoding Json_only;
+                   string_encoding Json_only ;
+                   bytes_encoding Json_only ;
+                   seq_encoding Json_only expr_encoding ;
+                   application_encoding Json_only expr_encoding ])
+        ~binary:(union ~tag_size:`Uint8
+                   [ int_encoding (Tag 0) ;
+                     string_encoding (Tag 1) ;
+                     seq_encoding (Tag 2) expr_encoding ;
+                     (* No args, no annot *)
+                     case (Tag 3)
+                       ~title:"Prim (no args, annot)"
+                       (obj1 (req "prim" prim_encoding))
+                       (function Prim (_, v, [], []) -> Some v
+                               | _ -> None)
+                       (fun v -> Prim (0, v, [], [])) ;
+                     (* No args, with annots *)
+                     case (Tag 4)
+                       ~title:"Prim (no args + annot)"
+                       (obj2 (req "prim" prim_encoding)
+                          (req "annots" annots_encoding))
+                       (function
+                         | Prim (_, v, [], annots) -> Some (v, annots)
+                         | _ -> None)
+                       (function (prim, annots) -> Prim (0, prim, [], annots)) ;
+                     (* Single arg, no annot *)
+                     case (Tag 5)
+                       ~title:"Prim (1 arg, no annot)"
+                       (obj2 (req "prim" prim_encoding)
+                          (req "arg" expr_encoding))
+                       (function
+                         | Prim (_, v, [ arg ], []) -> Some (v, arg)
+                         | _ -> None)
+                       (function (prim, arg) -> Prim (0, prim, [ arg ], [])) ;
+                     (* Single arg, with annot *)
+                     case (Tag 6)
+                       ~title:"Prim (1 arg + annot)"
+                       (obj3 (req "prim" prim_encoding)
+                          (req "arg" expr_encoding)
+                          (req "annots" annots_encoding))
+                       (function
+                         | Prim (_, prim, [ arg ], annots) -> Some (prim, arg, annots)
+                         | _ -> None)
+                       (fun (prim, arg, annots) -> Prim (0, prim, [ arg ], annots)) ;
+                     (* Two args, no annot *)
+                     case (Tag 7)
+                       ~title:"Prim (2 args, no annot)"
+                       (obj3 (req "prim" prim_encoding)
+                          (req "arg1" expr_encoding)
+                          (req "arg2" expr_encoding))
+                       (function
+                         | Prim (_, prim, [ arg1 ; arg2 ], []) -> Some (prim, arg1, arg2)
+                         | _ -> None)
+                       (fun (prim, arg1, arg2) -> Prim (0, prim, [ arg1 ; arg2 ], [])) ;
+                     (* Two args, with annots *)
+                     case (Tag 8)
+                       ~title:"Prim (2 args + annot)"
+                       (obj4 (req "prim" prim_encoding)
+                          (req "arg1" expr_encoding)
+                          (req "arg2" expr_encoding)
+                          (req "annots" annots_encoding))
+                       (function
+                         | Prim (_, prim, [ arg1 ; arg2 ], annots) -> Some (prim, arg1, arg2, annots)
+                         | _ -> None)
+                       (fun (prim, arg1, arg2, annots) -> Prim (0, prim, [ arg1 ; arg2 ], annots)) ;
+                     (* General case *)
+                     application_encoding (Tag 9) expr_encoding ;
+                     bytes_encoding (Tag 10) ]))
+  in
+  conv
+    (function Canonical node -> node)
+    (fun node -> strip_locations node)
+    node_encoding
+
+let canonical_encoding ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V1 ~variant prim_encoding
+let canonical_encoding_v1 ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V1 ~variant prim_encoding
+let canonical_encoding_v0 ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V0 ~variant prim_encoding
+
+let table_encoding ~variant location_encoding prim_encoding =
+  let open Data_encoding in
+  conv
+    (fun node ->
+       let canon, assoc = extract_locations node in
+       let _, table = List.split assoc in
+       (canon, table))
+    (fun (canon, table) ->
+       let table = Array.of_list table in
+       inject_locations (fun i -> table.(i)) canon)
+    (obj2
+       (req "expression" (canonical_encoding ~variant prim_encoding))
+       (req "locations" (list location_encoding)))
+
+let erased_encoding ~variant default_location prim_encoding =
+  let open Data_encoding in
+  conv
+    (fun node -> strip_locations node)
+    (fun canon -> inject_locations (fun _ -> default_location) canon)
+    (canonical_encoding ~variant prim_encoding)
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_main.mli b/vendors/tezos-modded/src/lib_micheline/micheline_main.mli
new file mode 100644
index 000000000..49cb40c56
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_main.mli
@@ -0,0 +1,104 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type annot = string list
+
+(** The abstract syntax tree of Micheline expressions. The first
+    parameter is used to contain locations, but can also embed custom
+    data. The second parameter is the type of primitive names. *)
+type ('l, 'p) node =
+  | Int of 'l * Z.t
+  | String of 'l * string
+  | Bytes of 'l * MBytes.t
+  | Prim of 'l * 'p * ('l, 'p) node list * annot
+  | Seq of 'l * ('l, 'p) node list
+
+(** Encoding for expressions, as their {!canonical} encoding.
+    Locations are stored in a side table.
+    See {!canonical_encoding} for the [variant] parameter. *)
+val table_encoding : variant:string ->
+  'l Data_encoding.encoding -> 'p Data_encoding.encoding ->
+  ('l, 'p) node Data_encoding.encoding
+
+(** Encoding for expressions, as their {!canonical} encoding.
+    Locations are erased when serialized, and restored to a provided
+    default value when deserialized.
+    See {!canonical_encoding} for the [variant] parameter. *)
+val erased_encoding : variant:string ->
+  'l -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
+
+(** Extract the location of the node. *)
+val location : ('l, 'p) node -> 'l
+
+(** Extract the annotations of the node. *)
+val annotations : ('l, 'p) node -> string list
+
+(** Expression form using canonical integer numbering as
+    locations. The root has number zero, and each node adds one in the
+    order of infix traversal. To be used when locations are not
+    important, or when one wants to attach properties to nodes in an
+    expression without rewriting it (using an indirection table with
+    canonical locations as keys). *)
+type 'p canonical
+
+(** Canonical integer locations that appear inside {!canonical} expressions. *)
+type canonical_location = int
+
+(** Encoding for canonical integer locations. *)
+val canonical_location_encoding : canonical_location Data_encoding.encoding
+
+(** Encoding for expressions in canonical form. The first parameter
+    is a name used to produce named definitions in the schemas. Make
+    sure to use different names if two expression variants with
+    different primitive encodings are used in the same schema. *)
+val canonical_encoding : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+
+(** Old version of {!canonical_encoding} for retrocompatibility.
+    Do not use in new code. *)
+val canonical_encoding_v0 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+
+(** Alias for {!canonical_encoding}. *)
+val canonical_encoding_v1 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+
+(** Compute the canonical form of an expression.
+    Drops the concrete locations completely. *)
+val strip_locations : (_, 'p) node -> 'p canonical
+
+(** Give the root node of an expression in canonical form. *)
+val root : 'p canonical -> (canonical_location, 'p) node
+
+(** Compute the canonical form of an expression.
+    Saves the concrete locations in an association list. *)
+val extract_locations : ('l, 'p) node -> 'p canonical * (canonical_location * 'l) list
+
+(** Transforms an expression in canonical form into a polymorphic one.
+    Takes a mapping function to inject the concrete locations. *)
+val inject_locations : (canonical_location -> 'l) -> 'p canonical -> ('l, 'p) node
+
+(** Copies the tree, updating its primitives. *)
+val map : ('a -> 'b) -> 'a canonical -> 'b canonical
+
+(** Copies the tree, updating its primitives and locations. *)
+val map_node : ('la -> 'lb) -> ('pa -> 'pb) -> ('la, 'pa) node -> ('lb, 'pb) node
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_parser.ml b/vendors/tezos-modded/src/lib_micheline/micheline_parser.ml
new file mode 100644
index 000000000..a52aeeb4e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_parser.ml
@@ -0,0 +1,880 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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 Error_monad
+open Micheline
+
+type 'a parsing_result = 'a * error list
+
+type point =
+  { point : int ;
+    byte : int ;
+    line : int ;
+    column : int }
+
+let point_zero =
+  { point = 0 ;
+    byte = 0 ;
+    line = 0 ;
+    column = 0 }
+
+let point_encoding =
+  let open Data_encoding in
+  conv
+    (fun { line ; column ; point ; byte } -> (line, column, point, byte))
+    (fun (line, column, point, byte) -> { line ; column ; point ; byte })
+    (obj4
+       (req "line" uint16)
+       (req "column" uint16)
+       (req "point" uint16)
+       (req "byte" uint16))
+
+type location =
+  { start : point ;
+    stop : point }
+
+let location_zero =
+  { start = point_zero ;
+    stop = point_zero }
+
+let location_encoding =
+  let open Data_encoding in
+  conv
+    (fun { start ; stop } -> (start, stop))
+    (fun (start, stop) -> { start ; stop })
+    (obj2
+       (req "start" point_encoding)
+       (req "stop" point_encoding))
+
+type token_value =
+  | String of string
+  | Bytes of string
+  | Int of string
+  | Ident of string
+  | Annot of string
+  | Comment of string
+  | Eol_comment of string
+  | Semi
+  | Open_paren | Close_paren
+  | Open_brace | Close_brace
+
+let token_value_encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag 0)
+        ~title:"String"
+        (obj1 (req "string" string))
+        (function String s -> Some s | _ -> None)
+        (fun s -> String s) ;
+      case (Tag 1)
+        ~title:"Int"
+        (obj1 (req "int" string))
+        (function Int s -> Some s | _ -> None)
+        (fun s -> Int s) ;
+      case (Tag 2)
+        ~title:"Annot"
+        (obj1 (req "annot" string))
+        (function Annot s -> Some s | _ -> None)
+        (fun s -> Annot s) ;
+      case (Tag 3)
+        ~title:"Comment"
+        (obj2 (req "comment" string) (dft "end_of_line" bool false))
+        (function
+          | Comment s -> Some (s, false)
+          | Eol_comment s -> Some (s, true) | _ -> None)
+        (function
+          | (s, false) -> Comment s
+          | (s, true) -> Eol_comment s) ;
+      case (Tag 4)
+        ~title:"Punctuation"
+        (obj1 (req "punctuation" (string_enum [
+             "(", Open_paren ;
+             ")", Close_paren ;
+             "{", Open_brace ;
+             "}", Close_brace ;
+             ";", Semi ])))
+        (fun t -> Some t) (fun t -> t) ;
+      case (Tag 5)
+        ~title:"Bytes"
+        (obj1 (req "bytes" string))
+        (function Bytes s -> Some s | _ -> None)
+        (fun s -> Bytes s) ]
+
+type token =
+  { token : token_value ;
+    loc : location }
+
+let max_annot_length = 255
+
+type error += Invalid_utf8_sequence of point * string
+type error += Unexpected_character of point * string
+type error += Undefined_escape_sequence of point * string
+type error += Missing_break_after_number of point
+type error += Unterminated_string of location
+type error += Unterminated_integer of location
+type error += Odd_lengthed_bytes of location
+type error += Unterminated_comment of location
+type error += Annotation_length of location
+
+let tokenize source =
+  let decoder = Uutf.decoder ~encoding:`UTF_8 (`String source) in
+  let here () =
+    { point = Uutf.decoder_count decoder ;
+      byte = Uutf.decoder_byte_count decoder ;
+      line = Uutf.decoder_line decoder ;
+      column = Uutf.decoder_col decoder } in
+  let tok start stop token =
+    { loc = { start ; stop } ; token } in
+  let stack = ref [] in
+  let errors = ref [] in
+  let rec next () =
+    match !stack with
+    | charloc :: charlocs ->
+        stack := charlocs ;
+        charloc
+    | [] ->
+        let loc = here () in
+        match Uutf.decode decoder with
+        | `Await -> assert false
+        | `Malformed s ->
+            errors := Invalid_utf8_sequence (loc, s) :: !errors ;
+            next ()
+        | `Uchar _ | `End as other -> other, loc in
+  let back charloc =
+    stack := charloc :: !stack in
+  let uchar_to_char c =
+    if Uchar.is_char c then
+      Some (Uchar.to_char c)
+    else
+      None in
+  let allowed_ident_char c =
+    match uchar_to_char c with
+    | Some ('a'..'z' | 'A'..'Z' | '_' | '0'..'9') -> true
+    | Some _ | None -> false in
+  let allowed_annot_char c =
+    match uchar_to_char c with
+    | Some ('a'..'z' | 'A'..'Z' | '_' | '.' | '%' | '@' | '0'..'9') -> true
+    | Some _ | None -> false in
+  let rec skip acc =
+    match next () with
+    | `End, _ -> List.rev acc
+    | `Uchar c, start ->
+        begin match uchar_to_char c with
+          | Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s _ -> Ident s)
+          | Some ('@' | ':' | '$' | '&' | '%' | '!' | '?') ->
+              annot acc start
+                (fun str stop ->
+                   if String.length str > max_annot_length
+                   then errors := (Annotation_length { start ; stop }) :: !errors ;
+                   Annot str)
+          | Some '-' ->
+              begin match next () with
+                | `End, stop ->
+                    errors := Unterminated_integer { start ; stop } :: !errors ;
+                    List.rev acc
+                | `Uchar c, stop as first ->
+                    begin match uchar_to_char c with
+                      | Some '0' -> base acc start
+                      | Some ('1'..'9') -> integer acc start
+                      | Some _ | None ->
+                          errors := Unterminated_integer { start ; stop } :: !errors ;
+                          back first ;
+                          skip acc
+                    end
+              end
+          | Some '0' -> base acc start
+          | Some ('1'..'9') -> integer acc start
+          | Some (' ' | '\n') -> skip acc
+          | Some ';' -> skip (tok start (here ()) Semi :: acc)
+          | Some '{' -> skip (tok start (here ()) Open_brace :: acc)
+          | Some '}' -> skip (tok start (here ()) Close_brace :: acc)
+          | Some '(' -> skip (tok start (here ()) Open_paren :: acc)
+          | Some ')' -> skip (tok start (here ()) Close_paren :: acc)
+          | Some '"' -> string acc [] start
+          | Some '#' -> eol_comment acc start
+          | Some '/' ->
+              begin match next () with
+                | `Uchar c, _ when Uchar.equal c (Uchar.of_char '*') ->
+                    comment acc start 0
+                | (`Uchar _ | `End), _ as charloc ->
+                    errors := Unexpected_character (start, "/") :: !errors ;
+                    back charloc ;
+                    skip acc
+              end
+          | Some _ | None ->
+              let byte = Uutf.decoder_byte_count decoder in
+              let s = String.sub source start.byte (byte - start.byte) in
+              errors := Unexpected_character (start, s) :: !errors ;
+              skip acc
+        end
+  and base acc start =
+    match next () with
+    | (`Uchar c, stop) as charloc ->
+        begin match uchar_to_char c with
+          | Some ('0'.. '9') -> integer acc start
+          | Some 'x' -> bytes acc start
+          | Some ('a'..'w' | 'y' | 'z' | 'A'..'Z') ->
+              errors := Missing_break_after_number stop :: !errors ;
+              back charloc ;
+              skip (tok start stop (Int "0") :: acc)
+          | Some _ | None ->
+              back charloc ;
+              skip (tok start stop (Int "0") :: acc)
+        end
+    | (_, stop) as other ->
+        back other ;
+        skip (tok start stop (Int "0") :: acc)
+  and integer acc start =
+    let tok stop =
+      let value =
+        String.sub source start.byte (stop.byte - start.byte) in
+      tok start stop (Int value) in
+    match next () with
+    | (`Uchar c, stop) as charloc ->
+        let missing_break () =
+          errors := Missing_break_after_number stop :: !errors ;
+          back charloc ;
+          skip (tok stop :: acc) in
+        begin match Uchar.to_char c with
+          | ('0'.. '9') ->
+              integer acc start
+          | ('a'..'z' | 'A'..'Z') ->
+              missing_break ()
+          | _ ->
+              back charloc ;
+              skip (tok stop :: acc)
+        end
+    | (`End, stop) as other ->
+        back other ;
+        skip (tok stop :: acc)
+  and bytes acc start =
+    let tok stop =
+      let value =
+        String.sub source start.byte (stop.byte - start.byte) in
+      tok start stop (Bytes value) in
+    match next () with
+    | (`Uchar c, stop) as charloc ->
+        let missing_break () =
+          errors := Missing_break_after_number stop :: !errors ;
+          back charloc ;
+          skip (tok stop :: acc) in
+        begin match Uchar.to_char c with
+          | ('0'..'9' | 'a'..'f' | 'A'..'F') ->
+              bytes acc start
+          | ('g'..'z' | 'G'..'Z') ->
+              missing_break ()
+          | _ ->
+              back charloc ;
+              skip (tok stop :: acc)
+        end
+    | (`End, stop) as other ->
+        back other ;
+        skip (tok stop :: acc)
+  and string acc sacc start =
+    let tok () =
+      tok start (here ()) (String (String.concat "" (List.rev sacc))) in
+    match next () with
+    | `End, stop ->
+        errors := Unterminated_string { start ; stop } :: !errors ;
+        skip (tok () :: acc)
+    | `Uchar c, stop ->
+        match uchar_to_char c with
+        | Some '"' -> skip (tok () :: acc)
+        | Some ('\n' | '\r') ->
+            errors := Unterminated_string { start ; stop } :: !errors ;
+            skip (tok () :: acc)
+        | Some '\\' ->
+            begin match next () with
+              | `End, stop ->
+                  errors := Unterminated_string { start ; stop } :: !errors ;
+                  skip (tok () :: acc)
+              | `Uchar c, loc ->
+                  match uchar_to_char c with
+                  | Some '"' -> string acc ("\"" :: sacc) start
+                  | Some 'r' -> string acc ("\r" :: sacc) start
+                  | Some 'n' -> string acc ("\n" :: sacc) start
+                  | Some 't' -> string acc ("\t" :: sacc) start
+                  | Some 'b' -> string acc ("\b" :: sacc) start
+                  | Some '\\' -> string acc ("\\" :: sacc) start
+                  | Some _ | None ->
+                      let byte = Uutf.decoder_byte_count decoder in
+                      let s = String.sub source loc.byte (byte - loc.byte) in
+                      errors := Undefined_escape_sequence (loc, s) :: !errors ;
+                      string acc sacc start
+            end
+        | Some _ | None ->
+            let byte = Uutf.decoder_byte_count decoder in
+            let s = String.sub source stop.byte (byte - stop.byte) in
+            string acc (s :: sacc) start
+  and generic_ident allow_char acc start (ret : string -> point -> token_value) =
+    let tok stop =
+      let name =
+        String.sub source start.byte (stop.byte - start.byte) in
+      tok start stop (ret name stop) in
+    match next () with
+    | (`Uchar c, stop) as charloc ->
+        if allow_char c then
+          generic_ident allow_char acc start ret
+        else begin
+          back charloc ;
+          skip (tok stop :: acc)
+        end
+    | (_, stop) as other ->
+        back other ;
+        skip (tok stop :: acc)
+  and ident acc start ret = generic_ident allowed_ident_char acc start ret
+  and annot acc start ret = generic_ident allowed_annot_char acc start ret
+  and comment acc start lvl =
+    match next () with
+    | `End, stop ->
+        errors := Unterminated_comment { start ; stop } :: !errors ;
+        let text = String.sub source start.byte (stop.byte - start.byte) in
+        skip (tok start stop (Comment text) :: acc)
+    | `Uchar c, _ ->
+        begin match uchar_to_char c with
+          | Some '*' ->
+              begin match next () with
+                | `Uchar c, _ when Uchar.equal c (Uchar.of_char '/') ->
+                    if lvl = 0 then
+                      let stop = here () in
+                      let text =
+                        String.sub source start.byte (stop.byte - start.byte) in
+                      skip (tok start stop (Comment text) :: acc)
+                    else
+                      comment acc start (lvl - 1)
+                | other ->
+                    back other ;
+                    comment acc start lvl
+              end
+          | Some '/' ->
+              begin match next () with
+                | `Uchar c, _ when Uchar.equal c (Uchar.of_char '*') ->
+                    comment acc start (lvl + 1)
+                | other ->
+                    back other ;
+                    comment acc start lvl
+              end
+          | Some _ | None -> comment acc start lvl
+        end
+  and eol_comment acc start =
+    let tok stop =
+      let text = String.sub source start.byte (stop.byte - start.byte) in
+      tok start stop (Eol_comment text) in
+    match next () with
+    | `Uchar c, stop ->
+        begin match uchar_to_char c with
+          | Some '\n' -> skip (tok stop :: acc)
+          | Some _ | None -> eol_comment acc start
+        end
+    | (_, stop) as other ->
+        back other ;
+        skip (tok stop :: acc) in
+  let tokens = skip [] in
+  tokens, List.rev !errors
+
+type node = (location, string) Micheline.node
+
+let node_encoding =
+  Micheline.table_encoding ~variant:"generic" location_encoding Data_encoding.string
+
+(* Beginning of a sequence of consecutive primitives *)
+let min_point : node list -> point = function
+  | [] -> point_zero
+  | Int ({ start }, _) :: _
+  | String ({ start }, _) :: _
+  | Bytes ({ start }, _) :: _
+  | Prim ({ start }, _, _, _) :: _
+  | Seq ({ start }, _) :: _ -> start
+
+(* End of a sequence of consecutive primitives *)
+let rec max_point : node list -> point  = function
+  | [] -> point_zero
+  | _ :: (_ :: _ as rest) -> max_point rest
+  | Int ({ stop }, _) :: []
+  | String ({ stop }, _) :: []
+  | Bytes ({ stop }, _) :: []
+  | Prim ({ stop }, _, _, _) :: []
+  | Seq ({ stop }, _) :: [] -> stop
+
+(* An item in the parser's state stack.
+   Not every value of type [mode list] is a valid parsing context.
+   It must respect the following additional invariants.
+   - a state stack always ends in [Toplevel _],
+   - [Toplevel _] does not appear anywhere else,
+   - [Unwrapped _] cannot appear directly on top of [Wrapped _],
+   - [Wrapped _] cannot appear directly on top of [Sequence _],
+   - [Wrapped _] cannot appear directly on top of [Sequence _]. *)
+type mode =
+  | Toplevel of node list
+  | Expression of node option
+  | Sequence of token * node list
+  | Unwrapped of location * string * node list * string list
+  | Wrapped of token * string * node list * string list
+
+(* Enter a new parsing state. *)
+let push_mode mode stack =
+  mode :: stack
+
+(* Leave a parsing state. *)
+let pop_mode = function
+  | [] -> assert false
+  | _ :: rest -> rest
+
+(* Usually after a [pop_mode], jump back into the previous parsing
+   state, injecting the current reduction (insert the just parsed item
+   of a sequence or argument of a primitive application). *)
+let fill_mode result = function
+  | [] -> assert false
+  | Expression _ :: _ :: _ -> assert false
+  | Expression (Some _) :: [] -> assert false
+  | Toplevel _ :: _ :: _ -> assert false
+  | Expression None :: []  ->
+      Expression (Some result) :: []
+  | Toplevel exprs :: [] ->
+      Toplevel (result :: exprs) :: []
+  | Sequence (token, exprs) :: rest ->
+      Sequence (token, result :: exprs) :: rest
+  | Wrapped (token, name, exprs, annot) :: rest ->
+      Wrapped (token, name, result :: exprs, annot) :: rest
+  | Unwrapped (start, name, exprs, annot) :: rest ->
+      Unwrapped (start, name, result :: exprs, annot) :: rest
+
+type error += Unclosed of token
+type error += Unexpected of token
+type error += Extra of token
+type error += Misaligned of node
+type error += Empty
+
+let rec annots = function
+  | { token = Annot annot } :: rest ->
+      let annots, rest = annots rest in
+      annot :: annots, rest
+  | rest -> [], rest
+
+let rec parse ?(check = true) errors tokens stack =
+  (* Two steps:
+     - 1. parse without checking indentation [parse]
+     - 2. check indentation [check] (inlined in 1) *)
+  match stack, tokens with
+  (* Start by preventing all absurd cases, so now the pattern
+     matching exhaustivity can tell us that we treater all
+     possible tokens for all possible valid states. *)
+  | [], _
+  | [ Wrapped _ ], _
+  | [ Unwrapped _ ], _
+  | Unwrapped _ :: Unwrapped _ :: _, _
+  | Unwrapped _ :: Wrapped _ :: _, _
+  | Toplevel _ :: _ :: _, _
+  | Expression _ :: _ :: _, _ ->
+      assert false
+  (* Return *)
+  | Expression (Some result) :: _, [] ->
+      [ result ], List.rev errors
+  | Expression (Some _) :: _, token :: rem ->
+      let errors = Unexpected token :: errors in
+      parse ~check errors rem (* skip *) stack
+  | Expression None :: _, [] ->
+      let errors = Empty :: errors in
+      let ghost = { start = point_zero ; stop = point_zero} in
+      [ Seq (ghost, []) ], List.rev errors
+  | Toplevel [ Seq (_, exprs) as expr ] :: [],
+    [] ->
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      exprs, List.rev errors
+  | Toplevel exprs :: [],
+    [] ->
+      let exprs = List.rev exprs in
+      let loc = { start = min_point exprs ; stop = max_point exprs } in
+      let expr = Seq (loc, exprs) in
+      let errors = if check then do_check ~toplevel: true errors expr else errors in
+      exprs, List.rev errors
+  (* Ignore comments *)
+  | _,
+    { token = Eol_comment _ | Comment _ } :: rest ->
+      parse ~check errors rest stack
+  | (Expression None | Sequence _ | Toplevel _) :: _,
+    ({ token = Int _ | String _ | Bytes _ } as token):: { token = Eol_comment _ | Comment _ } :: rest
+  | (Wrapped _ | Unwrapped _) :: _,
+    ({ token = Open_paren } as token)
+    :: { token = Eol_comment _ | Comment _ } :: rest ->
+      parse ~check errors (token :: rest) stack
+  (* Erroneous states *)
+  | (Wrapped _ | Unwrapped _) :: _ ,
+    ({ token = Open_paren } as token)
+    :: { token = Open_paren | Open_brace } :: rem
+  | Unwrapped _ :: Expression _ :: _ ,
+    ({ token = Semi | Close_brace | Close_paren } as token) :: rem
+  | Expression None :: _ ,
+    ({ token = Semi | Close_brace | Close_paren | Open_paren } as token) :: rem ->
+      let errors = Unexpected token :: errors in
+      parse ~check errors rem (* skip *) stack
+  | (Sequence _ | Toplevel _) :: _ ,
+    ({ token = Semi } as valid) :: ({ token = Semi } as token) :: rem ->
+      let errors = Extra token :: errors in
+      parse ~check errors (valid (* skip *) :: rem) stack
+  | (Wrapped _ | Unwrapped _) :: _ ,
+    { token = Open_paren }
+    :: ({ token = Int _ | String _ | Bytes _ | Annot _ | Close_paren } as token) :: rem
+  | (Expression None | Sequence _ | Toplevel _) :: _,
+    { token = Int _ | String _ | Bytes _ } :: ({ token = Ident _ | Int _ | String _ | Bytes _ | Annot _ | Close_paren | Open_paren | Open_brace } as token) :: rem
+  | Unwrapped (_, _, _, _) :: Toplevel _ :: _,
+    ({ token = Close_brace } as token) :: rem
+  | Unwrapped (_, _, _, _) :: _,
+    ({ token = Close_paren } as token) :: rem
+  | Toplevel _ :: [],
+    ({ token = Close_paren } as token) :: rem
+  | Toplevel _ :: [],
+    ({ token = Open_paren } as token) :: rem
+  | Toplevel _ :: [],
+    ({ token = Close_brace } as token) :: rem
+  | Sequence _ :: _,
+    ({ token = Open_paren } as token) :: rem
+  | Sequence _ :: _,
+    ({ token = Close_paren } as token :: rem)
+  | (Wrapped _ | Unwrapped _) :: _,
+    ({ token = Open_paren } as token) :: ({ token = Close_brace | Semi } :: _ | [] as rem)
+  | _,
+    ({ token = Annot _ } as token) :: rem ->
+      let errors = Unexpected token :: errors in
+      parse ~check errors rem (* skip *) stack
+  | Wrapped (token, _, _, _) :: _, ([] | { token = Close_brace | Semi } :: _) ->
+      let errors = Unclosed token :: errors in
+      let fake = { token with token = Close_paren } in
+      let tokens = (* insert *) fake :: tokens  in
+      parse ~check errors tokens stack
+  | (Sequence (token, _) :: _ | Unwrapped _ :: Sequence (token, _) :: _), [] ->
+      let errors = Unclosed token :: errors in
+      let fake = { token with token = Close_brace } in
+      let tokens = (* insert *) fake :: tokens  in
+      parse ~check errors tokens stack
+  (* Valid states *)
+  | (Toplevel _ | Sequence (_, _)) :: _ ,
+    { token = Ident name ; loc } :: ({ token = Annot _ } :: _ as rest) ->
+      let annots, rest = annots rest in
+      let mode = Unwrapped (loc, name, [], annots) in
+      parse ~check errors rest (push_mode mode stack)
+  | (Expression None | Toplevel _ | Sequence (_, _)) :: _ ,
+    { token = Ident name ; loc } :: rest ->
+      let mode = Unwrapped (loc, name, [], []) in
+      parse ~check errors rest (push_mode mode stack)
+  | (Unwrapped _ | Wrapped _) :: _,
+    { token = Int value ; loc } :: rest
+  | (Expression None | Sequence _ | Toplevel _) :: _,
+    { token = Int value ; loc } :: ([] | { token = Semi | Close_brace} :: _ as rest) ->
+      let expr : node = Int (loc, Z.of_string value) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr stack)
+  | (Unwrapped _ | Wrapped _) :: _,
+    { token = String contents ; loc } :: rest
+  | (Expression None | Sequence _ | Toplevel _) :: _,
+    { token = String contents ; loc } :: ([] | { token = Semi | Close_brace} :: _ as rest) ->
+      let expr : node = String (loc, contents) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr stack)
+  | (Unwrapped _ | Wrapped _) :: _,
+    { token = Bytes contents ; loc } :: rest
+  | (Expression None | Sequence _ | Toplevel _) :: _,
+    { token = Bytes contents ; loc } :: ([] | { token = Semi | Close_brace} :: _ as rest) ->
+      let errors, contents = if String.length contents mod 2 <> 0 then
+          Odd_lengthed_bytes loc :: errors, contents ^ "0"
+        else errors, contents in
+      let bytes =
+        MBytes.of_hex (`Hex (String.sub contents 2 (String.length contents - 2))) in
+      let expr : node = Bytes (loc, bytes) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr stack)
+  | Sequence ({ loc = { start } }, exprs) :: _ ,
+    { token = Close_brace ; loc = { stop } } :: rest ->
+      let exprs = List.rev exprs in
+      let expr = Micheline.Seq ({ start ; stop }, exprs) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr (pop_mode stack))
+  | (Sequence _ | Toplevel _) :: _ ,
+    { token = Semi } :: rest ->
+      parse ~check errors rest stack
+  | Unwrapped ({ start ; stop }, name, exprs, annot) :: Expression _ :: _,
+    ([] as rest)
+  | Unwrapped ({ start ; stop }, name, exprs, annot) :: Toplevel _ :: _,
+    ({ token = Semi } :: _ | [] as rest)
+  | Unwrapped ({ start ; stop }, name, exprs, annot) :: Sequence _ :: _ ,
+    ({ token = Close_brace | Semi } :: _ as rest)
+  | Wrapped ({ loc = { start ; stop } }, name, exprs, annot) :: _ ,
+    { token = Close_paren } :: rest ->
+      let exprs = List.rev exprs in
+      let stop = if exprs = [] then stop else max_point exprs in
+      let expr = Micheline.Prim ({ start ; stop }, name, exprs, annot) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr (pop_mode stack))
+  | (Wrapped _ | Unwrapped _) :: _ ,
+    ({ token = Open_paren } as token) :: { token = Ident name } :: ({ token = Annot _ } :: _ as rest) ->
+      let annots, rest = annots rest in
+      let mode = Wrapped (token, name, [], annots) in
+      parse ~check errors rest (push_mode mode stack)
+  | (Wrapped _ | Unwrapped _) :: _ ,
+    ({ token = Open_paren } as token) :: { token = Ident name } :: rest ->
+      let mode = Wrapped (token, name, [], []) in
+      parse ~check errors rest (push_mode mode stack)
+  | (Wrapped _ | Unwrapped _) :: _ ,
+    { token = Ident name ; loc } :: rest ->
+      let expr = Micheline.Prim (loc, name, [], []) in
+      let errors = if check then do_check ~toplevel: false errors expr else errors in
+      parse ~check errors rest (fill_mode expr stack)
+  | (Wrapped _ | Unwrapped _ | Toplevel _ | Sequence _ | Expression None) :: _ ,
+    ({ token = Open_brace } as token) :: rest ->
+      let mode = Sequence (token, []) in
+      parse ~check errors rest (push_mode mode stack)
+(* indentation checker *)
+and do_check ?(toplevel = false) errors = function
+  | Seq ({ start ; stop }, []) as expr ->
+      if start.column >= stop.column then
+        Misaligned expr :: errors
+      else errors
+  | Prim ({ start ; stop }, _, first :: rest, _)
+  | Seq ({ start ; stop }, first :: rest) as expr ->
+      let { column = first_column ; line = first_line } =
+        min_point [ first ] in
+      if start.column >= stop.column then
+        Misaligned expr :: errors
+      else if not toplevel && start.column >= first_column then
+        Misaligned expr :: errors
+      else
+        (* In a sequence or in the arguments of a primitive, we
+           require all items to be aligned, but we relax the rule to
+           allow consecutive items to be writtem on the same line. *)
+        let rec in_line_or_aligned prev_start_line errors = function
+          | [] -> errors
+          | expr :: rest ->
+              let { column ; line = start_line } = min_point [ expr ] in
+              let { line = stop_line } = max_point [ expr ] in
+              let errors =
+                if stop_line <> prev_start_line
+                && column <> first_column then
+                  Misaligned expr :: errors
+                else
+                  errors in
+              in_line_or_aligned start_line errors rest in
+        in_line_or_aligned first_line errors rest
+  | Prim (_, _, [], _) | String _ | Int _ | Bytes _ -> errors
+
+let parse_expression ?check tokens =
+  let result = match tokens with
+    | ({ token = Open_paren } as token) :: { token = Ident name } :: { token = Annot annot } :: rest ->
+        let annots, rest = annots rest in
+        let mode = Wrapped (token, name, [], annot :: annots) in
+        parse ?check [] rest [ mode ; Expression None ]
+    | ({ token = Open_paren } as token) :: { token = Ident name } :: rest ->
+        let mode = Wrapped (token, name, [], []) in
+        parse ?check [] rest [ mode ; Expression None ]
+    | _ ->
+        parse ?check [] tokens [ Expression None ] in
+  match result with
+  | [ single ], errors -> single, errors
+  | _ -> assert false
+
+let parse_toplevel ?check tokens =
+  parse ?check [] tokens [ Toplevel [] ]
+
+let print_point ppf { line ; column } =
+  Format.fprintf ppf
+    "At line %d character %d"
+    line column
+
+let print_token_kind ppf = function
+  | Open_paren | Close_paren -> Format.fprintf ppf "parenthesis"
+  | Open_brace | Close_brace -> Format.fprintf ppf "curly brace"
+  | String _ -> Format.fprintf ppf "string constant"
+  | Bytes _ -> Format.fprintf ppf "bytes constant"
+  | Int _ -> Format.fprintf ppf "integer constant"
+  | Ident _ -> Format.fprintf ppf "identifier"
+  | Annot _ -> Format.fprintf ppf "annotation"
+  | Comment _ | Eol_comment _ -> Format.fprintf ppf "comment"
+  | Semi -> Format.fprintf ppf "semi colon"
+
+let print_location ppf loc =
+  if loc.start.line = loc.stop.line then
+    if loc.start.column = loc.stop.column then
+      Format.fprintf ppf
+        "At line %d character %d"
+        loc.start.line loc.start.column
+    else
+      Format.fprintf ppf
+        "At line %d characters %d to %d"
+        loc.start.line loc.start.column loc.stop.column
+  else
+    Format.fprintf ppf
+      "From line %d character %d to line %d character %d"
+      loc.start.line loc.start.column loc.stop.line loc.stop.column
+
+let no_parsing_error (ast, errors) =
+  match errors with
+  | [] -> ok ast
+  | errors -> Error errors
+
+let () =
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.invalid_utf8_sequence"
+    ~title: "Micheline parser error: invalid UTF-8 sequence"
+    ~description: "While parsing a piece of Micheline source, \
+                   a sequence of bytes that is not valid UTF-8 \
+                   was encountered."
+    ~pp:(fun ppf (point, str) -> Format.fprintf ppf "%a, invalid UTF-8 sequence %S" print_point point str)
+    Data_encoding.(obj2 (req "point" point_encoding) (req "sequence" string))
+    (function Invalid_utf8_sequence (point, str) -> Some (point, str) | _ -> None)
+    (fun (point, str) -> Invalid_utf8_sequence (point, str)) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unexpected_character"
+    ~title: "Micheline parser error: unexpected character"
+    ~description: "While parsing a piece of Micheline source, \
+                   an unexpected character was encountered."
+    ~pp:(fun ppf (point, str) -> Format.fprintf ppf "%a, unexpected character %s" print_point point str)
+    Data_encoding.(obj2 (req "point" point_encoding) (req "character" string))
+    (function Unexpected_character (point, str) -> Some (point, str) | _ -> None)
+    (fun (point, str) -> Unexpected_character (point, str)) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.undefined_escape_sequence"
+    ~title: "Micheline parser error: undefined escape sequence"
+    ~description: "While parsing a piece of Micheline source, \
+                   an unexpected escape sequence was encountered in a string."
+    ~pp:(fun ppf (point, str) -> Format.fprintf ppf "%a, undefined escape sequence \"%s\"" print_point point str)
+    Data_encoding.(obj2 (req "point" point_encoding) (req "sequence" string))
+    (function Undefined_escape_sequence (point, str) -> Some (point, str) | _ -> None)
+    (fun (point, str) -> Undefined_escape_sequence (point, str)) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.missing_break_after_number"
+    ~title: "Micheline parser error: missing break after number"
+    ~description: "While parsing a piece of Micheline source, \
+                   a number was not visually separated from \
+                   its follower token, leading to misreadability."
+    ~pp:(fun ppf point -> Format.fprintf ppf "%a, missing break after number" print_point point)
+    Data_encoding.(obj1 (req "point" point_encoding))
+    (function Missing_break_after_number point -> Some point | _ -> None)
+    (fun point -> Missing_break_after_number point) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unterminated_string"
+    ~title: "Micheline parser error: unterminated string"
+    ~description: "While parsing a piece of Micheline source, \
+                   a string was not terminated."
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, unterminated string" print_location loc)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Unterminated_string loc -> Some loc | _ -> None)
+    (fun loc -> Unterminated_string loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unterminated_integer"
+    ~title: "Micheline parser error: unterminated integer"
+    ~description: "While parsing a piece of Micheline source, \
+                   an integer was not terminated."
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, unterminated integer" print_location loc)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Unterminated_integer loc -> Some loc | _ -> None)
+    (fun loc -> Unterminated_integer loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.odd_lengthed_bytes"
+    ~title: "Micheline parser error: odd lengthed bytes"
+    ~description: "While parsing a piece of Micheline source, the \
+                   length of a byte sequence (0x...) was not a \
+                   multiple of two, leaving a trailing half byte."
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, odd_lengthed bytes" print_location loc)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Odd_lengthed_bytes loc -> Some loc | _ -> None)
+    (fun loc -> Odd_lengthed_bytes loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unterminated_comment"
+    ~title: "Micheline parser error: unterminated comment"
+    ~description: "While parsing a piece of Micheline source, \
+                   a commentX was not terminated."
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, unterminated comment" print_location loc)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Unterminated_comment loc -> Some loc | _ -> None)
+    (fun loc -> Unterminated_comment loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.annotation_exceeds_max_length"
+    ~title: "Micheline parser error: annotation exceeds max length"
+    ~description: (Format.sprintf
+                     "While parsing a piece of Micheline source, \
+                      an annotation exceeded the maximum length (%d)." max_annot_length)
+    ~pp:(fun ppf loc -> Format.fprintf ppf "%a, annotation exceeded maximum length (%d chars)"
+            print_location
+            loc max_annot_length)
+    Data_encoding.(obj1 (req "location" location_encoding))
+    (function Annotation_length loc -> Some loc | _ -> None)
+    (fun loc -> Annotation_length loc) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unclosed_token"
+    ~title: "Micheline parser error: unclosed token"
+    ~description: "While parsing a piece of Micheline source, \
+                   a parenthesis or a brace was unclosed."
+    ~pp:(fun ppf (loc, token) ->
+        Format.fprintf ppf "%a, unclosed %a" print_location loc print_token_kind token)
+    Data_encoding.(obj2
+                     (req "location"location_encoding)
+                     (req "token" token_value_encoding))
+    (function Unclosed { loc ; token } -> Some (loc, token) | _ -> None)
+    (fun (loc, token) -> Unclosed { loc ; token }) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.unexpected_token"
+    ~title: "Micheline parser error: unexpected token"
+    ~description: "While parsing a piece of Micheline source, \
+                   an unexpected token was encountered."
+    ~pp:(fun ppf (loc, token) ->
+        Format.fprintf ppf "%a, unexpected %a" print_location loc print_token_kind token)
+    Data_encoding.(obj2
+                     (req "location"location_encoding)
+                     (req "token" token_value_encoding))
+    (function Unexpected { loc ; token } -> Some (loc, token) | _ -> None)
+    (fun (loc, token) -> Unexpected { loc ; token }) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.extra_token"
+    ~title: "Micheline parser error: extra token"
+    ~description: "While parsing a piece of Micheline source, \
+                   an extra semi colon or parenthesis was encountered."
+    ~pp:(fun ppf (loc, token) ->
+        Format.fprintf ppf "%a, extra %a" print_location loc print_token_kind token)
+    Data_encoding.(obj2
+                     (req "location"location_encoding)
+                     (req "token" token_value_encoding))
+    (function Extra { loc ; token } -> Some (loc, token) | _ -> None)
+    (fun (loc, token) -> Extra { loc ; token }) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.misaligned_node"
+    ~title: "Micheline parser error: misaligned node"
+    ~description: "While parsing a piece of Micheline source, \
+                   an expression was not aligned with its \
+                   siblings of the same mother application \
+                   or sequence."
+    ~pp:(fun ppf node ->
+        Format.fprintf ppf "%a, misaligned expression" print_location (location node))
+    Data_encoding.(obj1 (req "expression" node_encoding))
+    (function Misaligned node -> Some node | _ -> None)
+    (fun node -> Misaligned node) ;
+  register_error_kind `Permanent
+    ~id: "micheline.parse_error.empty_expression"
+    ~title: "Micheline parser error: empty_expression"
+    ~description: "Tried to interpret an empty piece or \
+                   Micheline source as a single expression."
+    ~pp:(fun ppf () -> Format.fprintf ppf "empty expression")
+    Data_encoding.empty
+    (function Empty -> Some () | _ -> None)
+    (fun () -> Empty)
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_parser.mli b/vendors/tezos-modded/src/lib_micheline/micheline_parser.mli
new file mode 100644
index 000000000..2e50f4cd4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_parser.mli
@@ -0,0 +1,101 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+type 'a parsing_result = 'a * error list
+
+val no_parsing_error : 'a parsing_result -> 'a tzresult
+
+type point =
+  { point : int ;
+    byte : int ;
+    line : int ;
+    column : int }
+
+val point_zero : point
+
+type location =
+  { start : point ;
+    stop : point }
+
+val location_zero : location
+
+val point_encoding : point Data_encoding.encoding
+
+val location_encoding : location Data_encoding.encoding
+
+type token_value =
+  | String of string
+  | Bytes of string
+  | Int of string
+  | Ident of string
+  | Annot of string
+  | Comment of string
+  | Eol_comment of string
+  | Semi
+  | Open_paren | Close_paren
+  | Open_brace | Close_brace
+
+type token =
+  { token : token_value ;
+    loc : location }
+
+val tokenize : string -> token list parsing_result
+
+type node = (location, string) Micheline.node
+
+(** Beginning of a sequence of consecutive primitives *)
+val min_point : node list -> point
+
+(** End of a sequence of consecutive primitives *)
+val max_point : node list -> point
+
+val max_annot_length : int
+
+val node_encoding : node Data_encoding.encoding
+
+type error += Invalid_utf8_sequence of point * string
+type error += Unexpected_character of point * string
+type error += Undefined_escape_sequence of point * string
+type error += Missing_break_after_number of point
+type error += Unterminated_string of location
+type error += Unterminated_integer of location
+type error += Odd_lengthed_bytes of location
+type error += Unterminated_comment of location
+type error += Unclosed of token
+type error += Unexpected of token
+type error += Extra of token
+type error += Misaligned of node
+type error += Empty
+type error += Annotation_length of location
+
+val parse_toplevel : ?check:bool -> token list -> node list parsing_result
+
+val parse_expression : ?check:bool -> token list -> node parsing_result
+
+val print_location : Format.formatter -> location -> unit
+
+val print_point : Format.formatter -> point -> unit
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_printer.ml b/vendors/tezos-modded/src/lib_micheline/micheline_printer.ml
new file mode 100644
index 000000000..eb2b0176b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_printer.ml
@@ -0,0 +1,183 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Micheline
+
+type location = { comment : string option }
+
+type node = (location, string) Micheline.node
+
+let printable
+    ?(comment = (fun _ -> None))
+    map_prim expr =
+  let map_loc loc =
+    { comment = comment loc } in
+  map_node map_loc map_prim (root expr)
+
+let print_comment ppf text =
+  Format.fprintf ppf "/* @[<h>%a@] */" Format.pp_print_text text
+
+let print_string ppf text =
+  Format.fprintf ppf "\"" ;
+  String.iter (function
+      | '"' -> Format.fprintf ppf "\\\""
+      | '\n' -> Format.fprintf ppf "\\n"
+      | '\r' -> Format.fprintf ppf "\\r"
+      | '\b' -> Format.fprintf ppf "\\b"
+      | '\t' -> Format.fprintf ppf "\\t"
+      | '\\' -> Format.fprintf ppf "\\\\"
+      | c -> Format.fprintf ppf "%c" c)
+    text ;
+  Format.fprintf ppf "\""
+
+let print_annotations =
+  Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string
+
+let preformat root =
+  let preformat_loc = function
+    | { comment = None } ->
+        (false, 0)
+    | { comment = Some text } ->
+        (String.contains text '\n', String.length text + 1) in
+  let preformat_annots = function
+    | [] -> 0
+    | annots -> String.length (String.concat " " annots) + 2 in
+  let rec preformat_expr = function
+    | Int (loc, value) ->
+        let cml, csz = preformat_loc loc in
+        Int ((cml, String.length (Z.to_string value) + csz, loc), value)
+    | String (loc, value) ->
+        let cml, csz = preformat_loc loc in
+        String ((cml, String.length value + csz, loc), value)
+    | Bytes (loc, value) ->
+        let cml, csz = preformat_loc loc in
+        Bytes ((cml, MBytes.length value * 2 + 2 + csz, loc), value)
+    | Prim (loc, name, items, annots) ->
+        let cml, csz = preformat_loc loc in
+        let asz = preformat_annots annots in
+        let items = List.map preformat_expr items in
+        let ml, sz =
+          List.fold_left
+            (fun (tml, tsz) e ->
+               let (ml, sz, _) = location e in
+               (tml || ml, tsz + 1 + sz))
+            (cml, String.length name + csz + asz)
+            items in
+        Prim ((ml, sz, loc), name, items, annots)
+    | Seq (loc, items) ->
+        let cml, csz = preformat_loc loc in
+        let items = List.map preformat_expr items in
+        let ml, sz =
+          List.fold_left
+            (fun (tml, tsz) e ->
+               let (ml, sz, _) = location e in
+               (tml || ml, tsz + 3 + sz))
+            (cml, 4 + csz)
+            items in
+        Seq ((ml, sz, loc), items) in
+  preformat_expr root
+
+let rec print_expr_unwrapped ppf = function
+  | Prim ((ml, s, { comment }), name, args, annot) ->
+      let name = match annot with
+        | [] -> name
+        | annots ->
+            Format.asprintf "%s @[<h>%a@]" name print_annotations annots in
+      if not ml && s < 80 then begin
+        if args = [] then
+          Format.fprintf ppf "%s" name
+        else
+          Format.fprintf ppf "@[<h>%s %a@]" name (Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr) args ;
+        begin match comment with
+          | None -> ()
+          | Some text -> Format.fprintf ppf "@ /* %s */" text
+        end ;
+      end else begin
+        if args = [] then
+          Format.fprintf ppf "%s" name
+        else if String.length name <= 4 then
+          Format.fprintf ppf "%s @[<v 0>%a@]" name (Format.pp_print_list print_expr) args
+        else
+          Format.fprintf ppf "@[<v 2>%s@,%a@]" name (Format.pp_print_list print_expr) args ;
+        begin match comment with
+          | None -> ()
+          | Some comment -> Format.fprintf ppf "@ %a" print_comment comment
+        end
+      end
+  | Int ((_, _, { comment }), value) ->
+      begin match comment with
+        | None -> Format.fprintf ppf "%s" (Z.to_string value)
+        | Some comment -> Format.fprintf ppf "%s@ %a" (Z.to_string value) print_comment comment
+      end
+  | String ((_, _, { comment }), value) ->
+      begin match comment with
+        | None -> print_string ppf value
+        | Some comment -> Format.fprintf ppf "%a@ %a" print_string value print_comment comment
+      end
+  | Bytes ((_, _, { comment }), value) ->
+      begin match comment with
+        | None -> Format.fprintf ppf "0x%a" MBytes.pp_hex value
+        | Some comment -> Format.fprintf ppf "0x%a@ %a" MBytes.pp_hex value print_comment comment
+      end
+  | Seq ((_, _, { comment = None }), []) ->
+      Format.fprintf ppf "{}"
+  | Seq ((ml, s, { comment }), items) ->
+      if not ml && s < 80 then
+        Format.fprintf ppf "{ @[<h 0>"
+      else
+        Format.fprintf ppf "{ @[<v 0>" ;
+      begin match comment, items with
+        | None, _ -> ()
+        | Some comment, [] -> Format.fprintf ppf "%a" print_comment comment
+        | Some comment, _ -> Format.fprintf ppf "%a@ " print_comment comment
+      end ;
+      Format.pp_print_list
+        ~pp_sep:(fun ppf () -> Format.fprintf ppf " ;@ ")
+        print_expr_unwrapped
+        ppf items ;
+      Format.fprintf ppf "@] }"
+
+and print_expr ppf = function
+  | Prim (_, _, _ :: _, _)
+  | Prim (_, _, [], _ :: _) as expr ->
+      Format.fprintf ppf "(%a)" print_expr_unwrapped expr
+  | expr -> print_expr_unwrapped ppf expr
+
+let with_unbounded_formatter ppf f x =
+  let buf = Buffer.create 10000 in
+  let sppf = Format.formatter_of_buffer buf in
+  Format.pp_set_margin sppf 199999 ;
+  Format.pp_set_max_indent sppf 99999 ;
+  Format.pp_set_max_boxes sppf 99999 ;
+  f sppf x ;
+  Format.fprintf sppf "%!" ;
+  let lines = String.split_on_char '\n' (Buffer.contents buf) in
+  Format.pp_print_list ~pp_sep:Format.pp_force_newline Format.pp_print_string ppf lines
+
+let print_expr_unwrapped ppf expr =
+  with_unbounded_formatter ppf print_expr_unwrapped (preformat expr)
+
+let print_expr ppf expr =
+  with_unbounded_formatter ppf print_expr (preformat expr)
diff --git a/vendors/tezos-modded/src/lib_micheline/micheline_printer.mli b/vendors/tezos-modded/src/lib_micheline/micheline_printer.mli
new file mode 100644
index 000000000..05b5a38be
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/micheline_printer.mli
@@ -0,0 +1,39 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Micheline
+
+val print_string : Format.formatter -> string -> unit
+
+type location = { comment : string option }
+
+type node = (location, string) Micheline.node
+
+val print_expr : Format.formatter -> (location, string) Micheline.node -> unit
+val print_expr_unwrapped : Format.formatter -> (location, string) Micheline.node -> unit
+
+val printable :
+  ?comment: (int -> string option) ->
+  ('p -> string) -> 'p canonical -> (location, string) Micheline.node
diff --git a/vendors/tezos-modded/src/lib_micheline/michelson_primitives.ml b/vendors/tezos-modded/src/lib_micheline/michelson_primitives.ml
new file mode 100644
index 000000000..09a2a0846
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/michelson_primitives.ml
@@ -0,0 +1,563 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Micheline_main
+
+type prim =
+  | K_parameter
+  | K_storage
+  | K_code
+  | D_False
+  | D_Elt
+  | D_Left
+  | D_None
+  | D_Pair
+  | D_Right
+  | D_Some
+  | D_True
+  | D_Unit
+  | I_PACK
+  | I_UNPACK
+  | I_BLAKE2B
+  | I_SHA256
+  | I_SHA512
+  | I_ABS
+  | I_ADD
+  | I_AMOUNT
+  | I_AND
+  | I_BALANCE
+  | I_CAR
+  | I_CDR
+  | I_CHECK_SIGNATURE
+  | I_COMPARE
+  | I_CONCAT
+  | I_CONS
+  | I_CREATE_ACCOUNT
+  | I_CREATE_CONTRACT
+  | I_IMPLICIT_ACCOUNT
+  | I_DIP
+  | I_DROP
+  | I_DUP
+  | I_EDIV
+  | I_EMPTY_MAP
+  | I_EMPTY_SET
+  | I_EQ
+  | I_EXEC
+  | I_FAILWITH
+  | I_GE
+  | I_GET
+  | I_GT
+  | I_HASH_KEY
+  | I_IF
+  | I_IF_CONS
+  | I_IF_LEFT
+  | I_IF_NONE
+  | I_INT
+  | I_LAMBDA
+  | I_LE
+  | I_LEFT
+  | I_LOOP
+  | I_LSL
+  | I_LSR
+  | I_LT
+  | I_MAP
+  | I_MEM
+  | I_MUL
+  | I_NEG
+  | I_NEQ
+  | I_NIL
+  | I_NONE
+  | I_NOP
+  | I_NOT
+  | I_NOW
+  | I_OR
+  | I_PAIR
+  | I_PUSH
+  | I_RIGHT
+  | I_SIZE
+  | I_SOME
+  | I_SOURCE
+  | I_SENDER
+  | I_SELF
+  | I_SLICE
+  | I_STEPS_TO_QUOTA
+  | I_SUB
+  | I_SWAP
+  | I_TRANSFER_TOKENS
+  | I_SET_DELEGATE
+  | I_UNIT
+  | I_UPDATE
+  | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
+  | I_ADDRESS
+  | I_CONTRACT
+  | I_ISNAT
+  | I_CAST
+  | I_RENAME
+  | T_bool
+  | T_contract
+  | T_int
+  | T_key
+  | T_key_hash
+  | T_lambda
+  | T_list
+  | T_map
+  | T_big_map
+  | T_nat
+  | T_option
+  | T_or
+  | T_pair
+  | T_set
+  | T_signature
+  | T_string
+  | T_bytes
+  | T_mutez
+  | T_timestamp
+  | T_unit
+  | T_operation
+  | T_address
+
+let valid_case name =
+  let is_lower = function  '_' | 'a'..'z' -> true | _ -> false in
+  let is_upper = function  '_' | 'A'..'Z' -> true | _ -> false in
+  let rec for_all a b f =
+    Compare.Int.(a > b) || f a && for_all (a + 1) b f in
+  let len = String.length name in
+  Compare.Int.(len <> 0)
+  &&
+  Compare.Char.(String.get name 0 <> '_')
+  &&
+  ((is_upper (String.get name 0)
+    && for_all 1 (len - 1) (fun i -> is_upper (String.get name i)))
+   ||
+   (is_upper (String.get name 0)
+    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i)))
+   ||
+   (is_lower (String.get name 0)
+    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i))))
+
+let string_of_prim = function
+  | K_parameter -> "parameter"
+  | K_storage -> "storage"
+  | K_code -> "code"
+  | D_False -> "False"
+  | D_Elt -> "Elt"
+  | D_Left -> "Left"
+  | D_None -> "None"
+  | D_Pair -> "Pair"
+  | D_Right -> "Right"
+  | D_Some -> "Some"
+  | D_True -> "True"
+  | D_Unit -> "Unit"
+  | I_PACK -> "PACK"
+  | I_UNPACK -> "UNPACK"
+  | I_BLAKE2B -> "BLAKE2B"
+  | I_SHA256 -> "SHA256"
+  | I_SHA512 -> "SHA512"
+  | I_ABS -> "ABS"
+  | I_ADD -> "ADD"
+  | I_AMOUNT -> "AMOUNT"
+  | I_AND -> "AND"
+  | I_BALANCE -> "BALANCE"
+  | I_CAR -> "CAR"
+  | I_CDR -> "CDR"
+  | I_CHECK_SIGNATURE -> "CHECK_SIGNATURE"
+  | I_COMPARE -> "COMPARE"
+  | I_CONCAT -> "CONCAT"
+  | I_CONS -> "CONS"
+  | I_CREATE_ACCOUNT -> "CREATE_ACCOUNT"
+  | I_CREATE_CONTRACT -> "CREATE_CONTRACT"
+  | I_IMPLICIT_ACCOUNT -> "IMPLICIT_ACCOUNT"
+  | I_DIP -> "DIP"
+  | I_DROP -> "DROP"
+  | I_DUP -> "DUP"
+  | I_EDIV -> "EDIV"
+  | I_EMPTY_MAP -> "EMPTY_MAP"
+  | I_EMPTY_SET -> "EMPTY_SET"
+  | I_EQ -> "EQ"
+  | I_EXEC -> "EXEC"
+  | I_FAILWITH -> "FAILWITH"
+  | I_GE -> "GE"
+  | I_GET -> "GET"
+  | I_GT -> "GT"
+  | I_HASH_KEY -> "HASH_KEY"
+  | I_IF -> "IF"
+  | I_IF_CONS -> "IF_CONS"
+  | I_IF_LEFT -> "IF_LEFT"
+  | I_IF_NONE -> "IF_NONE"
+  | I_INT -> "INT"
+  | I_LAMBDA -> "LAMBDA"
+  | I_LE -> "LE"
+  | I_LEFT -> "LEFT"
+  | I_LOOP -> "LOOP"
+  | I_LSL -> "LSL"
+  | I_LSR -> "LSR"
+  | I_LT -> "LT"
+  | I_MAP -> "MAP"
+  | I_MEM -> "MEM"
+  | I_MUL -> "MUL"
+  | I_NEG -> "NEG"
+  | I_NEQ -> "NEQ"
+  | I_NIL -> "NIL"
+  | I_NONE -> "NONE"
+  | I_NOP -> "NOP"
+  | I_NOT -> "NOT"
+  | I_NOW -> "NOW"
+  | I_OR -> "OR"
+  | I_PAIR -> "PAIR"
+  | I_PUSH -> "PUSH"
+  | I_RIGHT -> "RIGHT"
+  | I_SIZE -> "SIZE"
+  | I_SOME -> "SOME"
+  | I_SOURCE -> "SOURCE"
+  | I_SENDER -> "SENDER"
+  | I_SELF -> "SELF"
+  | I_SLICE -> "SLICE"
+  | I_STEPS_TO_QUOTA -> "STEPS_TO_QUOTA"
+  | I_SUB -> "SUB"
+  | I_SWAP -> "SWAP"
+  | I_TRANSFER_TOKENS -> "TRANSFER_TOKENS"
+  | I_SET_DELEGATE -> "SET_DELEGATE"
+  | I_UNIT -> "UNIT"
+  | I_UPDATE -> "UPDATE"
+  | I_XOR -> "XOR"
+  | I_ITER -> "ITER"
+  | I_LOOP_LEFT -> "LOOP_LEFT"
+  | I_ADDRESS -> "ADDRESS"
+  | I_CONTRACT -> "CONTRACT"
+  | I_ISNAT -> "ISNAT"
+  | I_CAST -> "CAST"
+  | I_RENAME -> "RENAME"
+  | T_bool -> "bool"
+  | T_contract -> "contract"
+  | T_int -> "int"
+  | T_key -> "key"
+  | T_key_hash -> "key_hash"
+  | T_lambda -> "lambda"
+  | T_list -> "list"
+  | T_map -> "map"
+  | T_big_map -> "big_map"
+  | T_nat -> "nat"
+  | T_option -> "option"
+  | T_or -> "or"
+  | T_pair -> "pair"
+  | T_set -> "set"
+  | T_signature -> "signature"
+  | T_string -> "string"
+  | T_bytes -> "bytes"
+  | T_mutez -> "mutez"
+  | T_timestamp -> "timestamp"
+  | T_unit -> "unit"
+  | T_operation -> "operation"
+  | T_address -> "address"
+
+type failure =
+    Unknown_primitive_name of string
+  | Invalid_case of string
+  | Invalid_primitive_name of string Micheline_main.canonical * Micheline_main.canonical_location
+
+let prim_of_string : string -> (prim , failure) result = function
+  | "parameter" -> Ok K_parameter
+  | "storage" -> Ok K_storage
+  | "code" -> Ok K_code
+  | "False" -> Ok D_False
+  | "Elt" -> Ok D_Elt
+  | "Left" -> Ok D_Left
+  | "None" -> Ok D_None
+  | "Pair" -> Ok D_Pair
+  | "Right" -> Ok D_Right
+  | "Some" -> Ok D_Some
+  | "True" -> Ok D_True
+  | "Unit" -> Ok D_Unit
+  | "PACK" -> Ok I_PACK
+  | "UNPACK" -> Ok I_UNPACK
+  | "BLAKE2B" -> Ok I_BLAKE2B
+  | "SHA256" -> Ok I_SHA256
+  | "SHA512" -> Ok I_SHA512
+  | "ABS" -> Ok I_ABS
+  | "ADD" -> Ok I_ADD
+  | "AMOUNT" -> Ok I_AMOUNT
+  | "AND" -> Ok I_AND
+  | "BALANCE" -> Ok I_BALANCE
+  | "CAR" -> Ok I_CAR
+  | "CDR" -> Ok I_CDR
+  | "CHECK_SIGNATURE" -> Ok I_CHECK_SIGNATURE
+  | "COMPARE" -> Ok I_COMPARE
+  | "CONCAT" -> Ok I_CONCAT
+  | "CONS" -> Ok I_CONS
+  | "CREATE_ACCOUNT" -> Ok I_CREATE_ACCOUNT
+  | "CREATE_CONTRACT" -> Ok I_CREATE_CONTRACT
+  | "IMPLICIT_ACCOUNT" -> Ok I_IMPLICIT_ACCOUNT
+  | "DIP" -> Ok I_DIP
+  | "DROP" -> Ok I_DROP
+  | "DUP" -> Ok I_DUP
+  | "EDIV" -> Ok I_EDIV
+  | "EMPTY_MAP" -> Ok I_EMPTY_MAP
+  | "EMPTY_SET" -> Ok I_EMPTY_SET
+  | "EQ" -> Ok I_EQ
+  | "EXEC" -> Ok I_EXEC
+  | "FAILWITH" -> Ok I_FAILWITH
+  | "GE" -> Ok I_GE
+  | "GET" -> Ok I_GET
+  | "GT" -> Ok I_GT
+  | "HASH_KEY" -> Ok I_HASH_KEY
+  | "IF" -> Ok I_IF
+  | "IF_CONS" -> Ok I_IF_CONS
+  | "IF_LEFT" -> Ok I_IF_LEFT
+  | "IF_NONE" -> Ok I_IF_NONE
+  | "INT" -> Ok I_INT
+  | "LAMBDA" -> Ok I_LAMBDA
+  | "LE" -> Ok I_LE
+  | "LEFT" -> Ok I_LEFT
+  | "LOOP" -> Ok I_LOOP
+  | "LSL" -> Ok I_LSL
+  | "LSR" -> Ok I_LSR
+  | "LT" -> Ok I_LT
+  | "MAP" -> Ok I_MAP
+  | "MEM" -> Ok I_MEM
+  | "MUL" -> Ok I_MUL
+  | "NEG" -> Ok I_NEG
+  | "NEQ" -> Ok I_NEQ
+  | "NIL" -> Ok I_NIL
+  | "NONE" -> Ok I_NONE
+  | "NOP" -> Ok I_NOP
+  | "NOT" -> Ok I_NOT
+  | "NOW" -> Ok I_NOW
+  | "OR" -> Ok I_OR
+  | "PAIR" -> Ok I_PAIR
+  | "PUSH" -> Ok I_PUSH
+  | "RIGHT" -> Ok I_RIGHT
+  | "SIZE" -> Ok I_SIZE
+  | "SOME" -> Ok I_SOME
+  | "SOURCE" -> Ok I_SOURCE
+  | "SENDER" -> Ok I_SENDER
+  | "SELF" -> Ok I_SELF
+  | "SLICE" -> Ok I_SLICE
+  | "STEPS_TO_QUOTA" -> Ok I_STEPS_TO_QUOTA
+  | "SUB" -> Ok I_SUB
+  | "SWAP" -> Ok I_SWAP
+  | "TRANSFER_TOKENS" -> Ok I_TRANSFER_TOKENS
+  | "SET_DELEGATE" -> Ok I_SET_DELEGATE
+  | "UNIT" -> Ok I_UNIT
+  | "UPDATE" -> Ok I_UPDATE
+  | "XOR" -> Ok I_XOR
+  | "ITER" -> Ok I_ITER
+  | "LOOP_LEFT" -> Ok I_LOOP_LEFT
+  | "ADDRESS" -> Ok I_ADDRESS
+  | "CONTRACT" -> Ok I_CONTRACT
+  | "ISNAT" -> Ok I_ISNAT
+  | "CAST" -> Ok I_CAST
+  | "RENAME" -> Ok I_RENAME
+  | "bool" -> Ok T_bool
+  | "contract" -> Ok T_contract
+  | "int" -> Ok T_int
+  | "key" -> Ok T_key
+  | "key_hash" -> Ok T_key_hash
+  | "lambda" -> Ok T_lambda
+  | "list" -> Ok T_list
+  | "map" -> Ok T_map
+  | "big_map" -> Ok T_big_map
+  | "nat" -> Ok T_nat
+  | "option" -> Ok T_option
+  | "or" -> Ok T_or
+  | "pair" -> Ok T_pair
+  | "set" -> Ok T_set
+  | "signature" -> Ok T_signature
+  | "string" -> Ok T_string
+  | "bytes" -> Ok T_bytes
+  | "mutez" -> Ok T_mutez
+  | "timestamp" -> Ok T_timestamp
+  | "unit" -> Ok T_unit
+  | "operation" -> Ok T_operation
+  | "address" -> Ok T_address
+  | n ->
+      if valid_case n then
+        Error (Unknown_primitive_name n)
+      else
+        Error (Invalid_case n)
+
+
+let prims_of_strings : string canonical -> (prim Micheline_main.canonical , failure) result = fun expr ->
+  let (>>?) x f : (_ , failure) result = match x with
+    | Ok x -> f x
+    | Error _ as err -> err in
+  let rec convert : (canonical_location , string) node -> ((canonical_location , prim) node , failure) result  = function
+    | Int _ | String _ | Bytes _ as expr -> Ok expr
+    | Seq (_, args) -> (
+        let aux : ((canonical_location , prim) node list , failure) result -> (canonical_location , string) node -> ((_ , prim) node list , failure) result =
+          fun acc arg ->
+            acc >>? fun acc' ->
+            convert arg >>? fun arg' ->
+            Ok (arg' :: acc')
+        in
+        (List.fold_left aux (Ok []) args) >>? fun args' ->
+        Ok (Seq (0, List.rev args'))
+      )
+    | Prim (_, prim, args, annot) -> (
+        prim_of_string prim >>? fun prim' ->
+        let aux : (_ list , failure) result -> _ -> (_ list , failure) result = fun acc arg ->
+          acc >>? fun args ->
+          convert arg >>? fun arg ->
+          Ok (arg :: args)
+        in
+        List.fold_left aux (Ok []) args >>? fun args' ->
+        Ok (Prim (0, prim', List.rev args', annot))
+      )
+  in
+  convert (root expr) >>? fun expr ->
+  Ok (strip_locations expr)
+
+let strings_of_prims expr =
+  let rec convert = function
+    | Int _ | String _ | Bytes _ as expr -> expr
+    | Prim (_, prim, args, annot) ->
+        let prim = string_of_prim prim in
+        let args = List.map convert args in
+        Prim (0, prim, args, annot)
+    | Seq (_, args) ->
+        let args = List.map convert args in
+        Seq (0, args) in
+  strip_locations (convert (root expr))
+
+let prim_encoding =
+  let open Data_encoding in
+  def "michelson.v1.primitives" @@
+  string_enum [
+    ("parameter", K_parameter) ;
+    ("storage", K_storage) ;
+    ("code", K_code) ;
+    ("False", D_False) ;
+    ("Elt", D_Elt) ;
+    ("Left", D_Left) ;
+    ("None", D_None) ;
+    ("Pair", D_Pair) ;
+    ("Right", D_Right) ;
+    ("Some", D_Some) ;
+    ("True", D_True) ;
+    ("Unit", D_Unit) ;
+    ("PACK", I_PACK) ;
+    ("UNPACK", I_UNPACK) ;
+    ("BLAKE2B", I_BLAKE2B) ;
+    ("SHA256", I_SHA256) ;
+    ("SHA512", I_SHA512) ;
+    ("ABS", I_ABS) ;
+    ("ADD", I_ADD) ;
+    ("AMOUNT", I_AMOUNT) ;
+    ("AND", I_AND) ;
+    ("BALANCE", I_BALANCE) ;
+    ("CAR", I_CAR) ;
+    ("CDR", I_CDR) ;
+    ("CHECK_SIGNATURE", I_CHECK_SIGNATURE) ;
+    ("COMPARE", I_COMPARE) ;
+    ("CONCAT", I_CONCAT) ;
+    ("CONS", I_CONS) ;
+    ("CREATE_ACCOUNT", I_CREATE_ACCOUNT) ;
+    ("CREATE_CONTRACT", I_CREATE_CONTRACT) ;
+    ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT) ;
+    ("DIP", I_DIP) ;
+    ("DROP", I_DROP) ;
+    ("DUP", I_DUP) ;
+    ("EDIV", I_EDIV) ;
+    ("EMPTY_MAP", I_EMPTY_MAP) ;
+    ("EMPTY_SET", I_EMPTY_SET) ;
+    ("EQ", I_EQ) ;
+    ("EXEC", I_EXEC) ;
+    ("FAILWITH", I_FAILWITH) ;
+    ("GE", I_GE) ;
+    ("GET", I_GET) ;
+    ("GT", I_GT) ;
+    ("HASH_KEY", I_HASH_KEY) ;
+    ("IF", I_IF) ;
+    ("IF_CONS", I_IF_CONS) ;
+    ("IF_LEFT", I_IF_LEFT) ;
+    ("IF_NONE", I_IF_NONE) ;
+    ("INT", I_INT) ;
+    ("LAMBDA", I_LAMBDA) ;
+    ("LE", I_LE) ;
+    ("LEFT", I_LEFT) ;
+    ("LOOP", I_LOOP) ;
+    ("LSL", I_LSL) ;
+    ("LSR", I_LSR) ;
+    ("LT", I_LT) ;
+    ("MAP", I_MAP) ;
+    ("MEM", I_MEM) ;
+    ("MUL", I_MUL) ;
+    ("NEG", I_NEG) ;
+    ("NEQ", I_NEQ) ;
+    ("NIL", I_NIL) ;
+    ("NONE", I_NONE) ;
+    ("NOT", I_NOT) ;
+    ("NOW", I_NOW) ;
+    ("OR", I_OR) ;
+    ("PAIR", I_PAIR) ;
+    ("PUSH", I_PUSH) ;
+    ("RIGHT", I_RIGHT) ;
+    ("SIZE", I_SIZE) ;
+    ("SOME", I_SOME) ;
+    ("SOURCE", I_SOURCE) ;
+    ("SENDER", I_SENDER) ;
+    ("SELF", I_SELF) ;
+    ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA) ;
+    ("SUB", I_SUB) ;
+    ("SWAP", I_SWAP) ;
+    ("TRANSFER_TOKENS", I_TRANSFER_TOKENS) ;
+    ("SET_DELEGATE", I_SET_DELEGATE) ;
+    ("UNIT", I_UNIT) ;
+    ("UPDATE", I_UPDATE) ;
+    ("XOR", I_XOR) ;
+    ("ITER", I_ITER) ;
+    ("LOOP_LEFT", I_LOOP_LEFT) ;
+    ("ADDRESS", I_ADDRESS) ;
+    ("CONTRACT", I_CONTRACT) ;
+    ("ISNAT", I_ISNAT) ;
+    ("CAST", I_CAST) ;
+    ("RENAME", I_RENAME) ;
+    ("bool", T_bool) ;
+    ("contract", T_contract) ;
+    ("int", T_int) ;
+    ("key", T_key) ;
+    ("key_hash", T_key_hash) ;
+    ("lambda", T_lambda) ;
+    ("list", T_list) ;
+    ("map", T_map) ;
+    ("big_map", T_big_map) ;
+    ("nat", T_nat) ;
+    ("option", T_option) ;
+    ("or", T_or) ;
+    ("pair", T_pair) ;
+    ("set", T_set) ;
+    ("signature", T_signature) ;
+    ("string", T_string) ;
+    ("bytes", T_bytes) ;
+    ("mutez", T_mutez) ;
+    ("timestamp", T_timestamp) ;
+    ("unit", T_unit) ;
+    ("operation", T_operation) ;
+    ("address", T_address) ;
+    (* Alpha_002 addition *)
+    ("SLICE", I_SLICE) ;
+  ]
+
diff --git a/vendors/tezos-modded/src/lib_micheline/test/assert.ml b/vendors/tezos-modded/src/lib_micheline/test/assert.ml
new file mode 100644
index 000000000..37b67089b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/test/assert.ml
@@ -0,0 +1,97 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Mini compatibility layer to avoid circular dependency *)
+module Compat = struct
+  let failwith fmt = Format.kasprintf (fun s -> Lwt.return (Error s)) fmt
+  let return_unit = Lwt.return (Ok ())
+  let (>>=) = Lwt.bind
+  let (>>=?) v f =
+    v >>= function
+    | Error _ as err -> Lwt.return err
+    | Ok v -> f v
+  let rec iter2_p f l1 l2 =
+    match l1, l2 with
+    | [], [] -> return_unit
+    | [], _ | _, [] -> invalid_arg "Error_monad.iter2_p"
+    | x1 :: l1 , x2 :: l2 ->
+        let tx = f x1 x2 and tl = iter2_p f l1 l2 in
+        tx >>= fun tx_res ->
+        tl >>= fun tl_res ->
+        match tx_res, tl_res with
+        | Ok (), Ok () -> Lwt.return (Ok ())
+        | Error exn1, Error exn2 -> failwith "%s -- %s" exn1 exn2
+        | Ok (), Error exn
+        | Error exn, Ok () -> Lwt.return (Error exn)
+end
+
+open Compat
+
+let fail loc printer given expected msg =
+  failwith
+    "@[<v 2> On %s : %s@ @[Given:\t%a@]@ @[Expected:\t%a@]@]"
+    loc msg printer given printer expected
+
+let default_printer fmt _ = Format.fprintf fmt ""
+
+let equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected =
+  if not (eq given expected) then
+    fail loc printer given expected msg
+  else
+    return_unit
+
+let not_equal ~loc ?(eq=(=)) ?(printer=default_printer) ?(msg="") given expected =
+  if eq given expected then
+    fail loc printer given expected msg
+  else
+    return_unit
+
+let pp_tokens fmt tokens =
+  let token_value_printer fmt token_value =
+    Format.fprintf fmt "@[%s@]"
+      (let open Micheline_parser in
+       match token_value with
+         String s -> Format.sprintf "String %S" s
+       | Bytes s ->  Format.sprintf "Bytes %S" s
+       | Int s -> Format.sprintf "Int %S" s
+       | Ident s -> Format.sprintf "Ident %S" s
+       | Annot s -> Format.sprintf "Annot %S" s
+       | Comment s -> Format.sprintf "Comment %S" s
+       | Eol_comment s -> Format.sprintf "Eol_comment %S" s
+       | Semi -> Format.sprintf "Semi"
+       | Open_paren -> Format.sprintf "Open_paren"
+       | Close_paren -> Format.sprintf "Close_paren"
+       | Open_brace -> Format.sprintf "Open_brace"
+       | Close_brace -> Format.sprintf "Close_brace"
+      ) in
+  Format.fprintf fmt "%a"
+    (Format.pp_print_list token_value_printer)
+    tokens
+
+let equal_tokens ~loc given expected =
+  equal ~loc ~eq:(=) ~printer:pp_tokens ~msg:"Tokens are not equal" given expected
+
+let not_equal_tokens ~loc given expected =
+  not_equal ~loc ~eq:(=) ~printer:pp_tokens ~msg:"Tokens are equal" given expected
diff --git a/vendors/tezos-modded/src/lib_micheline/test/dune b/vendors/tezos-modded/src/lib_micheline/test/dune
new file mode 100644
index 000000000..ee87647d5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/test/dune
@@ -0,0 +1,25 @@
+(executables
+ (names test_parser)
+ (libraries tezos-micheline
+            alcotest-lwt)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_micheline)))
+
+(alias
+  (name buildtest)
+  (deps test_parser.exe))
+
+(alias
+  (name runtest_micheline_parser)
+  (action (run %{exe:test_parser.exe})))
+
+(alias
+  (name runtest)
+  (deps (alias runtest_micheline_parser)))
+
+(alias
+  (name runtest_indent)
+  (deps (glob_files *.ml{,i}))
+  (action
+    (run bash
+      %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_micheline/test/test_parser.ml b/vendors/tezos-modded/src/lib_micheline/test/test_parser.ml
new file mode 100644
index 000000000..278bf9d74
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/test/test_parser.ml
@@ -0,0 +1,465 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(****************************************************************************)
+(* Token value   *)
+(****************************************************************************)
+
+open Assert.Compat
+
+let assert_tokenize ~loc given expected =
+  match Micheline_parser.tokenize given with
+  | tokens, [] ->
+      let tokens_got =
+        List.map (fun x -> x.Micheline_parser.token) tokens
+      in
+      Assert.equal_tokens ~loc tokens_got expected
+  | _, _ -> failwith "%s - Cannot tokenize %s" loc given
+
+let assert_tokenize_error ~loc given expected =
+  match Micheline_parser.tokenize given with
+  | tokens, [] ->
+      let tokens_got =
+        List.map (fun x -> x.Micheline_parser.token) tokens
+      in
+      Assert.not_equal_tokens ~loc tokens_got expected
+  | _, _ -> return_unit
+
+let test_tokenize_basic () =
+  (* String *)
+  assert_tokenize ~loc:__LOC__ "\"abc\"" [ String "abc" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "\"abc\t\"" [ String "abc\t" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "\"abc\b\"" [ String "abc\b" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "\"abc\\n\"" [ String "abc\n" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "\"abc\\r\"" [ String "abc\r" ] >>=? fun () ->
+  (*fail*)
+  assert_tokenize_error ~loc:__LOC__ "\"abc\n\"" [ String "abc\n" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"abc\\\"" [ String "abc\\" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"abc\"" [ String "abc\n" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"abc\r\"" [ String "abc\r" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "abc\r" [ String "abc\r" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"abc\"\r" [ String "abc\r" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"abc" [ String "abc" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "abc\"" [ String "abc" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "\"\"\"" [ String "" ] >>=? fun () ->
+  (* Bytes *)
+  assert_tokenize ~loc:__LOC__ "0xabc" [ Bytes "0xabc" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "0x" [ Bytes "0x" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "0x1" [ Bytes "0x1" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "xabc" [ Bytes "xabc" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "1xabc" [ Bytes "1xabc" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "1c" [ Bytes "1c" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0c" [ Bytes "0c" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0xx" [ Bytes "0xx" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0b" [ Bytes "0b" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0xg" [ Bytes "0xg" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0X" [ Bytes "0X" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "1x" [ Bytes "1x" ] >>=? fun () ->
+  (* Int *)
+  assert_tokenize ~loc:__LOC__ "10" [ Int "10" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "0" [ Int "0" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "00" [ Int "00" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "001" [ Int "001" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "-0" [ Int "0" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "-1" [ Int "-1" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "1" [ Int "1" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "-10" [ Int "-10" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ ".1000" [ Int ".1000" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "10_00" [ Int "10_00" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "1,000" [ Int "1,000" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "1000.000" [ Int "1000.000" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "-0" [ Int "-0" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "--0" [ Int "0" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "+0" [ Int "0" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "a" [ Int "a" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "0a" [ Int "0a" ] >>=? fun () ->
+  (* Ident *)
+  assert_tokenize ~loc:__LOC__ "string" [ Ident "string" ] >>=? fun () ->
+  (* Annotation *)
+  assert_tokenize ~loc:__LOC__ "@my_pair" [ Annot "@my_pair" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "@@my_pair" [ Annot "@@my_pair" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "$t" [ Annot "$t" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "&t" [ Annot "&t" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":t" [ Annot ":t" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":_" [ Annot ":_" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":0" [ Annot ":0" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":%" [ Annot ":%" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":%%" [ Annot ":%%" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":%@" [ Annot ":%@" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":%@_" [ Annot ":%@_" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ":%@_0" [ Annot ":%@_0" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%from" [ Annot "%from" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%@from" [ Annot "%@from" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%from_a" [ Annot "%from_a" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%from.a" [ Annot "%from.a" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%From.a" [ Annot "%From.a" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "%0From.a" [ Annot "%0From.a" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "?t" [ Annot "?t" ] >>=? fun () ->
+  (*fail*)
+  assert_tokenize_error ~loc:__LOC__ "??t" [ Annot "??t" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "&&t" [ Annot "&&t" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "$$t" [ Annot "$$t" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "_from" [ Annot "_from" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ ".from" [ Annot ".from" ] >>=? fun () ->
+  (*NOTE: the cases below fail because ':' is used in the middle of the
+    annotation. *)
+  assert_tokenize_error ~loc:__LOC__ "%:from" [ Annot "%:from" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "%:@from" [ Annot "%:@from" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "::t" [ Annot "::t" ] >>=? fun () ->
+  (* Comment *)
+  assert_tokenize ~loc:__LOC__
+    "/*\"/**/\"*/" [Comment "/*\"/**/\"*/"] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "/* /* /* */ */ */" [Comment "/* /* /* */ */ */"] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "/*parse 1" [Comment "/*parse 1"] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "parse 1*/" [Comment "parse 1*/"] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "/* */*/" [Comment "/* */*/"] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "/*/* */" [Comment "/*/* */"] >>=? fun () ->
+  (* EOL *)
+  assert_tokenize ~loc:__LOC__ "#Access" [ Eol_comment "#Access" ] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "##Access" [ Eol_comment "##Access" ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "?Access" [ Eol_comment "?Access" ] >>=? fun () ->
+  (* SKIP *)
+  assert_tokenize ~loc:__LOC__ ";" [ Semi] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "{" [ Open_brace] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "}" [ Close_brace] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "(" [ Open_paren] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ ")" [ Close_paren] >>=? fun () ->
+  (*fail*)
+  assert_tokenize_error ~loc:__LOC__ "{" [ Semi ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ ";" [ Open_brace ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "}" [ Open_brace ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ "(" [ Close_paren ] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__ ")" [ Open_paren ]
+
+(*********************)
+(* One line contracts *)
+
+let test_one_line_contract () =
+  assert_tokenize ~loc:__LOC__ "(option int)"
+    [Open_paren; Ident "option"; Ident "int"; Close_paren] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "DIP {ADD}"
+    [Ident "DIP"; Open_brace; Ident "ADD"; Close_brace] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "parameter int;"
+    [Ident "parameter"; Ident "int"; Semi] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "PUSH string \"abc\";"
+    [Ident "PUSH"; Ident "string"; String "abc"; Semi] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "DROP; SWAP"
+    [Ident "DROP"; Semi; Ident "SWAP"] >>=? fun () ->
+  (* NOTE: the cases below do not fail because we only do tokenization. *)
+  assert_tokenize ~loc:__LOC__ "DIP {ADD"
+    [Ident "DIP"; Open_brace; Ident "ADD"] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "(option int"
+    [Open_paren; Ident "option"; Ident "int"] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "parameter int}"
+    [Ident "parameter"; Ident "int"; Close_brace] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__ "}{}{}{"
+    [Close_brace; Open_brace; Close_brace; Open_brace; Close_brace; Open_brace]
+
+(*********************************)
+(* Conditional contracts *)
+
+let test_condition_contract () =
+  assert_tokenize ~loc:__LOC__
+    "parameter (or string (option int));\
+     storage unit;\
+     return string;\
+     code {CAR;\
+     IF_LEFT{}\
+     {IF_NONE {FAIL}\
+     {PUSH int 0; CMPGT; \
+     IF {FAIL}{PUSH string \"\"}}};\
+     UNIT; SWAP; PAIR}"
+    [Ident "parameter"; Open_paren; Ident "or"; Ident "string"; Open_paren;
+     Ident "option"; Ident "int"; Close_paren; Close_paren; Semi;
+     Ident "storage"; Ident "unit"; Semi;
+     Ident "return"; Ident "string"; Semi;
+     Ident "code"; Open_brace; Ident "CAR"; Semi;
+     Ident "IF_LEFT"; Open_brace; Close_brace;
+     Open_brace; Ident "IF_NONE"; Open_brace; Ident "FAIL"; Close_brace;
+     Open_brace; Ident "PUSH"; Ident "int"; Int "0"; Semi; Ident "CMPGT"; Semi;
+     Ident "IF"; Open_brace; Ident "FAIL"; Close_brace;
+     Open_brace; Ident "PUSH"; Ident "string"; String "";
+     Close_brace; Close_brace; Close_brace; Semi;
+     Ident "UNIT"; Semi; Ident "SWAP"; Semi; Ident "PAIR"; Close_brace
+    ] >>=? fun () ->
+  (* NOTE: the cases below do not fail because we only do tokenization. *)
+  assert_tokenize ~loc:__LOC__
+    "parameter (or string (option int);"
+    [Ident "parameter"; Open_paren; Ident "or"; Ident "string"; Open_paren;
+     Ident "option"; Ident "int"; Close_paren; Semi] >>=? fun () ->
+  assert_tokenize ~loc:__LOC__
+    "parameter (or)"
+    [Ident "parameter"; Open_paren; Ident "or"; Close_paren] >>=? fun () ->
+  assert_tokenize_error ~loc:__LOC__
+    "parameter (or"
+    [Ident "parameter"; Open_paren; Ident "or"; Close_paren]
+
+(****************************************************************************)
+(* Top-level parsing tests *)
+(****************************************************************************)
+
+let assert_toplevel_parsing ~loc source expected =
+  match Micheline_parser.tokenize source with
+  | _, (_::_)  -> failwith "%s - Cannot tokenize %s" loc source
+  | tokens, [] ->
+      match Micheline_parser.parse_toplevel tokens with
+      | _, (_::_) -> failwith "%s - Cannot parse_toplevel %s" loc source
+      | ast, [] ->
+          let ast = List.map Micheline.strip_locations ast in
+          let expected = List.map Micheline.strip_locations expected in
+          Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () ->
+          iter2_p (Assert.equal ~loc) ast expected >>=? fun () ->
+          return_unit
+
+let assert_toplevel_parsing_error ~loc source expected =
+  match Micheline_parser.tokenize source with
+  | _, (_::_)  -> return_unit
+  | tokens, [] ->
+      match Micheline_parser.parse_toplevel tokens with
+      | _, (_::_) -> return_unit
+      | ast, [] ->
+          let ast = List.map Micheline.strip_locations ast in
+          let expected = List.map Micheline.strip_locations expected in
+          Assert.equal ~loc (List.length ast) (List.length expected) >>=? fun () ->
+          iter2_p (Assert.not_equal ~loc) ast expected
+
+let test_basic_parsing () =
+  assert_toplevel_parsing ~loc:__LOC__ "parameter unit;"
+    [Prim ((), "parameter",
+           [Prim ((), "unit", [], [])],
+           [])] >>=? fun () ->
+  (* Sequence *)
+  assert_toplevel_parsing ~loc:__LOC__ "code {}"
+    [Prim ((), "code",
+           [ Seq ((), [])], [])] >>=? fun () ->
+  (* Int *)
+  assert_toplevel_parsing ~loc:__LOC__ "PUSH int 100"
+    [Prim ((), "PUSH",
+           [Prim ((), "int", [], []);
+            Int ((), Z.of_int 100)],
+           [])] >>=? fun () ->
+  (*NOTE: this case doesn't fail because we don't type check *)
+  assert_toplevel_parsing ~loc:__LOC__ "PUSH string 100"
+    [Prim ((), "PUSH",
+           [Prim ((), "string", [], []);
+            Int ((), Z.of_int 100)],
+           [])] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100_000"
+    [Prim ((), "PUSH",
+           [Prim ((), "string", [], []);
+            Int ((), Z.of_int 100_000)],
+           [])] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100"
+    [Prim ((), "PUSH",
+           [Prim ((), "int", [], []);
+            Int ((), Z.of_int 1000)],
+           [])] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int 100"
+    [Prim ((), "PUSH",
+           [Prim ((), "string", [], []);
+            Int ((), Z.of_int 100)],
+           [])] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "PUSH int \"100\""
+    [Prim ((), "PUSH",
+           [Prim ((), "string", [], []);
+            Int ((), Z.of_int 100)],
+           [])] >>=? fun () ->
+  (* String *)
+  assert_toplevel_parsing ~loc:__LOC__ "Pair False \"abc\""
+    [Prim (
+        (), "Pair",
+        [Prim (
+            (), "False", [], []);
+         String ((), "abc")], []
+      )] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "Pair False \"ab\""
+    [Prim (
+        (), "Pair",
+        [Prim (
+            (), "False", [], []);
+         String ((), "abc")], []
+      )] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "Pair False abc\""
+    [Prim (
+        (), "Pair",
+        [Prim (
+            (), "False", [], []);
+         String ((), "abc")], []
+      )] >>=? fun () ->
+  (* annotations *)
+  assert_toplevel_parsing ~loc:__LOC__ "NIL @annot string; #comment\n"
+    [Prim ((), "NIL", [Prim ((), "string", [], [])], ["@annot"])] >>=? fun () ->
+  assert_toplevel_parsing_error ~loc:__LOC__ "NIL @annot string; #comment\n"
+    [Prim ((), "NIL", [Prim ((), "string", [], [])], [])] >>=? fun () ->
+  assert_toplevel_parsing ~loc:__LOC__ "IF_NONE {FAIL} {}"
+    [Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], [])]);
+                            Seq ((), [])], [])] >>=? fun () ->
+  assert_toplevel_parsing ~loc:__LOC__ "PUSH (map int bool) (Map (Item 100 False))"
+    [Prim ((), "PUSH", [Prim ((), "map", [Prim ((), "int", [], []);
+                                          Prim ((), "bool", [], [])], []);
+                        Prim ((), "Map", [Prim ((), "Item",
+                                                [Int((), Z.of_int 100);
+                                                 Prim ((), "False", [], [])
+                                                ], []);
+                                         ], [])
+                       ]
+          , [])] >>=? fun () ->
+  assert_toplevel_parsing ~loc:__LOC__ "LAMDA @name int int {}"
+    [Prim ((), "LAMDA", [Prim ((), "int", [], []);
+                         Prim ((), "int", [], []);
+                         Seq ((), [])], ["@name"])] >>=? fun () ->
+  assert_toplevel_parsing ~loc:__LOC__ "code {DUP @test; DROP}"
+    [Prim ((), "code", [Seq ((), [Prim ((), "DUP", [], ["@test"]);
+                                  Prim ((), "DROP", [], [])])], [])]
+
+let test_condition_contract_parsing () =
+  assert_toplevel_parsing ~loc:__LOC__ "parameter unit;\
+                                        return unit;\
+                                        storage tez; #How much you have to send me \n\
+                                        code {CDR; DUP;\
+                                        AMOUNT; CMPLT;\
+                                        IF {FAIL}}"
+    [Prim ((), "parameter", [ Prim ((), "unit", [],[])], []);
+     Prim ((), "return", [Prim ((), "unit", [], [])], []);
+     Prim ((), "storage", [Prim ((), "tez", [], [])], []);
+     Prim ((), "code", [Seq ((), [Prim ((), "CDR", [], []);
+                                  Prim ((), "DUP", [], []);
+                                  Prim ((), "AMOUNT", [], []);
+                                  Prim ((), "CMPLT", [], []);
+                                  Prim ((), "IF",
+                                        [Seq ((),
+                                              [Prim ((), "FAIL", [], [])])]
+                                       , [])])],
+           [])
+    ]
+
+let test_list_append_parsing () =
+  assert_toplevel_parsing ~loc:__LOC__ "parameter (pair (list int)(list int));\
+                                        return (list int);\
+                                        storage unit;\
+                                        code { CAR; DUP; DIP{CDR}; CAR;\
+                                        NIL int; SWAP;\
+                                        LAMDA (pair int (list int))\
+                                        (list int)\
+                                        {DUP; CAR; DIP {CDR}; CONS};\
+                                        REDUCE;\
+                                        LAMDA (pair int (list int))\
+                                        (list int)\
+                                        {DUP; CAR; DIP{CDR}; CONS};\
+                                        UNIT; SWAP; PAIR}"
+    [Prim ((), "parameter",
+           [Prim ((), "pair",
+                  [Prim ((), "list", [Prim ((), "int", [], [])], []);
+                   Prim ((), "list", [Prim ((), "int", [], [])], [])], [])], []);
+     Prim ((), "return", [Prim ((), "list", [Prim ((), "int", [], [])], [])], []);
+     Prim ((), "storage", [Prim ((), "unit", [], [])], []);
+     Prim ((), "code",
+           [Seq ((),
+                 [Prim ((), "CAR", [], []);
+                  Prim ((), "DUP", [], []);
+                  Prim ((), "DIP", [Seq ((), [Prim ((), "CDR", [], [])])], []);
+                  Prim ((), "CAR", [], []);
+                  Prim ((), "NIL", [Prim ((), "int", [], [])], []);
+                  Prim ((), "SWAP", [], []);
+                  Prim ((), "LAMDA",
+                        [Prim ((), "pair",
+                               [Prim ((), "int", [], []);
+                                Prim ((), "list",
+                                      [Prim ((), "int", [], [])], [])
+                               ], []);
+                         Prim ((), "list", [Prim ((), "int", [], [])], []);
+                         Seq ((), [Prim ((), "DUP", [], []);
+                                   Prim ((), "CAR", [], []);
+                                   Prim ((), "DIP", [Seq ((), [Prim ((), "CDR", [], [])])], []);
+                                   Prim ((), "CONS", [], [])])
+                        ], []);
+                  Prim ((), "REDUCE", [], []);
+                  Prim ((), "LAMDA",
+                        [Prim ((), "pair",
+                               [Prim ((), "int", [], []);
+                                Prim ((), "list",
+                                      [Prim ((), "int", [], [])], [])
+                               ], []);
+                         Prim ((), "list", [Prim ((), "int", [], [])], []);
+                         Seq ((), [Prim ((), "DUP", [], []);
+                                   Prim ((), "CAR", [], []);
+                                   Prim ((), "DIP", [Seq ((), [Prim ((), "CDR", [], [])])], []);
+                                   Prim ((), "CONS", [], [])])
+                        ], []);
+                  Prim ((), "UNIT", [], []);
+                  Prim ((), "SWAP", [], []);
+                  Prim ((), "PAIR", [], [])
+                 ])], [])]
+
+(****************************************************************************)
+(* Expression parsing tests *)
+(****************************************************************************)
+
+let assert_expression_parsing ~loc source expected =
+  match Micheline_parser.tokenize source with
+  | _, (_::_)  -> failwith "%s - Cannot tokenize %s" loc source
+  | tokens, [] ->
+      match Micheline_parser.parse_expression tokens with
+      | _, (_::_) -> failwith "%s - Cannot parse_expression %s" loc source
+      | ast, [] ->
+          let ast = Micheline.strip_locations ast in
+          let expected = Micheline.strip_locations expected in
+          Assert.equal ~loc ast expected
+
+let test_parses_expression () =
+  (* String *)
+  assert_expression_parsing ~loc:__LOC__ "Pair False \"abc\""
+    (Prim ((), "Pair", [Prim ((), "False", [], []);
+                        String ((), "abc")], [])) >>=? fun () ->
+  (* Int *)
+  assert_expression_parsing ~loc:__LOC__ "Item 100"
+    (Prim ((), "Item", [Int ((), Z.of_int 100)], [])) >>=? fun () ->
+  (* Sequence *)
+  assert_expression_parsing ~loc:__LOC__ "{}"
+    (Seq ((), []))
+
+(****************************************************************************)
+
+let tests = [
+  "tokenize", (fun _ -> test_tokenize_basic ()) ;
+  "test one line contract", (fun _ -> test_one_line_contract ()) ;
+  "test_condition_contract", (fun _ -> test_condition_contract ()) ;
+  "test_basic_parsing", (fun _ -> test_basic_parsing ()) ;
+  "test_condition_contract_parsing", (fun _ -> test_condition_contract_parsing ()) ;
+  "test_list_append_parsing", (fun _ -> test_list_append_parsing ()) ;
+  "test_parses_expression", (fun _ -> test_parses_expression ()) ;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error err -> Lwt.fail_with err
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-lib-micheline" [
+    "micheline", List.map wrap tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_micheline/tezos-micheline.opam b/vendors/tezos-modded/src/lib_micheline/tezos-micheline.opam
new file mode 100644
index 000000000..1d21a91e4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_micheline/tezos-micheline.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-data-encoding"
+  "tezos-error-monad"
+  "uutf"
+  "alcotest-lwt" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_p2p/dune b/vendors/tezos-modded/src/lib_p2p/dune
new file mode 100644
index 000000000..dfd87b9e2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/dune
@@ -0,0 +1,16 @@
+(library
+ (name tezos_p2p)
+ (public_name tezos-p2p)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-shell-services)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_p2p/moving_average.ml b/vendors/tezos-modded/src/lib_p2p/moving_average.ml
new file mode 100644
index 000000000..a657fd246
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/moving_average.ml
@@ -0,0 +1,103 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+module Inttbl = Hashtbl.Make(struct
+    type t = int
+    let equal (x: int) (y: int) = x = y
+    let hash = Hashtbl.hash
+  end)
+
+type t = {
+  id: int;
+  alpha: int ;
+  mutable total: int64 ;
+  mutable current: int ;
+  mutable average: int ;
+}
+
+let counters = Inttbl.create 51
+
+let updated = Lwt_condition.create ()
+
+let update_hook = ref []
+let on_update f = update_hook := f :: !update_hook
+
+let worker_loop () =
+  let prev = ref @@ Mtime_clock.elapsed () in
+  let rec inner sleep =
+    sleep >>= fun () ->
+    let sleep = Lwt_unix.sleep 1. in
+    let now = Mtime_clock.elapsed () in
+    let elapsed = int_of_float (Mtime.Span.(to_ms now -. to_ms !prev)) in
+    prev := now;
+    Inttbl.iter
+      (fun _ c ->
+         c.average <-
+           (c.alpha * c.current) / elapsed + (1000 - c.alpha) * c.average / 1000;
+         c.current <- 0)
+      counters ;
+    List.iter (fun f -> f ()) !update_hook ;
+    Lwt_condition.broadcast updated () ;
+    inner sleep
+  in
+  inner (Lwt_unix.sleep 1.)
+
+let worker =
+  lazy begin
+    Lwt.async begin fun () ->
+      Lwt_utils.worker "counter"
+        ~run:worker_loop
+        ~cancel:(fun _ -> Lwt.return_unit)
+    end
+  end
+
+let create =
+  let cpt = ref 0 in
+  fun ~init ~alpha ->
+    Lazy.force worker ;
+    let id = !cpt in
+    incr cpt ;
+    assert (0. < alpha && alpha <= 1.) ;
+    let alpha = int_of_float (1000. *. alpha) in
+    let c = { id ; alpha ; total = 0L ; current = 0 ; average = init } in
+    Inttbl.add counters id c ;
+    c
+
+let add c x =
+  c.total <- Int64.(add c.total (of_int x)) ;
+  c.current <- c.current + x
+
+let destroy c =
+  Inttbl.remove counters c.id
+
+type stat = {
+  total: int64 ;
+  average: int ;
+}
+
+let stat ({ total ; average } : t) : stat =
+  { total ; average }
diff --git a/vendors/tezos-modded/src/lib_p2p/moving_average.mli b/vendors/tezos-modded/src/lib_p2p/moving_average.mli
new file mode 100644
index 000000000..c53b27943
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/moving_average.mli
@@ -0,0 +1,66 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Moving averages.
+
+    This module implements bandwidth counters based on (cumulative)
+    exponential moving average. Each counter is identified by an
+    integer. They are stored in an internal hash table.
+
+    See i.e.
+    https://en.wikipedia.org/wiki/Moving_average#Exponential_moving_average
+    for the algorithm.
+*)
+
+type t
+(** Type of one bandwidth counter. *)
+
+val create: init:int -> alpha:float -> t
+(** [create ~init ~alpha] is a counter with initial value [init] and
+    factor [alpha]. *)
+
+val destroy: t -> unit
+(** [destroy t] removes counter [t] from the internal hash table. *)
+
+val add: t -> int -> unit
+(** [add t id] adds [t] in the internal hash table under identifies
+    [id]. *)
+
+val on_update: (unit -> unit) -> unit
+(** [of_update f] registers [f] to be called on each update of the
+    internal worker (currently every 1s). *)
+
+val updated: unit Lwt_condition.t
+(** [updated] is a condition variable that gets signaled on each
+    update of the internal worker (currently every 1s). *)
+
+type stat = {
+  total: int64 ;
+  average: int ;
+}
+
+val stat: t -> stat
+(** [stat t] is a stat record reflecting the state of [t] at the time
+    of the call. *)
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p.ml b/vendors/tezos-modded/src/lib_p2p/p2p.ml
new file mode 100644
index 000000000..86bfd06c8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p.ml
@@ -0,0 +1,934 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make(struct let name = "p2p" end)
+
+type 'peer_meta peer_meta_config = 'peer_meta P2p_pool.peer_meta_config = {
+  peer_meta_encoding : 'peer_meta Data_encoding.t ;
+  peer_meta_initial : unit -> 'peer_meta ;
+  score : 'peer_meta -> float ;
+}
+
+type 'conn_meta conn_meta_config = 'conn_meta P2p_socket.metadata_config = {
+  conn_meta_encoding : 'conn_meta Data_encoding.t ;
+  conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
+  private_node : 'conn_meta -> bool ;
+}
+
+type 'msg app_message_encoding = 'msg P2p_pool.encoding =
+    Encoding : {
+      tag: int ;
+      title: string ;
+      encoding: 'a Data_encoding.t ;
+      wrap: 'a -> 'msg ;
+      unwrap: 'msg -> 'a option ;
+      max_length: int option ;
+    } -> 'msg app_message_encoding
+
+type 'msg message_config = 'msg P2p_pool.message_config = {
+  encoding : 'msg app_message_encoding list ;
+  versions : P2p_version.t list;
+}
+
+type config = {
+  listening_port : P2p_addr.port option ;
+  listening_addr : P2p_addr.t option ;
+  discovery_port : P2p_addr.port option ;
+  discovery_addr : Ipaddr.V4.t option ;
+  trusted_points : P2p_point.Id.t list ;
+  peers_file : string ;
+  private_mode : bool ;
+  identity : P2p_identity.t ;
+  proof_of_work_target : Crypto_box.target ;
+  disable_mempool : bool ;
+  trust_discovered_peers : bool ;
+}
+
+type limits = {
+
+  connection_timeout : float ;
+  authentication_timeout : float ;
+  greylist_timeout : int ;
+  maintenance_idle_time : float ;
+
+  min_connections : int ;
+  expected_connections : int ;
+  max_connections : int ;
+
+  backlog : int ;
+  max_incoming_connections : int ;
+
+  max_download_speed : int option ;
+  max_upload_speed : int option ;
+
+  read_buffer_size : int ;
+  read_queue_size : int option ;
+  write_queue_size : int option ;
+  incoming_app_message_queue_size : int option ;
+  incoming_message_queue_size : int option ;
+  outgoing_message_queue_size : int option ;
+
+  known_peer_ids_history_size : int ;
+  known_points_history_size : int ;
+  max_known_peer_ids : (int * int) option ;
+  max_known_points : (int * int) option ;
+
+  swap_linger : float ;
+
+  binary_chunks_size : int option ;
+}
+
+let create_scheduler limits =
+  let max_upload_speed =
+    Option.map limits.max_upload_speed ~f:(( * ) 1024) in
+  let max_download_speed =
+    Option.map limits.max_upload_speed ~f:(( * ) 1024) in
+  P2p_io_scheduler.create
+    ~read_buffer_size:limits.read_buffer_size
+    ?max_upload_speed
+    ?max_download_speed
+    ?read_queue_size:limits.read_queue_size
+    ?write_queue_size:limits.write_queue_size
+    ()
+
+let create_connection_pool config limits meta_cfg conn_meta_cfg msg_cfg io_sched =
+  let pool_cfg = {
+    P2p_pool.identity = config.identity ;
+    proof_of_work_target = config.proof_of_work_target ;
+    listening_port = config.listening_port ;
+    trusted_points = config.trusted_points ;
+    peers_file = config.peers_file ;
+    private_mode = config.private_mode ;
+    min_connections = limits.min_connections ;
+    max_connections = limits.max_connections ;
+    max_incoming_connections = limits.max_incoming_connections ;
+    connection_timeout = limits.connection_timeout ;
+    authentication_timeout = limits.authentication_timeout ;
+    incoming_app_message_queue_size = limits.incoming_app_message_queue_size ;
+    incoming_message_queue_size = limits.incoming_message_queue_size ;
+    outgoing_message_queue_size = limits.outgoing_message_queue_size ;
+    known_peer_ids_history_size = limits.known_peer_ids_history_size ;
+    known_points_history_size = limits.known_points_history_size ;
+    max_known_points = limits.max_known_points ;
+    max_known_peer_ids = limits.max_known_peer_ids ;
+    swap_linger = limits.swap_linger ;
+    binary_chunks_size = limits.binary_chunks_size ;
+  }
+  in
+  let pool =
+    P2p_pool.create pool_cfg meta_cfg conn_meta_cfg msg_cfg io_sched in
+  pool
+
+let may_create_discovery_worker _limits config pool =
+  match (config.listening_port, config.discovery_port, config.discovery_addr) with
+  | (Some listening_port, Some discovery_port, Some discovery_addr) ->
+      Some (P2p_discovery.create pool
+              config.identity.peer_id
+              ~listening_port
+              ~discovery_port ~discovery_addr
+              ~trust_discovered_peers:config.trust_discovered_peers)
+  | (_, _, _) ->
+      None
+
+let bounds ~min ~expected ~max =
+  assert (min <= expected) ;
+  assert (expected <= max) ;
+  let step_min =
+    (expected - min) / 3
+  and step_max =
+    (max - expected) / 3 in
+  { P2p_maintenance.min_threshold = min + step_min ;
+    min_target = min + 2 * step_min ;
+    max_target = max - 2 * step_max ;
+    max_threshold = max - step_max ;
+  }
+
+let create_maintenance_worker limits pool config =
+  let bounds =
+    bounds
+      ~min:limits.min_connections
+      ~expected:limits.expected_connections
+      ~max:limits.max_connections in
+  let maintenance_config = {
+    P2p_maintenance.
+    maintenance_idle_time = limits.maintenance_idle_time ;
+    greylist_timeout = limits.greylist_timeout ;
+    private_mode = config.private_mode ;
+  } in
+  let discovery = may_create_discovery_worker limits config pool in
+  P2p_maintenance.create ?discovery maintenance_config bounds pool
+
+let may_create_welcome_worker config limits pool =
+  match config.listening_port with
+  | None -> Lwt.return_none
+  | Some port ->
+      P2p_welcome.create
+        ~backlog:limits.backlog pool
+        ?addr:config.listening_addr
+        port >>= fun w ->
+      Lwt.return_some w
+
+type ('msg, 'peer_meta, 'conn_meta) connection =
+  ('msg, 'peer_meta, 'conn_meta) P2p_pool.connection
+
+module Real = struct
+
+  type ('msg, 'peer_meta, 'conn_meta) net = {
+    config: config ;
+    limits: limits ;
+    io_sched: P2p_io_scheduler.t ;
+    pool: ('msg, 'peer_meta, 'conn_meta) P2p_pool.t ;
+    maintenance: 'peer_meta P2p_maintenance.t ;
+    welcome: P2p_welcome.t option ;
+  }
+
+  let create ~config ~limits meta_cfg conn_meta_cfg msg_cfg =
+    let io_sched = create_scheduler limits in
+    create_connection_pool
+      config limits meta_cfg conn_meta_cfg msg_cfg io_sched >>= fun pool ->
+    let maintenance = create_maintenance_worker limits pool config in
+    may_create_welcome_worker config limits pool >>= fun welcome ->
+    return {
+      config ;
+      limits ;
+      io_sched ;
+      pool ;
+      maintenance ;
+      welcome ;
+    }
+
+  let peer_id { config } = config.identity.peer_id
+
+
+  let maintain { maintenance } () =
+    P2p_maintenance.maintain maintenance
+
+  let activate t () =
+    log_info "activate";
+    begin
+      match t.welcome with
+      | None -> ()
+      | Some w -> P2p_welcome.activate w
+    end ;
+    P2p_maintenance.activate t.maintenance ;
+    Lwt.async (fun () -> P2p_maintenance.maintain t.maintenance) ;
+    ()
+
+  let roll _net () = Lwt.return_unit (* TODO implement *)
+
+  (* returns when all workers have shutted down in the opposite
+     creation order. *)
+  let shutdown net () =
+    Lwt_utils.may ~f:P2p_welcome.shutdown net.welcome >>= fun () ->
+    P2p_maintenance.shutdown net.maintenance >>= fun () ->
+    P2p_pool.destroy net.pool >>= fun () ->
+    P2p_io_scheduler.shutdown ~timeout:3.0 net.io_sched
+
+  let connections { pool } () =
+    P2p_pool.Connection.fold pool
+      ~init:[] ~f:(fun _peer_id c acc -> c :: acc)
+  let find_connection { pool } peer_id =
+    P2p_pool.Connection.find_by_peer_id pool peer_id
+  let disconnect ?wait conn =
+    P2p_pool.disconnect ?wait conn
+  let connection_info _net conn =
+    P2p_pool.Connection.info conn
+  let connection_local_metadata _net conn =
+    P2p_pool.Connection.local_metadata conn
+  let connection_remote_metadata _net conn =
+    P2p_pool.Connection.remote_metadata conn
+  let connection_stat _net conn =
+    P2p_pool.Connection.stat conn
+  let global_stat { pool } () =
+    P2p_pool.pool_stat pool
+  let set_peer_metadata { pool } conn meta =
+    P2p_pool.Peers.set_peer_metadata pool conn meta
+  let get_peer_metadata { pool } conn =
+    P2p_pool.Peers.get_peer_metadata pool conn
+
+  let recv _net conn =
+    P2p_pool.read conn >>=? fun msg ->
+    lwt_debug "message read from %a"
+      P2p_peer.Id.pp
+      (P2p_pool.Connection.info conn).peer_id >>= fun () ->
+    return msg
+
+  let rec recv_any net () =
+    let pipes =
+      P2p_pool.Connection.fold
+        net.pool ~init:[]
+        ~f:begin fun _peer_id conn acc ->
+          (P2p_pool.is_readable conn >>= function
+            | Ok () -> Lwt.return_some conn
+            | Error _ -> Lwt_utils.never_ending ()) :: acc
+        end in
+    Lwt.pick (
+      ( P2p_pool.Pool_event.wait_new_connection net.pool >>= fun () ->
+        Lwt.return_none )::
+      pipes) >>= function
+    | None -> recv_any net ()
+    | Some conn ->
+        P2p_pool.read conn >>= function
+        | Ok msg ->
+            lwt_debug "message read from %a"
+              P2p_peer.Id.pp
+              (P2p_pool.Connection.info conn).peer_id >>= fun () ->
+            Lwt.return (conn, msg)
+        | Error _ ->
+            lwt_debug "error reading message from %a"
+              P2p_peer.Id.pp
+              (P2p_pool.Connection.info conn).peer_id >>= fun () ->
+            Lwt_unix.yield () >>= fun () ->
+            recv_any net ()
+
+  let send _net conn m =
+    P2p_pool.write conn m >>= function
+    | Ok () ->
+        lwt_debug "message sent to %a"
+          P2p_peer.Id.pp
+          (P2p_pool.Connection.info conn).peer_id >>= fun () ->
+        return_unit
+    | Error err ->
+        lwt_debug "error sending message from %a: %a"
+          P2p_peer.Id.pp
+          (P2p_pool.Connection.info conn).peer_id
+          pp_print_error err >>= fun () ->
+        Lwt.return (Error err)
+
+  let try_send _net conn v =
+    match P2p_pool.write_now conn v with
+    | Ok v ->
+        debug "message trysent to %a"
+          P2p_peer.Id.pp
+          (P2p_pool.Connection.info conn).peer_id ;
+        v
+    | Error err ->
+        debug "error trysending message to %a@ %a"
+          P2p_peer.Id.pp
+          (P2p_pool.Connection.info conn).peer_id
+          pp_print_error err ;
+        false
+
+  let broadcast { pool } msg =
+    P2p_pool.write_all pool msg ;
+    debug "message broadcasted"
+
+  let fold_connections { pool } ~init ~f =
+    P2p_pool.Connection.fold pool ~init ~f
+
+  let iter_connections { pool } f =
+    P2p_pool.Connection.fold pool
+      ~init:()
+      ~f:(fun gid conn () -> f gid conn)
+
+  let on_new_connection { pool } f =
+    P2p_pool.on_new_connection pool f
+
+  let pool { pool } = pool
+end
+
+module Fake = struct
+
+  let id = P2p_identity.generate (Crypto_box.make_target 0.)
+  let empty_stat = {
+    P2p_stat.total_sent = 0L ;
+    total_recv = 0L ;
+    current_inflow = 0 ;
+    current_outflow = 0 ;
+  }
+  let connection_info faked_metadata = {
+    P2p_connection.Info.incoming = false ;
+    peer_id = id.peer_id ;
+    id_point = (Ipaddr.V6.unspecified, None) ;
+    remote_socket_port = 0 ;
+    versions = [] ;
+    local_metadata = faked_metadata ;
+    remote_metadata = faked_metadata ;
+    private_node = false ;
+  }
+
+end
+
+type ('msg, 'peer_meta, 'conn_meta) t = {
+  versions : P2p_version.t list ;
+  peer_id : P2p_peer.Id.t ;
+  maintain : unit -> unit Lwt.t ;
+  roll : unit -> unit Lwt.t ;
+  shutdown : unit -> unit Lwt.t ;
+  connections : unit -> ('msg, 'peer_meta, 'conn_meta) connection list ;
+  find_connection :
+    P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection option ;
+  disconnect :
+    ?wait:bool -> ('msg, 'peer_meta, 'conn_meta) connection -> unit Lwt.t ;
+  connection_info :
+    ('msg, 'peer_meta, 'conn_meta) connection -> 'conn_meta P2p_connection.Info.t ;
+  connection_local_metadata :
+    ('msg, 'peer_meta, 'conn_meta) connection -> 'conn_meta ;
+  connection_remote_metadata :
+    ('msg, 'peer_meta, 'conn_meta) connection -> 'conn_meta ;
+  connection_stat : ('msg, 'peer_meta, 'conn_meta) connection -> P2p_stat.t ;
+  global_stat : unit -> P2p_stat.t ;
+  get_peer_metadata : P2p_peer.Id.t -> 'peer_meta ;
+  set_peer_metadata : P2p_peer.Id.t -> 'peer_meta -> unit ;
+  recv : ('msg, 'peer_meta, 'conn_meta) connection -> 'msg tzresult Lwt.t ;
+  recv_any : unit -> (('msg, 'peer_meta, 'conn_meta) connection * 'msg) Lwt.t ;
+  send :
+    ('msg, 'peer_meta, 'conn_meta) connection -> 'msg -> unit tzresult Lwt.t ;
+  try_send : ('msg, 'peer_meta, 'conn_meta) connection -> 'msg -> bool ;
+  broadcast : 'msg -> unit ;
+  pool : ('msg, 'peer_meta, 'conn_meta) P2p_pool.t option ;
+  fold_connections :
+    'a. init: 'a ->
+    f:(P2p_peer.Id.t ->
+       ('msg, 'peer_meta, 'conn_meta) connection -> 'a -> 'a) -> 'a ;
+  iter_connections :
+    (P2p_peer.Id.t ->
+     ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit ;
+  on_new_connection :
+    (P2p_peer.Id.t ->
+     ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit ;
+  activate : unit -> unit ;
+}
+type ('msg, 'peer_meta, 'conn_meta) net = ('msg, 'peer_meta, 'conn_meta) t
+
+let check_limits =
+  let fail_1 v orig =
+    if not (v <= 0.) then return_unit
+    else
+      Error_monad.failwith "value of option %S cannot be negative or null@."
+        orig
+  in
+  let fail_2 v orig =
+    if not (v < 0) then return_unit
+    else
+      Error_monad.failwith "value of option %S cannot be negative@." orig
+  in
+  fun c ->
+    fail_1 c.authentication_timeout
+      "authentication-timeout" >>=? fun () ->
+    fail_2 c.min_connections
+      "min-connections" >>=? fun () ->
+    fail_2 c.expected_connections
+      "expected-connections" >>=? fun () ->
+    fail_2 c.max_connections
+      "max-connections" >>=? fun () ->
+    fail_2 c.max_incoming_connections
+      "max-incoming-connections" >>=? fun () ->
+    fail_2 c.read_buffer_size
+      "read-buffer-size" >>=? fun () ->
+    fail_2 c.known_peer_ids_history_size
+      "known-peer-ids-history-size" >>=? fun () ->
+    fail_2 c.known_points_history_size
+      "known-points-history-size" >>=? fun () ->
+    fail_1 c.swap_linger
+      "swap-linger" >>=? fun () ->
+    begin
+      match c.binary_chunks_size with
+      | None -> return_unit
+      | Some size -> P2p_socket.check_binary_chunks_size size
+    end >>=? fun () ->
+    return_unit
+
+let create ~config ~limits peer_cfg conn_cfg msg_cfg =
+  check_limits limits >>=? fun () ->
+  Real.create ~config ~limits peer_cfg conn_cfg msg_cfg  >>=? fun net ->
+  return {
+    versions = msg_cfg.versions ;
+    peer_id = Real.peer_id net ;
+    maintain = Real.maintain net ;
+    roll = Real.roll net  ;
+    shutdown = Real.shutdown net  ;
+    connections = Real.connections net  ;
+    find_connection = Real.find_connection net ;
+    disconnect = Real.disconnect ;
+    connection_info = Real.connection_info net  ;
+    connection_local_metadata = Real.connection_local_metadata net  ;
+    connection_remote_metadata = Real.connection_remote_metadata net  ;
+    connection_stat = Real.connection_stat net ;
+    global_stat = Real.global_stat net ;
+    get_peer_metadata = Real.get_peer_metadata net ;
+    set_peer_metadata = Real.set_peer_metadata net ;
+    recv = Real.recv net ;
+    recv_any = Real.recv_any net ;
+    send = Real.send net ;
+    try_send = Real.try_send net ;
+    broadcast = Real.broadcast net ;
+    pool = Some net.pool ;
+    fold_connections = (fun ~init ~f -> Real.fold_connections net ~init ~f) ;
+    iter_connections = Real.iter_connections net ;
+    on_new_connection = Real.on_new_connection net ;
+    activate = Real.activate net ;
+  }
+
+let activate t =
+  log_info "activate P2P layer !";
+  t.activate ()
+
+let faked_network peer_cfg faked_metadata = {
+  versions = [] ;
+  peer_id = Fake.id.peer_id ;
+  maintain = Lwt.return ;
+  roll = Lwt.return ;
+  shutdown = Lwt.return ;
+  connections = (fun () -> []) ;
+  find_connection = (fun _ -> None) ;
+  disconnect = (fun ?wait:_ _ -> Lwt.return_unit) ;
+  connection_info = (fun _ -> Fake.connection_info faked_metadata) ;
+  connection_local_metadata = (fun _ -> faked_metadata) ;
+  connection_remote_metadata = (fun _ -> faked_metadata) ;
+  connection_stat = (fun _ -> Fake.empty_stat) ;
+  global_stat = (fun () -> Fake.empty_stat) ;
+  get_peer_metadata = (fun _ -> peer_cfg.peer_meta_initial ()) ;
+  set_peer_metadata = (fun _ _ -> ()) ;
+  recv = (fun _ -> Lwt_utils.never_ending ()) ;
+  recv_any = (fun () -> Lwt_utils.never_ending ()) ;
+  send = (fun _ _ -> fail P2p_errors.Connection_closed) ;
+  try_send = (fun _ _ -> false) ;
+  fold_connections = (fun ~init ~f:_ -> init) ;
+  iter_connections = (fun _f -> ()) ;
+  on_new_connection = (fun _f -> ()) ;
+  broadcast = ignore ;
+  pool = None ;
+  activate = (fun _ -> ()) ;
+}
+
+let peer_id net = net.peer_id
+let maintain net = net.maintain ()
+let roll net = net.roll ()
+let shutdown net = net.shutdown ()
+let connections net = net.connections ()
+let disconnect net = net.disconnect
+let find_connection net = net.find_connection
+let connection_info net = net.connection_info
+let connection_local_metadata net = net.connection_local_metadata
+let connection_remote_metadata net = net.connection_remote_metadata
+let connection_stat net = net.connection_stat
+let global_stat net = net.global_stat ()
+let get_peer_metadata net = net.get_peer_metadata
+let set_peer_metadata net = net.set_peer_metadata
+let recv net = net.recv
+let recv_any net = net.recv_any ()
+let send net = net.send
+let try_send net = net.try_send
+let broadcast net = net.broadcast
+let fold_connections net = net.fold_connections
+let iter_connections net = net.iter_connections
+let on_new_connection net = net.on_new_connection
+
+let greylist_addr net addr =
+  Option.iter net.pool ~f:(fun pool -> P2p_pool.greylist_addr pool addr)
+let greylist_peer net peer_id =
+  Option.iter net.pool ~f:(fun pool -> P2p_pool.greylist_peer pool peer_id)
+
+module Raw = struct
+  type 'a t = 'a P2p_pool.Message.t =
+    | Bootstrap
+    | Advertise of P2p_point.Id.t list
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
+    | Message of 'a
+    | Disconnect
+  let encoding = P2p_pool.Message.encoding
+end
+
+let info_of_point_info i =
+  let open P2p_point.Info in
+  let open P2p_point.State in
+  let state = match P2p_point_state.get i with
+    | Requested _ -> Requested
+    | Accepted { current_peer_id ; _ } -> Accepted current_peer_id
+    | Running { current_peer_id ; _ } -> Running current_peer_id
+    | Disconnected -> Disconnected in
+  P2p_point_state.Info.{
+    trusted = trusted i ;
+    state ;
+    greylisted_until = greylisted_until i ;
+    last_failed_connection = last_failed_connection i ;
+    last_rejected_connection = last_rejected_connection i ;
+    last_established_connection = last_established_connection i ;
+    last_disconnection = last_disconnection i ;
+    last_seen = last_seen i ;
+    last_miss = last_miss i ;
+  }
+
+let info_of_peer_info pool i =
+  let open P2p_peer.Info in
+  let open P2p_peer.State in
+  let state, id_point = match P2p_peer_state.get i with
+    | Accepted { current_point } -> Accepted, Some current_point
+    | Running { current_point } -> Running, Some current_point
+    | Disconnected -> Disconnected, None in
+  let peer_id = P2p_peer_state.Info.peer_id i in
+  let score = P2p_pool.Peers.get_score pool peer_id in
+  let conn_opt = P2p_pool.Connection.find_by_peer_id pool peer_id in
+  let stat =
+    match conn_opt with
+    | None -> P2p_stat.empty
+    | Some conn -> P2p_pool.Connection.stat conn in
+  let meta_opt =
+    match conn_opt with
+    | None -> None
+    | Some conn -> Some (P2p_pool.Connection.remote_metadata conn) in
+  P2p_peer_state.Info.{
+    score ;
+    trusted = trusted i ;
+    conn_metadata = meta_opt ;
+    peer_metadata = peer_metadata i;
+    state ;
+    id_point ;
+    stat ;
+    last_failed_connection = last_failed_connection i ;
+    last_rejected_connection = last_rejected_connection i ;
+    last_established_connection = last_established_connection i ;
+    last_disconnection = last_disconnection i ;
+    last_seen = last_seen i ;
+    last_miss = last_miss i ;
+  }
+
+let build_rpc_directory net =
+
+  let dir = RPC_directory.empty in
+
+  (* Network : Global *)
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.S.versions begin fun () () ->
+      return net.versions
+    end in
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.S.self begin fun () () ->
+      match net.pool with
+      | None -> failwith "The P2P layer is disabled."
+      | Some pool -> return (P2p_pool.config pool).identity.peer_id
+    end in
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.S.stat begin fun () () ->
+      match net.pool with
+      | None -> return P2p_stat.empty
+      | Some pool -> return (P2p_pool.pool_stat pool)
+    end in
+
+  let dir =
+    RPC_directory.gen_register0 dir P2p_services.S.events begin fun () () ->
+      let stream, stopper =
+        match net.pool with
+        | None -> Lwt_watcher.create_fake_stream ()
+        | Some pool -> P2p_pool.watch pool in
+      let shutdown () = Lwt_watcher.shutdown stopper in
+      let next () = Lwt_stream.get stream in
+      RPC_answer.return_stream { next ; shutdown }
+    end in
+
+  let dir =
+    RPC_directory.register1 dir P2p_services.S.connect begin fun point q () ->
+      match net.pool with
+      | None -> failwith "The P2P layer is disabled."
+      | Some pool ->
+          P2p_pool.connect ~timeout:q#timeout pool point >>=? fun _conn ->
+          return_unit
+    end in
+
+  (* Network : Connection *)
+
+  let dir =
+    RPC_directory.opt_register1 dir P2p_services.Connections.S.info
+      begin fun peer_id () () ->
+        return @@
+        Option.apply net.pool ~f: begin fun pool ->
+          Option.map ~f:P2p_pool.Connection.info
+            (P2p_pool.Connection.find_by_peer_id pool peer_id)
+        end
+      end in
+
+  let dir =
+    RPC_directory.lwt_register1 dir P2p_services.Connections.S.kick
+      begin fun peer_id q () ->
+        match net.pool with
+        | None -> Lwt.return_unit
+        | Some pool ->
+            match P2p_pool.Connection.find_by_peer_id pool peer_id with
+            | None -> Lwt.return_unit
+            | Some conn -> P2p_pool.disconnect ~wait:q#wait conn
+      end in
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.Connections.S.list
+      begin fun () () ->
+        match net.pool with
+        | None -> return_nil
+        | Some pool ->
+            return @@
+            P2p_pool.Connection.fold
+              pool ~init:[]
+              ~f:begin fun _peer_id c acc ->
+                P2p_pool.Connection.info c :: acc
+              end
+      end in
+
+  (* Network : Peer_id *)
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.Peers.S.list
+      begin fun q () ->
+        match net.pool with
+        | None -> return_nil
+        | Some pool ->
+            return @@
+            P2p_pool.Peers.fold_known pool
+              ~init:[]
+              ~f:begin fun peer_id i a ->
+                let info = info_of_peer_info pool i in
+                match q#filters with
+                | [] -> (peer_id, info) :: a
+                | filters when P2p_peer.State.filter filters info.state ->
+                    (peer_id, info) :: a
+                | _ -> a
+              end
+      end in
+
+  let dir =
+    RPC_directory.opt_register1 dir P2p_services.Peers.S.info
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> return_none
+        | Some pool ->
+            return @@
+            Option.map ~f:(info_of_peer_info pool)
+              (P2p_pool.Peers.info pool peer_id)
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.events
+      begin fun peer_id q () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            match P2p_pool.Peers.info pool peer_id with
+            | None -> RPC_answer.return []
+            | Some gi ->
+                let rev = false and max = max_int in
+                let evts =
+                  P2p_peer_state.Info.fold gi ~init:[]
+                    ~f:(fun a e -> e :: a) in
+                let evts = (if rev then List.rev_sub else List.sub) evts max in
+                if not q#monitor then
+                  RPC_answer.return evts
+                else
+                  let stream, stopper = P2p_peer_state.Info.watch gi in
+                  let shutdown () = Lwt_watcher.shutdown stopper in
+                  let first_request = ref true in
+                  let next () =
+                    if not !first_request then begin
+                      Lwt_stream.get stream >|= Option.map ~f:(fun i -> [i])
+                    end else begin
+                      first_request := false ;
+                      Lwt.return_some evts
+                    end in
+                  RPC_answer.return_stream { next ; shutdown }
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.ban
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.untrust pool peer_id ;
+            P2p_pool.Peers.ban pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.unban
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.unban pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.trust
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.trust pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.untrust
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.untrust pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.register1 dir P2p_services.Peers.S.banned
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> return_false
+        | Some pool when (P2p_pool.Peers.get_trusted pool peer_id) ->
+            return_false
+        | Some pool ->
+            return (P2p_pool.Peers.banned pool peer_id)
+      end in
+
+  (* Network : Point *)
+
+  let dir =
+    RPC_directory.register0 dir P2p_services.Points.S.list
+      begin fun q () ->
+        match net.pool with
+        | None -> return_nil
+        | Some pool ->
+            return @@
+            P2p_pool.Points.fold_known
+              pool ~init:[]
+              ~f:begin fun point i a ->
+                let info = info_of_point_info i in
+                match q#filters with
+                | [] -> (point, info) :: a
+                | filters when P2p_point.State.filter filters info.state ->
+                    (point, info) :: a
+                | _ -> a
+              end
+      end in
+
+  let dir =
+    RPC_directory.opt_register1 dir P2p_services.Points.S.info
+      begin fun point () () ->
+        match net.pool with
+        | None -> return_none
+        | Some pool ->
+            return @@
+            Option.map
+              (P2p_pool.Points.info pool point)
+              ~f:info_of_point_info
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.events
+      begin fun point_id q () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            match P2p_pool.Points.info pool point_id with
+            | None -> RPC_answer.return []
+            | Some gi ->
+                let rev = false and max = max_int in
+                let evts =
+                  P2p_point_state.Info.fold gi ~init:[]
+                    ~f:(fun a e -> e :: a) in
+                let evts = (if rev then List.rev_sub else List.sub) evts max in
+                if not q#monitor then
+                  RPC_answer.return evts
+                else
+                  let stream, stopper = P2p_point_state.Info.watch gi in
+                  let shutdown () = Lwt_watcher.shutdown stopper in
+                  let first_request = ref true in
+                  let next () =
+                    if not !first_request then begin
+                      Lwt_stream.get stream >|= Option.map ~f:(fun i -> [i])
+                    end else begin
+                      first_request := false ;
+                      Lwt.return_some evts
+                    end in
+                  RPC_answer.return_stream { next ; shutdown }
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.ban
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.untrust pool point;
+            P2p_pool.Points.ban pool point;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.unban
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.unban pool point;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.trust
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.trust pool point ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.untrust
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.untrust pool point ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.banned
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool when (P2p_pool.Points.get_trusted pool point) ->
+            RPC_answer.return false
+        | Some pool ->
+            RPC_answer.return (P2p_pool.Points.banned pool point)
+      end in
+
+  (* Network : Greylist *)
+
+  let dir =
+    RPC_directory.register dir P2p_services.ACL.S.clear
+      begin fun () () () ->
+        match net.pool with
+        | None -> return_unit
+        | Some pool ->
+            P2p_pool.acl_clear pool ;
+            return_unit
+      end in
+
+  dir
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p.mli b/vendors/tezos-modded/src/lib_p2p/p2p.mli
new file mode 100644
index 000000000..b719a854e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p.mli
@@ -0,0 +1,314 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell Net - Low level API for the Gossip network
+
+    This is the entry point of the peer-to-peer layer.
+
+    It is used by the Shell as the API to communicate with other
+    nodes.
+*)
+
+type 'peer_meta peer_meta_config = {
+  peer_meta_encoding : 'peer_meta Data_encoding.t;
+  peer_meta_initial : unit -> 'peer_meta;
+  score : 'peer_meta -> float ;
+}
+
+type 'conn_meta conn_meta_config = {
+  conn_meta_encoding : 'conn_meta Data_encoding.t;
+  conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
+  private_node : 'conn_meta -> bool ;
+}
+
+type 'msg app_message_encoding = Encoding : {
+    tag: int ;
+    title: string ;
+    encoding: 'a Data_encoding.t ;
+    wrap: 'a -> 'msg ;
+    unwrap: 'msg -> 'a option ;
+    max_length: int option ;
+  } -> 'msg app_message_encoding
+
+type 'msg message_config = {
+  encoding : 'msg app_message_encoding list ;
+  versions : P2p_version.t list;
+}
+
+(** Network configuration *)
+type config = {
+
+  listening_port : P2p_addr.port option;
+  (** Tells if incoming connections accepted, precising the TCP port
+      on which the peer can be reached (default: [9732])*)
+
+  listening_addr : P2p_addr.t option;
+  (** When incoming connections are accepted, precise on which
+      IP adddress the node listen (default: [[::]]). *)
+
+  discovery_port : P2p_addr.port option;
+  (** Tells if local peer discovery is enabled, precising the TCP port
+      on which the peer can be reached (default: [10732]) *)
+
+  discovery_addr : Ipaddr.V4.t option;
+  (** When local peer discovery is enabled, precise on which
+      IP address messages are broadcasted (default: [255.255.255.255]). *)
+
+  trusted_points : P2p_point.Id.t list ;
+  (** List of hard-coded known peers to bootstrap the network from. *)
+
+  peers_file : string ;
+  (** The path to the JSON file where the metadata associated to
+      peer_ids are loaded / stored. *)
+
+  private_mode : bool ;
+  (** If [true], only open outgoing/accept incoming connections
+      to/from peers whose addresses are in [trusted_peers], and inform
+      these peers that the identity of this node should be revealed to
+      the rest of the network. *)
+
+  identity : P2p_identity.t ;
+  (** Cryptographic identity of the peer. *)
+
+  proof_of_work_target : Crypto_box.target ;
+  (** Expected level of proof of work of peers' identity. *)
+
+  disable_mempool : bool ;
+  (** If [true], all non-empty mempools will be ignored. *)
+
+  trust_discovered_peers : bool ;
+  (** If [true], peers discovered on the local network will be trusted. *)
+
+}
+
+(** Network capacities *)
+type limits = {
+
+  connection_timeout : float ;
+  (** Maximum time allowed to the establishment of a connection. *)
+
+  authentication_timeout : float ;
+  (** Delay granted to a peer to perform authentication, in seconds. *)
+
+  greylist_timeout : int ;
+  (** GC delay for the grelists tables, in seconds. *)
+
+  maintenance_idle_time: float ;
+  (** How long to wait at most, in seconds, before running a maintenance loop. *)
+
+  min_connections : int ;
+  (** Strict minimum number of connections (triggers an urgent maintenance) *)
+
+  expected_connections : int ;
+  (** Targeted number of connections to reach when bootstrapping / maintaining *)
+
+  max_connections : int ;
+  (** Maximum number of connections (exceeding peers are disconnected) *)
+
+  backlog : int ;
+  (** Argument of [Lwt_unix.accept].*)
+
+  max_incoming_connections : int ;
+  (** Maximum not-yet-authenticated incoming connections. *)
+
+  max_download_speed : int option ;
+  (** Hard-limit in the number of bytes received per second. *)
+
+  max_upload_speed : int option ;
+  (** Hard-limit in the number of bytes sent per second. *)
+
+  read_buffer_size : int ;
+  (** Size in bytes of the buffer passed to [Lwt_unix.read]. *)
+
+  read_queue_size : int option ;
+  write_queue_size : int option ;
+  incoming_app_message_queue_size : int option ;
+  incoming_message_queue_size : int option ;
+  outgoing_message_queue_size : int option ;
+  (** Various bounds for internal queues. *)
+
+  known_peer_ids_history_size : int ;
+  known_points_history_size : int ;
+  (** Size of circular log buffers, in number of events recorded. *)
+
+  max_known_peer_ids : (int * int) option ;
+  max_known_points : (int * int) option ;
+  (** Optional limitation of internal hashtables (max, target) *)
+
+  swap_linger : float ;
+  (** Peer swapping does not occur more than once during a timespan of
+      [swap_linger] seconds. *)
+
+  binary_chunks_size : int option ;
+  (** Size (in bytes) of binary blocks that are sent to other
+      peers. Default value is 64 kB. Max value is 64kB. *)
+
+}
+
+(** Type of a P2P layer instance, parametrized by:
+    ['msg]: type of messages exchanged between peers
+    ['peer_meta]: type of the metadata associated with peers (score, etc.)
+    ['conn_meta]: type of the metadata associated with connection (ack_cfg)
+*)
+type ('msg, 'peer_meta, 'conn_meta) t
+type ('msg, 'peer_meta, 'conn_meta) net = ('msg, 'peer_meta, 'conn_meta) t
+
+(** A faked p2p layer, which do not initiate any connection
+    nor open any listening socket *)
+val faked_network :
+  'peer_meta peer_meta_config ->
+  'conn_meta ->
+  ('msg, 'peer_meta, 'conn_meta) net
+
+(** Main network initialisation function *)
+val create :
+  config:config -> limits:limits ->
+  'peer_meta peer_meta_config -> 'conn_meta conn_meta_config ->
+  'msg message_config ->  ('msg, 'peer_meta, 'conn_meta) net tzresult Lwt.t
+
+val activate : ('msg, 'peer_meta, 'conn_meta) net -> unit
+
+(** Return one's peer_id *)
+val peer_id : ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t
+
+(** A maintenance operation : try and reach the ideal number of peers *)
+val maintain : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
+
+(** Voluntarily drop some peers and replace them by new buddies *)
+val roll : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
+
+(** Close all connections properly *)
+val shutdown : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
+
+(** A connection to a peer *)
+type ('msg, 'peer_meta, 'conn_meta) connection
+
+(** Access the domain of active peers *)
+val connections :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection list
+
+(** Return the active peer with identity [peer_id] *)
+val find_connection :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  P2p_peer.Id.t ->
+  ('msg, 'peer_meta, 'conn_meta) connection option
+
+(** Access the info of an active peer, if available *)
+val connection_info :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'conn_meta P2p_connection.Info.t
+val connection_local_metadata :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'conn_meta
+val connection_remote_metadata :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'conn_meta
+val connection_stat :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  P2p_stat.t
+
+(** Cleanly closes a connection. *)
+val disconnect :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ?wait:bool ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  unit Lwt.t
+
+val global_stat : ('msg, 'peer_meta, 'conn_meta) net -> P2p_stat.t
+
+(** Accessors for meta information about a global identifier *)
+val get_peer_metadata :
+  ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> 'peer_meta
+val set_peer_metadata :
+  ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> 'peer_meta -> unit
+
+(** Wait for a message from a given connection. *)
+val recv :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'msg tzresult Lwt.t
+
+(** Wait for a message from any active connections. *)
+val recv_any :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  (('msg, 'peer_meta, 'conn_meta) connection * 'msg) Lwt.t
+
+(** [send net peer msg] is a thread that returns when [msg] has been
+    successfully enqueued in the send queue. *)
+val send :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'msg ->
+  unit tzresult Lwt.t
+
+(** [try_send net peer msg] is [true] if [msg] has been added to the
+    send queue for [peer], [false] otherwise *)
+val try_send :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  ('msg, 'peer_meta, 'conn_meta) connection ->
+  'msg ->
+  bool
+
+(** Send a message to all peers *)
+val broadcast : ('msg, 'peer_meta, 'conn_meta) net -> 'msg -> unit
+
+val fold_connections :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  init:'a ->
+  f:(P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> 'a -> 'a) ->
+  'a
+
+val iter_connections :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit
+
+val on_new_connection :
+  ('msg, 'peer_meta, 'conn_meta) net ->
+  (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit
+
+val build_rpc_directory :
+  (_, Peer_metadata.t , Connection_metadata.t) t -> unit RPC_directory.t
+
+val greylist_addr : ('msg, 'peer_meta, 'conn_meta) net -> P2p_addr.t -> unit
+val greylist_peer : ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> unit
+
+(**/**)
+
+module Raw : sig
+  type 'a t =
+    | Bootstrap
+    | Advertise of P2p_point.Id.t list
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
+    | Message of 'a
+    | Disconnect
+  val encoding: 'msg app_message_encoding list -> 'msg t Data_encoding.t
+end
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_acl.ml b/vendors/tezos-modded/src/lib_p2p/p2p_acl.ml
new file mode 100644
index 000000000..27278d2e4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_acl.ml
@@ -0,0 +1,231 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module PeerRing = Ring.MakeTable(struct
+    include P2p_peer.Id
+  end)
+
+module PatriciaTree(V:HashPtree.Value) = struct
+  module Size = struct
+    let size = 128
+  end
+  module Bits = HashPtree.Bits(Size)
+  module M = HashPtree.Make_BE_sized(V)(Size)
+
+  type t = M.t
+  let empty = M.empty
+
+  (* take into consideration the fact that the int64
+   * returned by Ipaddr.V6.to_int64 is signed *)
+  let z_of_bytes i =
+    let i = Z.of_int64 i in
+    Z.(if i < zero then i + of_int 2 ** 64 else i)
+
+  let z_of_ipv6 ip =
+    let hi_x, lo_x = Ipaddr.V6.to_int64 ip in
+    let hi = z_of_bytes hi_x in
+    let lo = z_of_bytes lo_x in
+    Z.((hi lsl 64) + lo)
+
+  let key_of_ipv6 ip =
+    Bits.of_z (z_of_ipv6 ip)
+
+  let z_mask_of_ipv6_prefix p =
+    let ip = Ipaddr.V6.Prefix.network p in
+    let len = Ipaddr.V6.Prefix.bits p in
+    z_of_ipv6 ip, Z.(lsl) Z.one (128 - len)
+
+  let key_mask_of_ipv6_prefix p =
+    let z, m = z_mask_of_ipv6_prefix p in
+    Bits.of_z z, Bits.of_z m
+
+  let z_to_ipv6 z =
+    (* assumes z is a 128 bit value *)
+    let hi_z = Z.(z asr 64) in
+    let hi =
+      if Z.(hi_z >= of_int 2 ** 63) then
+        (* If overflows int64, then returns the bit equivalent
+           representation (which is negative) *)
+        Int64.add 0x8000000000000000L
+          ((Z.(to_int64 (hi_z - (of_int 2 ** 63)))))
+      else
+        Z.(to_int64 hi_z)
+    in
+    let lo = Z.(to_int64 (z mod (pow ~$2 64))) in
+    Ipaddr.V6.of_int64 (hi, lo)
+
+  let remove key t =
+    M.remove (key_of_ipv6 key) t
+
+  let remove_prefix prefix t =
+    let key, mask = key_mask_of_ipv6_prefix prefix in
+    M.remove_prefix key mask t
+
+  let add_prefix prefix value t =
+    let key, mask = key_mask_of_ipv6_prefix prefix in
+    M.add (fun _ v -> v) ~key ~value ~mask t
+
+  let add key value t =
+    let key = key_of_ipv6 key in
+    M.add (fun _ v -> v) ~key ~value t
+
+  let mem key t = M.mem (key_of_ipv6 key) t
+
+  let key_mask_to_prefix key mask =
+    let len =
+      if Bits.(equal mask zero) then 0
+      else 128 - (Z.trailing_zeros (Bits.to_z mask))
+    in
+    Ipaddr.V6.Prefix.make len (z_to_ipv6 (Bits.to_z key))
+
+  let fold f t acc =
+    let f key mask value acc =
+      let prefix = key_mask_to_prefix key mask in
+      f prefix value acc
+    in
+    M.fold f t acc
+
+  let pp ppf t =
+    let lst = fold (fun p _ l -> p :: l) t [] in
+    Format.fprintf ppf "@[<2>[%a]@]"
+      Format.(pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ";@ ")
+                Ipaddr.V6.Prefix.pp)
+      lst
+
+end
+
+(* patricia trees using IpV6 addresses as keys *)
+module IpSet = struct
+
+  include PatriciaTree(Time)
+
+  let remove_old t ~older_than =
+    let module MI =
+    struct
+      type result = Time.t
+      let default = Time.max_value
+      let map _t _key value = value
+      let reduce _t left right = Time.(min left right)
+    end
+    in
+    let module MR = M.Map_Reduce(MI) in
+    MR.filter (fun addtime ->
+        Time.(older_than <= addtime)
+      ) t
+
+end
+
+module IpTable = Hashtbl.Make(struct
+    type t = Ipaddr.V6.t
+    let hash = Hashtbl.hash
+    let equal x y = Ipaddr.V6.compare x y = 0
+  end)
+
+type t = {
+  mutable greylist_ips : IpSet.t ;
+  greylist_peers : PeerRing.t ;
+  banned_ips : unit IpTable.t ;
+  banned_peers : unit P2p_peer.Table.t ;
+}
+
+let create size = {
+  greylist_ips = IpSet.empty;
+  greylist_peers = PeerRing.create size;
+  banned_ips = IpTable.create 53;
+  banned_peers = P2p_peer.Table.create 53;
+}
+
+(* check if an ip is banned. priority is for static blacklist, then
+   in the greylist *)
+let banned_addr acl addr =
+  IpTable.mem acl.banned_ips addr ||
+  IpSet.mem addr acl.greylist_ips
+
+(* Check is the peer_id is in the banned ring. It might be possible that
+   a peer ID that is not banned, but its ip address is. *)
+let banned_peer acl peer_id =
+  P2p_peer.Table.mem acl.banned_peers peer_id ||
+  PeerRing.mem acl.greylist_peers peer_id
+
+let clear acl =
+  acl.greylist_ips <- IpSet.empty;
+  P2p_peer.Table.clear acl.banned_peers;
+  IpTable.clear acl.banned_ips;
+  PeerRing.clear acl.greylist_peers
+
+module IPGreylist = struct
+
+  let add acl addr time =
+    acl.greylist_ips <- IpSet.add addr time acl.greylist_ips
+
+  let mem acl addr = IpSet.mem addr !acl.greylist_ips
+
+  (* The GC operation works only on the address set. Peers are removed
+     from the ring in a round-robin fashion. If a address is removed
+     by the GC from the acl.greylist set, it could potentially
+     persist in the acl.peers set until more peers are banned. *)
+  let remove_old acl ~older_than =
+    acl.greylist_ips <- IpSet.remove_old acl.greylist_ips ~older_than
+
+  let encoding = Data_encoding.(list P2p_addr.encoding)
+
+end
+
+module IPBlacklist = struct
+
+  let add acl addr =
+    IpTable.add acl.banned_ips addr ()
+
+  let remove acl addr =
+    IpTable.remove acl.banned_ips addr
+
+  let mem acl addr =
+    IpTable.mem acl.banned_ips addr
+
+end
+
+module PeerBlacklist = struct
+
+  let add acl addr =
+    P2p_peer.Table.add acl.banned_peers addr ()
+
+  let remove acl addr =
+    P2p_peer.Table.remove acl.banned_peers addr
+
+  let mem acl addr =
+    P2p_peer.Table.mem acl.banned_peers addr
+
+end
+
+module PeerGreylist = struct
+
+  let add acl peer_id =
+    PeerRing.add acl.greylist_peers peer_id
+
+  let mem acl peer_id =
+    (PeerRing.mem acl.greylist_peers peer_id)
+
+end
+
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_acl.mli b/vendors/tezos-modded/src/lib_p2p/p2p_acl.mli
new file mode 100644
index 000000000..aa0912753
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_acl.mli
@@ -0,0 +1,110 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(**
+   This module implements four Access Control Lists:
+   - ip greylist is a set of banned ip addresses automatically added by
+     the p2p layer.
+   - peer_id greylist is a set of banned peers ids automatically added by
+     the p2p layer.
+   - ip blacklist is a set of ip addresses manually added by the node admin.
+   - peers blacklist is a set of peers ids manually added by the node admin.
+
+   IP greylists use a time based GC to periodically remove entries from
+   the table, while peer_id grey lists are built using a ring structure,
+   where peers are removed from the table when removed from the fixed size
+   ring. Other tables are user defined and static.
+
+*)
+
+type t
+
+(** [create size] is a set of four ACLs (see above) with the peer_id
+    greylist being a ring buffer of size [size]. *)
+val create : int -> t
+
+(** [banned_addr t addr] is [true] if [addr] is blacklisted or
+    greylisted. *)
+val banned_addr : t -> P2p_addr.t -> bool
+
+(** [banned_peer t peer_id] is [true] if peer with id [peer_id] is
+    blacklisted or greylisted. *)
+val banned_peer : t -> P2p_peer.Id.t -> bool
+
+(** [clear t] clears all four ACLs. *)
+val clear : t -> unit
+
+module IPGreylist : sig
+
+  (** [add t addr] adds [addr] to the address greylist. *)
+  val add: t -> P2p_addr.t -> Time.t -> unit
+
+  (** [remove_old t ~older_than] removes all banned peers older than the
+      given time. *)
+  val remove_old: t -> older_than:Time.t -> unit
+
+  val encoding: P2p_addr.t list Data_encoding.t
+
+end
+
+module IPBlacklist : sig
+
+  val add: t -> P2p_addr.t -> unit
+  val remove: t -> P2p_addr.t -> unit
+
+end
+
+module PeerBlacklist : sig
+
+  val add: t -> P2p_peer.Id.t -> unit
+  val remove: t -> P2p_peer.Id.t -> unit
+
+end
+
+
+module PeerGreylist : sig
+
+  val add: t -> P2p_peer.Id.t -> unit
+
+end
+
+(** / *)
+
+module PeerRing : Ring.TABLE with type v = P2p_peer.Id.t
+
+module IpSet : sig
+  type t
+  val empty: t
+  val add : Ipaddr.V6.t -> Time.t -> t -> t
+  val add_prefix : Ipaddr.V6.Prefix.t -> Time.t -> t -> t
+  val remove : Ipaddr.V6.t -> t -> t
+  val remove_prefix : Ipaddr.V6.Prefix.t -> t -> t
+  val mem : Ipaddr.V6.t -> t -> bool
+  val fold: (Ipaddr.V6.Prefix.t -> Time.t -> 'a -> 'a) -> t -> 'a -> 'a
+  val pp : Format.formatter -> t -> unit
+  val remove_old : t -> older_than:Time.t -> t
+end
+
+module IpTable : Hashtbl.S with type key = Ipaddr.V6.t
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_discovery.ml b/vendors/tezos-modded/src/lib_p2p/p2p_discovery.ml
new file mode 100644
index 000000000..4cf268e7d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_discovery.ml
@@ -0,0 +1,275 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "p2p.discovery" end)
+
+type pool = Pool : ('msg, 'meta, 'meta_conn) P2p_pool.t -> pool
+
+module Message = struct
+
+  let encoding =
+    Data_encoding.(tup3 (Fixed.string 10) P2p_peer.Id.encoding int16)
+
+  let length = Data_encoding.Binary.fixed_length_exn encoding
+
+  let key = "DISCOMAGIC"
+
+  let make peer_id port =
+    Data_encoding.Binary.to_bytes_exn encoding (key, peer_id, port)
+
+end
+
+module Answer = struct
+
+  type t = {
+    my_peer_id: P2p_peer.Id.t ;
+    pool: pool ;
+    discovery_port: int ;
+    canceler: Lwt_canceler.t ;
+    trust_discovered_peers: bool ;
+    mutable worker: unit Lwt.t ;
+  }
+
+  let create_socket st =
+    Lwt.catch
+      begin fun () ->
+        let socket = Lwt_unix.socket PF_INET SOCK_DGRAM 0 in
+        Lwt_canceler.on_cancel st.canceler (fun () ->
+            Lwt_utils_unix.safe_close socket
+          ) ;
+        Lwt_unix.setsockopt socket SO_BROADCAST true ;
+        Lwt_unix.setsockopt socket SO_REUSEADDR true ;
+        let addr = Lwt_unix.ADDR_INET (Unix.inet_addr_any, st.discovery_port) in
+        Lwt_unix.bind socket addr >>= fun () ->
+        Lwt.return socket
+      end
+      begin fun exn ->
+        lwt_debug "Error creating a socket" >>= fun () ->
+        Lwt.fail exn
+      end
+
+  let loop st =
+    protect ~canceler:st.canceler begin fun () ->
+      create_socket st >>= fun socket ->
+      return socket
+    end >>=? fun socket ->
+    (* Infinite loop, should never exit. *)
+    let rec aux () =
+      let buf = MBytes.create Message.length in
+      protect ~canceler:st.canceler begin fun () ->
+        Lwt_bytes.recvfrom socket buf 0 Message.length [] >>= fun content ->
+        lwt_debug "Received discovery message..." >>= fun () ->
+        return content
+      end >>=? function
+      | (len, Lwt_unix.ADDR_INET (remote_addr, _))
+        when Compare.Int.equal len Message.length ->
+          begin match Data_encoding.Binary.of_bytes Message.encoding buf with
+            | Some (key, remote_peer_id, remote_port)
+              when Compare.String.equal key Message.key
+                && not (P2p_peer.Id.equal remote_peer_id st.my_peer_id) ->
+                let s_addr = Unix.string_of_inet_addr remote_addr in
+                begin match P2p_addr.of_string_opt s_addr with
+                  | None ->
+                      lwt_debug "Failed to parse %S\n@." s_addr >>= fun () ->
+                      aux ()
+                  | Some addr ->
+                      let Pool pool = st.pool in
+                      lwt_log_info "Registering new point %a:%d"
+                        P2p_addr.pp addr remote_port >>= fun () ->
+                      P2p_pool.register_new_point
+                        ~trusted:st.trust_discovered_peers
+                        pool st.my_peer_id
+                        (addr, remote_port) ;
+                      aux ()
+                end
+            | _ -> aux ()
+          end
+      | _ -> aux ()
+    in aux ()
+
+  let worker_loop st =
+    loop st >>= function
+    | Error [ Canceled ] ->
+        Lwt.return_unit
+    | Error err ->
+        lwt_log_error
+          "@[<v 2>Unexpected error in answer worker@ %a@]"
+          pp_print_error err >>= fun () ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+    | Ok () ->
+        lwt_log_error
+          "@[<v 2>Unexpected exit in answer worker@]" >>= fun () ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+
+  let create my_peer_id pool ~trust_discovered_peers ~discovery_port = {
+    canceler = Lwt_canceler.create () ;
+    my_peer_id ;
+    discovery_port ;
+    trust_discovered_peers ;
+    pool = Pool pool ;
+    worker = Lwt.return_unit ;
+  }
+
+  let activate st =
+    st.worker <-
+      Lwt_utils.worker "discovery_answer"
+        ~run:(fun () -> worker_loop st)
+        ~cancel:(fun () -> Lwt_canceler.cancel st.canceler)
+
+end
+
+(* ************************************************************ *)
+(* Sender  *)
+
+module Sender = struct
+
+  type t = {
+    canceler: Lwt_canceler.t ;
+    my_peer_id: P2p_peer.Id.t ;
+    listening_port: int ;
+    discovery_port: int ;
+    discovery_addr: Ipaddr.V4.t ;
+    pool: pool ;
+    restart_discovery: unit Lwt_condition.t ;
+    mutable worker: unit Lwt.t ;
+  }
+
+  module Config = struct
+    type t = {
+      delay: float;
+      loop: int;
+    }
+    let initial = {
+      delay = 0.1 ;
+      loop = 0 ;
+    }
+    let increase_delay config = { config with delay = 2.0 *. config.delay ; }
+    let max_loop = 10
+  end
+
+  let broadcast_message st =
+    let msg = Message.make st.my_peer_id st.listening_port in
+    Lwt.catch
+      begin fun () ->
+        let socket = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+        Lwt_canceler.on_cancel st.canceler (fun () ->
+            Lwt_utils_unix.safe_close socket
+          ) ;
+        Lwt_unix.setsockopt socket Lwt_unix.SO_BROADCAST true ;
+        let broadcast_ipv4 = Ipaddr_unix.V4.to_inet_addr st.discovery_addr in
+        let addr = Lwt_unix.ADDR_INET (broadcast_ipv4, st.discovery_port) in
+        Lwt_unix.connect socket addr >>= fun () ->
+        lwt_debug "Broadcasting discovery message..." >>= fun () ->
+        Lwt_bytes.sendto socket msg 0 Message.length [] addr >>= fun _len ->
+        Lwt_utils_unix.safe_close socket
+      end
+      begin fun _exn ->
+        lwt_debug "Error broadcasting a discovery request" >>= fun () ->
+        Lwt.return_unit
+      end
+
+  let rec worker_loop sender_config st =
+    begin
+      protect ~canceler:st.canceler begin fun () ->
+        broadcast_message st >>= fun () ->
+        return_unit
+      end >>=? fun () ->
+      protect ~canceler:st.canceler begin fun () ->
+        Lwt.pick [
+          begin
+            Lwt_condition.wait st.restart_discovery >>= fun () ->
+            return Config.initial
+          end ;
+          begin
+            Lwt_unix.sleep sender_config.Config.delay >>= fun () ->
+            return { sender_config with Config.loop = succ sender_config.loop ; }
+          end ;
+        ]
+      end
+    end >>= function
+    | Ok config when config.Config.loop = Config.max_loop ->
+        let new_sender_config = {
+          config with Config.loop = pred config.loop ;
+        } in
+        worker_loop new_sender_config st
+    | Ok config ->
+        let new_sender_config = Config.increase_delay config in
+        worker_loop new_sender_config st
+    | Error [ Canceled ] ->
+        Lwt.return_unit
+    | Error err ->
+        lwt_log_error
+          "@[<v 2>Unexpected error in sender worker@ %a@]"
+          pp_print_error err >>= fun () ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+
+  let create my_peer_id pool ~listening_port ~discovery_port ~discovery_addr = {
+    canceler = Lwt_canceler.create () ;
+    my_peer_id ;
+    listening_port ;
+    discovery_port ;
+    discovery_addr ;
+    restart_discovery = Lwt_condition.create () ;
+    pool = Pool pool ;
+    worker = Lwt.return_unit ;
+  }
+
+  let activate st =
+    st.worker <-
+      Lwt_utils.worker "discovery_sender"
+        ~run:begin fun () -> worker_loop Config.initial st end
+        ~cancel:begin fun () -> Lwt_canceler.cancel st.canceler end
+
+end
+
+(* ********************************************************************** *)
+
+type t = {
+  answer: Answer.t ;
+  sender: Sender.t ;
+}
+
+let create ~listening_port ~discovery_port ~discovery_addr ~trust_discovered_peers pool my_peer_id =
+  let answer = Answer.create my_peer_id pool ~discovery_port ~trust_discovered_peers in
+  let sender =
+    Sender.create
+      my_peer_id pool ~listening_port ~discovery_port ~discovery_addr in
+  { answer ; sender }
+
+let activate { answer ; sender } =
+  Answer.activate answer ;
+  Sender.activate sender
+
+let wakeup t = Lwt_condition.signal t.sender.restart_discovery ()
+
+let shutdown t =
+  Lwt.join [
+    Lwt_canceler.cancel t.answer.canceler ;
+    Lwt_canceler.cancel t.sender.canceler ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_discovery.mli b/vendors/tezos-modded/src/lib_p2p/p2p_discovery.mli
new file mode 100644
index 000000000..01a3e0b2b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_discovery.mli
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+(** Local peer discovery.
+
+    This module manages the discovery of local peers through UDP broadcasting.
+    It is composed of two workers:
+    - The sender worker whose role is to broadcast discovery messages.
+    - The answer worker whose role is to listen discovery messages and register new
+      peers in the current pool.
+    Discovery messages are composed of an arbitrary key, the listening port and
+    the peer id of the current peer.
+*)
+
+(** Type of a discovery worker. *)
+type t
+
+(** [create ~listening_port ~discovery_port ~discovery_addr pool peer_id]
+    returns a discovery worker registering local peers to the [pool]
+    and broadcasting discovery messages with the [peer_id] and
+    the [listening_port] through the address [discovery_addr:discovery_port]. *)
+val create :
+  listening_port:int ->
+  discovery_port:int -> discovery_addr:Ipaddr.V4.t ->
+  trust_discovered_peers:bool ->
+  ('a, 'b, 'c) P2p_pool.t -> P2p_peer.Table.key ->
+  t
+
+val activate : t -> unit
+
+(** [wakeup t] sends a signal to the sender machine of [t], asking it
+    to immediately proceed to broadcasting. *)
+val wakeup : t -> unit
+
+(** [shutdown t] returns when [t] has completed shutdown. *)
+val shutdown : t -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_fd.ml b/vendors/tezos-modded/src/lib_p2p/p2p_fd.ml
new file mode 100644
index 000000000..b1a6c241b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_fd.ml
@@ -0,0 +1,107 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* logging facility to monitor sockets *)
+
+let is_not_windows = Sys.os_type <> "Win32"
+let () =
+  (* Otherwise some writes trigger a SIGPIPE instead of raising an
+     Lwt_unit exception. In the node, this is already done by
+     Cohttp, so this is only useful when using the P2P layer as a
+     stand alone library.  *)
+  if is_not_windows  then
+    Sys.(set_signal sigpipe Signal_ignore)
+
+(* Logging facility for the P2P layer *)
+module Log = Logging.Make(struct let name = "p2p.fd" end)
+
+type t = {
+  fd : Lwt_unix.file_descr ;
+  id : int ;
+  mutable nread : int ;
+  mutable nwrit : int ;
+}
+
+(* we use a prefix ' cnx:' that allows easy grepping in the log to lookup
+   everything related to a particular connection. *)
+let log t fmt =
+  Format.kasprintf (fun s -> Log.debug "cnx:%d:%s" t.id s) fmt
+
+let create =
+  let counter = ref 0 in
+  function fd ->
+    incr counter;
+    let t = { fd ; id = !counter ; nread = 0 ; nwrit = 0 } in
+    log t "create: fd %d" t.id ;
+    t
+
+let string_of_sockaddr addr =
+  match addr with
+  | Lwt_unix.ADDR_INET (ip, port) ->
+      Printf.sprintf "%s:%d" (Unix.string_of_inet_addr ip) port
+  | Lwt_unix.ADDR_UNIX file ->
+      Printf.sprintf "@%s" file
+
+let id t = t.id
+
+let socket proto kind arg =
+  create (Lwt_unix.socket proto kind arg)
+
+let close t =
+  log t "close: stats %d/%d" t.nread t.nwrit ;
+  Lwt_utils_unix.safe_close t.fd
+
+let read t buf pos len =
+  log t "try-read: %d" len;
+  Lwt_bytes.read t.fd buf pos len >>= fun nread ->
+  t.nread <- t.nread + nread ;
+  log t "read: %d (%d)" nread t.nread ;
+  Lwt.return nread
+
+let write t buf =
+  let len = MBytes.length buf in
+  log t "try-write: %d" len;
+  Lwt_utils_unix.write_mbytes t.fd buf >>= fun () ->
+  t.nwrit <- t.nwrit + len ;
+  log t "written: %d (%d)" len t.nwrit ;
+  Lwt.return ()
+
+let connect t saddr =
+  log t "connect: %s" (string_of_sockaddr saddr);
+  Lwt_unix.connect t.fd saddr
+
+let accept sock =
+  Lwt_unix.accept sock >>= fun (fd, saddr) ->
+  let t = create fd in
+  log t "accept: %s" (string_of_sockaddr saddr);
+  Lwt.return (t, saddr)
+
+module Table =
+  Hashtbl.Make(struct
+    type nonrec t = t
+    let equal { id = x ; _ } { id = y ; _ } = x = y
+    let hash { id ; _ } = Hashtbl.hash id
+  end)
+
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_fd.mli b/vendors/tezos-modded/src/lib_p2p/p2p_fd.mli
new file mode 100644
index 000000000..a8a3adb1c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_fd.mli
@@ -0,0 +1,39 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Bottom-up logging facility for the P2P layer. Use this to track
+   all information related to a particular connection. *)
+
+type t
+
+val id : t -> int
+val read : t -> Lwt_bytes.t -> int -> int -> int Lwt.t
+val close : t -> unit Lwt.t
+val write : t -> MBytes.t -> unit Lwt.t
+val socket : Lwt_unix.socket_domain -> Lwt_unix.socket_type -> int -> t
+val connect : t -> Lwt_unix.sockaddr -> unit Lwt.t
+val accept : Lwt_unix.file_descr -> (t * Lwt_unix.sockaddr) Lwt.t
+
+module Table : Hashtbl.S with type key = t
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.ml b/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.ml
new file mode 100644
index 000000000..0d7d3fc9a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.ml
@@ -0,0 +1,509 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* TODO decide whether we need to preallocate buffers or not. *)
+
+include Logging.Make (struct let name = "p2p.io-scheduler" end)
+
+let alpha = 0.2
+
+module type IO = sig
+  val name: string
+  type in_param
+  val pop: in_param -> MBytes.t tzresult Lwt.t
+  type out_param
+  val push: out_param -> MBytes.t -> unit tzresult Lwt.t
+  val close: out_param -> error list -> unit Lwt.t
+end
+
+module Scheduler(IO : IO) = struct
+
+  type t = {
+    canceler: Lwt_canceler.t ;
+    mutable worker: unit Lwt.t ;
+    counter: Moving_average.t ;
+    max_speed: int option ;
+    mutable quota: int ;
+    quota_updated: unit Lwt_condition.t ;
+    readys: unit Lwt_condition.t ;
+    readys_high: (connection * MBytes.t tzresult) Queue.t ;
+    readys_low: (connection * MBytes.t tzresult) Queue.t ;
+  }
+
+  and connection = {
+    id: int ;
+    mutable closed: bool ;
+    canceler: Lwt_canceler.t ;
+    in_param: IO.in_param ;
+    out_param: IO.out_param ;
+    mutable current_pop: MBytes.t tzresult Lwt.t ;
+    mutable current_push: unit tzresult Lwt.t ;
+    counter: Moving_average.t ;
+    mutable quota: int ;
+    mutable last_quota: int ;
+  }
+
+  let cancel (conn : connection) err =
+    Lwt_utils.unless conn.closed begin fun () ->
+      lwt_debug "Connection closed (%d, %s) " conn.id IO.name >>= fun () ->
+      conn.closed <- true ;
+      Lwt.catch
+        (fun () -> IO.close conn.out_param err)
+        (fun _ -> Lwt.return_unit) >>= fun () ->
+      Lwt_canceler.cancel conn.canceler
+    end
+
+  let waiter st conn =
+    assert (Lwt.state conn.current_pop <> Sleep) ;
+    conn.current_pop <- IO.pop conn.in_param ;
+    Lwt.async begin fun () ->
+      conn.current_pop >>= fun res ->
+      conn.current_push >>= fun _ ->
+      let was_empty =
+        Queue.is_empty st.readys_high && Queue.is_empty st.readys_low in
+      if conn.quota > 0 then
+        Queue.push (conn, res) st.readys_high
+      else
+        Queue.push (conn, res) st.readys_low ;
+      if was_empty then Lwt_condition.broadcast st.readys () ;
+      Lwt.return_unit
+    end
+
+  let wait_data st =
+    let is_empty =
+      Queue.is_empty st.readys_high && Queue.is_empty st.readys_low in
+    if is_empty then Lwt_condition.wait st.readys else Lwt.return_unit
+
+  let check_quota st =
+    if st.max_speed <> None && st.quota < 0 then begin
+      lwt_debug "scheduler.wait_quota(%s)" IO.name >>= fun () ->
+      Lwt_condition.wait st.quota_updated
+    end else
+      Lwt_unix.yield ()
+
+  let rec worker_loop st =
+    check_quota st >>= fun () ->
+    lwt_debug "scheduler.wait(%s)" IO.name >>= fun () ->
+    Lwt.pick [
+      Lwt_canceler.cancelation st.canceler ;
+      wait_data st
+    ] >>= fun () ->
+    if Lwt_canceler.canceled st.canceler then
+      Lwt.return_unit
+    else
+      let prio, (conn, msg) =
+        if not (Queue.is_empty st.readys_high) then
+          true, (Queue.pop st.readys_high)
+        else
+          false, (Queue.pop st.readys_low)
+      in
+      match msg with
+      | Error [ Canceled ] ->
+          worker_loop st
+      | Error ([P2p_errors.Connection_closed |
+                Exn ( Lwt_pipe.Closed |
+                      Unix.Unix_error ((EBADF | ETIMEDOUT), _, _) )]
+               as err) ->
+          lwt_debug "Connection closed (pop: %d, %s)"
+            conn.id IO.name >>= fun () ->
+          cancel conn err >>= fun () ->
+          worker_loop st
+      | Error err ->
+          lwt_log_error
+            "@[Unexpected error in connection (pop: %d, %s):@ %a@]"
+            conn.id IO.name pp_print_error err >>= fun () ->
+          cancel conn err >>= fun () ->
+          worker_loop st
+      | Ok msg ->
+          conn.current_push <- begin
+            IO.push conn.out_param msg >>= function
+            | Ok ()
+            | Error [ Canceled ] ->
+                return_unit
+            | Error ([P2p_errors.Connection_closed |
+                      Exn (Unix.Unix_error (EBADF, _, _) |
+                           Lwt_pipe.Closed)] as err) ->
+                lwt_debug "Connection closed (push: %d, %s)"
+                  conn.id IO.name >>= fun () ->
+                cancel conn err >>= fun () ->
+                return_unit
+            | Error err ->
+                lwt_log_error
+                  "@[Unexpected error in connection (push: %d, %s):@ %a@]"
+                  conn.id IO.name pp_print_error err >>= fun () ->
+                cancel conn err >>= fun () ->
+                Lwt.return (Error err)
+          end ;
+          let len = MBytes.length msg in
+          lwt_debug "Handle: %d (%d, %s)" len conn.id IO.name >>= fun () ->
+          Moving_average.add st.counter len ;
+          st.quota <- st.quota - len ;
+          Moving_average.add conn.counter len ;
+          if prio then conn.quota <- conn.quota - len ;
+          waiter st conn ;
+          worker_loop st
+
+  let create max_speed =
+    let st = {
+      canceler = Lwt_canceler.create () ;
+      worker = Lwt.return_unit ;
+      counter = Moving_average.create ~init:0 ~alpha ;
+      max_speed ; quota = Option.unopt ~default:0 max_speed ;
+      quota_updated = Lwt_condition.create () ;
+      readys = Lwt_condition.create () ;
+      readys_high = Queue.create () ;
+      readys_low = Queue.create () ;
+    } in
+    st.worker <-
+      Lwt_utils.worker IO.name
+        ~run:(fun () -> worker_loop st)
+        ~cancel:(fun () -> Lwt_canceler.cancel st.canceler) ;
+    st
+
+  let create_connection st in_param out_param canceler id =
+    debug "scheduler(%s).create_connection (%d)" IO.name id ;
+    let conn =
+      { id ; closed = false ;
+        canceler ;
+        in_param ; out_param ;
+        current_pop = Lwt.fail Not_found (* dummy *) ;
+        current_push = return_unit ;
+        counter = Moving_average.create ~init:0 ~alpha ;
+        quota = 0 ; last_quota = 0 ;
+      } in
+    waiter st conn ;
+    conn
+
+  let update_quota st =
+    debug "scheduler(%s).update_quota" IO.name ;
+    Option.iter st.max_speed ~f:begin fun quota ->
+      st.quota <- (min st.quota 0) + quota ;
+      Lwt_condition.broadcast st.quota_updated ()
+    end ;
+    if not (Queue.is_empty st.readys_low) then begin
+      let tmp = Queue.create () in
+      Queue.iter
+        (fun ((conn : connection), _ as msg) ->
+           if conn.quota > 0 then
+             Queue.push msg st.readys_high
+           else
+             Queue.push msg tmp)
+        st.readys_low ;
+      Queue.clear st.readys_low ;
+      Queue.transfer tmp st.readys_low ;
+    end
+
+  let shutdown st =
+    lwt_debug "--> scheduler(%s).shutdown" IO.name >>= fun () ->
+    Lwt_canceler.cancel st.canceler >>= fun () ->
+    st.worker >>= fun () ->
+    lwt_debug "<-- scheduler(%s).shutdown" IO.name >>= fun () ->
+    Lwt.return_unit
+
+
+end
+
+module ReadScheduler = Scheduler(struct
+    let name = "io_scheduler(read)"
+    type in_param = P2p_fd.t * int
+    let pop (fd, maxlen) =
+      Lwt.catch
+        (fun () ->
+           let buf = MBytes.create maxlen in
+           P2p_fd.read fd buf 0 maxlen >>= fun len ->
+           if len = 0 then
+             fail P2p_errors.Connection_closed
+           else
+             return (MBytes.sub buf 0 len) )
+        (function
+          | Unix.Unix_error(Unix.ECONNRESET, _, _) ->
+              fail P2p_errors.Connection_closed
+          | exn ->
+              Lwt.return (error_exn exn))
+    type out_param = MBytes.t tzresult Lwt_pipe.t
+    let push p msg =
+      Lwt.catch
+        (fun () -> Lwt_pipe.push p (Ok msg) >>= return)
+        (fun exn -> fail (Exn exn))
+    let close p err =
+      Lwt.catch
+        (fun () -> Lwt_pipe.push p (Error err))
+        (fun _ -> Lwt.return_unit)
+  end)
+
+module WriteScheduler = Scheduler(struct
+    let name = "io_scheduler(write)"
+    type in_param = MBytes.t Lwt_pipe.t
+    let pop p =
+      Lwt.catch
+        (fun () -> Lwt_pipe.pop p >>= return)
+        (fun _ -> fail (Exn Lwt_pipe.Closed))
+    type out_param = P2p_fd.t
+    let push fd buf =
+      Lwt.catch
+        (fun () ->
+           P2p_fd.write fd buf >>= return)
+        (function
+          | Unix.Unix_error(Unix.ECONNRESET, _, _)
+          | Unix.Unix_error(Unix.EPIPE, _, _)
+          | Lwt.Canceled
+          | End_of_file ->
+              fail P2p_errors.Connection_closed
+          | exn ->
+              Lwt.return (error_exn exn))
+    let close _p _err = Lwt.return_unit
+  end)
+
+type connection = {
+  sched: t ;
+  conn: P2p_fd.t;
+  canceler: Lwt_canceler.t ;
+  read_conn: ReadScheduler.connection ;
+  read_queue: MBytes.t tzresult Lwt_pipe.t ;
+  write_conn: WriteScheduler.connection ;
+  write_queue: MBytes.t Lwt_pipe.t ;
+  mutable partial_read: MBytes.t option ;
+}
+
+and t = {
+  mutable closed: bool ;
+  connected: connection P2p_fd.Table.t ;
+  read_scheduler: ReadScheduler.t ;
+  write_scheduler: WriteScheduler.t ;
+  max_upload_speed: int option ; (* bytes per second. *)
+  max_download_speed: int option ;
+  read_buffer_size: int ;
+  read_queue_size: int option ;
+  write_queue_size: int option ;
+}
+
+let reset_quota st =
+  debug "--> reset quota" ;
+  let { Moving_average.average = current_inflow } =
+    Moving_average.stat st.read_scheduler.counter
+  and { Moving_average.average = current_outflow } =
+    Moving_average.stat st.write_scheduler.counter in
+  let nb_conn = P2p_fd.Table.length st.connected in
+  if nb_conn > 0 then begin
+    let fair_read_quota = current_inflow / nb_conn
+    and fair_write_quota = current_outflow / nb_conn in
+    P2p_fd.Table.iter
+      (fun _id conn ->
+         conn.read_conn.last_quota <- fair_read_quota ;
+         conn.read_conn.quota <-
+           (min conn.read_conn.quota 0) + fair_read_quota ;
+         conn.write_conn.last_quota <- fair_write_quota ;
+         conn.write_conn.quota <-
+           (min conn.write_conn.quota 0) + fair_write_quota ; )
+      st.connected
+  end ;
+  ReadScheduler.update_quota st.read_scheduler ;
+  WriteScheduler.update_quota st.write_scheduler
+
+let create
+    ?max_upload_speed ?max_download_speed
+    ?read_queue_size ?write_queue_size
+    ~read_buffer_size
+    () =
+  log_info "--> create" ;
+  let st = {
+    closed = false ;
+    connected = P2p_fd.Table.create 53 ;
+    read_scheduler = ReadScheduler.create max_download_speed ;
+    write_scheduler = WriteScheduler.create max_upload_speed ;
+    max_upload_speed ;
+    max_download_speed ;
+    read_buffer_size ;
+    read_queue_size ;
+    write_queue_size ;
+  } in
+  Moving_average.on_update (fun () -> reset_quota st) ;
+  st
+
+exception Closed
+
+let read_size = function
+  | Ok buf -> (Sys.word_size / 8) * 8 + MBytes.length buf + Lwt_pipe.push_overhead
+  | Error _ -> 0 (* we push Error only when we close the socket,
+                    we don't fear memory leaks in that case... *)
+
+let write_size mbytes =
+  (Sys.word_size / 8) * 6 + MBytes.length mbytes + Lwt_pipe.push_overhead
+
+let register st conn =
+  if st.closed then begin
+    Lwt.async (fun () -> P2p_fd.close conn) ;
+    raise Closed
+  end else begin
+    let id = P2p_fd.id conn in
+    let canceler = Lwt_canceler.create () in
+    let read_size =
+      Option.map st.read_queue_size ~f:(fun v -> v, read_size) in
+    let write_size =
+      Option.map st.write_queue_size ~f:(fun v -> v, write_size) in
+    let read_queue = Lwt_pipe.create ?size:read_size () in
+    let write_queue = Lwt_pipe.create ?size:write_size () in
+    let read_conn =
+      ReadScheduler.create_connection
+        st.read_scheduler (conn, st.read_buffer_size) read_queue canceler id
+    and write_conn =
+      WriteScheduler.create_connection
+        st.write_scheduler write_queue conn canceler id in
+    Lwt_canceler.on_cancel canceler begin fun () ->
+      P2p_fd.Table.remove st.connected conn ;
+      Moving_average.destroy read_conn.counter ;
+      Moving_average.destroy write_conn.counter ;
+      Lwt_pipe.close write_queue ;
+      Lwt_pipe.close read_queue ;
+      P2p_fd.close conn
+    end ;
+    let conn = {
+      sched = st ; conn ; canceler ;
+      read_queue ; read_conn ;
+      write_queue ; write_conn ;
+      partial_read = None ;
+    } in
+    P2p_fd.Table.add st.connected conn.conn conn ;
+    log_info "--> register (%d)" id ;
+    conn
+  end
+
+let write ?canceler { write_queue } msg =
+  trace P2p_errors.Connection_closed @@
+  protect ?canceler begin fun () ->
+    Lwt_pipe.push write_queue msg >>= return
+  end
+let write_now { write_queue } msg = Lwt_pipe.push_now write_queue msg
+
+let read_from conn ?pos ?len buf msg =
+  let maxlen = MBytes.length buf in
+  let pos = Option.unopt ~default:0 pos in
+  assert (0 <= pos && pos < maxlen) ;
+  let len = Option.unopt ~default:(maxlen - pos) len in
+  assert (len <= maxlen - pos) ;
+  match msg with
+  | Ok msg ->
+      let msg_len = MBytes.length msg in
+      let read_len = min len msg_len in
+      MBytes.blit msg 0 buf pos read_len ;
+      if read_len < msg_len then
+        conn.partial_read <-
+          Some (MBytes.sub msg read_len (msg_len - read_len)) ;
+      Ok read_len
+  | Error _ ->
+      Error [P2p_errors.Connection_closed]
+
+let read_now conn ?pos ?len buf =
+  match conn.partial_read with
+  | Some msg ->
+      conn.partial_read <- None ;
+      Some (read_from conn ?pos ?len buf (Ok msg))
+  | None ->
+      try
+        Option.map
+          ~f:(read_from conn ?pos ?len buf)
+          (Lwt_pipe.pop_now conn.read_queue)
+      with Lwt_pipe.Closed -> Some (Error [P2p_errors.Connection_closed])
+
+let read ?canceler conn ?pos ?len buf =
+  match conn.partial_read with
+  | Some msg ->
+      conn.partial_read <- None ;
+      Lwt.return (read_from conn ?pos ?len buf (Ok msg))
+  | None ->
+      Lwt.catch
+        (fun () ->
+           protect ?canceler begin fun () ->
+             Lwt_pipe.pop conn.read_queue
+           end >|= fun msg ->
+           read_from conn ?pos ?len buf msg)
+        (fun _ -> fail P2p_errors.Connection_closed)
+
+let read_full ?canceler conn ?pos ?len buf =
+  let maxlen = MBytes.length buf in
+  let pos = Option.unopt ~default:0 pos in
+  let len = Option.unopt ~default:(maxlen - pos) len in
+  assert (0 <= pos && pos < maxlen) ;
+  assert (len <= maxlen - pos) ;
+  let rec loop pos len =
+    if len = 0 then
+      return_unit
+    else
+      read ?canceler conn ~pos ~len buf >>=? fun read_len ->
+      loop (pos + read_len) (len - read_len) in
+  loop pos len
+
+let convert ~ws ~rs =
+  { P2p_stat.total_sent = ws.Moving_average.total ;
+    total_recv = rs.Moving_average.total ;
+    current_outflow = ws.average ;
+    current_inflow = rs.average ;
+  }
+
+let global_stat { read_scheduler ; write_scheduler } =
+  let rs = Moving_average.stat read_scheduler.counter
+  and ws = Moving_average.stat write_scheduler.counter in
+  convert ~rs ~ws
+
+let stat { read_conn ; write_conn} =
+  let rs = Moving_average.stat read_conn.counter
+  and ws = Moving_average.stat write_conn.counter in
+  convert ~rs ~ws
+
+let close ?timeout conn =
+  let id = P2p_fd.id conn.conn in
+  lwt_log_info "--> close (%d)" id >>= fun () ->
+  P2p_fd.Table.remove conn.sched.connected conn.conn ;
+  Lwt_pipe.close conn.write_queue ;
+  begin
+    match timeout with
+    | None ->
+        return (Lwt_canceler.cancelation conn.canceler)
+    | Some timeout ->
+        with_timeout
+          ~canceler:conn.canceler
+          (Lwt_unix.sleep timeout)
+          (fun canceler -> return (Lwt_canceler.cancelation canceler))
+  end >>=? fun _ ->
+  conn.write_conn.current_push >>= fun res ->
+  lwt_log_info "<-- close (%d)" id >>= fun () ->
+  Lwt.return res
+
+let iter_connection { connected } f =
+  P2p_fd.Table.iter (fun _ conn -> f conn) connected
+
+let shutdown ?timeout st =
+  lwt_log_info "--> shutdown" >>= fun () ->
+  st.closed <- true ;
+  ReadScheduler.shutdown st.read_scheduler >>= fun () ->
+  P2p_fd.Table.fold
+    (fun _peer_id conn acc -> close ?timeout conn >>= fun _ -> acc)
+    st.connected
+    Lwt.return_unit >>= fun () ->
+  WriteScheduler.shutdown st.write_scheduler >>= fun () ->
+  lwt_log_info "<-- shutdown" >>= fun () ->
+  Lwt.return_unit
+
+let id conn = P2p_fd.id conn.conn
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.mli b/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.mli
new file mode 100644
index 000000000..a259d5f3f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_io_scheduler.mli
@@ -0,0 +1,112 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Generic IO scheduling between file descriptors.
+
+    In order to use IO scheduling, the [register] function must be
+    used to make a file descriptor managed by a [scheduler].. It will
+    return a value of type [connection] that must be used to perform IO
+    on the managed file descriptor using this module's dedicated IO
+    functions (read, write, etc.).
+
+    Each connection is allowed a read (resp. write) quota, which is
+    for now fairly distributed among connections.
+
+    To each connection is associated a read (resp. write) queue where
+    data is copied to (resp. read from), at a rate of
+    max_download_speed / num_connections (resp. max_upload_speed /
+    num_connections).
+*)
+
+type connection
+(** Type of a connection. *)
+
+type t
+(** Type of an IO scheduler. *)
+
+val create:
+  ?max_upload_speed:int ->
+  ?max_download_speed:int ->
+  ?read_queue_size:int ->
+  ?write_queue_size:int ->
+  read_buffer_size:int ->
+  unit -> t
+(** [create ~max_upload_speed ~max_download_speed ~read_queue_size
+    ~write_queue_size ()] is an IO scheduler with specified (global)
+    max upload (resp. download) speed, and specified read
+    (resp. write) queue sizes (in bytes) for connections. *)
+
+val register: t -> P2p_fd.t -> connection
+(** [register sched fd] is a [connection] managed by [sched]. *)
+
+val write:
+  ?canceler:Lwt_canceler.t ->
+  connection -> MBytes.t -> unit tzresult Lwt.t
+(** [write conn msg] returns [Ok ()] when [msg] has been added to
+    [conn]'s write queue, or fail with an error. *)
+
+val write_now: connection -> MBytes.t -> bool
+(** [write_now conn msg] is [true] iff [msg] has been (immediately)
+    added to [conn]'s write queue, [false] if it has been dropped. *)
+
+val read_now:
+  connection -> ?pos:int -> ?len:int -> MBytes.t -> int tzresult option
+(** [read_now conn ~pos ~len buf] blits at most [len] bytes from
+    [conn]'s read queue and returns the number of bytes written in
+    [buf] starting at [pos]. *)
+
+val read:
+  ?canceler:Lwt_canceler.t ->
+  connection -> ?pos:int -> ?len:int -> MBytes.t -> int tzresult Lwt.t
+(** Like [read_now], but waits till [conn] read queue has at least one
+    element instead of failing. *)
+
+val read_full:
+  ?canceler:Lwt_canceler.t ->
+  connection -> ?pos:int -> ?len:int -> MBytes.t -> unit tzresult Lwt.t
+(** Like [read], but blits exactly [len] bytes in [buf]. *)
+
+val stat: connection -> P2p_stat.t
+(** [stat conn] is a snapshot of current bandwidth usage for
+    [conn]. *)
+
+val global_stat: t -> P2p_stat.t
+(** [global_stat sched] is a snapshot of [sched]'s bandwidth usage
+    (sum of [stat conn] for each [conn] in [sched]). *)
+
+val iter_connection: t -> (connection -> unit) -> unit
+(** [iter_connection sched f] applies [f] on each connection managed
+    by [sched]. *)
+
+val close: ?timeout:float -> connection -> unit tzresult Lwt.t
+(** [close conn] cancels [conn] and returns after any pending data has
+    been sent. *)
+
+val shutdown: ?timeout:float -> t -> unit Lwt.t
+(** [shutdown sched] returns after all connections managed by [sched]
+    have been closed and [sched]'s inner worker has successfully
+    canceled. *)
+
+val id : connection -> int
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.ml b/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.ml
new file mode 100644
index 000000000..d6695e507
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.ml
@@ -0,0 +1,254 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "p2p.maintenance" end)
+
+type bounds = {
+  min_threshold: int ;
+  min_target: int ;
+  max_target: int ;
+  max_threshold: int ;
+}
+
+type config = {
+  maintenance_idle_time: float ;
+  greylist_timeout: int ;
+  private_mode: bool ;
+}
+
+type 'meta pool = Pool : ('msg, 'meta, 'meta_conn) P2p_pool.t -> 'meta pool
+
+type 'meta t = {
+  canceler: Lwt_canceler.t ;
+  config: config ;
+  bounds: bounds ;
+  pool: 'meta pool ;
+  discovery: P2p_discovery.t option ;
+  just_maintained: unit Lwt_condition.t ;
+  please_maintain: unit Lwt_condition.t ;
+  mutable maintain_worker: unit Lwt.t ;
+}
+
+(** Select [expected] points among the disconnected known points.
+    It ignores points which are greylisted, or for which a connection
+    failed after [start_time] and the pointes that are banned. It
+    first selects points with the oldest last tentative.
+    Non-trusted points are also ignored if option --private-mode is set. *)
+let connectable st start_time expected seen_points =
+  let Pool pool = st.pool in
+  let now = Time.now () in
+  let module Bounded_point_info =
+    List.Bounded(struct
+      type t = (Time.t option * P2p_point.Id.t)
+      let compare (t1, _) (t2, _) =
+        match t1, t2 with
+        | None, None -> 0
+        | None, Some _ -> 1
+        | Some _, None -> -1
+        | Some t1, Some t2 -> Time.compare t2 t1
+    end) in
+  let acc = Bounded_point_info.create expected in
+  let seen_points =
+    P2p_pool.Points.fold_known pool ~init:seen_points
+      ~f:begin fun point pi seen_points ->
+        (* consider the point only if:
+           - it is not in seen_points and
+           - it is not banned, and
+           - it is trusted if we are in `closed` mode
+        *)
+        if P2p_point.Set.mem point seen_points ||
+           P2p_pool.Points.banned pool point ||
+           (st.config.private_mode && not (P2p_point_state.Info.trusted pi))
+        then
+          seen_points
+        else
+          let seen_points = P2p_point.Set.add point seen_points in
+          match P2p_point_state.get pi with
+          | Disconnected -> begin
+              match P2p_point_state.Info.last_miss pi with
+              | Some last when Time.(start_time < last)
+                            || P2p_point_state.Info.greylisted ~now pi ->
+                  seen_points
+              | last ->
+                  Bounded_point_info.insert (last, point) acc ;
+                  seen_points
+            end
+          | _ -> seen_points
+      end
+  in
+  List.map snd (Bounded_point_info.get acc), seen_points
+
+(** Try to create connections to new peers. It tries to create at
+    least [min_to_contact] connections, and will never creates more
+    than [max_to_contact]. But, if after trying once all disconnected
+    peers, it returns [false]. *)
+let rec try_to_contact
+    st ?(start_time = Time.now ()) ~seen_points
+    min_to_contact max_to_contact =
+  let Pool pool = st.pool in
+  if min_to_contact <= 0 then
+    Lwt.return_true
+  else
+    let contactable, seen_points =
+      connectable st start_time max_to_contact seen_points in
+    if contactable = [] then
+      Lwt_unix.yield () >>= fun () ->
+      Lwt.return_false
+    else
+      List.fold_left
+        (fun acc point ->
+           protect ~canceler:st.canceler begin fun () ->
+             P2p_pool.connect pool point
+           end >>= function
+           | Ok _ -> acc >|= succ
+           | Error _ -> acc)
+        (Lwt.return 0)
+        contactable >>= fun established ->
+      try_to_contact st ~start_time ~seen_points
+        (min_to_contact - established) (max_to_contact - established)
+
+(** Do a maintenance step. It will terminate only when the number
+    of connections is between `min_threshold` and `max_threshold`.
+    Do a pass in the list of banned peers and remove all peers that
+    have been banned for more then xxx seconds *)
+let rec maintain st =
+  let Pool pool = st.pool in
+  let n_connected = P2p_pool.active_connections pool in
+  let older_than =
+    Time.(add (now ()) (Int64.of_int (- st.config.greylist_timeout)))
+  in
+  P2p_pool.gc_greylist pool ~older_than ;
+  if n_connected < st.bounds.min_threshold then
+    too_few_connections st n_connected
+  else if st.bounds.max_threshold < n_connected then
+    too_many_connections st n_connected
+  else begin
+    (* end of maintenance when enough users have been reached *)
+    Lwt_condition.broadcast st.just_maintained () ;
+    lwt_debug "Maintenance step ended" >>= fun () ->
+    return_unit
+  end
+
+and too_few_connections st n_connected =
+  let Pool pool = st.pool in
+  (* too few connections, try and contact many peers *)
+  lwt_log_notice "Too few connections (%d)" n_connected >>= fun () ->
+  let min_to_contact = st.bounds.min_target - n_connected in
+  let max_to_contact = st.bounds.max_target - n_connected in
+  try_to_contact
+    st min_to_contact max_to_contact ~seen_points:P2p_point.Set.empty >>=
+  fun success ->
+  if success then begin
+    maintain st
+  end else begin
+    (* not enough contacts, ask the pals of our pals,
+       discover the local network and then wait *)
+    P2p_pool.broadcast_bootstrap_msg pool ;
+    Option.iter ~f:P2p_discovery.wakeup st.discovery ;
+    protect ~canceler:st.canceler begin fun () ->
+      Lwt.pick [
+        P2p_pool.Pool_event.wait_new_peer pool ;
+        P2p_pool.Pool_event.wait_new_point pool ;
+        Lwt_unix.sleep 5.0 (* TODO exponential back-off ??
+                                   or wait for the existence of a
+                                   non grey-listed peer ?? *)
+      ] >>= return
+    end >>=? fun () ->
+    maintain st
+  end
+
+and too_many_connections st n_connected =
+  let Pool pool = st.pool in
+  (* too many connections, start the russian roulette *)
+  let to_kill = n_connected - st.bounds.max_target in
+  lwt_log_notice "Too many connections, will kill %d" to_kill >>= fun () ->
+  snd @@ P2p_pool.Connection.fold pool
+    ~init:(to_kill, Lwt.return_unit)
+    ~f:(fun _ conn (i, t) ->
+        if i = 0 then (0, t)
+        else (i - 1, t >>= fun () -> P2p_pool.disconnect conn))
+  >>= fun () ->
+  maintain st
+
+let rec worker_loop st =
+  let Pool pool = st.pool in
+  begin
+    protect ~canceler:st.canceler begin fun () ->
+      Lwt.pick [
+        Lwt_unix.sleep st.config.maintenance_idle_time ; (* default: every two minutes *)
+        Lwt_condition.wait st.please_maintain ; (* when asked *)
+        P2p_pool.Pool_event.wait_too_few_connections pool ; (* limits *)
+        P2p_pool.Pool_event.wait_too_many_connections pool ;
+      ] >>= fun () ->
+      return_unit
+    end >>=? fun () ->
+    let n_connected = P2p_pool.active_connections pool in
+    if n_connected < st.bounds.min_threshold
+    || st.bounds.max_threshold < n_connected then
+      maintain st
+    else begin
+      P2p_pool.send_swap_request pool ;
+      return_unit
+    end
+  end >>= function
+  | Ok () -> worker_loop st
+  | Error [ Canceled ] -> Lwt.return_unit
+  | Error _ -> Lwt.return_unit
+
+let create ?discovery config bounds pool = {
+  canceler = Lwt_canceler.create () ;
+  config ;
+  bounds ;
+  discovery ;
+  pool = Pool pool ;
+  just_maintained = Lwt_condition.create () ;
+  please_maintain = Lwt_condition.create () ;
+  maintain_worker = Lwt.return_unit ;
+}
+
+let activate st =
+  st.maintain_worker <-
+    Lwt_utils.worker "maintenance"
+      ~run:(fun () -> worker_loop st)
+      ~cancel:(fun () -> Lwt_canceler.cancel st.canceler) ;
+  Option.iter st.discovery ~f:P2p_discovery.activate
+
+let maintain { just_maintained ; please_maintain } =
+  let wait = Lwt_condition.wait just_maintained in
+  Lwt_condition.broadcast please_maintain () ;
+  wait
+
+let shutdown {
+    canceler ;
+    discovery ;
+    maintain_worker ;
+    just_maintained ;
+  } =
+  Lwt_canceler.cancel canceler >>= fun () ->
+  Lwt_utils.may ~f:P2p_discovery.shutdown discovery >>= fun () ->
+  maintain_worker >>= fun () ->
+  Lwt_condition.broadcast just_maintained () ;
+  Lwt.return_unit
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.mli b/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.mli
new file mode 100644
index 000000000..675d1c7ff
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_maintenance.mli
@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* min <= min_threshold <= min_target <= max_target <= max_threshold <= max *)
+
+(** P2P maintenance worker.
+
+    The P2P layer urges the maintainer to work when the number of
+    connections reaches `max` or is below `min`. Otherwise, the
+    maintener is lazy and only looks up for connections every two
+    minutes (hardcoded constant). The [maintain] function is another
+    way to signal the maintainer that a maintenance step is desired.
+
+    When the maintener detects that the number of connections is over
+    `max_threshold`, it randomly kills connections to reach
+    `max_target`.
+
+    When the maintener detects that the number of connections is below
+    `min_threshold`, it creates enough connection to reach at least
+    `min_target` (and never more than `max_target`). In the process, it
+    might ask its actual peers for new peers.  *)
+
+type bounds = {
+  min_threshold: int ;
+  min_target: int ;
+  max_target: int ;
+  max_threshold: int ;
+}
+
+type config = {
+
+  maintenance_idle_time: float ;
+  (** How long to wait at most, in seconds, before running a maintenance loop. *)
+
+  greylist_timeout: int ;
+  (** GC delay for the greylists tables, in seconds. *)
+
+  private_mode: bool ;
+  (** If [true], only open outgoing/accept incoming connections
+      to/from peers whose addresses are in [trusted_peers], and inform
+      these peers that the identity of this node should be revealed to
+      the rest of the network. *)
+
+}
+
+
+type 'meta t
+(** Type of a maintenance worker. *)
+
+val create:
+  ?discovery:P2p_discovery.t ->
+  config -> bounds ->
+  ('msg, 'meta, 'meta_conn) P2p_pool.t ->
+  'meta t
+(** [run ?discovery config bounds pool] returns a maintenance worker, with
+    the [discovery] worker if present, for [pool] with connection targets
+    specified in [bounds]. *)
+
+val activate: 'meta t -> unit
+(** [activate t] start the worker that will maintain connections *)
+
+val maintain: 'meta t -> unit Lwt.t
+(** [maintain t] gives a hint to maintenance worker [t] that
+    maintenance is needed and returns whenever [t] has done a
+    maintenance cycle. *)
+
+val shutdown: 'meta t -> unit Lwt.t
+(** [shutdown t] is a thread that returns whenever [t] has
+    successfully shut down. *)
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.ml b/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.ml
new file mode 100644
index 000000000..bbfd98b06
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.ml
@@ -0,0 +1,219 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 P2p_peer
+
+type ('conn, 'conn_meta) t =
+  | Accepted of { current_point: P2p_connection.Id.t ;
+                  cancel: Lwt_canceler.t }
+  | Running of { data: 'conn ;
+                 conn_metadata: 'conn_meta ;
+                 current_point: P2p_connection.Id.t }
+  | Disconnected
+type ('conn, 'conn_meta) state = ('conn, 'conn_meta) t
+
+let pp ppf = function
+  | Accepted { current_point ; _ } ->
+      Format.fprintf ppf "accepted %a" P2p_connection.Id.pp current_point
+  | Running { current_point ; _ } ->
+      Format.fprintf ppf "running %a" P2p_connection.Id.pp current_point
+  | Disconnected ->
+      Format.fprintf ppf "disconnected"
+
+module Info = struct
+
+  type ('conn, 'peer_meta, 'conn_meta) t = {
+    peer_id : Id.t ;
+    created : Time.t ;
+    mutable state : ('conn, 'conn_meta) state ;
+    mutable peer_metadata : 'peer_meta ;
+    mutable trusted : bool ;
+    mutable last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_established_connection : (P2p_connection.Id.t * Time.t) option ;
+    mutable last_disconnection : (P2p_connection.Id.t * Time.t) option ;
+    events : Pool_event.t Ring.t ;
+    watchers : Pool_event.t Lwt_watcher.input ;
+  }
+  type ('conn, 'peer_meta, 'conn_meta) peer_info = ('conn, 'peer_meta, 'conn_meta) t
+
+  let compare gi1 gi2 = Id.compare gi1.peer_id gi2.peer_id
+
+  let log_size = 100
+
+  let create ?(created = Time.now ()) ?(trusted = false) ~peer_metadata peer_id =
+    { peer_id ;
+      created ;
+      state = Disconnected ;
+      peer_metadata ;
+      trusted ;
+      last_failed_connection = None ;
+      last_rejected_connection = None ;
+      last_established_connection = None ;
+      last_disconnection = None ;
+      events = Ring.create log_size ;
+      watchers = Lwt_watcher.create_input () ;
+    }
+
+  let encoding peer_metadata_encoding =
+    let open Data_encoding in
+    conv
+      (fun { peer_id ; trusted ; peer_metadata ; events ; created ;
+             last_failed_connection ; last_rejected_connection ;
+             last_established_connection ; last_disconnection ; _ } ->
+        (peer_id, created, trusted, peer_metadata, Ring.elements events,
+         last_failed_connection, last_rejected_connection,
+         last_established_connection, last_disconnection))
+      (fun (peer_id, created, trusted, peer_metadata, event_list,
+            last_failed_connection, last_rejected_connection,
+            last_established_connection, last_disconnection) ->
+        let info = create ~trusted ~peer_metadata peer_id in
+        let events = Ring.create log_size in
+        Ring.add_list info.events event_list ;
+        { state = Disconnected ;
+          trusted ; peer_id ; peer_metadata ; created ;
+          last_failed_connection ;
+          last_rejected_connection ;
+          last_established_connection ;
+          last_disconnection ;
+          events ;
+          watchers = Lwt_watcher.create_input () ;
+        })
+      (obj9
+         (req "peer_id" Id.encoding)
+         (req "created" Time.encoding)
+         (dft "trusted" bool false)
+         (req "peer_metadata" peer_metadata_encoding)
+         (dft "events" (list Pool_event.encoding) [])
+         (opt "last_failed_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_rejected_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_established_connection"
+            (tup2 P2p_connection.Id.encoding Time.encoding))
+         (opt "last_disconnection"
+            (tup2 P2p_connection.Id.encoding Time.encoding)))
+
+  let peer_id { peer_id ; _ } = peer_id
+  let created { created ; _ } = created
+  let peer_metadata { peer_metadata ; _ } = peer_metadata
+  let set_peer_metadata gi peer_metadata = gi.peer_metadata <- peer_metadata
+  let trusted { trusted ; _ } = trusted
+  let set_trusted gi = gi.trusted <- true
+  let unset_trusted gi = gi.trusted <- false
+  let last_established_connection s = s.last_established_connection
+  let last_disconnection s = s.last_disconnection
+  let last_failed_connection s = s.last_failed_connection
+  let last_rejected_connection s = s.last_rejected_connection
+
+  let last_seen s =
+    Time.recent
+      s.last_established_connection
+      (Time.recent s.last_rejected_connection s.last_disconnection)
+  let last_miss s =
+    Time.recent
+      s.last_failed_connection
+      (Time.recent s.last_rejected_connection s.last_disconnection)
+
+  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) point kind =
+    let event = { Pool_event.kind ; timestamp ; point } in
+    Ring.add events event ;
+    Lwt_watcher.notify watchers event
+
+  let log_incoming_rejection ?timestamp peer_info point =
+    log peer_info ?timestamp point Rejecting_request
+
+  module File = struct
+
+    let load path peer_metadata_encoding =
+      let enc =
+        Data_encoding.list (encoding peer_metadata_encoding) in
+      if path <> "/dev/null" && Sys.file_exists path then
+        Lwt_utils_unix.Json.read_file path >>=? fun json ->
+        return (Data_encoding.Json.destruct enc json)
+      else
+        return_nil
+
+    let save path peer_metadata_encoding peers =
+      let open Data_encoding in
+      Lwt_utils_unix.Json.write_file path @@
+      Json.construct (list (encoding peer_metadata_encoding)) peers
+
+  end
+
+  let watch { watchers ; _ } = Lwt_watcher.create_stream watchers
+  let fold { events ; _ } ~init ~f = Ring.fold events ~init ~f
+
+end
+
+let get { Info.state ; _ } = state
+
+let is_disconnected { Info.state ; _ } =
+  match state with
+  | Disconnected -> true
+  | Accepted _ | Running _ -> false
+
+let set_accepted
+    ?(timestamp = Time.now ())
+    peer_info current_point cancel =
+  assert begin
+    match peer_info.Info.state with
+    | Accepted _ | Running _ -> false
+    | Disconnected -> true
+  end ;
+  peer_info.state <- Accepted { current_point ; cancel } ;
+  Info.log peer_info ~timestamp current_point Accepting_request
+
+let set_running
+    ?(timestamp = Time.now ())
+    peer_info point data conn_metadata =
+  assert begin
+    match peer_info.Info.state with
+    | Disconnected -> true (* request to unknown peer_id. *)
+    | Running _ -> false
+    | Accepted { current_point ; _ } ->
+        P2p_connection.Id.equal point current_point
+  end ;
+  peer_info.state <- Running { data ; conn_metadata ; current_point = point } ;
+  peer_info.last_established_connection <- Some (point, timestamp) ;
+  Info.log peer_info ~timestamp point Connection_established
+
+let set_disconnected
+    ?(timestamp = Time.now ()) ?(requested = false) peer_info =
+  let current_point, (event : Pool_event.kind) =
+    match peer_info.Info.state with
+    | Accepted { current_point ; _ } ->
+        peer_info.last_rejected_connection <-
+          Some (current_point, timestamp) ;
+        current_point, Request_rejected
+    | Running { current_point ; _ } ->
+        peer_info.last_disconnection <-
+          Some (current_point, timestamp) ;
+        current_point,
+        if requested then Disconnection else External_disconnection
+    | Disconnected -> assert false
+  in
+  peer_info.state <- Disconnected ;
+  Info.log peer_info ~timestamp current_point event
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.mli b/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.mli
new file mode 100644
index 000000000..a72cee575
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_peer_state.mli
@@ -0,0 +1,131 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 P2p_peer
+
+type ('conn, 'conn_meta) t =
+  | Accepted of { current_point: P2p_connection.Id.t ;
+                  cancel: Lwt_canceler.t }
+  (** We accepted a incoming connection, we greeted back and
+      we are waiting for an acknowledgement. *)
+  | Running of { data: 'conn ;
+                 conn_metadata: 'conn_meta ;
+                 current_point: P2p_connection.Id.t }
+  (** Successfully authentificated connection, normal business. *)
+  | Disconnected
+  (** No connection established currently. *)
+type ('conn, 'conn_meta) state = ('conn, 'conn_meta) t
+
+val pp : Format.formatter -> ('conn, 'conn_meta) t -> unit
+
+module Info : sig
+
+  type ('conn, 'peer_meta, 'conn_meta) t
+  type ('conn, 'peer_meta, 'conn_meta) peer_info = ('conn, 'peer_meta, 'conn_meta) t
+
+  val compare : ('conn, 'peer_meta, 'conn_meta) t -> ('conn, 'peer_meta, 'conn_meta) t -> int
+
+  val create :
+    ?created:Time.t ->
+    ?trusted:bool ->
+    peer_metadata:'peer_meta ->
+    Id.t -> ('conn, 'peer_meta, 'conn_meta) peer_info
+  (** [create ~trusted ~meta peer_id] is a freshly minted peer_id info for
+      [peer_id]. *)
+
+  val peer_id : ('conn, 'peer_meta, 'conn_meta) peer_info -> Id.t
+
+  val created : ('conn, 'peer_meta, 'conn_meta) peer_info -> Time.t
+  val peer_metadata : ('conn, 'peer_meta, 'conn_meta) peer_info -> 'peer_meta
+  val set_peer_metadata : ('conn, 'peer_meta, 'conn_meta) peer_info -> 'peer_meta -> unit
+
+  val trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> bool
+  val set_trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> unit
+  val unset_trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> unit
+
+  val last_failed_connection :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_rejected_connection :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_established_connection :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  val last_disconnection :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+
+  val last_seen :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  (** [last_seen gi] is the most recent of:
+
+      * last established connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val last_miss :
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
+  (** [last_miss gi] is the most recent of:
+
+      * last failed connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val log_incoming_rejection :
+    ?timestamp:Time.t ->
+    ('conn, 'peer_meta, 'conn_meta) peer_info -> P2p_connection.Id.t -> unit
+
+  module File : sig
+    val load :
+      string -> 'peer_meta Data_encoding.t ->
+      ('conn, 'peer_meta, 'conn_meta) peer_info list tzresult Lwt.t
+    val save :
+      string -> 'peer_meta Data_encoding.t ->
+      ('conn, 'peer_meta, 'conn_meta) peer_info list -> unit tzresult Lwt.t
+  end
+
+  val fold :
+    ('conn, 'peer_meta, 'conn_meta) t -> init:'a -> f:('a -> Pool_event.t -> 'a) -> 'a
+
+  val watch :
+    ('conn, 'peer_meta, 'conn_meta) t -> Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
+
+end
+
+val get : ('conn, 'peer_meta, 'conn_meta) Info.t -> ('conn, 'conn_meta) state
+
+val is_disconnected : ('conn, 'peer_meta, 'conn_meta) Info.t -> bool
+
+val set_accepted :
+  ?timestamp:Time.t ->
+  ('conn, 'peer_meta, 'conn_meta) Info.t -> P2p_connection.Id.t -> Lwt_canceler.t -> unit
+
+val set_running :
+  ?timestamp:Time.t ->
+  ('conn, 'peer_meta, 'conn_meta) Info.t -> P2p_connection.Id.t -> 'conn -> 'conn_meta -> unit
+
+val set_disconnected :
+  ?timestamp:Time.t ->
+  ?requested:bool ->
+  ('conn, 'peer_meta, 'conn_meta) Info.t -> unit
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_point_state.ml b/vendors/tezos-modded/src/lib_p2p/p2p_point_state.ml
new file mode 100644
index 000000000..80d3f0395
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_point_state.ml
@@ -0,0 +1,221 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 P2p_point
+
+type 'data t =
+  | Requested of { cancel: Lwt_canceler.t }
+  | Accepted of { current_peer_id: P2p_peer.Id.t ;
+                  cancel: Lwt_canceler.t }
+  | Running of { data: 'data ;
+                 current_peer_id: P2p_peer.Id.t }
+  | Disconnected
+type 'data state = 'data t
+
+let pp ppf = function
+  | Requested _ ->
+      Format.fprintf ppf "requested"
+  | Accepted { current_peer_id ; _ } ->
+      Format.fprintf ppf "accepted %a" P2p_peer.Id.pp current_peer_id
+  | Running { current_peer_id ; _ } ->
+      Format.fprintf ppf "running %a" P2p_peer.Id.pp current_peer_id
+  | Disconnected ->
+      Format.fprintf ppf "disconnected"
+
+module Info = struct
+
+  type greylisting_config = {
+    factor: float ;
+    initial_delay: int ;
+    disconnection_delay: int ;
+  }
+
+  type 'data t = {
+    point : Id.t ;
+    mutable trusted : bool ;
+    mutable state : 'data state ;
+    mutable last_failed_connection : Time.t option ;
+    mutable last_rejected_connection : (P2p_peer.Id.t * Time.t) option ;
+    mutable last_established_connection : (P2p_peer.Id.t * Time.t) option ;
+    mutable known_public : bool ;
+    mutable last_disconnection : (P2p_peer.Id.t * Time.t) option ;
+    greylisting : greylisting_config ;
+    mutable greylisting_delay : float ;
+    mutable greylisting_end : Time.t ;
+    events : Pool_event.t Ring.t ;
+    watchers : Pool_event.t Lwt_watcher.input ;
+  }
+  type 'data point_info = 'data t
+
+  let compare pi1 pi2 = Id.compare pi1.point pi2.point
+
+  let log_size = 100
+
+  let default_greylisting_config = {
+    factor = 1.2 ;
+    initial_delay = 1 ;
+    disconnection_delay = 60 ;
+  }
+
+  let create
+      ?(trusted = false)
+      ?(greylisting_config = default_greylisting_config) addr  port = {
+    point = (addr, port) ;
+    trusted ;
+    state = Disconnected ;
+    last_failed_connection = None ;
+    last_rejected_connection = None ;
+    last_established_connection = None ;
+    last_disconnection = None ;
+    known_public = false ;
+    events = Ring.create log_size ;
+    greylisting = greylisting_config ;
+    greylisting_delay = 1. ;
+    greylisting_end = Time.epoch ;
+    watchers = Lwt_watcher.create_input () ;
+  }
+
+  let point s = s.point
+  let trusted s = s.trusted
+  let set_trusted gi = gi.trusted <- true
+  let unset_trusted gi = gi.trusted <- false
+  let last_established_connection s = s.last_established_connection
+  let last_disconnection s = s.last_disconnection
+  let last_failed_connection s = s.last_failed_connection
+  let last_rejected_connection s = s.last_rejected_connection
+  let known_public s = s.known_public
+  let greylisted ?(now = Time.now ()) s =
+    Time.compare now s.greylisting_end <= 0
+  let greylisted_until s = s.greylisting_end
+
+  let last_seen s =
+    Time.recent s.last_rejected_connection
+      (Time.recent s.last_established_connection s.last_disconnection)
+  let last_miss s =
+    match
+      s.last_failed_connection,
+      (Option.map ~f:(fun (_, time) -> time) @@
+       Time.recent s.last_rejected_connection s.last_disconnection) with
+    | (None, None) -> None
+    | (None, (Some _ as a))
+    | (Some _ as a, None) -> a
+    | (Some t1 as a1 , (Some t2 as a2)) ->
+        if Time.compare t1 t2 < 0 then a2 else a1
+
+  let log { events ; watchers ; _ } ?(timestamp = Time.now ()) kind =
+    let event = { Pool_event.kind ; timestamp } in
+    Ring.add events event ;
+    Lwt_watcher.notify watchers event
+
+  let log_incoming_rejection ?timestamp point_info peer_id =
+    log point_info ?timestamp (Rejecting_request peer_id)
+
+
+  let fold { events ; _ } ~init ~f = Ring.fold events ~init ~f
+
+  let watch { watchers ; _ } = Lwt_watcher.create_stream watchers
+
+end
+
+let get { Info.state ; _ } = state
+
+let is_disconnected { Info.state ; _ } =
+  match state with
+  | Disconnected -> true
+  | Requested _ | Accepted _ | Running _ -> false
+
+let set_requested ?timestamp point_info cancel =
+  assert begin
+    match point_info.Info.state with
+    | Requested _ -> true
+    | Accepted _ | Running _ -> false
+    | Disconnected -> true
+  end ;
+  point_info.state <- Requested { cancel } ;
+  Info.log point_info ?timestamp Outgoing_request
+
+let set_accepted
+    ?(timestamp = Time.now ())
+    point_info current_peer_id cancel =
+  (* log_notice "SET_ACCEPTED %a@." P2p_point.pp point_info.point ; *)
+  assert begin
+    match point_info.Info.state with
+    | Accepted _ | Running _ -> false
+    | Requested _ | Disconnected -> true
+  end ;
+  point_info.state <- Accepted { current_peer_id ; cancel } ;
+  Info.log point_info ~timestamp (Accepting_request current_peer_id)
+
+let set_running
+    ?(timestamp = Time.now ())
+    ~known_private point_info peer_id data  =
+  assert begin
+    match point_info.Info.state with
+    | Disconnected -> true (* request to unknown peer_id. *)
+    | Running _ -> false
+    | Accepted { current_peer_id ; _ } -> P2p_peer.Id.equal peer_id current_peer_id
+    | Requested _ -> true
+  end ;
+  point_info.state <- Running { data ; current_peer_id = peer_id } ;
+  point_info.known_public <- not known_private ;
+  point_info.last_established_connection <- Some (peer_id, timestamp) ;
+  Info.log point_info ~timestamp (Connection_established peer_id)
+
+let set_greylisted timestamp point_info =
+  point_info.Info.greylisting_end <-
+    Time.add
+      timestamp
+      (Int64.of_float point_info.Info.greylisting_delay) ;
+  point_info.greylisting_delay <-
+    point_info.greylisting_delay *. point_info.greylisting.factor
+
+let set_disconnected
+    ?(timestamp = Time.now ()) ?(requested = false) point_info =
+  let event : Pool_event.kind =
+    match point_info.Info.state with
+    | Requested _ ->
+        set_greylisted timestamp point_info ;
+        point_info.last_failed_connection <- Some timestamp ;
+        Request_rejected None
+    | Accepted { current_peer_id ; _ } ->
+        set_greylisted timestamp point_info ;
+        point_info.last_rejected_connection <-
+          Some (current_peer_id, timestamp) ;
+        Request_rejected (Some current_peer_id)
+    | Running { current_peer_id ; _ } ->
+        point_info.greylisting_delay <-
+          float_of_int point_info.greylisting.initial_delay ;
+        point_info.greylisting_end <-
+          Time.add timestamp
+            (Int64.of_int point_info.greylisting.disconnection_delay) ;
+        point_info.last_disconnection <- Some (current_peer_id, timestamp) ;
+        if requested
+        then Disconnection current_peer_id
+        else External_disconnection current_peer_id
+    | Disconnected ->
+        assert false
+  in
+  point_info.state <- Disconnected ;
+  Info.log point_info ~timestamp event
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_point_state.mli b/vendors/tezos-modded/src/lib_p2p/p2p_point_state.mli
new file mode 100644
index 000000000..ad6d33359
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_point_state.mli
@@ -0,0 +1,137 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 P2p_point
+
+type 'conn t =
+  | Requested of { cancel: Lwt_canceler.t }
+  (** We initiated a connection. *)
+  | Accepted of { current_peer_id: P2p_peer.Id.t ;
+                  cancel: Lwt_canceler.t }
+  (** We accepted a incoming connection. *)
+  | Running of { data: 'conn ;
+                 current_peer_id: P2p_peer.Id.t }
+  (** Successfully authentificated connection, normal business. *)
+  | Disconnected
+  (** No connection established currently. *)
+type 'conn state = 'conn t
+
+val pp : Format.formatter -> 'conn t -> unit
+
+module Info : sig
+
+  type 'conn t
+  type 'conn point_info = 'conn t
+  (** Type of info associated to a point. *)
+
+  val compare : 'conn point_info -> 'conn point_info -> int
+
+  type greylisting_config = {
+    factor: float ;
+    initial_delay: int ;
+    disconnection_delay: int ;
+  }
+
+  val create :
+    ?trusted:bool ->
+    ?greylisting_config:greylisting_config ->
+    P2p_addr.t -> P2p_addr.port -> 'conn point_info
+  (** [create ~trusted addr port] is a freshly minted point_info. If
+      [trusted] is true, this point is considered trusted and will
+      be treated as such. *)
+
+  val trusted : 'conn point_info -> bool
+  (** [trusted pi] is [true] iff [pi] has is trusted,
+      i.e. "whitelisted". *)
+
+  val known_public : 'conn point_info -> bool
+
+  val set_trusted : 'conn point_info -> unit
+  val unset_trusted : 'conn point_info -> unit
+
+  val last_failed_connection :
+    'conn point_info -> Time.t option
+  val last_rejected_connection :
+    'conn point_info -> (P2p_peer.Id.t * Time.t) option
+  val last_established_connection :
+    'conn point_info -> (P2p_peer.Id.t * Time.t) option
+  val last_disconnection :
+    'conn point_info -> (P2p_peer.Id.t * Time.t) option
+
+  val last_seen :
+    'conn point_info -> (P2p_peer.Id.t * Time.t) option
+  (** [last_seen pi] is the most recent of:
+
+      * last established connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val last_miss :
+    'conn point_info -> Time.t option
+  (** [last_miss pi] is the most recent of:
+
+      * last failed connection
+      * last rejected connection
+      * last disconnection
+  *)
+
+  val greylisted :
+    ?now:Time.t -> 'conn point_info -> bool
+
+  val greylisted_until : 'conn point_info -> Time.t
+
+  val point : 'conn point_info -> Id.t
+
+  val log_incoming_rejection :
+    ?timestamp:Time.t -> 'conn point_info -> P2p_peer.Id.t -> unit
+
+  val fold :
+    'conn t -> init:'a -> f:('a -> Pool_event.t -> 'a) -> 'a
+
+  val watch :
+    'conn t -> Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
+end
+
+val get : 'conn Info.t -> 'conn t
+
+val is_disconnected : 'conn Info.t -> bool
+
+val set_requested :
+  ?timestamp:Time.t ->
+  'conn Info.t -> Lwt_canceler.t -> unit
+
+val set_accepted :
+  ?timestamp:Time.t ->
+  'conn Info.t -> P2p_peer.Id.t -> Lwt_canceler.t -> unit
+
+val set_running :
+  ?timestamp:Time.t ->
+  known_private: bool ->
+  'conn Info.t -> P2p_peer.Id.t -> 'conn -> unit
+
+val set_disconnected :
+  ?timestamp:Time.t -> ?requested:bool -> 'conn Info.t -> unit
+
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_pool.ml b/vendors/tezos-modded/src/lib_p2p/p2p_pool.ml
new file mode 100644
index 000000000..11a634153
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_pool.ml
@@ -0,0 +1,1262 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* TODO Test cancelation of a (pending) connection *)
+
+(* TODO do not recompute list_known_points at each requests...  but
+        only once in a while, e.g. every minutes or when a point
+        or the associated peer_id is blacklisted. *)
+
+(* TODO allow to track "requested peer_ids" when we reconnect to a point. *)
+
+include Logging.Make (struct let name = "p2p.connection-pool" end)
+
+type 'msg encoding = Encoding : {
+    tag: int ;
+    title: string ;
+    encoding: 'a Data_encoding.t ;
+    wrap: 'a -> 'msg ;
+    unwrap: 'msg -> 'a option ;
+    max_length: int option ;
+  } -> 'msg encoding
+
+module Message = struct
+
+  type 'msg t =
+    | Bootstrap
+    | Advertise of P2p_point.Id.t list
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
+    | Message of 'msg
+    | Disconnect
+
+  let encoding msg_encoding =
+    let open Data_encoding in
+    dynamic_size @@
+    union ~tag_size:`Uint16
+      ([ case (Tag 0x01) ~title:"Disconnect"
+           (obj1 (req "kind" (constant "Disconnect")))
+           (function Disconnect -> Some () | _ -> None)
+           (fun () -> Disconnect);
+         case (Tag 0x02) ~title:"Bootstrap"
+           (obj1 (req "kind" (constant "Bootstrap")))
+           (function Bootstrap -> Some () | _ -> None)
+           (fun () -> Bootstrap);
+         case (Tag 0x03) ~title:"Advertise"
+           (obj2
+              (req "id" (Variable.list P2p_point.Id.encoding))
+              (req "kind" (constant "Advertise")))
+           (function Advertise points -> Some (points, ()) | _ -> None)
+           (fun (points, ()) -> Advertise points);
+         case (Tag 0x04) ~title:"Swap_request"
+           (obj3
+              (req "point" P2p_point.Id.encoding)
+              (req "peer_id" P2p_peer.Id.encoding)
+              (req "kind" (constant "Swap_request")))
+           (function
+             | Swap_request (point, peer_id) -> Some (point, peer_id, ())
+             | _ -> None)
+           (fun (point, peer_id, ()) -> Swap_request (point, peer_id)) ;
+         case (Tag 0x05)
+           ~title:"Swap_ack"
+           (obj3
+              (req "point" P2p_point.Id.encoding)
+              (req "peer_id" P2p_peer.Id.encoding)
+              (req "kind" (constant "Swap_ack")))
+           (function
+             | Swap_ack (point, peer_id) -> Some (point, peer_id, ())
+             | _ -> None)
+           (fun (point, peer_id, ()) -> Swap_ack (point, peer_id)) ;
+       ] @
+       ListLabels.map msg_encoding
+         ~f:(function Encoding { tag ; title ; encoding ; wrap ; unwrap } ->
+             Data_encoding.case (Tag tag)
+               ~title
+               encoding
+               (function Message msg -> unwrap msg | _ -> None)
+               (fun msg -> Message (wrap msg))))
+
+end
+
+
+module Answerer = struct
+
+  type 'msg callback = {
+    bootstrap: unit -> P2p_point.Id.t list Lwt.t ;
+    advertise: P2p_point.Id.t list -> unit Lwt.t ;
+    message: int -> 'msg -> unit Lwt.t ;
+    swap_request: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ;
+    swap_ack: P2p_point.Id.t -> P2p_peer.Id.t -> unit Lwt.t ;
+  }
+
+  type ('msg, 'meta) t = {
+    canceler: Lwt_canceler.t ;
+    conn: ('msg Message.t, 'meta) P2p_socket.t ;
+    callback: 'msg callback ;
+    mutable worker: unit Lwt.t ;
+  }
+
+  let rec worker_loop st =
+    Lwt_unix.yield () >>= fun () ->
+    protect ~canceler:st.canceler begin fun () ->
+      P2p_socket.read st.conn
+    end >>= function
+    | Ok (_, Bootstrap) -> begin
+        (* st.callback.bootstrap will return an empty list if the node
+           is in private mode *)
+        st.callback.bootstrap () >>= function
+        | [] ->
+            worker_loop st
+        | points ->
+            match P2p_socket.write_now st.conn (Advertise points) with
+            | Ok _sent ->
+                (* if not sent then ?? TODO count dropped message ?? *)
+                worker_loop st
+            | Error _ ->
+                Lwt_canceler.cancel st.canceler >>= fun () ->
+                Lwt.return_unit
+      end
+    | Ok (_, Advertise points) ->
+        (* st.callback.advertise will ignore the points if the node is
+           in private mode *)
+        st.callback.advertise points >>= fun () ->
+        worker_loop st
+    | Ok (_, Swap_request (point, peer)) ->
+        st.callback.swap_request point peer >>= fun () ->
+        worker_loop st
+    | Ok (_, Swap_ack (point, peer)) ->
+        st.callback.swap_ack point peer >>= fun () ->
+        worker_loop st
+    | Ok (size, Message msg) ->
+        st.callback.message size msg >>= fun () ->
+        worker_loop st
+    | Ok (_, Disconnect) | Error [P2p_errors.Connection_closed] ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+    | Error [P2p_errors.Decoding_error] ->
+        (* TODO: Penalize peer... *)
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+    | Error [ Canceled ] ->
+        Lwt.return_unit
+    | Error err ->
+        lwt_log_error "@[Answerer unexpected error:@ %a@]"
+          Error_monad.pp_print_error err >>= fun () ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+
+  let run conn canceler callback =
+    let st = {
+      canceler ; conn ; callback ;
+      worker = Lwt.return_unit ;
+    } in
+    st.worker <-
+      Lwt_utils.worker "answerer"
+        ~run:(fun () -> worker_loop st)
+        ~cancel:(fun () -> Lwt_canceler.cancel canceler) ;
+    st
+
+  let shutdown st =
+    Lwt_canceler.cancel st.canceler >>= fun () ->
+    st.worker
+
+end
+
+type config = {
+
+  identity : P2p_identity.t ;
+  proof_of_work_target : Crypto_box.target ;
+
+  trusted_points : P2p_point.Id.t list ;
+  peers_file : string ;
+  private_mode : bool ;
+
+  listening_port : P2p_addr.port option ;
+  min_connections : int ;
+  max_connections : int ;
+  max_incoming_connections : int ;
+  connection_timeout : float ;
+  authentication_timeout : float ;
+
+  incoming_app_message_queue_size : int option ;
+  incoming_message_queue_size : int option ;
+  outgoing_message_queue_size : int option ;
+
+  known_peer_ids_history_size : int ;
+  known_points_history_size : int ;
+  max_known_points : (int * int) option ; (* max, gc target *)
+  max_known_peer_ids : (int * int) option ; (* max, gc target *)
+
+  swap_linger : float ;
+
+  binary_chunks_size : int option ;
+}
+
+type 'peer_meta peer_meta_config = {
+  peer_meta_encoding : 'peer_meta Data_encoding.t ;
+  peer_meta_initial : unit -> 'peer_meta ;
+  score : 'peer_meta -> float ;
+}
+
+type 'msg message_config = {
+  encoding : 'msg encoding list ;
+  versions : P2p_version.t list;
+}
+
+type ('msg, 'peer_meta, 'conn_meta) t = {
+  config : config ;
+  peer_meta_config : 'peer_meta peer_meta_config ;
+  conn_meta_config : 'conn_meta P2p_socket.metadata_config ;
+  message_config : 'msg message_config ;
+  my_id_points : unit P2p_point.Table.t ;
+  known_peer_ids :
+    (('msg, 'peer_meta, 'conn_meta) connection,
+     'peer_meta,
+     'conn_meta) P2p_peer_state.Info.t P2p_peer.Table.t ;
+  connected_peer_ids :
+    (('msg, 'peer_meta, 'conn_meta) connection,
+     'peer_meta,
+     'conn_meta) P2p_peer_state.Info.t P2p_peer.Table.t ;
+  known_points :
+    ('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t P2p_point.Table.t ;
+  connected_points :
+    ('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t P2p_point.Table.t ;
+  incoming : Lwt_canceler.t P2p_point.Table.t ;
+  io_sched : P2p_io_scheduler.t ;
+  encoding : 'msg Message.t Data_encoding.t ;
+  events : events ;
+  watcher : P2p_connection.Pool_event.t Lwt_watcher.input ;
+  acl : P2p_acl.t ;
+  mutable new_connection_hook :
+    (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) list ;
+  mutable latest_accepted_swap : Time.t ;
+  mutable latest_succesfull_swap : Time.t  ;
+}
+
+and events = {
+  too_few_connections : unit Lwt_condition.t ;
+  too_many_connections : unit Lwt_condition.t ;
+  new_peer : unit Lwt_condition.t ;
+  new_point : unit Lwt_condition.t ;
+  new_connection : unit Lwt_condition.t ;
+}
+
+and ('msg, 'peer_meta, 'conn_meta) connection = {
+  canceler : Lwt_canceler.t ;
+  messages : (int * 'msg) Lwt_pipe.t ;
+  conn : ('msg Message.t, 'conn_meta) P2p_socket.t ;
+  peer_info :
+    (('msg, 'peer_meta, 'conn_meta) connection, 'peer_meta, 'conn_meta) P2p_peer_state.Info.t ;
+  point_info :
+    ('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t option ;
+  answerer : ('msg, 'conn_meta) Answerer.t Lazy.t ;
+  mutable last_sent_swap_request : (Time.t * P2p_peer.Id.t) option ;
+  mutable wait_close : bool ;
+}
+
+type ('msg, 'peer_meta, 'conn_meta) pool = ('msg, 'peer_meta, 'conn_meta) t
+
+module Pool_event = struct
+  let wait_too_few_connections pool =
+    Lwt_condition.wait pool.events.too_few_connections
+  let wait_too_many_connections pool =
+    Lwt_condition.wait pool.events.too_many_connections
+  let wait_new_peer pool =
+    Lwt_condition.wait pool.events.new_peer
+  let wait_new_point pool =
+    Lwt_condition.wait pool.events.new_point
+  let wait_new_connection pool =
+    Lwt_condition.wait pool.events.new_connection
+end
+
+let watch { watcher } = Lwt_watcher.create_stream watcher
+let log { watcher } event = Lwt_watcher.notify watcher event
+let private_node_warn fmt =
+  Format.kasprintf (fun s -> lwt_warn "[private node] %s" s) fmt
+
+module Gc_point_set = List.Bounded(struct
+    type t = Time.t * P2p_point.Id.t
+    let compare (x, _) (y, _) = - (Time.compare x y)
+  end)
+
+let gc_points ({ config = { max_known_points } ; known_points } as pool) =
+  match max_known_points with
+  | None -> ()
+  | Some (_, target) ->
+      let current_size = P2p_point.Table.length known_points in
+      if current_size > target then
+        let to_remove_target = current_size - target in
+        let now = Time.now () in (* TODO: maybe time of discovery? *)
+        let table = Gc_point_set.create to_remove_target in
+        P2p_point.Table.iter (fun p point_info ->
+            if P2p_point_state.is_disconnected point_info then
+              let time =
+                match P2p_point_state.Info.last_miss point_info with
+                | None -> now
+                | Some t -> t in
+              Gc_point_set.insert (time, p) table
+          ) known_points ;
+        let to_remove = Gc_point_set.get table in
+        ListLabels.iter to_remove ~f:begin fun (_, p) ->
+          P2p_point.Table.remove known_points p
+        end ;
+        log pool Gc_points
+
+let register_point pool ?trusted _source_peer_id (addr, port as point) =
+  match P2p_point.Table.find_opt pool.known_points point with
+  | None ->
+      let point_info = P2p_point_state.Info.create ?trusted addr port in
+      Option.iter pool.config.max_known_points ~f:begin fun (max, _) ->
+        if P2p_point.Table.length pool.known_points >= max then gc_points pool
+      end ;
+      P2p_point.Table.add pool.known_points point point_info ;
+      Lwt_condition.broadcast pool.events.new_point () ;
+      log pool (New_point point) ;
+      point_info
+  | Some point_info ->
+      begin
+        match trusted with
+        | Some true -> P2p_point_state.Info.set_trusted point_info ;
+        | _ -> ()
+      end ;
+      point_info
+
+let may_register_my_id_point pool = function
+  | [P2p_errors.Myself (addr, Some port)] ->
+      P2p_point.Table.add pool.my_id_points (addr, port) () ;
+      P2p_point.Table.remove pool.known_points (addr, port)
+  | _ -> ()
+
+
+(* Bounded table used to garbage collect peer_id infos when needed. The
+   strategy used is to remove the info of the peer_id with the lowest
+   score first. In case of equality, the info of the most recent added
+   peer_id is removed. The rationale behind this choice is that in the
+   case of a flood attack, the newly added infos will probably belong
+   to peer_ids with the same (low) score and removing the most recent ones
+   ensure that older (and probably legit) peer_id infos are kept. *)
+module Gc_peer_set = List.Bounded(struct
+    type t = float * Time.t * P2p_peer.Id.t
+    let compare (s, t, _) (s', t', _) =
+      let score_cmp = Pervasives.compare s s' in
+      if score_cmp = 0 then Time.compare t t' else - score_cmp
+  end)
+
+let gc_peer_ids ({ peer_meta_config = { score } ;
+                   config = { max_known_peer_ids } ;
+                   known_peer_ids ; } as pool) =
+  match max_known_peer_ids with
+  | None -> ()
+  | Some (_, target) ->
+      let current_size = P2p_peer.Table.length known_peer_ids in
+      if current_size > target then
+        let to_remove_target = current_size - target in
+        let table = Gc_peer_set.create to_remove_target in
+        P2p_peer.Table.iter (fun peer_id peer_info ->
+            let created = P2p_peer_state.Info.created peer_info in
+            let score = score @@ P2p_peer_state.Info.peer_metadata peer_info in
+            if P2p_peer_state.is_disconnected peer_info then
+              Gc_peer_set.insert (score, created, peer_id) table
+          ) known_peer_ids ;
+        let to_remove = Gc_peer_set.get table in
+        ListLabels.iter to_remove ~f:begin fun (_, _, peer_id) ->
+          P2p_peer.Table.remove known_peer_ids peer_id
+        end ;
+        log pool Gc_peer_ids
+
+let register_peer pool peer_id =
+  match P2p_peer.Table.find_opt pool.known_peer_ids peer_id with
+  | None ->
+      Lwt_condition.broadcast pool.events.new_peer () ;
+      let peer =
+        P2p_peer_state.Info.create peer_id
+          ~peer_metadata:(pool.peer_meta_config.peer_meta_initial ()) in
+      Option.iter pool.config.max_known_peer_ids ~f:begin fun (max, _) ->
+        if P2p_peer.Table.length pool.known_peer_ids >= max then gc_peer_ids pool
+      end ;
+      P2p_peer.Table.add pool.known_peer_ids peer_id peer ;
+      log pool (New_peer peer_id) ;
+      peer
+  | Some peer -> peer
+
+
+(***************************************************************************)
+
+let read { messages ; conn } =
+  Lwt.catch
+    (fun () ->
+       Lwt_pipe.pop messages >>= fun (s, msg) ->
+       lwt_debug "%d bytes message popped from queue %a\027[0m"
+         s P2p_peer.Id.pp (P2p_socket.info conn).peer_id >>= fun () ->
+       return msg)
+    (fun _ (* Closed *) -> fail P2p_errors.Connection_closed)
+
+let is_readable { messages } =
+  Lwt.catch
+    (fun () -> Lwt_pipe.values_available messages >>= return)
+    (fun _ (* Closed *) -> fail P2p_errors.Connection_closed)
+
+let write { conn } msg =
+  P2p_socket.write conn (Message msg)
+
+let write_sync { conn } msg =
+  P2p_socket.write_sync conn (Message msg)
+
+let raw_write_sync { conn } buf =
+  P2p_socket.raw_write_sync conn buf
+
+let write_now { conn } msg =
+  P2p_socket.write_now conn (Message msg)
+
+let write_all pool msg =
+  P2p_peer.Table.iter
+    (fun _peer_id peer_info ->
+       match P2p_peer_state.get peer_info with
+       | Running { data = conn } ->
+           ignore (write_now conn msg : bool tzresult )
+       | _ -> ())
+    pool.connected_peer_ids
+
+let broadcast_bootstrap_msg pool =
+  if not pool.config.private_mode then
+    P2p_peer.Table.iter
+      (fun _peer_id peer_info ->
+         match P2p_peer_state.get peer_info with
+         | Running { data = { conn } } ->
+             (* should not ask private nodes for the list of their
+                known peers*)
+             if not (P2p_socket.private_node conn) then
+               ignore (P2p_socket.write_now conn Bootstrap : bool tzresult )
+         | _ -> ())
+      pool.connected_peer_ids
+
+
+(***************************************************************************)
+
+(* this function duplicates bit of code from the modules below to avoid
+   creating mutually recurvive modules *)
+let connection_of_peer_id pool peer_id =
+  Option.apply
+    (P2p_peer.Table.find_opt pool.known_peer_ids peer_id) ~f:begin fun p ->
+    match P2p_peer_state.get p with
+    | Running { data } -> Some data
+    | _ -> None
+  end
+
+(* Every running connection matching the point's ip address is returned. *)
+let connections_of_addr pool addr =
+  P2p_point.Table.fold
+    (fun (addr', _) p acc ->
+       if Ipaddr.V6.compare addr addr' = 0
+       then
+         match P2p_point_state.get p with
+         | P2p_point_state.Running { data } -> data :: acc
+         | _ -> acc
+       else acc
+    ) pool.connected_points []
+
+let get_addr pool peer_id =
+  Option.map (connection_of_peer_id pool peer_id) ~f:begin fun ci ->
+    (P2p_socket.info ci.conn).id_point
+  end
+
+module Points = struct
+
+  type ('msg, 'peer_meta, 'conn_meta) info =
+    ('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t
+
+  let info { known_points } point =
+    P2p_point.Table.find_opt known_points point
+
+  let get_trusted pool point =
+    Option.unopt_map ~default:false ~f:P2p_point_state.Info.trusted
+      (P2p_point.Table.find_opt pool.known_points point)
+
+  let set_trusted pool point =
+    P2p_point_state.Info.set_trusted
+      (register_point pool pool.config.identity.peer_id point)
+
+  let unset_trusted pool point =
+    Option.iter ~f:P2p_point_state.Info.unset_trusted
+      (P2p_point.Table.find_opt pool.known_points point)
+
+  let fold_known pool ~init ~f =
+    P2p_point.Table.fold f pool.known_points init
+
+  let fold_connected  pool ~init ~f =
+    P2p_point.Table.fold f pool.connected_points init
+
+  let banned pool (addr, _port) =
+    P2p_acl.banned_addr pool.acl addr
+
+  let ban pool (addr, _port) =
+    P2p_acl.IPBlacklist.add pool.acl addr ;
+    (* Kick [addr]:* if it is in `Running` state. *)
+    List.iter (fun conn ->
+        conn.wait_close <- false ;
+        Lwt.async (fun () -> Answerer.shutdown (Lazy.force conn.answerer))
+      ) (connections_of_addr pool addr)
+
+  let unban pool (addr, _port) =
+    P2p_acl.IPBlacklist.remove pool.acl addr
+
+  let trust pool ((addr, _port) as point) =
+    P2p_acl.IPBlacklist.remove pool.acl addr ;
+    set_trusted pool point
+
+  let untrust pool point =
+    unset_trusted pool point
+
+end
+
+module Peers = struct
+
+  type ('msg, 'peer_meta, 'conn_meta) info =
+    (('msg, 'peer_meta, 'conn_meta) connection, 'peer_meta, 'conn_meta) P2p_peer_state.Info.t
+
+  let info { known_peer_ids } peer_id =
+    try Some (P2p_peer.Table.find known_peer_ids peer_id)
+    with Not_found -> None
+
+  let get_peer_metadata pool peer_id =
+    try P2p_peer_state.Info.peer_metadata (P2p_peer.Table.find pool.known_peer_ids peer_id)
+    with Not_found -> pool.peer_meta_config.peer_meta_initial ()
+
+  let get_score pool peer_id =
+    pool.peer_meta_config.score (get_peer_metadata pool peer_id)
+
+  let set_peer_metadata pool peer_id data =
+    P2p_peer_state.Info.set_peer_metadata (register_peer pool peer_id) data
+
+  let get_trusted pool peer_id =
+    try P2p_peer_state.Info.trusted (P2p_peer.Table.find pool.known_peer_ids peer_id)
+    with Not_found -> false
+
+  let set_trusted pool peer_id =
+    try P2p_peer_state.Info.set_trusted (register_peer pool peer_id)
+    with Not_found -> ()
+
+  let unset_trusted pool peer_id =
+    try P2p_peer_state.Info.unset_trusted (P2p_peer.Table.find pool.known_peer_ids peer_id)
+    with Not_found -> ()
+
+  let fold_known pool ~init ~f =
+    P2p_peer.Table.fold f pool.known_peer_ids init
+
+  let fold_connected pool ~init ~f =
+    P2p_peer.Table.fold f pool.connected_peer_ids init
+
+  let ban pool peer =
+    P2p_acl.PeerBlacklist.add pool.acl peer ;
+    (* Kick [peer] if it is in `Running` state. *)
+    Option.iter (connection_of_peer_id pool peer) ~f:begin fun conn ->
+      conn.wait_close <- false ;
+      Lwt.async (fun () -> Answerer.shutdown (Lazy.force conn.answerer))
+    end
+
+  let unban pool peer =
+    P2p_acl.PeerBlacklist.remove pool.acl peer
+
+  let trust pool peer =
+    unban pool peer ;
+    set_trusted pool peer
+
+  let untrust pool peer =
+    unset_trusted pool peer
+
+  let banned pool peer =
+    P2p_acl.banned_peer pool.acl peer
+
+end
+
+module Connection = struct
+
+  let private_node conn = P2p_socket.private_node conn.conn
+
+  let fold pool ~init ~f =
+    Peers.fold_connected pool ~init ~f:begin fun peer_id peer_info acc ->
+      match P2p_peer_state.get peer_info with
+      | Running { data } -> f peer_id data acc
+      | _ -> acc
+    end
+
+  let list pool =
+    fold pool ~init:[] ~f:(fun peer_id c acc -> (peer_id, c) :: acc)
+
+  let random ?different_than ~no_private pool =
+    let candidates =
+      fold pool ~init:[] ~f:begin fun _peer conn acc ->
+        if no_private && (private_node conn) then
+          acc
+        else
+          match different_than with
+          | Some excluded_conn
+            when P2p_socket.equal conn.conn excluded_conn.conn -> acc
+          | Some _ | None -> conn :: acc
+      end in
+    match candidates with
+    | [] -> None
+    | _ :: _ ->
+        Some (List.nth candidates (Random.int @@ List.length candidates))
+
+  let random_lowid ?different_than ~no_private pool =
+    let candidates =
+      fold pool ~init:[] ~f:begin fun _peer conn acc ->
+        if no_private && (private_node conn) then
+          acc
+        else
+          match different_than with
+          | Some excluded_conn
+            when P2p_socket.equal conn.conn excluded_conn.conn -> acc
+          | Some _ | None ->
+              let ci = P2p_socket.info conn.conn in
+              match ci.id_point with
+              | _, None -> acc
+              | addr, Some port -> ((addr, port), ci.peer_id, conn) :: acc
+      end in
+    match candidates with
+    | [] -> None
+    | _ :: _ ->
+        Some (List.nth candidates (Random.int @@ List.length candidates))
+
+  let stat { conn } =
+    P2p_socket.stat conn
+
+  let info { conn } =
+    P2p_socket.info conn
+
+  let local_metadata { conn } =
+    P2p_socket.local_metadata conn
+
+  let remote_metadata { conn } =
+    P2p_socket.remote_metadata conn
+
+  let find_by_peer_id pool peer_id =
+    Option.apply
+      (Peers.info pool peer_id)
+      ~f:(fun p ->
+          match P2p_peer_state.get p with
+          | Running { data } -> Some data
+          | _ -> None)
+
+  let find_by_point pool point =
+    Option.apply
+      (Points.info pool point)
+      ~f:(fun p ->
+          match P2p_point_state.get p with
+          | Running { data } -> Some data
+          | _ -> None)
+
+end
+
+let greylist_addr pool addr =
+  P2p_acl.IPGreylist.add pool.acl addr (Time.now ())
+
+let greylist_peer pool peer =
+  Option.iter (get_addr pool peer) ~f:begin fun (addr, _port) ->
+    greylist_addr pool addr ;
+    P2p_acl.PeerGreylist.add pool.acl peer
+  end
+
+let acl_clear pool =
+  P2p_acl.clear pool.acl
+
+let gc_greylist ~older_than pool =
+  P2p_acl.IPGreylist.remove_old ~older_than pool.acl
+
+let pool_stat { io_sched } =
+  P2p_io_scheduler.global_stat io_sched
+
+let config { config } = config
+
+let score { peer_meta_config = { score }} meta = score meta
+
+(***************************************************************************)
+
+let fail_unless_disconnected_point point_info =
+  match P2p_point_state.get point_info with
+  | Disconnected -> return_unit
+  | Requested _ | Accepted _ -> fail P2p_errors.Pending_connection
+  | Running _ -> fail P2p_errors.Connected
+
+let fail_unless_disconnected_peer_id peer_info =
+  match P2p_peer_state.get peer_info with
+  | Disconnected -> return_unit
+  | Accepted _ -> fail P2p_errors.Pending_connection
+  | Running _ -> fail P2p_errors.Connected
+
+let compare_known_point_info p1 p2 =
+  (* The most-recently disconnected peers are greater. *)
+  (* Then come long-standing connected peers. *)
+  let disconnected1 = P2p_point_state.is_disconnected p1
+  and disconnected2 = P2p_point_state.is_disconnected p2 in
+  let compare_last_seen p1 p2 =
+    match P2p_point_state.Info.last_seen p1, P2p_point_state.Info.last_seen p2 with
+    | None, None -> Random.int 2 * 2 - 1 (* HACK... *)
+    | Some _, None -> 1
+    | None, Some _ -> -1
+    | Some (_, time1), Some (_, time2) ->
+        match compare time1 time2 with
+        | 0 -> Random.int 2 * 2 - 1 (* HACK... *)
+        | x -> x in
+  match disconnected1, disconnected2 with
+  | false, false -> compare_last_seen p1 p2
+  | false, true -> -1
+  | true, false -> 1
+  | true, true -> compare_last_seen p2 p1
+
+let rec connect ?timeout pool point =
+  fail_when (Points.banned pool point)
+    (P2p_errors.Point_banned point) >>=? fun () ->
+  let timeout =
+    Option.unopt ~default:pool.config.connection_timeout timeout in
+  fail_unless
+    (active_connections pool <= pool.config.max_connections)
+    P2p_errors.Too_many_connections >>=? fun () ->
+  let canceler = Lwt_canceler.create () in
+  with_timeout ~canceler (Lwt_unix.sleep timeout) begin fun canceler ->
+    let point_info =
+      register_point pool pool.config.identity.peer_id point in
+    let addr, port as point = P2p_point_state.Info.point point_info in
+    fail_unless
+      (not pool.config.private_mode || P2p_point_state.Info.trusted point_info)
+      P2p_errors.Private_mode >>=? fun () ->
+    fail_unless_disconnected_point point_info >>=? fun () ->
+    P2p_point_state.set_requested point_info canceler ;
+    let fd = P2p_fd.socket PF_INET6 SOCK_STREAM 0 in
+    let uaddr =
+      Lwt_unix.ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port) in
+    lwt_debug "connect: %a" P2p_point.Id.pp point >>= fun () ->
+    protect ~canceler begin fun () ->
+      log pool (Outgoing_connection point) ;
+      P2p_fd.connect fd uaddr >>= fun () ->
+      return_unit
+    end ~on_error: begin fun err ->
+      lwt_debug "connect: %a -> disconnect" P2p_point.Id.pp point >>= fun () ->
+      P2p_point_state.set_disconnected point_info ;
+      P2p_fd.close fd >>= fun () ->
+      match err with
+      | [Exn (Unix.Unix_error (Unix.ECONNREFUSED, _, _))] ->
+          fail P2p_errors.Connection_refused
+      | err -> Lwt.return (Error err)
+    end >>=? fun () ->
+    lwt_debug "connect: %a -> authenticate" P2p_point.Id.pp point >>= fun () ->
+    authenticate pool ~point_info canceler fd point
+  end
+
+and authenticate pool ?point_info canceler fd point =
+  let fd = P2p_io_scheduler.register pool.io_sched fd in
+  raw_authenticate pool ?point_info canceler fd point >>= function
+  | Ok connection -> return connection
+  | Error _ as err ->
+      P2p_io_scheduler.close fd >>=? fun () ->
+      Lwt.return err
+
+and raw_authenticate pool ?point_info canceler fd point =
+  let incoming = point_info = None in
+  lwt_debug "authenticate: %a%s"
+    P2p_point.Id.pp point
+    (if incoming then " incoming" else "") >>= fun () ->
+  protect ~canceler begin fun () ->
+    P2p_socket.authenticate
+      ~canceler
+      ~proof_of_work_target:pool.config.proof_of_work_target
+      ~incoming fd point
+      ?listening_port:pool.config.listening_port
+      pool.config.identity pool.message_config.versions
+      pool.conn_meta_config
+  end ~on_error: begin fun err ->
+    begin match err with
+      | [ Canceled ] ->
+          (* Currently only on time out *)
+          lwt_debug "authenticate: %a%s -> canceled"
+            P2p_point.Id.pp point
+            (if incoming then " incoming" else "")
+      | err -> begin
+          (* Authentication incorrect! Temp ban the offending points/peers *)
+          List.iter (function
+              | P2p_errors.Not_enough_proof_of_work _
+              | P2p_errors.Invalid_auth
+              | P2p_errors.Decipher_error
+              | P2p_errors.Invalid_message_size
+              | P2p_errors.Encoding_error
+              | P2p_errors.Decoding_error
+              | P2p_errors.Invalid_chunks_size _ ->
+                  greylist_addr pool (fst point)
+              | _ -> ()
+            ) err ;
+          lwt_debug "@[authenticate: %a%s -> failed@ %a@]"
+            P2p_point.Id.pp point
+            (if incoming then " incoming" else "")
+            pp_print_error err
+        end
+    end >>= fun () ->
+    may_register_my_id_point pool err ;
+    log pool (Authentication_failed point) ;
+    if incoming then
+      P2p_point.Table.remove pool.incoming point
+    else
+      Option.iter ~f:P2p_point_state.set_disconnected point_info ;
+    Lwt.return (Error err)
+  end >>=? fun (info, auth_fd) ->
+  (* Authentication correct! *)
+  lwt_debug "authenticate: %a -> auth %a"
+    P2p_point.Id.pp point
+    P2p_peer.Id.pp info.peer_id >>= fun () ->
+  fail_when (Peers.banned pool info.peer_id)
+    (P2p_errors.Peer_banned info.peer_id) >>=? fun () ->
+  let remote_point_info =
+    match info.id_point with
+    | addr, Some port
+      when not (P2p_point.Table.mem pool.my_id_points (addr, port)) ->
+        Some (register_point pool info.peer_id (addr, port))
+    | _ -> None in
+  let connection_point_info =
+    match point_info, remote_point_info with
+    | None, None -> None
+    | Some _ as point_info, _ | _, (Some _ as point_info) -> point_info in
+  let peer_info = register_peer pool info.peer_id in
+  let acceptable_versions =
+    P2p_version.common info.versions pool.message_config.versions
+  in
+  let acceptable_point =
+    Option.unopt_map connection_point_info
+      ~default:(not pool.config.private_mode)
+      ~f:begin fun connection_point_info ->
+        match P2p_point_state.get connection_point_info with
+        | Requested _ -> not incoming
+        | Disconnected ->
+            let unexpected =
+              pool.config.private_mode
+              && not (P2p_point_state.Info.trusted connection_point_info)
+            in
+            if unexpected then
+              warn "[private node] incoming connection from untrused \
+                    peer rejected!";
+            not unexpected
+        | Accepted _ | Running _ -> false
+      end
+  in
+  let acceptable_peer_id =
+    match P2p_peer_state.get peer_info with
+    | Accepted _ ->
+        (* TODO: in some circumstances cancel and accept... *)
+        false
+    | Running _ -> false
+    | Disconnected -> true
+  in
+  if incoming then
+    P2p_point.Table.remove pool.incoming point ;
+  match acceptable_versions with
+  | Some version when acceptable_peer_id && acceptable_point -> begin
+      log pool (Accepting_request (point, info.id_point, info.peer_id)) ;
+      Option.iter connection_point_info
+        ~f:(fun point_info ->
+            P2p_point_state.set_accepted point_info info.peer_id canceler) ;
+      P2p_peer_state.set_accepted peer_info info.id_point canceler ;
+      lwt_debug "authenticate: %a -> accept %a"
+        P2p_point.Id.pp point
+        P2p_peer.Id.pp info.peer_id >>= fun () ->
+      protect ~canceler begin fun () ->
+        P2p_socket.accept
+          ?incoming_message_queue_size:pool.config.incoming_message_queue_size
+          ?outgoing_message_queue_size:pool.config.outgoing_message_queue_size
+          ?binary_chunks_size:pool.config.binary_chunks_size
+          ~canceler
+          auth_fd pool.encoding >>=? fun conn ->
+        lwt_debug "authenticate: %a -> Connected %a"
+          P2p_point.Id.pp point
+          P2p_peer.Id.pp info.peer_id >>= fun () ->
+        return conn
+      end ~on_error: begin fun err ->
+        if incoming then
+          log pool
+            (Request_rejected (point, Some (info.id_point, info.peer_id))) ;
+        lwt_debug "authenticate: %a -> rejected %a"
+          P2p_point.Id.pp point
+          P2p_peer.Id.pp info.peer_id >>= fun () ->
+        Option.iter connection_point_info
+          ~f:P2p_point_state.set_disconnected ;
+        P2p_peer_state.set_disconnected peer_info ;
+        Lwt.return (Error err)
+      end >>=? fun conn ->
+      let id_point =
+        match info.id_point, Option.map ~f:P2p_point_state.Info.point point_info with
+        | (addr, _), Some (_, port) -> addr, Some port
+        | id_point, None ->  id_point in
+      return
+        (create_connection
+           pool conn
+           id_point connection_point_info peer_info version)
+    end
+  | _ -> begin
+      log pool (Rejecting_request (point, info.id_point, info.peer_id)) ;
+      lwt_debug "authenticate: %a -> kick %a point: %B peer_id: %B"
+        P2p_point.Id.pp point
+        P2p_peer.Id.pp info.peer_id
+        acceptable_point acceptable_peer_id >>= fun () ->
+      P2p_socket.kick auth_fd >>= fun () ->
+      if not incoming then begin
+        Option.iter ~f:P2p_point_state.set_disconnected point_info ;
+        (* FIXME P2p_peer_state.set_disconnected ~requested:true peer_info ; *)
+      end ;
+      fail (P2p_errors.Rejected info.peer_id)
+    end
+
+and create_connection pool p2p_conn id_point point_info peer_info _version =
+  let peer_id = P2p_peer_state.Info.peer_id peer_info in
+  let canceler = Lwt_canceler.create () in
+  let size =
+    Option.map pool.config.incoming_app_message_queue_size
+      ~f:(fun qs -> qs, fun (size, _) ->
+          (Sys.word_size / 8) * 11 + size + Lwt_pipe.push_overhead) in
+  let messages = Lwt_pipe.create ?size () in
+
+  let rec callback_default =
+    { Answerer.message =
+        (fun size msg -> Lwt_pipe.push messages (size, msg)) ;
+      advertise =
+        (fun points -> register_new_points pool conn points ) ;
+      bootstrap =
+        (fun () -> list_known_points ~ignore_private:true pool conn) ;
+      swap_request =
+        (fun point peer_id -> swap_request pool conn point peer_id ) ;
+      swap_ack =
+        (fun point peer_id -> swap_ack pool conn point peer_id ) ;
+    }
+
+  (* when the node is in private mode: deactivate advertising,
+     peers_swap and sending list of peers in callback *)
+  and callback_private =
+    { Answerer.message =
+        (fun size msg -> Lwt_pipe.push messages (size, msg)) ;
+      advertise =
+        (fun _points ->
+           private_node_warn
+             "Received new peers addresses from %a"
+             P2p_peer.Id.pp peer_id >>= fun () ->
+           Lwt.return_unit
+        ) ;
+      bootstrap =
+        (fun () ->
+           private_node_warn
+             "Receive requests for peers addresses from %a"
+             P2p_peer.Id.pp peer_id >>= fun () ->
+           Lwt.return_nil
+        ) ;
+      swap_request =
+        (fun _point _peer_id ->
+           private_node_warn
+             "Received swap requests from %a"
+             P2p_peer.Id.pp peer_id >>= fun () ->
+           Lwt.return_unit
+        ) ;
+      swap_ack =
+        (fun _point _peer_id ->
+           private_node_warn
+             "Received swap ack from %a"
+             P2p_peer.Id.pp peer_id >>= fun () ->
+           Lwt.return_unit
+        ) ;
+    }
+
+  and answerer =
+    lazy (
+      Answerer.run p2p_conn canceler @@
+      if pool.config.private_mode then callback_private else callback_default
+    )
+
+  and conn =
+    { conn = p2p_conn ; point_info ; peer_info ;
+      messages ; canceler ; answerer ; wait_close = false ;
+      last_sent_swap_request = None } in
+  ignore (Lazy.force answerer) ;
+  let conn_meta = P2p_socket.remote_metadata p2p_conn in
+  Option.iter point_info ~f:begin fun point_info ->
+    let point = P2p_point_state.Info.point point_info in
+    P2p_point_state.set_running
+      ~known_private:(pool.conn_meta_config.private_node conn_meta)
+      point_info peer_id conn;
+    P2p_point.Table.add pool.connected_points point point_info ;
+  end ;
+  log pool (Connection_established (id_point, peer_id)) ;
+  P2p_peer_state.set_running peer_info id_point conn conn_meta ;
+  P2p_peer.Table.add pool.connected_peer_ids peer_id peer_info ;
+  Lwt_condition.broadcast pool.events.new_connection () ;
+  Lwt_canceler.on_cancel canceler begin fun () ->
+    lwt_debug "Disconnect: %a (%a)"
+      P2p_peer.Id.pp peer_id P2p_connection.Id.pp id_point >>= fun () ->
+    Option.iter ~f:P2p_point_state.set_disconnected point_info ;
+    log pool (Disconnection peer_id) ;
+    P2p_peer_state.set_disconnected peer_info ;
+    Option.iter point_info ~f:begin fun point_info ->
+      P2p_point.Table.remove pool.connected_points (P2p_point_state.Info.point point_info) ;
+    end ;
+    P2p_peer.Table.remove pool.connected_peer_ids peer_id ;
+    if pool.config.max_connections <= active_connections pool then begin
+      Lwt_condition.broadcast pool.events.too_many_connections () ;
+      log pool Too_many_connections ;
+    end ;
+    Lwt_pipe.close messages ;
+    P2p_socket.close ~wait:conn.wait_close conn.conn
+  end ;
+  List.iter (fun f -> f peer_id conn) pool.new_connection_hook ;
+  if active_connections pool < pool.config.min_connections then begin
+    Lwt_condition.broadcast pool.events.too_few_connections () ;
+    log pool Too_few_connections ;
+  end ;
+  conn
+
+and disconnect ?(wait = false) conn =
+  conn.wait_close <- wait ;
+  Answerer.shutdown (Lazy.force conn.answerer)
+
+and register_new_points ?trusted pool conn =
+  let source_peer_id = P2p_peer_state.Info.peer_id conn.peer_info in
+  fun points ->
+    List.iter (register_new_point ?trusted pool source_peer_id) points ;
+    Lwt.return_unit
+
+and register_new_point ?trusted pool source_peer_id point =
+  if not (P2p_point.Table.mem pool.my_id_points point) then
+    ignore (register_point ?trusted pool source_peer_id point)
+
+and list_known_points ?(ignore_private = false) pool conn =
+  if Connection.private_node conn then
+    private_node_warn "Private peer (%a) asked other peers addresses"
+      P2p_peer.Id.pp (P2p_peer_state.Info.peer_id conn.peer_info) >>= fun () ->
+    Lwt.return_nil
+  else
+    let knowns =
+      P2p_point.Table.fold
+        (fun _ point_info acc ->
+           if ignore_private &&
+              not (P2p_point_state.Info.known_public point_info) then acc
+           else point_info :: acc)
+        pool.known_points [] in
+    let best_knowns =
+      List.take_n ~compare:compare_known_point_info 50 knowns in
+    Lwt.return (List.map P2p_point_state.Info.point best_knowns)
+
+and active_connections pool = P2p_peer.Table.length pool.connected_peer_ids
+
+and swap_request pool conn new_point _new_peer_id =
+  let source_peer_id = P2p_peer_state.Info.peer_id conn.peer_info in
+  log pool (Swap_request_received { source = source_peer_id }) ;
+  lwt_log_info
+    "Swap request received from %a" P2p_peer.Id.pp source_peer_id >>= fun () ->
+  (* Ignore if already connected to peer or already swapped less
+     than <swap_linger> seconds ago. *)
+  let now = Time.now () in
+  let span_since_last_swap =
+    Int64.to_int @@
+    Time.diff now
+      (Time.max pool.latest_succesfull_swap pool.latest_accepted_swap) in
+  let new_point_info = register_point pool source_peer_id new_point in
+  if span_since_last_swap < int_of_float pool.config.swap_linger
+  || not (P2p_point_state.is_disconnected new_point_info) then begin
+    log pool (Swap_request_ignored { source = source_peer_id }) ;
+    lwt_log_info "Ignoring swap request from %a" P2p_peer.Id.pp source_peer_id
+  end else begin
+    match Connection.random_lowid pool ~no_private:true with
+    | None ->
+        lwt_log_info
+          "No swap candidate for %a" P2p_peer.Id.pp source_peer_id
+    | Some (proposed_point, proposed_peer_id, _proposed_conn) ->
+        match P2p_socket.write_now
+                conn.conn (Swap_ack (proposed_point, proposed_peer_id)) with
+        | Ok true ->
+            log pool (Swap_ack_sent { source = source_peer_id }) ;
+            swap pool conn proposed_peer_id new_point >>= fun () ->
+            Lwt.return_unit
+        | Ok false ->
+            log pool (Swap_request_received { source = source_peer_id }) ;
+            Lwt.return_unit
+        | Error _ ->
+            log pool (Swap_request_received { source = source_peer_id }) ;
+            Lwt.return_unit
+  end
+
+and swap_ack pool conn new_point _new_peer_id =
+  let source_peer_id = P2p_peer_state.Info.peer_id conn.peer_info in
+  log pool (Swap_ack_received { source = source_peer_id }) ;
+  lwt_log_info
+    "Swap ack received from %a" P2p_peer.Id.pp source_peer_id >>= fun () ->
+  match conn.last_sent_swap_request with
+  | None -> Lwt.return_unit (* ignore *)
+  | Some (_time, proposed_peer_id) ->
+      match Connection.find_by_peer_id pool proposed_peer_id with
+      | None ->
+          swap pool conn proposed_peer_id new_point >>= fun () ->
+          Lwt.return_unit
+      | Some _ ->
+          Lwt.return_unit
+
+and swap pool conn current_peer_id new_point =
+  let source_peer_id = P2p_peer_state.Info.peer_id conn.peer_info in
+  pool.latest_accepted_swap <- Time.now () ;
+  connect pool new_point >>= function
+  | Ok _new_conn -> begin
+      pool.latest_succesfull_swap <- Time.now () ;
+      log pool (Swap_success { source = source_peer_id }) ;
+      lwt_log_info "Swap to %a succeeded" P2p_point.Id.pp new_point >>= fun () ->
+      match Connection.find_by_peer_id pool current_peer_id with
+      | None -> Lwt.return_unit
+      | Some conn ->
+          disconnect conn >>= fun () ->
+          Lwt.return_unit
+    end
+  | Error err -> begin
+      pool.latest_accepted_swap <- pool.latest_succesfull_swap ;
+      log pool (Swap_failure { source = source_peer_id }) ;
+      match err with
+      | [ Timeout ] ->
+          lwt_debug "Swap to %a was interupted: %a"
+            P2p_point.Id.pp new_point pp_print_error err
+      | _ ->
+          lwt_log_error "Swap to %a failed: %a"
+            P2p_point.Id.pp new_point pp_print_error err
+    end
+
+let accept pool fd point =
+  log pool (Incoming_connection point) ;
+  let max_active_conns =
+    if Random.bool () then
+      (* randomly allow one additional incoming connection *)
+      pool.config.max_connections + 1
+    else
+      pool.config.max_connections in
+  if pool.config.max_incoming_connections <= P2p_point.Table.length pool.incoming
+  || max_active_conns <= active_connections pool
+  (* silently ignore banned points *)
+  || (P2p_acl.banned_addr pool.acl (fst point)) then
+    Lwt.async (fun () -> P2p_fd.close fd)
+  else
+    let canceler = Lwt_canceler.create () in
+    P2p_point.Table.add pool.incoming point canceler ;
+    Lwt.async begin fun () ->
+      with_timeout
+        ~canceler (Lwt_unix.sleep pool.config.authentication_timeout)
+        (fun canceler -> authenticate pool canceler fd point)
+    end
+
+let send_swap_request pool =
+  match Connection.random ~no_private:true pool with
+  | Some recipient when not pool.config.private_mode -> begin
+      let recipient_peer_id = (Connection.info recipient).peer_id in
+      match
+        Connection.random_lowid
+          ~different_than:recipient
+          ~no_private:true pool
+      with
+      | None -> ()
+      | Some (proposed_point, proposed_peer_id, _proposed_conn) ->
+          log pool (Swap_request_sent { source = recipient_peer_id }) ;
+          recipient.last_sent_swap_request <-
+            Some (Time.now (), proposed_peer_id) ;
+          ignore (P2p_socket.write_now recipient.conn
+                    (Swap_request (proposed_point, proposed_peer_id)))
+    end
+  | Some _ | None -> ()
+
+(***************************************************************************)
+
+let create config peer_meta_config conn_meta_config message_config io_sched =
+  let events = {
+    too_few_connections = Lwt_condition.create () ;
+    too_many_connections = Lwt_condition.create () ;
+    new_peer = Lwt_condition.create () ;
+    new_point = Lwt_condition.create () ;
+    new_connection = Lwt_condition.create () ;
+  } in
+  let pool = {
+    config ; peer_meta_config ; conn_meta_config ; message_config ;
+    my_id_points = P2p_point.Table.create 7 ;
+    known_peer_ids = P2p_peer.Table.create 53 ;
+    connected_peer_ids = P2p_peer.Table.create 53 ;
+    known_points = P2p_point.Table.create 53 ;
+    connected_points = P2p_point.Table.create 53 ;
+    incoming = P2p_point.Table.create 53 ;
+    io_sched ;
+    encoding = Message.encoding message_config.encoding ;
+    events ;
+    watcher = Lwt_watcher.create_input () ;
+    acl = P2p_acl.create 1023;
+    new_connection_hook = [] ;
+    latest_accepted_swap = Time.epoch ;
+    latest_succesfull_swap = Time.epoch ;
+  } in
+  List.iter (Points.set_trusted pool) config.trusted_points ;
+  P2p_peer_state.Info.File.load
+    config.peers_file
+    peer_meta_config.peer_meta_encoding >>= function
+  | Ok peer_ids ->
+      List.iter
+        (fun peer_info ->
+           let peer_id = P2p_peer_state.Info.peer_id peer_info in
+           P2p_peer.Table.add pool.known_peer_ids peer_id peer_info)
+        peer_ids ;
+      Lwt.return pool
+  | Error err ->
+      log_error "@[Failed to parse peers file:@ %a@]"
+        pp_print_error err ;
+      Lwt.return pool
+
+let destroy ({ config ; peer_meta_config } as pool) =
+  lwt_log_info "Saving metadata in %s" config.peers_file >>= fun () ->
+  begin
+    P2p_peer_state.Info.File.save
+      config.peers_file
+      peer_meta_config.peer_meta_encoding
+      (P2p_peer.Table.fold (fun _ a b -> a::b) pool.known_peer_ids []) >>= function
+    | Error err ->
+        log_error "@[Failed to save peers file:@ %a@]"
+          pp_print_error err;
+        Lwt.return_unit
+    | Ok ()-> Lwt.return_unit
+  end >>= fun () ->
+  P2p_point.Table.fold (fun _point point_info acc ->
+      match P2p_point_state.get point_info with
+      | Requested { cancel } | Accepted { cancel } ->
+          Lwt_canceler.cancel cancel >>= fun () -> acc
+      | Running { data = conn } ->
+          disconnect conn >>= fun () -> acc
+      | Disconnected ->  acc)
+    pool.known_points @@
+  P2p_peer.Table.fold (fun _peer_id peer_info acc ->
+      match P2p_peer_state.get peer_info with
+      | Accepted { cancel } ->
+          Lwt_canceler.cancel cancel >>= fun () -> acc
+      | Running { data = conn } ->
+          disconnect conn >>= fun () -> acc
+      | Disconnected ->  acc)
+    pool.known_peer_ids @@
+  P2p_point.Table.fold (fun _point canceler acc ->
+      Lwt_canceler.cancel canceler >>= fun () -> acc)
+    pool.incoming Lwt.return_unit
+
+let on_new_connection pool f =
+  pool.new_connection_hook <- f :: pool.new_connection_hook
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_pool.mli b/vendors/tezos-modded/src/lib_p2p/p2p_pool.mli
new file mode 100644
index 000000000..7a14912e4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_pool.mli
@@ -0,0 +1,440 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Pool of connections. This module manages the connection pool that
+    the peer-to-peer layer needs to maintain in order to function
+    correctly.
+
+    A pool and its connections are parametrized by the type of
+    messages exchanged over the connection and the type of
+    meta-information associated with a peer. The type
+    [('msg, 'peer_meta,'conn_meta)
+    connection] is a wrapper on top of [P2p_socket.t] that adds
+    meta-informations, data-structures describing the detailed state of
+    the peer and the connection, as well as a new message queue
+    (referred to "app  message queue") that will only contain the
+    messages from the internal [P2p_socket.t] that needs to be examined
+    by the higher layers. Some messages are directly processed by an
+    internal worker and thus never propagated above. *)
+
+type 'msg encoding = Encoding : {
+    tag: int ;
+    title: string ;
+    encoding: 'a Data_encoding.t ;
+    wrap: 'a -> 'msg ;
+    unwrap: 'msg -> 'a option ;
+    max_length: int option ;
+  } -> 'msg encoding
+
+(** {1 Pool management} *)
+
+type ('msg, 'peer_meta, 'conn_meta) t
+
+type ('msg, 'peer_meta, 'conn_meta) pool = ('msg, 'peer_meta, 'conn_meta) t
+(** The type of a pool of connections, parametrized by resp. the type
+    of messages and the meta-informations associated to an identity and
+    a connection. *)
+
+type config = {
+
+  identity : P2p_identity.t ;
+  (** Our identity. *)
+
+  proof_of_work_target : Crypto_box.target ;
+  (** The proof of work target we require from peers. *)
+
+  trusted_points : P2p_point.Id.t list ;
+  (** List of hard-coded known peers to bootstrap the network from. *)
+
+  peers_file : string ;
+  (** The path to the JSON file where the metadata associated to
+      peer_ids are loaded / stored. *)
+
+  private_mode : bool ;
+  (** If [true], only open outgoing/accept incoming connections
+      to/from peers whose addresses are in [trusted_peers], and inform
+      these peers that the identity of this node should be revealed to
+      the rest of the network. *)
+
+  listening_port : P2p_addr.port option ;
+  (** If provided, it will be passed to [P2p_connection.authenticate]
+      when we authenticate against a new peer. *)
+
+  min_connections : int ;
+  (** Strict minimum number of connections
+      (triggers [LogEvent.too_few_connections]). *)
+
+  max_connections : int ;
+  (** Max number of connections. If it's reached, [connect] and
+      [accept] will fail, i.e. not add more connections
+      (also triggers [LogEvent.too_many_connections]). *)
+
+  max_incoming_connections : int ;
+  (** Max not-yet-authentified incoming connections.
+      Above this number, [accept] will start dropping incoming
+      connections. *)
+
+  connection_timeout : float ;
+  (** Maximum time allowed to the establishment of a connection. *)
+
+  authentication_timeout : float ;
+  (** Delay granted to a peer to perform authentication, in seconds. *)
+
+  incoming_app_message_queue_size : int option ;
+  (** Size of the message queue for user messages (messages returned
+      by this module's [read] function. *)
+
+  incoming_message_queue_size : int option ;
+  (** Size of the incoming message queue internal of a peer's Reader
+      (See [P2p_connection.accept]). *)
+
+  outgoing_message_queue_size : int option ;
+  (** Size of the outgoing message queue internal to a peer's Writer
+      (See [P2p_connection.accept]). *)
+
+  known_peer_ids_history_size : int ;
+  (** Size of the known peer_ids log buffer (default: 50) *)
+
+  known_points_history_size : int ;
+  (** Size of the known points log buffer (default: 50) *)
+
+  max_known_points : (int * int) option ;
+  (** Parameters for the the garbage collection of known points. If
+      None, no garbage collection is performed. Otherwise, the first
+      integer of the couple limits the size of the "known points"
+      table. When this number is reached, the table is expurged from
+      disconnected points, older first, to try to reach the amount of
+      connections indicated by the second integer. *)
+
+  max_known_peer_ids : (int * int) option ;
+  (** Like [max_known_points], but for known peer_ids. *)
+
+  swap_linger : float ;
+  (** Peer swapping does not occur more than once during a timespan of
+      [spap_linger] seconds. *)
+
+  binary_chunks_size : int option ;
+  (** Size (in bytes) of binary blocks that are sent to other
+      peers. Default value is 64 kB. *)
+}
+
+type 'peer_meta peer_meta_config = {
+  peer_meta_encoding : 'peer_meta Data_encoding.t ;
+  peer_meta_initial : unit -> 'peer_meta ;
+  score : 'peer_meta -> float ;
+}
+
+type 'msg message_config = {
+  encoding : 'msg encoding list ;
+  versions : P2p_version.t list;
+}
+
+val create:
+  config ->
+  'peer_meta peer_meta_config ->
+  'conn_meta P2p_socket.metadata_config ->
+  'msg message_config ->
+  P2p_io_scheduler.t ->
+  ('msg, 'peer_meta,'conn_meta) pool Lwt.t
+(** [create config meta_cfg msg_cfg io_sched] is a freshly minted
+    pool. *)
+
+val destroy: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+(** [destroy pool] returns when member connections are either
+    disconnected or canceled. *)
+
+val active_connections: ('msg, 'peer_meta,'conn_meta) pool -> int
+(** [active_connections pool] is the number of connections inside
+    [pool]. *)
+
+val pool_stat: ('msg, 'peer_meta,'conn_meta) pool -> P2p_stat.t
+(** [pool_stat pool] is a snapshot of current bandwidth usage for the
+    entire [pool]. *)
+
+val config : _ pool -> config
+(** [config pool] is the [config] argument passed to [pool] at
+    creation. *)
+
+val send_swap_request: ('msg, 'peer_meta,'conn_meta) pool -> unit
+(** [send_swap_request pool] given two connected peers pi and pj (pi
+    <> pj), suggest swap with pi for the peer pj. This behaviour is
+    disabled in private mode *)
+
+val score: ('msg, 'peer_meta,'conn_meta) pool -> 'peer_meta -> float
+(** [score pool peer_meta] returns the score of a peer in the pool
+    whose peer_meta is provided *)
+
+(** {2 Pool events} *)
+
+module Pool_event : sig
+
+  val wait_too_few_connections: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+  (** [wait_too_few_connections pool] is determined when the number of
+      connections drops below the desired level. *)
+
+  val wait_too_many_connections: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+  (** [wait_too_many_connections pool] is determined when the number of
+      connections exceeds the desired level. *)
+
+  val wait_new_peer: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+  (** [wait_new_peer pool] is determined when a new peer
+      (i.e. authentication successful) gets added to the pool. *)
+
+  val wait_new_point: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+  (** [wait_new_point pool] is determined when a new point gets registered
+      to the pool. *)
+
+  val wait_new_connection: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
+  (** [wait_new_connection pool] is determined when a new connection is
+      successfully established in the pool. *)
+
+end
+
+
+(** {1 Connections management} *)
+
+type ('msg, 'peer_meta,'conn_meta) connection
+(** Type of a connection to a peer, parametrized by the type of
+    messages exchanged as well as meta-information associated to a
+    peer and a connection. It mostly wraps [P2p_connection.connection],
+    adding meta-information and data-structures describing a more
+    fine-grained logical state of the connection. *)
+
+val connect:
+  ?timeout:float ->
+  ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t ->
+  ('msg, 'peer_meta,'conn_meta) connection tzresult Lwt.t
+(** [connect ?timeout pool point] tries to add a connection to [point]
+    in [pool] in less than [timeout] seconds. *)
+
+val accept:
+  ('msg, 'peer_meta,'conn_meta) pool -> P2p_fd.t -> P2p_point.Id.t -> unit
+(** [accept pool fd point] instructs [pool] to start the process of
+    accepting a connection from [fd]. Used by [P2p_welcome]. *)
+
+val register_new_point:
+  ?trusted:bool ->
+  ('a, 'b, 'c) pool -> P2p_peer.Table.key -> P2p_point.Id.t -> unit
+(** [register_new_point pool source_peer_id point] tries to register [point]
+    in pool's internal peer table. *)
+
+val disconnect:
+  ?wait:bool -> ('msg, 'peer_meta,'conn_meta) connection -> unit Lwt.t
+(** [disconnect conn] cleanly closes [conn] and returns after [conn]'s
+    internal worker has returned. *)
+
+module Connection : sig
+
+  val info: ('msg, 'peer_meta,'conn_meta) connection -> 'conn_meta P2p_connection.Info.t
+  val local_metadata: ('msg, 'peer_meta,'conn_meta) connection -> 'conn_meta
+  val remote_metadata: ('msg, 'peer_meta,'conn_meta) connection -> 'conn_meta
+
+  val stat:  ('msg, 'peer_meta,'conn_meta) connection -> P2p_stat.t
+  (** [stat conn] is a snapshot of current bandwidth usage for
+      [conn]. *)
+
+  val fold:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    init:'a ->
+    f:(P2p_peer.Id.t ->  ('msg, 'peer_meta,'conn_meta) connection -> 'a -> 'a) ->
+    'a
+
+  val list:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    (P2p_peer.Id.t * ('msg, 'peer_meta,'conn_meta) connection) list
+
+  val find_by_point:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    P2p_point.Id.t ->
+    ('msg, 'peer_meta,'conn_meta) connection option
+
+  val find_by_peer_id:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    P2p_peer.Id.t ->
+    ('msg, 'peer_meta,'conn_meta) connection option
+
+  val private_node: ('msg, 'peer_meta,'conn_meta) connection -> bool
+  (** [private_node conn] returns 'true' if the node assocoatied to this
+      connection is in private mode *)
+
+end
+
+val on_new_connection:
+  ('msg, 'peer_meta,'conn_meta) pool ->
+  (P2p_peer.Id.t -> ('msg, 'peer_meta,'conn_meta) connection -> unit) -> unit
+
+(** {1 I/O on connections} *)
+
+val read:  ('msg, 'peer_meta,'conn_meta) connection -> 'msg tzresult Lwt.t
+(** [read conn] returns a message popped from [conn]'s app message
+    queue, or fails with [Connection_closed]. *)
+
+val is_readable: ('msg, 'peer_meta,'conn_meta) connection -> unit tzresult Lwt.t
+(** [is_readable conn] returns when there is at least one message
+    ready to be read. *)
+
+val write:
+  ('msg, 'peer_meta,'conn_meta) connection -> 'msg -> unit tzresult Lwt.t
+(** [write conn msg] is [P2p_connection.write conn' msg] where [conn']
+    is the internal [P2p_connection.t] inside [conn]. *)
+
+val write_sync:
+  ('msg, 'peer_meta,'conn_meta) connection -> 'msg -> unit tzresult Lwt.t
+(** [write_sync conn msg] is [P2p_connection.write_sync conn' msg]
+    where [conn'] is the internal [P2p_connection.t] inside [conn]. *)
+
+(**/**)
+val raw_write_sync:
+  ('msg, 'peer_meta,'conn_meta) connection -> MBytes.t -> unit tzresult Lwt.t
+(**/**)
+
+val write_now:  ('msg, 'peer_meta,'conn_meta) connection -> 'msg -> bool tzresult
+(** [write_now conn msg] is [P2p_connection.write_now conn' msg] where
+    [conn'] is the internal [P2p_connection.t] inside [conn]. *)
+
+(** {2 Broadcast functions} *)
+
+val write_all:  ('msg, 'peer_meta,'conn_meta) pool -> 'msg -> unit
+(** [write_all pool msg] is [write_now conn msg] for all member
+    connections to [pool] in [Running] state. *)
+
+val broadcast_bootstrap_msg:  ('msg, 'peer_meta,'conn_meta) pool -> unit
+(** [broadcast_bootstrap_msg pool] is [P2P_connection.write_now conn Bootstrap]
+    for all member connections to [pool] in [Running] state.
+    This behavior is deactivated if the node is in private mode  *)
+
+val greylist_addr : ('msg, 'peer_meta,'conn_meta) pool -> P2p_addr.t -> unit
+(** [greylist_addr pool addr] adds [addr] to [pool]'s IP greylist. *)
+
+val greylist_peer : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+(** [greylist_peer pool peer] adds [peer] to [pool]'s peer greylist
+    and [peer]'s address to [pool]'s IP greylist. *)
+
+val gc_greylist: older_than:Time.t -> ('msg, 'peer_meta,'conn_meta) pool -> unit
+(** [gc_greylist ~older_than pool] *)
+
+val acl_clear : ('msg, 'peer_meta,'conn_meta) pool -> unit
+(** [acl_clear pool] clears ACL tables. *)
+
+(** {1 Functions on [Peer_id]} *)
+
+module Peers : sig
+
+  type ('msg, 'peer_meta,'conn_meta) info =
+    (('msg, 'peer_meta,'conn_meta) connection, 'peer_meta,'conn_meta) P2p_peer_state.Info.t
+
+  val info:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    P2p_peer.Id.t ->
+    ('msg, 'peer_meta,'conn_meta) info option
+
+  val get_peer_metadata:
+    ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> 'peer_meta
+  val set_peer_metadata:
+    ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> 'peer_meta -> unit
+  val get_score: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> float
+
+  val get_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> bool
+  val set_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val unset_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+
+  val fold_known:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    init:'a ->
+    f:(P2p_peer.Id.t ->  ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
+    'a
+
+  val fold_connected:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    init:'a ->
+    f:(P2p_peer.Id.t ->  ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
+    'a
+
+  val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val unban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val untrust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> bool
+
+end
+
+(** {1 Functions on [Points]} *)
+
+module Points : sig
+
+  type ('msg, 'peer_meta,'conn_meta) info =
+    ('msg, 'peer_meta,'conn_meta) connection P2p_point_state.Info.t
+
+  val info:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    P2p_point.Id.t ->
+    ('msg, 'peer_meta,'conn_meta) info option
+
+  val get_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> bool
+  val set_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val unset_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+
+  val fold_known:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    init:'a ->
+    f:(P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) info  -> 'a -> 'a) ->
+    'a
+
+  val fold_connected:
+    ('msg, 'peer_meta,'conn_meta) pool ->
+    init:'a ->
+    f:(P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) info  -> 'a -> 'a) ->
+    'a
+
+  val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val unban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val untrust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> bool
+
+end
+
+val watch:
+  ('msg, 'peer_meta,'conn_meta) pool ->
+  P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
+(** [watch pool] is a [stream, close] a [stream] of events and a
+    [close] function for this stream. *)
+
+(**/**)
+
+module Message : sig
+
+  type 'msg t =
+    | Bootstrap
+    | Advertise of P2p_point.Id.t list
+    | Swap_request of P2p_point.Id.t * P2p_peer.Id.t
+    | Swap_ack of P2p_point.Id.t * P2p_peer.Id.t
+    | Message of 'msg
+    | Disconnect
+
+  val encoding: 'msg encoding list -> 'msg t Data_encoding.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_socket.ml b/vendors/tezos-modded/src/lib_p2p/p2p_socket.ml
new file mode 100644
index 000000000..11b5c997f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_socket.ml
@@ -0,0 +1,675 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* TODO test `close ~wait:true`. *)
+
+include Logging.Make(struct let name = "p2p.connection" end)
+
+module Crypto = struct
+
+  (* maximal size of the buffer *)
+  let bufsize = 1 lsl 16 - 1
+  let header_length = 2
+  let max_content_length = bufsize - Crypto_box.zerobytes
+
+  (* The header length is only stored in the encrypted message, but
+     within the space allowed by boxzerobytes, so it does not cost in
+     space in the buffer. *)
+  let max_encrypted_length = bufsize - Crypto_box.boxzerobytes
+
+  (* The size of extra data added by encryption. *)
+  let boxextrabytes = Crypto_box.zerobytes - Crypto_box.boxzerobytes
+  (* The number of bytes added by encryption + header *)
+  let extrabytes = header_length + boxextrabytes
+
+  type data = {
+    channel_key : Crypto_box.channel_key ;
+    mutable local_nonce : Crypto_box.nonce ;
+    mutable remote_nonce : Crypto_box.nonce ;
+  }
+
+  (* We do the following assumptions on the NaCl library.  Note that
+     we also make the assumption, here, that the NaCl library allows
+     in-place boxing and unboxing, since we use the same buffer for
+     input and output. *)
+  let () = assert (Crypto_box.boxzerobytes >= header_length)
+
+  let write_chunk ?canceler fd cryptobox_data msg =
+    let msglen = MBytes.length msg in
+    fail_unless
+      (msglen <= max_content_length) P2p_errors.Invalid_message_size >>=? fun () ->
+    let buf_length = msglen + Crypto_box.zerobytes in
+    let buf = MBytes.make buf_length '\x00' in
+    MBytes.blit msg 0 buf Crypto_box.zerobytes msglen ;
+    let local_nonce = cryptobox_data.local_nonce in
+    cryptobox_data.local_nonce <- Crypto_box.increment_nonce local_nonce ;
+    Crypto_box.fast_box_noalloc
+      cryptobox_data.channel_key local_nonce buf ;
+    let encrypted_length = buf_length - Crypto_box.boxzerobytes in
+    let header_pos = Crypto_box.boxzerobytes - header_length in
+    MBytes.set_int16 buf header_pos encrypted_length ;
+    let payload = MBytes.sub buf header_pos (buf_length - header_pos) in
+    P2p_io_scheduler.write ?canceler fd payload
+
+  let read_chunk ?canceler fd cryptobox_data =
+    let header_buf = MBytes.create header_length in
+    P2p_io_scheduler.read_full ?canceler ~len:header_length fd header_buf >>=? fun () ->
+    let encrypted_length = MBytes.get_uint16 header_buf 0 in
+    let buf_length = encrypted_length + Crypto_box.boxzerobytes in
+    let buf = MBytes.make buf_length '\x00' in
+    P2p_io_scheduler.read_full ?canceler
+      ~pos:Crypto_box.boxzerobytes ~len:encrypted_length fd buf >>=? fun () ->
+    let remote_nonce = cryptobox_data.remote_nonce in
+    cryptobox_data.remote_nonce <- Crypto_box.increment_nonce remote_nonce ;
+    match
+      Crypto_box.fast_box_open_noalloc
+        cryptobox_data.channel_key remote_nonce buf
+    with
+    | false ->
+        fail P2p_errors.Decipher_error
+    | true ->
+        return (MBytes.sub buf Crypto_box.zerobytes
+                  (buf_length - Crypto_box.zerobytes))
+
+end
+
+(* Note: there is an inconsistency here, since we display an error in
+   bytes, whereas the option is set in kbytes. Also, since the default
+   size is 64kB-1, it is actually impossible to set the default
+   size using the option (the max is 63 kB). *)
+let check_binary_chunks_size size =
+  let value = size - Crypto.extrabytes in
+  fail_unless
+    (value > 0 &&
+     value <= Crypto.max_content_length)
+    (P2p_errors.Invalid_chunks_size
+       { value = size ;
+         min = Crypto.extrabytes + 1 ;
+         max = Crypto.bufsize ;
+       })
+
+module Connection_message = struct
+
+  type t = {
+    port : int option ;
+    versions : P2p_version.t list ;
+    public_key : Crypto_box.public_key ;
+    proof_of_work_stamp : Crypto_box.nonce ;
+    message_nonce : Crypto_box.nonce ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { port ; public_key ; proof_of_work_stamp ;
+             message_nonce ; versions } ->
+        let port = match port with None -> 0 | Some port -> port in
+        (port, public_key, proof_of_work_stamp,
+         message_nonce, versions))
+      (fun (port, public_key, proof_of_work_stamp,
+            message_nonce, versions) ->
+        let port = if port = 0 then None else Some port in
+        { port ; public_key ; proof_of_work_stamp ;
+          message_nonce ; versions })
+      (obj5
+         (req "port" uint16)
+         (req "pubkey" Crypto_box.public_key_encoding)
+         (req "proof_of_work_stamp" Crypto_box.nonce_encoding)
+         (req "message_nonce" Crypto_box.nonce_encoding)
+         (req "versions" (Variable.list P2p_version.encoding)))
+
+  let write ~canceler fd message =
+    let encoded_message_len =
+      Data_encoding.Binary.length encoding message in
+    fail_unless
+      (encoded_message_len < 1 lsl (Crypto.header_length * 8))
+      P2p_errors.Encoding_error >>=? fun () ->
+    let len = Crypto.header_length + encoded_message_len in
+    let buf = MBytes.create len in
+    match Data_encoding.Binary.write
+            encoding message buf Crypto.header_length len with
+    | None ->
+        fail P2p_errors.Encoding_error
+    | Some last ->
+        fail_unless (last = len) P2p_errors.Encoding_error >>=? fun () ->
+        MBytes.set_int16 buf 0 encoded_message_len ;
+        P2p_io_scheduler.write ~canceler fd buf >>=? fun () ->
+        (* We return the raw message as it is used later to compute
+           the nonces *)
+        return buf
+
+  let read ~canceler fd =
+    let header_buf = MBytes.create Crypto.header_length in
+    P2p_io_scheduler.read_full ~canceler
+      ~len:Crypto.header_length fd header_buf >>=? fun () ->
+    let len = MBytes.get_uint16 header_buf 0 in
+    let pos = Crypto.header_length in
+    let buf = MBytes.create (pos + len) in
+    MBytes.set_int16 buf 0 len ;
+    P2p_io_scheduler.read_full ~canceler ~len ~pos fd buf >>=? fun () ->
+    match Data_encoding.Binary.read encoding buf pos len with
+    | None ->
+        fail P2p_errors.Decoding_error
+    | Some (next_pos, message) ->
+        if next_pos <> pos+len then
+          fail P2p_errors.Decoding_error
+        else
+          return (message, buf)
+
+end
+
+type 'meta metadata_config = {
+  conn_meta_encoding : 'meta Data_encoding.t ;
+  conn_meta_value : P2p_peer.Id.t -> 'meta ;
+  private_node : 'meta -> bool ;
+}
+
+module Metadata = struct
+
+  let write ~canceler metadata_config cryptobox_data fd message =
+    let encoded_message_len =
+      Data_encoding.Binary.length metadata_config.conn_meta_encoding message in
+    let buf = MBytes.create encoded_message_len in
+    match
+      Data_encoding.Binary.write
+        metadata_config.conn_meta_encoding message buf 0 encoded_message_len
+    with
+    | None ->
+        fail P2p_errors.Encoding_error
+    | Some last ->
+        fail_unless (last = encoded_message_len)
+          P2p_errors.Encoding_error >>=? fun () ->
+        Crypto.write_chunk ~canceler cryptobox_data fd buf
+
+  let read ~canceler metadata_config fd cryptobox_data =
+    Crypto.read_chunk ~canceler fd cryptobox_data >>=? fun buf ->
+    let length = MBytes.length buf in
+    let encoding = metadata_config.conn_meta_encoding in
+    match
+      Data_encoding.Binary.read encoding buf 0 length
+    with
+    | None ->
+        fail P2p_errors.Decoding_error
+    | Some (read_len, message) ->
+        if read_len <> length then
+          fail P2p_errors.Decoding_error
+        else
+          return message
+
+end
+
+module Ack = struct
+
+  type t = Ack | Nack
+
+  let encoding =
+    let open Data_encoding in
+    let ack_encoding = obj1 (req "ack" empty) in
+    let nack_encoding = obj1 (req "nack" empty) in
+    let ack_case tag =
+      case tag ack_encoding
+        ~title:"Ack"
+        (function
+          | Ack -> Some ()
+          | _ -> None)
+        (fun () -> Ack) in
+    let nack_case tag =
+      case tag nack_encoding
+        ~title:"Nack"
+        (function
+          | Nack -> Some ()
+          | _ -> None
+        )
+        (fun _ -> Nack) in
+    union [
+      ack_case (Tag 0) ;
+      nack_case (Tag 255) ;
+    ]
+
+  let write ?canceler fd cryptobox_data message =
+    let encoded_message_len =
+      Data_encoding.Binary.length encoding message in
+    let buf = MBytes.create encoded_message_len in
+    match Data_encoding.Binary.write encoding message buf 0 encoded_message_len with
+    | None ->
+        fail P2p_errors.Encoding_error
+    | Some last ->
+        fail_unless (last = encoded_message_len)
+          P2p_errors.Encoding_error >>=? fun () ->
+        Crypto.write_chunk ?canceler fd cryptobox_data buf
+
+  let read ?canceler fd cryptobox_data =
+    Crypto.read_chunk ?canceler fd cryptobox_data >>=? fun buf ->
+    let length = MBytes.length buf in
+    match Data_encoding.Binary.read encoding buf 0 length with
+    | None ->
+        fail P2p_errors.Decoding_error
+    | Some (read_len, message) ->
+        if read_len <> length then
+          fail P2p_errors.Decoding_error
+        else
+          return message
+
+end
+
+type 'meta authenticated_connection = {
+  fd: P2p_io_scheduler.connection ;
+  info: 'meta P2p_connection.Info.t ;
+  cryptobox_data: Crypto.data ;
+}
+
+let kick { fd ; cryptobox_data ; _ } =
+  Ack.write fd cryptobox_data Nack >>= fun _ ->
+  P2p_io_scheduler.close fd >>= fun _ ->
+  Lwt.return_unit
+
+(* First step: write and read credentials, makes no difference
+   whether we're trying to connect to a peer or checking an incoming
+   connection, both parties must first introduce themselves. *)
+let authenticate
+    ~canceler
+    ~proof_of_work_target
+    ~incoming fd (remote_addr, remote_socket_port as point)
+    ?listening_port identity supported_versions metadata_config =
+  let local_nonce_seed = Crypto_box.random_nonce () in
+  lwt_debug "Sending authenfication to %a" P2p_point.Id.pp point >>= fun () ->
+  Connection_message.write ~canceler fd
+    { public_key = identity.P2p_identity.public_key ;
+      proof_of_work_stamp = identity.proof_of_work_stamp ;
+      message_nonce = local_nonce_seed ;
+      port = listening_port ;
+      versions = supported_versions } >>=? fun sent_msg ->
+  Connection_message.read ~canceler fd >>=? fun (msg, recv_msg) ->
+  let remote_listening_port =
+    if incoming then msg.port else Some remote_socket_port in
+  let id_point = remote_addr, remote_listening_port in
+  let remote_peer_id = Crypto_box.hash msg.public_key in
+  fail_unless
+    (remote_peer_id <> identity.P2p_identity.peer_id)
+    (P2p_errors.Myself id_point) >>=? fun () ->
+  fail_unless
+    (Crypto_box.check_proof_of_work
+       msg.public_key msg.proof_of_work_stamp proof_of_work_target)
+    (P2p_errors.Not_enough_proof_of_work remote_peer_id) >>=? fun () ->
+  let channel_key =
+    Crypto_box.precompute identity.P2p_identity.secret_key msg.public_key in
+  let (local_nonce, remote_nonce) =
+    Crypto_box.generate_nonces ~incoming ~sent_msg ~recv_msg in
+  let cryptobox_data = { Crypto.channel_key ; local_nonce ; remote_nonce } in
+  let local_metadata = metadata_config.conn_meta_value remote_peer_id in
+  Metadata.write ~canceler metadata_config fd cryptobox_data local_metadata >>=? fun () ->
+  Metadata.read ~canceler metadata_config fd cryptobox_data >>=? fun remote_metadata ->
+  let info =
+    { P2p_connection.Info.peer_id = remote_peer_id ;
+      versions = msg.versions ; incoming ;
+      id_point ; remote_socket_port ;
+      private_node = metadata_config.private_node remote_metadata ;
+      local_metadata ;
+      remote_metadata ;
+    } in
+  return (info, { fd ; info ; cryptobox_data })
+
+module Reader = struct
+
+  type ('msg, 'meta) t = {
+    canceler: Lwt_canceler.t ;
+    conn: 'meta authenticated_connection ;
+    encoding: 'msg Data_encoding.t ;
+    messages: (int * 'msg) tzresult Lwt_pipe.t ;
+    mutable worker: unit Lwt.t ;
+  }
+
+  let read_message st init =
+    let rec loop status =
+      Lwt_unix.yield () >>= fun () ->
+      let open Data_encoding.Binary in
+      match status with
+      | Success { result ; size ; stream } ->
+          return_some (result, size, stream)
+      | Error _err ->
+          lwt_debug "[read_message] incremental decoding error" >>= fun () ->
+          return_none
+      | Await decode_next_buf ->
+          Crypto.read_chunk ~canceler:st.canceler
+            st.conn.fd st.conn.cryptobox_data >>=? fun buf ->
+          lwt_debug
+            "reading %d bytes from %a"
+            (MBytes.length buf) P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+          loop (decode_next_buf buf) in
+    loop (Data_encoding.Binary.read_stream ?init st.encoding)
+
+
+  let rec worker_loop st stream =
+    begin
+      read_message st stream >>=? fun msg ->
+      match msg with
+      | None ->
+          protect ~canceler:st.canceler begin fun () ->
+            Lwt_pipe.push st.messages (Error [P2p_errors.Decoding_error]) >>= fun () ->
+            return_none
+          end
+      | Some (msg, size, stream) ->
+          protect ~canceler:st.canceler begin fun () ->
+            Lwt_pipe.push st.messages (Ok (size, msg)) >>= fun () ->
+            return_some stream
+          end
+    end >>= function
+    | Ok (Some stream) ->
+        worker_loop st (Some stream)
+    | Ok None ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+    | Error [Canceled | Exn Lwt_pipe.Closed] ->
+        lwt_debug "connection closed to %a"
+          P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+        Lwt.return_unit
+    | Error _ as err ->
+        Lwt_pipe.safe_push_now st.messages err ;
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+
+  let run ?size conn encoding canceler =
+    let compute_size = function
+      | Ok (size, _) -> (Sys.word_size / 8) * 11 + size + Lwt_pipe.push_overhead
+      | Error _ -> 0 (* we push Error only when we close the socket,
+                        we don't fear memory leaks in that case... *) in
+    let size = Option.map size ~f:(fun max -> (max, compute_size)) in
+    let st =
+      { canceler ; conn ; encoding ;
+        messages = Lwt_pipe.create ?size () ;
+        worker = Lwt.return_unit ;
+      } in
+    Lwt_canceler.on_cancel st.canceler begin fun () ->
+      Lwt_pipe.close st.messages ;
+      Lwt.return_unit
+    end ;
+    st.worker <-
+      Lwt_utils.worker "reader"
+        ~run:(fun () -> worker_loop st None)
+        ~cancel:(fun () -> Lwt_canceler.cancel st.canceler) ;
+    st
+
+  let shutdown st =
+    Lwt_canceler.cancel st.canceler >>= fun () ->
+    st.worker
+
+end
+
+module Writer = struct
+
+  type ('msg, 'meta) t = {
+    canceler: Lwt_canceler.t ;
+    conn: 'meta authenticated_connection ;
+    encoding: 'msg Data_encoding.t ;
+    messages: (MBytes.t list * unit tzresult Lwt.u option) Lwt_pipe.t ;
+    mutable worker: unit Lwt.t ;
+    binary_chunks_size: int ; (* in bytes *)
+  }
+
+  let send_message st buf =
+    let rec loop = function
+      | [] -> return_unit
+      | buf :: l ->
+          Crypto.write_chunk ~canceler:st.canceler
+            st.conn.fd st.conn.cryptobox_data buf >>=? fun () ->
+          lwt_debug "writing %d bytes to %a"
+            (MBytes.length buf) P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+          loop l in
+    loop buf
+
+  let encode_message st msg =
+    try ok (MBytes.cut
+              st.binary_chunks_size
+              (Data_encoding.Binary.to_bytes_exn st.encoding msg))
+    with Data_encoding.Binary.Write_error _ ->
+      error P2p_errors.Encoding_error
+
+  let rec worker_loop st =
+    Lwt_unix.yield () >>= fun () ->
+    protect ~canceler:st.canceler begin fun () ->
+      Lwt_pipe.pop st.messages >>= return
+    end >>= function
+    | Error [Canceled | Exn Lwt_pipe.Closed] ->
+        lwt_debug "connection closed to %a"
+          P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+        Lwt.return_unit
+    | Error err ->
+        lwt_log_error
+          "@[<v 2>error writing to %a@ %a@]"
+          P2p_peer.Id.pp st.conn.info.peer_id pp_print_error err >>= fun () ->
+        Lwt_canceler.cancel st.canceler >>= fun () ->
+        Lwt.return_unit
+    | Ok (buf, wakener) ->
+        send_message st buf >>= fun res ->
+        match res with
+        | Ok () ->
+            Option.iter wakener ~f:(fun u -> Lwt.wakeup_later u res) ;
+            worker_loop st
+        | Error err ->
+            Option.iter wakener
+              ~f:(fun u ->
+                  Lwt.wakeup_later u
+                    (Error [P2p_errors.Connection_closed])) ;
+            match err with
+            | [ Canceled | Exn Lwt_pipe.Closed ] ->
+                lwt_debug "connection closed to %a"
+                  P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+                Lwt.return_unit
+            | [ P2p_errors.Connection_closed ] ->
+                lwt_debug "connection closed to %a"
+                  P2p_peer.Id.pp st.conn.info.peer_id >>= fun () ->
+                Lwt_canceler.cancel st.canceler >>= fun () ->
+                Lwt.return_unit
+            | err ->
+                lwt_log_error
+                  "@[<v 2>error writing to %a@ %a@]"
+                  P2p_peer.Id.pp st.conn.info.peer_id
+                  pp_print_error err >>= fun () ->
+                Lwt_canceler.cancel st.canceler >>= fun () ->
+                Lwt.return_unit
+
+  let run
+      ?size ?binary_chunks_size
+      conn encoding canceler =
+    let binary_chunks_size =
+      match binary_chunks_size with
+      | None -> Crypto.max_content_length
+      | Some size ->
+          let size = size - Crypto.extrabytes in
+          assert (size > 0) ;
+          assert (size <= Crypto.max_content_length) ;
+          size
+    in
+    let compute_size =
+      let buf_list_size =
+        List.fold_left
+          (fun sz buf ->
+             sz + MBytes.length buf + 2 * Sys.word_size) 0
+      in
+      function
+      | buf_l, None ->
+          Sys.word_size + buf_list_size buf_l + Lwt_pipe.push_overhead
+      | buf_l, Some _ ->
+          2 * Sys.word_size + buf_list_size buf_l + Lwt_pipe.push_overhead
+    in
+    let size = Option.map size ~f:(fun max -> max, compute_size) in
+    let st =
+      { canceler ; conn ; encoding ;
+        messages = Lwt_pipe.create ?size () ;
+        worker = Lwt.return_unit ;
+        binary_chunks_size = binary_chunks_size ;
+      } in
+    Lwt_canceler.on_cancel st.canceler begin fun () ->
+      Lwt_pipe.close st.messages ;
+      while not (Lwt_pipe.is_empty st.messages) do
+        let _, w = Lwt_pipe.pop_now_exn st.messages in
+        Option.iter w
+          ~f:(fun u -> Lwt.wakeup_later u (Error [Exn Lwt_pipe.Closed]))
+      done ;
+      Lwt.return_unit
+    end ;
+    st.worker <-
+      Lwt_utils.worker "writer"
+        ~run:(fun () -> worker_loop st)
+        ~cancel:(fun () -> Lwt_canceler.cancel st.canceler) ;
+    st
+
+  let shutdown st =
+    Lwt_canceler.cancel st.canceler >>= fun () ->
+    st.worker
+
+end
+
+type ('msg, 'meta) t = {
+  conn : 'meta authenticated_connection ;
+  reader : ('msg, 'meta) Reader.t ;
+  writer : ('msg, 'meta) Writer.t ;
+}
+
+let equal { conn = { fd = fd2 } } { conn = { fd = fd1 } } =
+  P2p_io_scheduler.id fd1 = P2p_io_scheduler.id fd2
+
+let pp ppf { conn } = P2p_connection.Info.pp (fun _ _ -> ()) ppf conn.info
+let info { conn } = conn.info
+let local_metadata { conn } = conn.info.local_metadata
+let remote_metadata { conn } = conn.info.remote_metadata
+let private_node { conn } = conn.info.private_node
+
+let accept
+    ?incoming_message_queue_size ?outgoing_message_queue_size
+    ?binary_chunks_size
+    ~canceler
+    conn
+    encoding =
+  protect begin fun () ->
+    Ack.write ~canceler conn.fd conn.cryptobox_data Ack >>=? fun () ->
+    Ack.read ~canceler conn.fd conn.cryptobox_data
+  end ~on_error:begin fun err ->
+    P2p_io_scheduler.close conn.fd >>= fun _ ->
+    match err with
+    | [ P2p_errors.Connection_closed ] -> fail P2p_errors.Rejected_socket_connection
+    | [ P2p_errors.Decipher_error ] -> fail P2p_errors.Invalid_auth
+    | err -> Lwt.return (Error err)
+  end >>=? function
+  | Ack ->
+      let canceler = Lwt_canceler.create () in
+      let reader =
+        Reader.run ?size:incoming_message_queue_size conn encoding canceler
+      and writer =
+        Writer.run
+          ?size:outgoing_message_queue_size ?binary_chunks_size
+          conn encoding canceler
+      in
+      let conn = { conn ; reader ; writer } in
+      Lwt_canceler.on_cancel canceler begin fun () ->
+        P2p_io_scheduler.close conn.conn.fd >>= fun _ ->
+        Lwt.return_unit
+      end ;
+      return conn
+  | Nack ->
+      fail P2p_errors.Rejected_socket_connection
+
+let catch_closed_pipe f =
+  Lwt.catch f begin function
+    | Lwt_pipe.Closed -> fail P2p_errors.Connection_closed
+    | exn -> fail (Exn exn)
+  end >>= function
+  | Error [Exn Lwt_pipe.Closed] ->
+      fail P2p_errors.Connection_closed
+  | Error _ | Ok _ as v -> Lwt.return v
+
+let pp_json encoding ppf msg =
+  Data_encoding.Json.pp ppf
+    (Data_encoding.Json.construct encoding msg)
+
+let write { writer ; conn } msg =
+  catch_closed_pipe begin fun () ->
+    debug "Sending message to %a: %a"
+      P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
+    Lwt.return (Writer.encode_message writer msg) >>=? fun buf ->
+    Lwt_pipe.push writer.messages (buf, None) >>= return
+  end
+
+let write_sync { writer ; conn } msg =
+  catch_closed_pipe begin fun () ->
+    let waiter, wakener = Lwt.wait () in
+    debug "Sending message to %a: %a"
+      P2p_peer.Id.pp_short conn.info.peer_id ( pp_json writer.encoding ) msg ;
+    Lwt.return (Writer.encode_message writer msg) >>=? fun buf ->
+    Lwt_pipe.push writer.messages (buf, Some wakener) >>= fun () ->
+    waiter
+  end
+
+let write_now { writer ; conn } msg =
+  debug "Try sending message to %a: %a"
+    P2p_peer.Id.pp_short conn.info.peer_id (pp_json writer.encoding) msg ;
+  Writer.encode_message writer msg >>? fun buf ->
+  try Ok (Lwt_pipe.push_now writer.messages (buf, None))
+  with Lwt_pipe.Closed -> Error [P2p_errors.Connection_closed]
+
+let rec split_bytes size bytes =
+  if MBytes.length bytes <= size then
+    [bytes]
+  else
+    MBytes.sub bytes 0 size ::
+    split_bytes size (MBytes.sub bytes size (MBytes.length bytes - size))
+
+let raw_write_sync { writer } bytes =
+  let bytes = split_bytes writer.binary_chunks_size bytes in
+  catch_closed_pipe begin fun () ->
+    let waiter, wakener = Lwt.wait () in
+    Lwt_pipe.push writer.messages (bytes, Some wakener) >>= fun () ->
+    waiter
+  end
+
+let is_readable { reader } =
+  not (Lwt_pipe.is_empty reader.messages)
+let wait_readable { reader } =
+  catch_closed_pipe begin fun () ->
+    Lwt_pipe.values_available reader.messages >>= return
+  end
+let read { reader } =
+  catch_closed_pipe begin fun () ->
+    Lwt_pipe.pop reader.messages
+  end
+let read_now { reader } =
+  try Lwt_pipe.pop_now reader.messages
+  with Lwt_pipe.Closed -> Some (Error [P2p_errors.Connection_closed])
+
+let stat { conn = { fd } } = P2p_io_scheduler.stat fd
+
+let close ?(wait = false) st =
+  begin
+    if not wait then Lwt.return_unit
+    else begin
+      Lwt_pipe.close st.reader.messages ;
+      Lwt_pipe.close st.writer.messages ;
+      st.writer.worker
+    end
+  end >>= fun () ->
+  Reader.shutdown st.reader >>= fun () ->
+  Writer.shutdown st.writer >>= fun () ->
+  P2p_io_scheduler.close st.conn.fd >>= fun _ ->
+  Lwt.return_unit
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_socket.mli b/vendors/tezos-modded/src/lib_p2p/p2p_socket.mli
new file mode 100644
index 000000000..d0e4a9e78
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_socket.mli
@@ -0,0 +1,145 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Typed and encrypted connections to peers.
+
+    This modules adds message encoding and encryption to
+    [P2p_io_scheduler]'s generic throttled connections.
+
+    Each connection have an associated internal read (resp. write)
+    queue containing messages (of type ['msg]), whose size can be
+    limited by providing corresponding arguments to [accept].
+*)
+
+(** {1 Types} *)
+
+type 'meta metadata_config = {
+  conn_meta_encoding : 'meta Data_encoding.t ;
+  conn_meta_value : P2p_peer.Id.t -> 'meta ;
+  private_node : 'meta -> bool ;
+}
+(** Type for the parameter negotiation mechanism. *)
+
+type 'meta authenticated_connection
+(** Type of a connection that successfully passed the authentication
+    phase, but has not been accepted yet. Parametrized by the type
+    of expected parameter in the `ack` message. *)
+
+type ('msg, 'meta) t
+(** Type of an accepted connection, parametrized by the type of
+    messages exchanged between peers. *)
+
+val equal: ('mst, 'meta) t -> ('msg, 'meta) t -> bool
+
+val pp: Format.formatter -> ('msg, 'meta) t -> unit
+val info: ('msg, 'meta) t -> 'meta P2p_connection.Info.t
+val local_metadata: ('msg, 'meta) t -> 'meta
+val remote_metadata: ('msg, 'meta) t -> 'meta
+val private_node: ('msg, 'meta) t -> bool
+
+(** {1 Low-level functions (do not use directly)} *)
+
+val authenticate:
+  canceler:Lwt_canceler.t ->
+  proof_of_work_target:Crypto_box.target ->
+  incoming:bool ->
+  P2p_io_scheduler.connection -> P2p_point.Id.t ->
+  ?listening_port: int ->
+  P2p_identity.t -> P2p_version.t list ->
+  'meta metadata_config ->
+  ('meta P2p_connection.Info.t * 'meta authenticated_connection) tzresult Lwt.t
+(** (Low-level) (Cancelable) Authentication function of a remote
+    peer. Used in [P2p_connection_pool], to promote a
+    [P2P_io_scheduler.connection] into an [authenticated_connection] (auth
+    correct, acceptation undecided). *)
+
+val kick: 'meta authenticated_connection -> unit Lwt.t
+(** (Low-level) (Cancelable) [kick afd] notifies the remote peer that
+    we refuse this connection and then closes [afd]. Used in
+    [P2p_connection_pool] to reject an [authenticated_connection] which we do
+    not want to connect to for some reason. *)
+
+val accept:
+  ?incoming_message_queue_size:int ->
+  ?outgoing_message_queue_size:int ->
+  ?binary_chunks_size: int ->
+  canceler:Lwt_canceler.t ->
+  'meta authenticated_connection ->
+  'msg Data_encoding.t -> ('msg, 'meta) t tzresult Lwt.t
+(** (Low-level) (Cancelable) Accepts a remote peer given an
+    authenticated_connection. Used in [P2p_connection_pool], to promote an
+    [authenticated_connection] to the status of an active peer. *)
+
+val check_binary_chunks_size: int -> unit tzresult Lwt.t
+(** Precheck for the [?binary_chunks_size] parameter of [accept]. *)
+
+(** {1 IO functions on connections} *)
+
+(** {2 Output functions} *)
+
+val write: ('msg, 'meta) t -> 'msg -> unit tzresult Lwt.t
+(** [write conn msg] returns when [msg] has successfully been added to
+    [conn]'s internal write queue or fails with a corresponding
+    error. *)
+
+val write_now: ('msg, 'meta) t -> 'msg -> bool tzresult
+(** [write_now conn msg] is [Ok true] if [msg] has been added to
+    [conn]'s internal write queue, [Ok false] if [msg] has been
+    dropped, or fails with a correponding error otherwise. *)
+
+val write_sync: ('msg, 'meta) t -> 'msg -> unit tzresult Lwt.t
+(** [write_sync conn msg] returns when [msg] has been successfully
+    sent to the remote end of [conn], or fails accordingly. *)
+
+(** {2 Input functions} *)
+
+val is_readable: ('msg, 'meta) t -> bool
+(** [is_readable conn] is [true] iff [conn] internal read queue is not
+    empty. *)
+
+val wait_readable: ('msg, 'meta) t -> unit tzresult Lwt.t
+(** (Cancelable) [wait_readable conn] returns when [conn]'s internal
+    read queue becomes readable (i.e. not empty). *)
+
+val read: ('msg, 'meta) t -> (int * 'msg) tzresult Lwt.t
+(** [read conn msg] returns when [msg] has successfully been popped
+    from [conn]'s internal read queue or fails with a corresponding
+    error. *)
+
+val read_now: ('msg, 'meta) t -> (int * 'msg) tzresult option
+(** [read_now conn msg] is [Some msg] if [conn]'s internal read queue
+    is not empty, [None] if it is empty, or fails with a correponding
+    error otherwise. *)
+
+val stat: ('msg, 'meta) t -> P2p_stat.t
+(** [stat conn] is a snapshot of current bandwidth usage for
+    [conn]. *)
+
+val close: ?wait:bool -> ('msg, 'meta) t -> unit Lwt.t
+
+(**/**)
+
+(** for testing only *)
+val raw_write_sync: ('msg, 'meta) t -> MBytes.t -> unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_welcome.ml b/vendors/tezos-modded/src/lib_p2p/p2p_welcome.ml
new file mode 100644
index 000000000..f0edecc0a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_welcome.ml
@@ -0,0 +1,94 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "p2p.welcome" end)
+
+type pool = Pool : ('msg, 'meta, 'meta_conn) P2p_pool.t -> pool
+
+type t = {
+  socket: Lwt_unix.file_descr ;
+  canceler: Lwt_canceler.t ;
+  pool: pool ;
+  mutable worker: unit Lwt.t ;
+}
+
+let rec worker_loop st =
+  let Pool pool = st.pool in
+  Lwt_unix.yield () >>= fun () ->
+  protect ~canceler:st.canceler begin fun () ->
+    P2p_fd.accept st.socket >>= return
+  end >>= function
+  | Ok (fd, addr) ->
+      let point =
+        match addr with
+        | Lwt_unix.ADDR_UNIX _ -> assert false
+        | Lwt_unix.ADDR_INET (addr, port) ->
+            (Ipaddr_unix.V6.of_inet_addr_exn addr, port) in
+      P2p_pool.accept pool fd point ;
+      worker_loop st
+  | Error [ Canceled ] ->
+      Lwt.return_unit
+  | Error err ->
+      lwt_log_error "@[<v 2>Unexpected error in the Welcome worker@ %a@]"
+        pp_print_error err >>= fun () ->
+      Lwt.return_unit
+
+let create_listening_socket ~backlog ?(addr = Ipaddr.V6.unspecified) port =
+  let main_socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+  Lwt_unix.(setsockopt main_socket SO_REUSEADDR true) ;
+  Lwt_unix.bind main_socket
+    Unix.(ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port)) >>= fun () ->
+  Lwt_unix.listen main_socket backlog ;
+  Lwt.return main_socket
+
+let create ?addr ~backlog pool port =
+  Lwt.catch begin fun () ->
+    create_listening_socket
+      ~backlog ?addr port >>= fun socket ->
+    let canceler = Lwt_canceler.create () in
+    Lwt_canceler.on_cancel canceler begin fun () ->
+      Lwt_utils_unix.safe_close socket
+    end ;
+    let st = {
+      socket ; canceler ; pool = Pool pool ;
+      worker = Lwt.return_unit ;
+    } in
+    Lwt.return st
+  end begin fun exn ->
+    lwt_log_error
+      "@[<v 2>Cannot accept incoming connections@ %a@]"
+      pp_exn exn >>= fun () ->
+    Lwt.fail exn
+  end
+
+let activate st =
+  st.worker <-
+    Lwt_utils.worker "welcome"
+      ~run:(fun () -> worker_loop st)
+      ~cancel:(fun () -> Lwt_canceler.cancel st.canceler)
+
+let shutdown st =
+  Lwt_canceler.cancel st.canceler >>= fun () ->
+  st.worker
diff --git a/vendors/tezos-modded/src/lib_p2p/p2p_welcome.mli b/vendors/tezos-modded/src/lib_p2p/p2p_welcome.mli
new file mode 100644
index 000000000..c1b81c18b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/p2p_welcome.mli
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Welcome worker.
+
+    Accept incoming connections and add them to the pool.
+*)
+
+type t
+(** Type of a welcome worker. *)
+
+val create :
+  ?addr:P2p_addr.t -> backlog:int ->
+  ('msg, 'meta, 'meta_conn) P2p_pool.t -> P2p_addr.port -> t Lwt.t
+(** [create ?addr ~backlog pool port] returns a running welcome worker
+    adding connections into [pool] listening on [addr:port]. [backlog]
+    is passed to [Lwt_unix.listen]. *)
+
+val activate : t -> unit
+(** [activate t] start the worker that will accept connections *)
+
+val shutdown: t -> unit Lwt.t
+(** [shutdown t] returns when [t] has completed shutdown. *)
diff --git a/vendors/tezos-modded/src/lib_p2p/test/dune b/vendors/tezos-modded/src/lib_p2p/test/dune
new file mode 100644
index 000000000..162e590ce
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/dune
@@ -0,0 +1,92 @@
+(executables
+ (names test_p2p_socket
+        test_p2p_pool
+        test_p2p_io_scheduler
+        test_p2p_peerset
+        test_p2p_ipv6set
+        test_p2p_banned_peers
+        )
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-shell-services
+            tezos-p2p
+            alcotest-lwt)
+ (flags (:standard -w -9-32
+                   -linkall
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services
+                   -open Tezos_p2p)))
+
+(alias
+ (name buildtest)
+ (deps test_p2p_socket.exe
+       test_p2p_pool.exe
+       test_p2p_io_scheduler.exe
+       test_p2p_peerset.exe
+       test_p2p_ipv6set.exe
+       test_p2p_banned_peers.exe
+       ))
+
+(alias
+ (name runtest_p2p_socket)
+ (action (run %{exe:test_p2p_socket.exe} -v)))
+
+(alias
+ (name runtest_p2p_pool)
+ (action (run %{exe:test_p2p_pool.exe} --clients 10 --repeat 5 -v)))
+
+(alias
+ (name runtest_p2p_io_scheduler)
+ (action (run %{exe:test_p2p_io_scheduler.exe}
+              --delay 5 --clients 8
+              --max-upload-speed 262144 ;; 1 << 18 = 256kB
+              --max-download-speed 1048576 ;; 1 << 20 = 1MB
+              )))
+
+(alias
+ (name runtest_p2p_socket_ipv4)
+ (action (run %{exe:test_p2p_socket.exe} -v
+              --addr "::ffff:127.0.0.1")))
+
+(alias
+ (name runtest_p2p_pool_ipv4)
+ (action (run %{exe:test_p2p_pool.exe} --clients 10 --repeat 5 -v
+              --addr "::ffff:127.0.0.1")))
+
+(alias
+ (name runtest_p2p_io_scheduler_ipv4)
+ (action (run %{exe:test_p2p_io_scheduler.exe}
+              --delay 5 --clients 8
+              --max-upload-speed 262144 ;; 1 << 18 = 256kB
+              --max-download-speed 1048576 ;; 1 << 20 = 1MB
+              --addr "::ffff:127.0.0.1"
+              )))
+
+(alias
+ (name runtest_p2p_ipv6set)
+ (action (run %{exe:test_p2p_ipv6set.exe} -v)))
+
+(alias
+ (name runtest_p2p_peerset)
+ (action (run %{exe:test_p2p_peerset.exe} -v)))
+
+(alias
+ (name runtest_p2p_banned_peers)
+ (action (run %{exe:test_p2p_banned_peers.exe} -v)))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_p2p_socket_ipv4)
+       (alias runtest_p2p_pool_ipv4)
+       (alias runtest_p2p_io_scheduler_ipv4)
+       (alias runtest_p2p_peerset)
+       (alias runtest_p2p_ipv6set)
+       (alias runtest_p2p_banned_peers)
+       ))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_p2p/test/process.ml b/vendors/tezos-modded/src/lib_p2p/test/process.ml
new file mode 100644
index 000000000..5b5222da5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/process.ml
@@ -0,0 +1,186 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+let () = Lwt_unix.set_default_async_method Async_none
+
+let section = Lwt_log.Section.make "process"
+let log_f ~level format =
+  if level < Lwt_log.Section.level section then
+    Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
+  else
+    Format.kasprintf (fun msg -> Lwt_log.log ~section ~level msg) format
+let lwt_debug fmt = log_f ~level:Lwt_log.Debug fmt
+let lwt_log_notice fmt = log_f ~level:Lwt_log.Notice fmt
+let lwt_log_info fmt = log_f ~level:Lwt_log.Info fmt
+let lwt_log_error fmt = log_f ~level:Lwt_log.Error fmt
+
+exception Exited of int
+exception Signaled of int
+exception Stopped of int
+
+let handle_error f =
+  Lwt.catch
+    f
+    (fun exn -> Lwt.return_error [Exn exn]) >>= function
+  | Ok () -> Lwt.return_unit
+  | Error err ->
+      lwt_debug "%a" pp_print_error err >>= fun () ->
+      exit 1
+
+module Channel = struct
+  type ('a, 'b) t = (Lwt_io.input_channel * Lwt_io.output_channel)
+  let push (_, outch) v =
+    Lwt.catch
+      (fun () -> Lwt_io.write_value outch v >>= Lwt.return_ok)
+      (fun exn -> Lwt.return_error [Exn exn])
+  let pop (inch, _) =
+    Lwt.catch
+      (fun () -> Lwt_io.read_value inch >>= Lwt.return_ok)
+      (fun exn -> Lwt.return_error [Exn exn])
+end
+
+let wait pid =
+  Lwt.catch
+    (fun () ->
+       Lwt_unix.waitpid [] pid >>= function
+       | (_,Lwt_unix.WEXITED 0) ->
+           Lwt.return_ok ()
+       | (_,Lwt_unix.WEXITED n) ->
+           Lwt.return_error [Exn (Exited n)]
+       | (_,Lwt_unix.WSIGNALED n) ->
+           Lwt.return_error [Exn (Signaled n)]
+       | (_,Lwt_unix.WSTOPPED n) ->
+           Lwt.return_error [Exn (Stopped n)])
+    (function
+      | Lwt.Canceled ->
+          Unix.kill pid Sys.sigkill ;
+          Lwt.return_ok ()
+      | exn ->
+          Lwt.return_error [Exn exn])
+
+type ('a, 'b) t = {
+  termination: unit tzresult Lwt.t ;
+  channel: ('b, 'a) Channel.t ;
+}
+
+let template = "$(date) - $(section): $(message)"
+
+let detach ?(prefix = "") f =
+  Lwt_io.flush_all () >>= fun () ->
+  let main_in, child_out = Lwt_io.pipe () in
+  let child_in, main_out = Lwt_io.pipe () in
+  match Lwt_unix.fork () with
+  | 0 ->
+      Lwt_log.default :=
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
+      Random.self_init () ;
+      let template = Format.asprintf "%s$(message)" prefix in
+      Lwt_main.run begin
+        Lwt_io.close main_in >>= fun () ->
+        Lwt_io.close main_out >>= fun () ->
+        Lwt_log.default :=
+          Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr () ;
+        lwt_log_notice "PID: %d" (Unix.getpid ()) >>= fun () ->
+        handle_error (fun () -> f (child_in, child_out))
+      end ;
+      exit 0
+  | pid ->
+      let termination = wait pid in
+      Lwt_io.close child_in >>= fun () ->
+      Lwt_io.close child_out >>= fun () ->
+      Lwt.return ({ termination ; channel = (main_in, main_out) })
+
+let signal_name =
+  let names =
+    [ Sys.sigabrt, "ABRT" ;
+      Sys.sigalrm, "ALRM" ;
+      Sys.sigfpe, "FPE" ;
+      Sys.sighup, "HUP" ;
+      Sys.sigill, "ILL" ;
+      Sys.sigint, "INT" ;
+      Sys.sigkill, "KILL" ;
+      Sys.sigpipe, "PIPE" ;
+      Sys.sigquit, "QUIT" ;
+      Sys.sigsegv, "SEGV" ;
+      Sys.sigterm, "TERM" ;
+      Sys.sigusr1, "USR1" ;
+      Sys.sigusr2, "USR2" ;
+      Sys.sigchld, "CHLD" ;
+      Sys.sigcont, "CONT" ;
+      Sys.sigstop, "STOP" ;
+      Sys.sigtstp, "TSTP" ;
+      Sys.sigttin, "TTIN" ;
+      Sys.sigttou, "TTOU" ;
+      Sys.sigvtalrm, "VTALRM" ;
+      Sys.sigprof, "PROF" ;
+      Sys.sigbus, "BUS" ;
+      Sys.sigpoll, "POLL" ;
+      Sys.sigsys, "SYS" ;
+      Sys.sigtrap, "TRAP" ;
+      Sys.sigurg, "URG" ;
+      Sys.sigxcpu, "XCPU" ;
+      Sys.sigxfsz, "XFSZ" ] in
+  fun n -> List.assoc n names
+
+let wait_all processes =
+  let rec loop processes =
+    match processes with
+    | [] -> Lwt.return_none
+    | processes ->
+        Lwt.nchoose_split processes >>= function
+        | (finished, remaining) ->
+            let rec handle = function
+              | [] -> loop remaining
+              | Ok () :: finished -> handle finished
+              | Error err :: _ ->
+                  Lwt.return_some (err, remaining) in
+            handle finished in
+  loop (List.map (fun p -> p.termination) processes) >>= function
+  | None ->
+      lwt_log_info "All done!" >>= fun () ->
+      Lwt.return_ok ()
+  | Some ([Exn (Exited n)], remaining) ->
+      lwt_log_error "Early error!" >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process finished with error %d !" n
+  | Some ([Exn (Signaled n)], remaining) ->
+      lwt_log_error "Early error!" >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process was killed by a SIG%s !" (signal_name n)
+  | Some ([Exn (Stopped n)], remaining) ->
+      lwt_log_error "Early error!" >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process was stopped by a SIG%s !" (signal_name n)
+  | Some (err, remaining) ->
+      lwt_log_error "@[<v 2>Unexpected error!@,%a@]"
+        pp_print_error err >>= fun () ->
+      List.iter Lwt.cancel remaining ;
+      join remaining >>= fun _ ->
+      failwith "A process finished with an unexpected error !"
diff --git a/vendors/tezos-modded/src/lib_p2p/test/process.mli b/vendors/tezos-modded/src/lib_p2p/test/process.mli
new file mode 100644
index 000000000..f8ec3a211
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/process.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+exception Exited of int
+
+module Channel : sig
+  type ('a, 'b) t
+  val push: ('a, 'b) t -> 'a -> unit tzresult Lwt.t
+  val pop: ('a, 'b) t -> 'b tzresult Lwt.t
+end
+
+type ('a, 'b) t = {
+  termination: unit tzresult Lwt.t ;
+  channel: ('b, 'a) Channel.t ;
+}
+
+val detach:
+  ?prefix:string ->
+  (('a, 'b) Channel.t -> unit tzresult Lwt.t) ->
+  ('a, 'b) t Lwt.t
+
+val wait_all: ('a, 'b) t list -> unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_banned_peers.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_banned_peers.ml
new file mode 100644
index 000000000..94eccdc73
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_banned_peers.ml
@@ -0,0 +1,79 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test-p2p-banned_peers" end)
+
+let assert_equal_bool ~msg a b =
+  if a <> b then Alcotest.fail msg
+
+let a = fun (peer,addr) ->
+  (P2p_peer.Id.hash_string [peer], Ipaddr.V6.of_string_exn addr)
+
+let foo = a ("foo","ffff::3")
+let bar = a ("bar","ffff:00::ff")
+let baz = a ("baz","a::2")
+let peers = [foo;bar;baz]
+
+let test_empty _ =
+  let empty = P2p_acl.create 10 in
+  List.iter (fun (_peer,addr) ->
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr empty addr)
+    ) peers ;
+  Lwt.return_unit
+;;
+
+let test_ban _ =
+  let set = P2p_acl.create 10 in
+  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr Time.epoch) peers;
+  List.iter (fun (_,addr) ->
+      assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr)
+    ) peers ;
+  Lwt.return_unit
+;;
+
+let test_gc _ =
+  let set = P2p_acl.create 10 in
+  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr Time.epoch) peers;
+  List.iter (fun (_peer,addr) ->
+      assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr)
+    ) peers ;
+  (* remove all peers *)
+  P2p_acl.IPGreylist.remove_old set ~older_than:Time.max_value ;
+  List.iter (fun (_peer,addr) ->
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr set addr)
+    ) peers ;
+  Lwt.return_unit
+
+let () =
+  let wrap (n, f) =
+    Alcotest_lwt.test_case n `Quick (fun _ () -> f ()) in
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p.peerset",
+    List.map wrap [
+      "empty", test_empty ;
+      "ban", test_ban;
+      "gc", test_gc;
+    ]
+  ]
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_io_scheduler.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_io_scheduler.ml
new file mode 100644
index 000000000..cb7a68756
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_io_scheduler.ml
@@ -0,0 +1,256 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test-p2p-io-scheduler" end)
+
+exception Error of error list
+
+let rec listen ?port addr =
+  let tentative_port =
+    match port with
+    | None -> 1024 + Random.int 8192
+    | Some port -> port in
+  let uaddr = Ipaddr_unix.V6.to_inet_addr addr in
+  let main_socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+  Lwt_unix.(setsockopt main_socket SO_REUSEADDR true) ;
+  Lwt.catch begin fun () ->
+    Lwt_unix.bind main_socket
+      (ADDR_INET (uaddr, tentative_port)) >>= fun () ->
+    Lwt_unix.listen main_socket 50 ;
+    Lwt.return (main_socket, tentative_port)
+  end begin function
+    | Unix.Unix_error
+        ((Unix.EADDRINUSE | Unix.EADDRNOTAVAIL), _, _) when port = None ->
+        listen addr
+    | exn -> Lwt.fail exn
+  end
+
+let accept main_socket =
+  P2p_fd.accept main_socket >>= fun (fd, _sockaddr) ->
+  return fd
+
+let rec accept_n main_socket n =
+  if n <= 0 then
+    return_nil
+  else
+    accept_n main_socket (n-1) >>=? fun acc ->
+    accept main_socket >>=? fun conn ->
+    return (conn :: acc)
+
+let connect addr port =
+  let fd = P2p_fd.socket PF_INET6 SOCK_STREAM 0 in
+  let uaddr =
+    Lwt_unix.ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port) in
+  P2p_fd.connect fd uaddr >>= fun () ->
+  return fd
+
+let simple_msgs =
+  [|
+    MBytes.create (1 lsl 6) ;
+    MBytes.create (1 lsl 7) ;
+    MBytes.create (1 lsl 8) ;
+    MBytes.create (1 lsl 9) ;
+    MBytes.create (1 lsl 10) ;
+    MBytes.create (1 lsl 11) ;
+    MBytes.create (1 lsl 12) ;
+    MBytes.create (1 lsl 13) ;
+    MBytes.create (1 lsl 14) ;
+    MBytes.create (1 lsl 15) ;
+    MBytes.create (1 lsl 16) ;
+  |]
+let nb_simple_msgs = Array.length simple_msgs
+
+let receive conn =
+  let buf = MBytes.create (1 lsl 16) in
+  let rec loop () =
+    P2p_io_scheduler.read conn buf >>= function
+    | Ok _ -> loop ()
+    | Error [P2p_errors.Connection_closed] ->
+        Lwt.return_unit
+    | Error err -> Lwt.fail (Error err)
+  in
+  loop ()
+
+let server
+    ?(display_client_stat = true)
+    ?max_download_speed ?read_queue_size ~read_buffer_size
+    main_socket n =
+  let sched =
+    P2p_io_scheduler.create
+      ?max_download_speed
+      ?read_queue_size
+      ~read_buffer_size
+      () in
+  Moving_average.on_update begin fun () ->
+    log_notice "Stat: %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ;
+    if display_client_stat then
+      P2p_io_scheduler.iter_connection sched
+        (fun conn ->
+           log_notice
+             " client(%d) %a"
+             (P2p_io_scheduler.id conn)
+             P2p_stat.pp (P2p_io_scheduler.stat conn)) ;
+  end ;
+  (* Accept and read message until the connection is closed. *)
+  accept_n main_socket n >>=? fun conns ->
+  let conns = List.map (P2p_io_scheduler.register sched) conns in
+  Lwt.join (List.map receive conns) >>= fun () ->
+  iter_p P2p_io_scheduler.close conns >>=? fun () ->
+  log_notice "OK %a" P2p_stat.pp (P2p_io_scheduler.global_stat sched) ;
+  return_unit
+
+let max_size ?max_upload_speed () =
+  match max_upload_speed with
+  | None -> nb_simple_msgs
+  | Some max_upload_speed ->
+      let rec loop n =
+        if n <= 1 then 1
+        else if MBytes.length simple_msgs.(n-1) <= max_upload_speed then n
+        else loop (n - 1)
+      in
+      loop nb_simple_msgs
+
+let rec send conn nb_simple_msgs =
+  Lwt_main.yield () >>= fun () ->
+  let msg = simple_msgs.(Random.int nb_simple_msgs) in
+  P2p_io_scheduler.write conn msg >>=? fun () ->
+  send conn nb_simple_msgs
+
+let client ?max_upload_speed ?write_queue_size addr port time _n =
+  let sched =
+    P2p_io_scheduler.create
+      ?max_upload_speed ?write_queue_size ~read_buffer_size:(1 lsl 12) () in
+  connect addr port >>=? fun conn ->
+  let conn = P2p_io_scheduler.register sched conn in
+  let nb_simple_msgs = max_size ?max_upload_speed () in
+  Lwt.pick [ send conn nb_simple_msgs ;
+             Lwt_unix.sleep time >>= return ] >>=? fun () ->
+  P2p_io_scheduler.close conn >>=? fun () ->
+  let stat = P2p_io_scheduler.stat conn in
+  lwt_log_notice "Client OK %a" P2p_stat.pp stat >>= fun () ->
+  return_unit
+
+let run
+    ?display_client_stat
+    ?max_download_speed ?max_upload_speed
+    ~read_buffer_size ?read_queue_size ?write_queue_size
+    addr port time n =
+  Logging_unix.init () >>= fun () ->
+  listen ?port addr >>= fun (main_socket, port) ->
+  Process.detach ~prefix:"server: " begin fun _ ->
+    server
+      ?display_client_stat ?max_download_speed
+      ~read_buffer_size ?read_queue_size
+      main_socket n
+  end >>= fun server_node ->
+  let client n =
+    let prefix = Printf.sprintf "client(%d): " n in
+    Process.detach ~prefix begin fun _ ->
+      Lwt_utils_unix.safe_close main_socket >>= fun () ->
+      client ?max_upload_speed ?write_queue_size addr port time n
+    end in
+  Lwt_list.map_p client (1 -- n) >>= fun client_nodes ->
+  Process.wait_all (server_node :: client_nodes)
+
+let () = Random.self_init ()
+
+let addr = ref Ipaddr.V6.localhost
+let port = ref None
+
+let max_download_speed = ref None
+let max_upload_speed = ref None
+
+let read_buffer_size = ref (1 lsl 14)
+let read_queue_size = ref (Some (1 lsl 14))
+let write_queue_size = ref (Some (1 lsl 14))
+
+let delay = ref 60.
+let clients = ref 8
+
+let display_client_stat = ref None
+
+let spec =
+  Arg.[
+
+    "--port", Int (fun p -> port := Some p), " Listening port";
+
+    "--addr", String (fun p -> addr := Ipaddr.V6.of_string_exn p),
+    " Listening addr";
+
+    "--max-download-speed", Int (fun i -> max_download_speed := Some i),
+    " Max download speed in B/s (default: unbounded)";
+
+    "--max-upload-speed", Int (fun i -> max_upload_speed := Some i),
+    " Max upload speed in B/s (default: unbounded)";
+
+    "--read-buffer-size", Set_int read_buffer_size,
+    " Size of the read buffers";
+
+    "--read-queue-size", Int (fun i ->
+        read_queue_size := if i <= 0 then None else Some i),
+    " Size of the read queue (0=unbounded)";
+
+    "--write-queue-size", Int (fun i ->
+        write_queue_size := if i <= 0 then None else Some i),
+    " Size of the write queue (0=unbounded)";
+
+    "--delay", Set_float delay,  " Client execution time.";
+    "--clients", Set_int clients,  " Number of concurrent clients.";
+
+    "--hide-clients-stat", Unit (fun () -> display_client_stat := Some false),
+    " Hide the client bandwidth statistic." ;
+
+    "--display_clients_stat", Unit (fun () -> display_client_stat := Some true),
+    " Display the client bandwidth statistic." ;
+
+  ]
+
+let () =
+  let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
+  let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
+  Arg.parse spec anon_fun usage_msg
+
+let wrap n f =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p.io-scheduler", [
+      wrap "trivial-quota" (fun () ->
+          run
+            ?display_client_stat:!display_client_stat
+            ?max_download_speed:!max_download_speed
+            ?max_upload_speed:!max_upload_speed
+            ~read_buffer_size:!read_buffer_size
+            ?read_queue_size:!read_queue_size
+            ?write_queue_size:!write_queue_size
+            !addr !port !delay !clients)
+    ]
+  ]
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_ipv6set.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_ipv6set.ml
new file mode 100644
index 000000000..2cb96445e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_ipv6set.ml
@@ -0,0 +1,155 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test-p2p-banned_ip" end)
+
+let assert_equal ?(eq = (=)) ?prn ~msg a b =
+  let msg = match prn with
+    | None -> msg
+    | Some prn ->
+        Format.asprintf "@[<v 2>%s@,n(%a)@,<>@,(%a)@]" msg prn a prn b in
+  if not (eq a b) then Alcotest.fail msg
+
+let assert_equal_bool = assert_equal
+
+let a = Ipaddr.V6.of_string_exn
+let p = Ipaddr.V6.Prefix.of_string_exn
+
+let timenow = Time.now ()
+
+let of_list l =
+  List.fold_left (fun acc k ->
+      P2p_acl.IpSet.add_prefix k timenow acc
+    ) P2p_acl.IpSet.empty l
+
+let test_empty _ =
+  let addrs = List.map a [ "::" ; "ffff::" ; "a::2" ; ] in
+  List.iter (fun addr ->
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.IpSet.mem addr P2p_acl.IpSet.empty)
+    ) addrs
+
+let test_inclusion _ =
+  let set = P2p_acl.IpSet.add_prefix (p "ffff::/16") timenow P2p_acl.IpSet.empty in
+  let included = List.map a [ "ffff::3" ; "ffff:ffff::" ; "ffff:00::ff" ; ] in
+  let not_included = List.map a [  "fffe::3" ; "ffee:ffff::" ; "::" ; ] in
+  List.iter (fun addr ->
+      assert_equal_bool ~msg:__LOC__ true (P2p_acl.IpSet.mem addr set)
+    ) included ;
+  List.iter (fun addr ->
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.IpSet.mem addr set)
+    ) not_included;
+
+  let set = P2p_acl.IpSet.add_prefix (p "f000::/4") timenow P2p_acl.IpSet.empty in
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "e000::") set) ;
+
+  (* Add one IP *)
+  let set = P2p_acl.IpSet.add_prefix (p "::/128") timenow P2p_acl.IpSet.empty in
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "1::") set) ;
+
+  let set = P2p_acl.IpSet.add_prefix (p "ffff:eeee::/32") timenow P2p_acl.IpSet.empty in
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "eeee:ffff::1") set) ;
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "ffff:eeee::1") set) ;
+
+  let set = P2p_acl.IpSet.add_prefix (p "::/17") timenow P2p_acl.IpSet.empty in
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "0000:0000::") set) ;
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "0000:7000::") set) ;
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "0000:8000::1") set) ;
+
+  let setlist = [p "e000::/4" ; p "a000::/4" ; p "ffff::/16"] in
+  let set = of_list setlist in
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "ffff::1") set) ;
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "a111:8000::1") set) ;
+
+  let set = of_list [p "e000::/4" ; p "a000::/4" ;
+                     p "1234:5678::1/128"; p "ffff::/16"] in
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "1234:5678::1") set) ;
+  assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem (a "a111:8000::1") set) ;
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "b111:8000::1") set) ;
+  assert_equal ~msg:__LOC__ false (P2p_acl.IpSet.mem (a "1234:5678::100") set)
+
+
+let test_contiguous _ =
+  let set = of_list [p "::/1" ; p "8000::/1"] in
+  List.iter (fun addr ->
+      assert_equal ~msg:__LOC__ true (P2p_acl.IpSet.mem addr set)
+    ) [a "00::" ; a "01::" ; a "ff::" ]
+
+module PSet = Set.Make(Ipaddr.V6.Prefix)
+
+let test_fold _ =
+  let addr_list = [p "::/1" ; p "8000::/1" ; p "ffff:ffff::/32" ; ] in
+  let pset = PSet.of_list addr_list in
+  let ipv6set =
+    P2p_acl.IpSet.fold (fun prefix _value s ->
+        PSet.add prefix s
+      ) (of_list addr_list) PSet.empty ;
+  in
+  assert_equal ~eq:PSet.equal ~msg:__LOC__ ipv6set pset
+
+let print_pset ppf pset =
+  PSet.iter (fun p ->
+      Format.fprintf ppf "%a " Ipaddr.V6.Prefix.pp p
+    ) pset
+
+let print_list ppf l =
+  List.iter (fun p ->
+      Format.fprintf ppf "%a " Ipaddr.V6.Prefix.pp p
+    ) l
+
+let test_to_list _ =
+  let to_list s = P2p_acl.IpSet.fold (fun k _v acc -> k::acc) s [] in
+  let list_eq = List.for_all2 (fun x y -> Ipaddr.V6.Prefix.compare x y = 0) in
+  let assert_equal_set ~msg a b =
+    let a = List.sort compare a in
+    let b = List.sort compare (to_list b) in
+    assert_equal ~prn:print_list ~eq:list_eq ~msg a b in
+
+  let set = P2p_acl.IpSet.add_prefix (p "::/0") timenow P2p_acl.IpSet.empty in
+  assert_equal ~eq:list_eq ~prn:print_list ~msg:__LOC__ [p "::/0"] (to_list set) ;
+
+  let set = of_list [p "::/1" ; p "8000::/1"] in
+  assert_equal ~eq:list_eq ~prn:print_list ~msg:__LOC__  [p "8000::/1"; p "::/1" ] (to_list set) ;
+
+  let setlist = [p "1234:5678::/32"] in
+  let set = of_list setlist in
+  assert_equal_set ~msg:__LOC__ setlist set ;
+
+  let setlist = [p "e000::/4" ; p "a000::/4" ;
+                 p "ffff::/16" ;
+                 p "1234:5678::/32" ;
+                ] in
+  let set = of_list setlist in
+  assert_equal_set ~msg:__LOC__ setlist set
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p.ipv6set", [
+      "empty", `Quick, test_empty ;
+      "inclusion", `Quick, test_inclusion ;
+      "contiguous", `Quick, test_contiguous ;
+      "test_fold", `Quick, test_fold ;
+      "to_list", `Quick, test_to_list ;
+    ]
+  ]
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_peerset.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_peerset.ml
new file mode 100644
index 000000000..9fce3940d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_peerset.ml
@@ -0,0 +1,75 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test-p2p-banned_peers" end)
+
+let assert_equal_bool ~msg a b =
+  if a <> b then Alcotest.fail msg
+
+let a = fun s -> P2p_peer.Id.hash_string [s]
+
+let test_empty _ =
+  let peers = List.map a [ "foo"; "bar"; "baz" ; ] in
+  let empty = P2p_acl.PeerRing.create 10 in
+  List.iter (fun peer ->
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.PeerRing.mem empty peer)
+    ) peers
+
+let test_add _ =
+  let peers = List.map a [ "foo"; "bar"; "baz" ; ]  in
+  let set = P2p_acl.PeerRing.create 10 in
+  List.iter (fun peer -> P2p_acl.PeerRing.add set peer) peers;
+  List.iter (fun peer ->
+      assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set peer)
+    ) peers
+
+let test_remove _ =
+  let peers = List.map a [ "foo"; "bar"; "baz" ; ]  in
+  let set = P2p_acl.PeerRing.create 10 in
+  List.iter (fun peer -> P2p_acl.PeerRing.add set peer) peers;
+  assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set (a "bar"));
+  P2p_acl.PeerRing.remove set (a "bar");
+  assert_equal_bool ~msg:__LOC__ false (P2p_acl.PeerRing.mem set (a "bar"))
+
+let test_overflow _ =
+  let peers = List.map a [ "foo"; "bar"; "baz" ; ]  in
+  let set = P2p_acl.PeerRing.create 3 in
+  List.iter (fun peer -> P2p_acl.PeerRing.add set peer) peers;
+  assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set (a "baz"));
+  P2p_acl.PeerRing.add set (a "zor");
+  assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set (a "zor"));
+  assert_equal_bool ~msg:__LOC__ false (P2p_acl.PeerRing.mem set (a "foo"));
+  assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set (a "bar"));
+  assert_equal_bool ~msg:__LOC__ true (P2p_acl.PeerRing.mem set (a "baz"))
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p.peerset", [
+      "empty", `Quick, test_empty ;
+      "add", `Quick, test_add;
+      "overflow", `Quick, test_overflow;
+      "remove", `Quick, test_remove;
+    ]
+  ]
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_pool.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_pool.ml
new file mode 100644
index 000000000..f4c26453d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_pool.ml
@@ -0,0 +1,329 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test.p2p.connection-pool" end)
+
+type message =
+  | Ping
+
+let msg_config : message P2p_pool.message_config = {
+  encoding = [
+    P2p_pool.Encoding {
+      tag = 0x10 ;
+      title = "Ping" ;
+      encoding = Data_encoding.empty ;
+      wrap = (function () -> Ping) ;
+      unwrap = (function Ping -> Some ()) ;
+      max_length = None ;
+    } ;
+  ] ;
+  versions =  P2p_version.[ { name = "TEST" ; major = 0 ; minor = 0 } ] ;
+}
+
+type metadata = unit
+
+let peer_meta_config : metadata P2p_pool.peer_meta_config = {
+  peer_meta_encoding = Data_encoding.empty ;
+  peer_meta_initial = (fun _ -> ()) ;
+  score = fun () -> 0. ;
+}
+
+let conn_meta_config : metadata P2p_socket.metadata_config = {
+  conn_meta_encoding = Data_encoding.empty ;
+  conn_meta_value = (fun _ -> ()) ;
+  private_node = (fun _ -> false) ;
+}
+
+let sync ch =
+  Process.Channel.push ch () >>=? fun () ->
+  Process.Channel.pop ch >>=? fun () ->
+  return_unit
+
+let rec sync_nodes nodes =
+  iter_p
+    (fun { Process.channel } -> Process.Channel.pop channel)
+    nodes >>=? fun () ->
+  iter_p
+    (fun { Process.channel } -> Process.Channel.push channel ())
+    nodes >>=? fun () ->
+  sync_nodes nodes
+
+let sync_nodes nodes =
+  sync_nodes nodes >>= function
+  | Ok () | Error (Exn End_of_file :: _) ->
+      return_unit
+  | Error _ as err ->
+      Lwt.return err
+
+let detach_node f points n =
+  let (addr, port), points = List.select n points in
+  let proof_of_work_target = Crypto_box.make_target 0. in
+  let identity = P2p_identity.generate proof_of_work_target in
+  let nb_points = List.length points in
+  let config = P2p_pool.{
+      identity ;
+      proof_of_work_target ;
+      trusted_points = points ;
+      peers_file = "/dev/null" ;
+      private_mode = true ;
+      listening_port = Some port ;
+      min_connections = nb_points ;
+      max_connections = nb_points ;
+      max_incoming_connections = nb_points ;
+      connection_timeout = 10. ;
+      authentication_timeout = 2. ;
+      incoming_app_message_queue_size = None ;
+      incoming_message_queue_size = None ;
+      outgoing_message_queue_size = None ;
+      known_peer_ids_history_size = 100 ;
+      known_points_history_size = 100 ;
+      max_known_points = None ;
+      max_known_peer_ids = None ;
+      swap_linger = 0. ;
+      binary_chunks_size = None
+    } in
+  Process.detach
+    ~prefix:(Format.asprintf "%a: " P2p_peer.Id.pp_short identity.peer_id)
+    begin fun channel ->
+      let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in
+      P2p_pool.create
+        config peer_meta_config conn_meta_config msg_config sched >>= fun pool ->
+      P2p_welcome.create ~backlog:10 pool ~addr port >>= fun welcome ->
+      P2p_welcome.activate welcome;
+      lwt_log_info "Node ready (port: %d)" port >>= fun () ->
+      sync channel >>=? fun () ->
+      f channel pool points >>=? fun () ->
+      lwt_log_info "Shutting down..." >>= fun () ->
+      P2p_welcome.shutdown welcome >>= fun () ->
+      P2p_pool.destroy pool >>= fun () ->
+      P2p_io_scheduler.shutdown sched >>= fun () ->
+      lwt_log_info "Bye." >>= fun () ->
+      return_unit
+    end
+
+let detach_nodes run_node points =
+  let clients = List.length points in
+  Lwt_list.map_p
+    (detach_node run_node points) (0 -- (clients - 1)) >>= fun nodes ->
+  Lwt.ignore_result (sync_nodes nodes) ;
+  Process.wait_all nodes
+
+type error += Connect | Write | Read
+
+module Simple = struct
+
+  let rec connect ~timeout pool point =
+    lwt_log_info "Connect to %a" P2p_point.Id.pp point >>= fun () ->
+    P2p_pool.connect pool point ~timeout >>= function
+    | Error [P2p_errors.Connected] -> begin
+        match P2p_pool.Connection.find_by_point pool point with
+        | Some conn -> return conn
+        | None -> failwith "Woops..."
+      end
+    | Error ([ P2p_errors.Connection_refused
+             | P2p_errors.Pending_connection
+             | P2p_errors.Rejected_socket_connection
+             | Canceled
+             | Timeout
+             | P2p_errors.Rejected _ as err ]) ->
+        lwt_log_info "Connection to %a failed (%a)"
+          P2p_point.Id.pp point
+          (fun ppf err -> match err with
+             | P2p_errors.Connection_refused ->
+                 Format.fprintf ppf "connection refused"
+             | P2p_errors.Pending_connection ->
+                 Format.fprintf ppf "pending connection"
+             | P2p_errors.Rejected_socket_connection ->
+                 Format.fprintf ppf "rejected"
+             | Canceled ->
+                 Format.fprintf ppf "canceled"
+             | Timeout ->
+                 Format.fprintf ppf "timeout"
+             | P2p_errors.Rejected peer ->
+                 Format.fprintf ppf "rejected (%a)" P2p_peer.Id.pp peer
+             | _ -> assert false) err >>= fun () ->
+        Lwt_unix.sleep (0.5 +. Random.float 2.) >>= fun () ->
+        connect ~timeout pool point
+    | Ok _ | Error _ as res -> Lwt.return res
+
+  let connect_all ~timeout pool points =
+    map_p (connect ~timeout pool) points
+
+  let write_all conns msg  =
+    iter_p
+      (fun conn ->
+         trace Write @@ P2p_pool.write_sync conn msg)
+      conns
+
+  let read_all conns =
+    iter_p
+      (fun conn ->
+         trace Read @@ P2p_pool.read conn >>=? fun Ping ->
+         return_unit)
+      conns
+
+  let close_all conns =
+    Lwt_list.iter_p P2p_pool.disconnect conns
+
+  let node channel pool points =
+    connect_all ~timeout:2. pool points >>=? fun conns ->
+    lwt_log_info "Bootstrap OK" >>= fun () ->
+    sync channel >>=? fun () ->
+    write_all conns Ping >>=? fun () ->
+    lwt_log_info "Sent all messages." >>= fun () ->
+    sync channel >>=? fun () ->
+    read_all conns >>=? fun () ->
+    lwt_log_info "Read all messages." >>= fun () ->
+    sync channel >>=? fun () ->
+    close_all conns >>= fun () ->
+    lwt_log_info "All connections successfully closed." >>= fun () ->
+    return_unit
+
+  let run points = detach_nodes node points
+
+end
+
+module Random_connections = struct
+
+  let rec connect_random pool total rem point n =
+    Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () ->
+    (trace Connect @@ Simple.connect ~timeout:2. pool point) >>=? fun conn ->
+    (trace Write @@ P2p_pool.write conn Ping) >>= fun _ ->
+    (trace Read @@ P2p_pool.read conn) >>=? fun Ping ->
+    Lwt_unix.sleep (0.2 +. Random.float 1.0) >>= fun () ->
+    P2p_pool.disconnect conn >>= fun () ->
+    begin
+      decr rem ;
+      if !rem mod total = 0 then
+        lwt_log_info "Remaining: %d." (!rem / total)
+      else
+        Lwt.return_unit
+    end >>= fun () ->
+    if n > 1 then
+      connect_random pool total rem point (pred n)
+    else
+      return_unit
+
+  let connect_random_all pool points n =
+    let total = List.length points in
+    let rem = ref (n * total) in
+    iter_p (fun point -> connect_random pool total rem point n) points
+
+  let node repeat _channel pool points =
+    lwt_log_info "Begin random connections." >>= fun () ->
+    connect_random_all pool points repeat >>=? fun () ->
+    lwt_log_info "Random connections OK." >>= fun () ->
+    return_unit
+
+  let run points repeat = detach_nodes (node repeat) points
+
+end
+
+module Garbled = struct
+
+  let is_connection_closed = function
+    | Error ((Write | Read) :: P2p_errors.Connection_closed :: _) -> true
+    | Ok _ -> false
+    | Error err ->
+        log_info "Unexpected error: %a" pp_print_error err ;
+        false
+
+  let write_bad_all conns =
+    let bad_msg = MBytes.of_string (String.make 16 '\000') in
+    iter_p
+      (fun conn ->
+         trace Write @@ P2p_pool.raw_write_sync conn bad_msg)
+      conns
+
+  let node ch pool points =
+    Simple.connect_all ~timeout:2. pool points >>=? fun conns ->
+    sync ch >>=? fun () ->
+    begin
+      write_bad_all conns >>=? fun () ->
+      Simple.read_all conns
+    end >>= fun err ->
+    _assert (is_connection_closed err) __LOC__ ""
+
+  let run points = detach_nodes node points
+
+end
+
+let () = Random.self_init ()
+
+let addr = ref Ipaddr.V6.localhost
+let port = ref (1024 + Random.int 8192)
+let clients = ref 10
+let repeat_connections = ref 5
+
+let spec = Arg.[
+
+    "--port", Int (fun p -> port := p), " Listening port of the first peer.";
+
+    "--addr", String (fun p -> addr := Ipaddr.V6.of_string_exn p),
+    " Listening addr";
+
+    "--clients", Set_int clients,  " Number of concurrent clients." ;
+
+    "--repeat", Set_int repeat_connections,
+    " Number of connections/disconnections." ;
+
+
+    "-v", Unit (fun () ->
+        Lwt_log_core.(add_rule "test.p2p.connection-pool" Info) ;
+        Lwt_log_core.(add_rule "p2p.connection-pool" Info)),
+    " Log up to info msgs" ;
+
+    "-vv", Unit (fun () ->
+        Lwt_log_core.(add_rule "test.p2p.connection-pool" Debug) ;
+        Lwt_log_core.(add_rule "p2p.connection-pool" Debug)),
+    " Log up to debug msgs";
+
+  ]
+
+let wrap n f =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let main () =
+  let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
+  let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
+  Arg.parse spec anon_fun usage_msg ;
+  let ports = !port -- (!port + !clients - 1) in
+  let points = List.map (fun port -> !addr, port) ports in
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p-connection-pool", [
+      wrap "simple" (fun _ -> Simple.run points) ;
+      wrap "random" (fun _ -> Random_connections.run points !repeat_connections) ;
+      wrap "garbled" (fun _ -> Garbled.run points) ;
+    ]
+  ]
+let () =
+  Sys.catch_break true ;
+  try main ()
+  with _ -> ()
diff --git a/vendors/tezos-modded/src/lib_p2p/test/test_p2p_socket.ml b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_socket.ml
new file mode 100644
index 000000000..54bcd06be
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/test/test_p2p_socket.ml
@@ -0,0 +1,464 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make (struct let name = "test.p2p.connection" end)
+
+let addr = ref Ipaddr.V6.localhost
+
+let canceler = Lwt_canceler.create () (* unused *)
+
+let proof_of_work_target = Crypto_box.make_target 16.
+let id1 = P2p_identity.generate proof_of_work_target
+let id2 = P2p_identity.generate proof_of_work_target
+
+let id0 =
+  (* Luckilly, this will be an insuficient proof of work! *)
+  P2p_identity.generate (Crypto_box.make_target 0.)
+
+let versions = P2p_version.[{ name = "TEST" ; minor = 0 ; major = 0 }]
+
+type metadata = unit
+let conn_meta_config : metadata P2p_socket.metadata_config = {
+  conn_meta_encoding = Data_encoding.empty ;
+  conn_meta_value = (fun _ -> ()) ;
+  private_node = (fun _ -> false) ;
+}
+
+let rec listen ?port addr =
+  let tentative_port =
+    match port with
+    | None -> 1024 + Random.int 8192
+    | Some port -> port in
+  let uaddr = Ipaddr_unix.V6.to_inet_addr addr in
+  let main_socket = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+  Lwt_unix.(setsockopt main_socket SO_REUSEADDR true) ;
+  Lwt.catch begin fun () ->
+    Lwt_unix.bind main_socket
+      (ADDR_INET (uaddr, tentative_port)) >>= fun () ->
+    Lwt_unix.listen main_socket 1 ;
+    Lwt.return (main_socket, tentative_port)
+  end begin function
+    | Unix.Unix_error
+        ((Unix.EADDRINUSE | Unix.EADDRNOTAVAIL), _, _) when port = None ->
+        listen addr
+    | exn -> Lwt.fail exn
+  end
+
+let sync ch =
+  Process.Channel.push ch () >>=? fun () ->
+  Process.Channel.pop ch >>=? fun () ->
+  return_unit
+
+let rec sync_nodes nodes =
+  iter_p
+    (fun { Process.channel } -> Process.Channel.pop channel)
+    nodes >>=? fun () ->
+  iter_p
+    (fun { Process.channel } -> Process.Channel.push channel ())
+    nodes >>=? fun () ->
+  sync_nodes nodes
+
+let sync_nodes nodes =
+  sync_nodes nodes >>= function
+  | Ok () | Error (Exn End_of_file :: _) ->
+      return_unit
+  | Error _ as err ->
+      Lwt.return err
+
+let run_nodes client server =
+  listen !addr >>= fun (main_socket, port) ->
+  Process.detach ~prefix:"server: " begin fun channel ->
+    let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in
+    server channel sched main_socket >>=? fun () ->
+    P2p_io_scheduler.shutdown sched >>= fun () ->
+    return_unit
+  end >>= fun server_node ->
+  Process.detach ~prefix:"client: " begin fun channel ->
+    Lwt_utils_unix.safe_close main_socket >>= fun () ->
+    let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in
+    client channel sched !addr port >>=? fun () ->
+    P2p_io_scheduler.shutdown sched >>= fun () ->
+    return_unit
+  end >>= fun client_node ->
+  let nodes = [ server_node ; client_node ] in
+  Lwt.ignore_result (sync_nodes nodes) ;
+  Process.wait_all nodes
+
+let raw_accept sched main_socket =
+  P2p_fd.accept main_socket >>= fun (fd, sockaddr) ->
+  let fd = P2p_io_scheduler.register sched fd in
+  let point =
+    match sockaddr with
+    | Lwt_unix.ADDR_UNIX _ -> assert false
+    | Lwt_unix.ADDR_INET (addr, port) ->
+        Ipaddr_unix.V6.of_inet_addr_exn addr, port in
+  Lwt.return (fd, point)
+
+let accept sched main_socket =
+  raw_accept sched main_socket >>= fun (fd, point) ->
+  P2p_socket.authenticate
+    ~canceler
+    ~proof_of_work_target
+    ~incoming:true fd point id1 versions
+    conn_meta_config
+
+let raw_connect sched addr port =
+  let fd = P2p_fd.socket PF_INET6 SOCK_STREAM 0 in
+  let uaddr =
+    Lwt_unix.ADDR_INET (Ipaddr_unix.V6.to_inet_addr addr, port) in
+  P2p_fd.connect fd uaddr >>= fun () ->
+  let fd = P2p_io_scheduler.register sched fd in
+  Lwt.return fd
+
+let connect sched addr port id =
+  raw_connect sched addr port >>= fun fd ->
+  P2p_socket.authenticate
+    ~canceler
+    ~proof_of_work_target
+    ~incoming:false fd
+    (addr, port) id versions conn_meta_config >>=? fun (info, auth_fd) ->
+  _assert (not info.incoming) __LOC__ "" >>=? fun () ->
+  _assert (P2p_peer.Id.compare info.peer_id id1.peer_id = 0)
+    __LOC__ "" >>=? fun () ->
+  return auth_fd
+
+let is_connection_closed = function
+  | Error [P2p_errors.Connection_closed] -> true
+  | Ok _ -> false
+  | Error err ->
+      log_notice "Error: %a" pp_print_error err ;
+      false
+
+let is_decoding_error = function
+  | Error [P2p_errors.Decoding_error] -> true
+  | Ok _ -> false
+  | Error err ->
+      log_notice "Error: %a" pp_print_error err ;
+      false
+
+module Low_level = struct
+
+  let simple_msg = Rand.generate (1 lsl 4)
+
+  let client _ch sched addr port =
+    let msg = MBytes.create (MBytes.length simple_msg) in
+    raw_connect sched addr port >>= fun fd ->
+    P2p_io_scheduler.read_full fd msg >>=? fun () ->
+    _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
+    P2p_io_scheduler.close fd >>=? fun () ->
+    return_unit
+
+  let server _ch sched socket =
+    raw_accept sched socket >>= fun (fd, _point) ->
+    P2p_io_scheduler.write fd simple_msg >>=? fun () ->
+    P2p_io_scheduler.close fd >>=? fun _ ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Kick = struct
+
+  let encoding = Data_encoding.bytes
+
+  let is_rejected = function
+    | Error [P2p_errors.Rejected_socket_connection] -> true
+    | Ok _ -> false
+    | Error err ->
+        log_notice "Error: %a" pp_print_error err ;
+        false
+
+  let server _ch sched socket =
+    accept sched socket >>=? fun (info, auth_fd) ->
+    _assert (info.incoming) __LOC__ "" >>=? fun () ->
+    _assert (P2p_peer.Id.compare info.peer_id id2.peer_id = 0)
+      __LOC__ "" >>=? fun () ->
+    P2p_socket.kick auth_fd >>= fun () ->
+    return_unit
+
+  let client _ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>= fun conn ->
+    _assert (is_rejected conn) __LOC__ "" >>=? fun () ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Kicked = struct
+
+  let encoding = Data_encoding.bytes
+
+  let server _ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>= fun conn ->
+    _assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () ->
+    return_unit
+
+  let client _ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.kick auth_fd >>= fun () ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Simple_message = struct
+
+  let encoding = Data_encoding.bytes
+
+  let simple_msg = Rand.generate (1 lsl 4)
+  let simple_msg2 = Rand.generate (1 lsl 4)
+
+  let server ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let client ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Chunked_message = struct
+
+  let encoding = Data_encoding.bytes
+
+  let simple_msg = Rand.generate (1 lsl 8)
+  let simple_msg2 = Rand.generate (1 lsl 8)
+
+  let server ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept
+      ~canceler
+      ~binary_chunks_size:21 auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let client ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept
+      ~canceler
+      ~binary_chunks_size:21 auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Oversized_message = struct
+
+  let encoding = Data_encoding.bytes
+
+  let simple_msg = Rand.generate (1 lsl 17)
+  let simple_msg2 = Rand.generate (1 lsl 17)
+
+  let server ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let client ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
+    P2p_socket.read conn >>=? fun (_msg_size, msg) ->
+    _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Close_on_read = struct
+
+  let encoding = Data_encoding.bytes
+
+  let simple_msg = Rand.generate (1 lsl 4)
+
+  let server ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    sync ch >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let client ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    sync ch >>=? fun () ->
+    P2p_socket.read conn >>= fun err ->
+    _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Close_on_write = struct
+
+  let encoding = Data_encoding.bytes
+
+  let simple_msg = Rand.generate (1 lsl 4)
+
+  let server ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.close conn >>= fun _stat ->
+    sync ch >>=? fun ()->
+    return_unit
+
+  let client ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    sync ch >>=? fun ()->
+    Lwt_unix.sleep 0.1 >>= fun () ->
+    P2p_socket.write_sync conn simple_msg >>= fun err ->
+    _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+module Garbled_data = struct
+
+  let encoding =
+    let open Data_encoding in
+    dynamic_size @@ option @@ string
+
+  (* generate a fixed garbled_msg to avoid 'Data_encoding.Binary.Await
+     _', which blocks 'make test' *)
+  let garbled_msg =
+    let buf = MBytes.create (1 lsl 4) in
+    MBytes.set_int32 buf 0 (Int32.of_int 4);
+    MBytes.set_int32 buf 4 (Int32.of_int (-1));
+    MBytes.set_int32 buf 8 (Int32.of_int (-1));
+    MBytes.set_int32 buf 12 (Int32.of_int (-1));
+    buf
+
+  let server _ch sched socket =
+    accept sched socket >>=? fun (_info, auth_fd) ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.raw_write_sync conn garbled_msg >>=? fun () ->
+    P2p_socket.read conn >>= fun err ->
+    _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let client _ch sched addr port =
+    connect sched addr port id2 >>=? fun auth_fd ->
+    P2p_socket.accept ~canceler auth_fd encoding >>=? fun conn ->
+    P2p_socket.read conn >>= fun err ->
+    _assert (is_decoding_error err) __LOC__ "" >>=? fun () ->
+    P2p_socket.close conn >>= fun _stat ->
+    return_unit
+
+  let run _dir = run_nodes client server
+
+end
+
+let spec = Arg.[
+
+    "--addr", String (fun p -> addr := Ipaddr.V6.of_string_exn p),
+    " Listening addr";
+
+    "-v", Unit (fun () ->
+        Lwt_log_core.(add_rule "test.p2p.connection" Info) ;
+        Lwt_log_core.(add_rule "p2p.connection" Info)),
+    " Log up to info msgs" ;
+
+    "-vv", Unit (fun () ->
+        Lwt_log_core.(add_rule "test.p2p.connection" Debug) ;
+        Lwt_log_core.(add_rule "p2p.connection" Debug)),
+    " Log up to debug msgs";
+
+  ]
+
+let wrap n f =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let main () =
+  let anon_fun _num_peers = raise (Arg.Bad "No anonymous argument.") in
+  let usage_msg = "Usage: %s.\nArguments are:" in
+  Arg.parse spec anon_fun usage_msg ;
+  Alcotest.run ~argv:[|""|] "tezos-p2p" [
+    "p2p-connection.", [
+      wrap "low-level" Low_level.run ;
+      wrap "kick" Kick.run ;
+      wrap "kicked" Kicked.run ;
+      wrap "simple-message" Simple_message.run ;
+      wrap "chunked-message" Chunked_message.run ;
+      wrap "oversized-message" Oversized_message.run ;
+      wrap "close-on-read" Close_on_read.run ;
+      wrap "close-on-write" Close_on_write.run ;
+      wrap "garbled-data" Garbled_data.run ;
+    ]
+  ]
+
+let () =
+  Sys.catch_break true ;
+  try main ()
+  with _ -> ()
diff --git a/vendors/tezos-modded/src/lib_p2p/tezos-p2p.opam b/vendors/tezos-modded/src/lib_p2p/tezos-p2p.opam
new file mode 100644
index 000000000..65fa125f4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_p2p/tezos-p2p.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-stdlib-unix"
+  "tezos-shell-services"
+  "alcotest-lwt" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/byte.ml b/vendors/tezos-modded/src/lib_protocol_compiler/byte.ml
new file mode 100644
index 000000000..c8382ee5d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/byte.ml
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The OCaml compiler not being implemented with Lwt, the compilation
+    take place in a separated process (by using [Lwt_process.exec]).
+
+    The [main] function is the entry point for the forked process.
+    While [Updater.compile] is the 'forking' function to be called by
+    the [tezos-node] process.
+
+*)
+
+(** Semi-generic compilation functions *)
+
+let pack_objects output objects =
+  let output = output ^ ".cmo" in
+  Compmisc.init_path true;
+  Bytepackager.package_files
+    Format.err_formatter Env.initial_safe_string objects output ;
+  Warnings.check_fatal () ;
+  output
+
+let link_shared output objects =
+  Compenv.(readenv Format.err_formatter Before_link) ;
+  Compmisc.init_path true;
+  Bytelink.link Format.err_formatter objects output ;
+  Warnings.check_fatal ()
+
+let compile_ml ?for_pack ml =
+  let target = Filename.chop_extension ml in
+  Clflags.for_package := for_pack ;
+  Compenv.(readenv Format.err_formatter (Before_compile ml));
+  Compile.implementation Format.err_formatter ml target ;
+  Clflags.for_package := None ;
+  target ^ ".cmo"
+
+let () =
+  Clflags.native_code := false
+
+let driver = Compiler.{ compile_ml ; link_shared ; pack_objects }
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/byte.mli b/vendors/tezos-modded/src/lib_protocol_compiler/byte.mli
new file mode 100644
index 000000000..ab47182b4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/byte.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 driver: Compiler.driver
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/compiler.ml b/vendors/tezos-modded/src/lib_protocol_compiler/compiler.ml
new file mode 100644
index 000000000..8623165fc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/compiler.ml
@@ -0,0 +1,283 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 warnings = "+a-4-6-7-9-29-40..42-44-45-48"
+let warn_error = "-a+8"
+
+let () =
+  Clflags.unsafe_string := false
+
+(** Override the default 'Env.Persistent_signature.load'
+    with a lookup in locally defined hashtable.
+*)
+
+let preloaded_cmis : (string, Env.Persistent_signature.t) Hashtbl.t =
+  Hashtbl.create ~random:true 42
+
+(* Set hook *)
+let () =
+  Env.Persistent_signature.load :=
+    (fun ~unit_name ->
+       try Some (Hashtbl.find preloaded_cmis (String.capitalize_ascii unit_name))
+       with Not_found -> None)
+
+let load_cmi_from_file file =
+  Hashtbl.add preloaded_cmis
+    (String.capitalize_ascii Filename.(basename (chop_extension file)))
+    { filename = file ;
+      cmi = Cmi_format.read_cmi file ;
+    }
+
+let load_embeded_cmi (unit_name, content) =
+  let content = Bytes.of_string content in
+  (* Read cmi magic *)
+  let magic_len = String.length Config.cmi_magic_number in
+  let magic = Bytes.sub content 0 magic_len in
+  assert (magic = Bytes.of_string Config.cmi_magic_number) ;
+  (* Read cmi_name and cmi_sign *)
+  let pos = magic_len in
+  let (cmi_name, cmi_sign) = Marshal.from_bytes content pos in
+  let pos = pos + Marshal.total_size content pos in
+  (* Read cmi_crcs *)
+  let cmi_crcs = Marshal.from_bytes content pos in
+  let pos = pos + Marshal.total_size content pos  in
+  (* Read cmi_flags *)
+  let cmi_flags = Marshal.from_bytes content pos in
+  (* TODO check crcrs... *)
+  Hashtbl.add
+    preloaded_cmis
+    (String.capitalize_ascii unit_name)
+    { filename  =  unit_name ^ ".cmi" ;
+      cmi = { cmi_name; cmi_sign; cmi_crcs; cmi_flags } ;
+    }
+
+let load_embeded_cmis cmis = List.iter load_embeded_cmi cmis
+
+(** Compilation environment.
+
+    [tezos_protocol_env] defines the list of [cmi] available while compiling
+    the protocol version. The [cmi] are packed into the [tezos-node]
+    binary by using [ocp-ocamlres], see the Makefile.
+
+    [register_env] defines a complementary list of [cmi] available
+    while compiling the generated [register.ml] file (that register
+    the protocol first-class module into the [Updater.versions]
+    hashtable).
+
+*)
+
+
+let tezos_protocol_env =
+  let open Embedded_cmis in
+  [
+    "CamlinternalFormatBasics", camlinternalFormatBasics_cmi ;
+    "Tezos_protocol_environment_sigs", tezos_protocol_environment_sigs_cmi ;
+    "Tezos_protocol_environment_sigs__V1", tezos_protocol_environment_sigs__V1_cmi ;
+  ]
+
+let register_env =
+  let open Embedded_cmis in
+  [
+    "tezos_protocol_registerer__Registerer", tezos_protocol_registerer__Registerer_cmi ;
+  ]
+
+
+(** Helpers *)
+
+let (//) = Filename.concat
+
+let create_file ?(perm = 0o644) name content =
+  let open Unix in
+  let fd = openfile name [O_TRUNC; O_CREAT; O_WRONLY] perm in
+  ignore(write_substring fd content 0 (String.length content));
+  close fd
+
+let safe_unlink file =
+  try Unix.unlink file
+  with Unix.Unix_error(Unix.ENOENT, _, _) -> ()
+
+let unlink_cmi dir (file, _) =
+  safe_unlink (dir // file ^ ".cmi")
+
+let unlink_object obj =
+  safe_unlink obj;
+  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".cmi");
+  safe_unlink (Filename.chop_suffix obj ".cmx" ^ ".o")
+
+let debug_flag = ref false
+
+let debug fmt =
+  if !debug_flag then Format.eprintf fmt
+  else Format.ifprintf Format.err_formatter fmt
+
+let mktemp_dir () =
+  Filename.get_temp_dir_name () //
+  Printf.sprintf "tezos-protocol-build-%06X" (Random.int 0xFFFFFF)
+
+(** Main *)
+
+type driver = {
+  compile_ml: ?for_pack:string -> string -> string ;
+  pack_objects: string -> string list -> string ;
+  link_shared: string -> string list -> unit ;
+}
+
+let main { compile_ml ; pack_objects ; link_shared } =
+  Random.self_init () ;
+  let anonymous = ref []
+  and static = ref false
+  and register = ref false
+  and build_dir = ref None
+  and output_file = ref None
+  and output_dep = ref false
+  and hash_only = ref false
+  and check_protocol_hash = ref true in
+  let args_spec = [
+    "-o", Arg.String (fun s -> output_file := Some s), "" ;
+    "-hash-only", Arg.Set hash_only, " Only display the hash of the protocol and don't compile" ;
+    "-no-hash-check", Arg.Clear check_protocol_hash, " Don't check that TEZOS_PROTOCOL declares the expected protocol hash (if existent)" ;
+    "-static", Arg.Set static, " Only build the static library (no .cmxs)" ;
+    "-register", Arg.Set register, " Generate the `Registerer` module" ;
+    "-bin-annot", Arg.Set Clflags.binary_annotations, " (see ocamlopt)" ;
+    "-g", Arg.Set Clflags.debug, " (see ocamlopt)" ;
+    "-output-dep", Arg.Set output_dep, " ..." ;
+    "-build-dir", Arg.String (fun s -> build_dir := Some s),
+    "use custom build directory and preserve build artifacts"
+  ] in
+  let usage_msg =
+    Printf.sprintf
+      "Usage: %s [options] <srcdir>\nOptions are:"
+      Sys.argv.(0) in
+  Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ;
+  let source_dir =
+    match List.rev !anonymous with
+    | [ protocol_dir ] -> protocol_dir
+    | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in
+  let announced_hash, protocol =
+    match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with
+    | Ok (hash, proto) -> (hash, proto)
+    | Error err ->
+        Format.eprintf
+          "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err ;
+        exit 2 in
+  let real_hash = Protocol.hash protocol in
+  if !hash_only then begin
+    Format.printf "%a@." Protocol_hash.pp real_hash ;
+    exit 0 ;
+  end ;
+  let hash =
+    match announced_hash with
+    | None -> real_hash
+    | Some hash
+      when !check_protocol_hash && not (Protocol_hash.equal real_hash hash) ->
+        Format.eprintf
+          "Inconsistent hash for protocol in TEZOS_PROTOCOL.@\n\
+           Found: %a@\n\
+           Expected: %a@."
+          Protocol_hash.pp hash
+          Protocol_hash.pp real_hash ;
+        exit 2
+    | Some hash -> hash in
+  let build_dir =
+    match !build_dir with
+    | None ->
+        let dir = mktemp_dir () in
+        at_exit (fun () -> Lwt_main.run (Lwt_utils_unix.remove_dir dir)) ;
+        dir
+    | Some dir -> dir in
+  let output =
+    match !output_file with
+    | Some output -> output
+    | None -> Format.asprintf "proto_%a" Protocol_hash.pp hash in
+  Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 build_dir) ;
+  Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 (Filename.dirname output)) ;
+  (* Generate the 'functor' *)
+  let functor_file = build_dir // "functor.ml" in
+  let oc = open_out functor_file in
+  Packer.dump oc hash
+    (Array.map
+       begin fun { Protocol.name }  ->
+         let name_lowercase = String.uncapitalize_ascii name in
+         source_dir // name_lowercase ^ ".ml"
+       end
+       (Array.of_list protocol.components)) ;
+  close_out oc ;
+  (* Compile the protocol *)
+  let proto_cmi = Filename.chop_extension functor_file ^ ".cmi" in
+  let functor_unit =
+    String.capitalize_ascii
+      Filename.(basename (chop_extension functor_file)) in
+  let for_pack = String.capitalize_ascii (Filename.basename output) in
+  (* Initialize the compilers *)
+  Compenv.(readenv Format.err_formatter Before_args);
+  Clflags.nopervasives := true;
+  Clflags.no_std_include := true ;
+  Clflags.include_dirs := [Filename.dirname functor_file] ;
+  Warnings.parse_options false warnings ;
+  Warnings.parse_options true warn_error ;
+
+  load_embeded_cmis tezos_protocol_env ;
+  let packed_protocol_object = compile_ml ~for_pack functor_file in
+
+  let register_objects =
+    if not !register then
+      []
+    else begin
+      load_embeded_cmis register_env ;
+      load_cmi_from_file proto_cmi ;
+      (* Compiler the 'registering module' *)
+      let register_file = Filename.dirname functor_file // "register.ml" in
+      create_file register_file
+        (Printf.sprintf
+           "module Name = struct let name = %S end\n\
+           \ let () = Tezos_protocol_registerer__Registerer.register Name.name (module %s.Make)"
+           (Protocol_hash.to_b58check hash)
+           functor_unit) ;
+      let register_object = compile_ml ~for_pack register_file in
+      [ register_object ]
+    end
+  in
+
+  let resulting_object =
+    pack_objects output (packed_protocol_object :: register_objects) in
+
+  (* Create the final [cmxs] *)
+  if not !static then begin
+    Clflags.link_everything := true ;
+    link_shared (output ^ ".cmxs") [resulting_object] ;
+  end ;
+
+  if !output_dep then begin
+    let dsrc = Digest.file functor_file in
+    let dimpl = Digest.file resulting_object in
+    let dintf = Digest.file (Filename.chop_extension resulting_object ^ ".cmi") in
+    Format.printf "module Toto = struct include %s end ;; \n" for_pack ;
+    Format.printf "let src_digest = %S ;;\n" (Digest.to_hex dsrc) ;
+    Format.printf "let impl_digest = %S ;;\n" (Digest.to_hex dimpl) ;
+    Format.printf "let intf_digest = %S ;;\n" (Digest.to_hex dintf)
+  end ;
+
+  Format.printf "Success: %a.@." Protocol_hash.pp hash
+
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/dune b/vendors/tezos-modded/src/lib_protocol_compiler/dune
new file mode 100644
index 000000000..182cb4038
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/dune
@@ -0,0 +1,138 @@
+(rule
+ (targets embedded_cmis.ml)
+ (action
+  (run %{bin:ocp-ocamlres} -format ocaml -o %{targets}
+       %{lib:stdlib:camlinternalFormatBasics.cmi}
+       %{dep:.tezos_protocol_registerer.objs/tezos_protocol_registerer__Registerer.cmi}
+       %{lib:tezos-protocol-environment-sigs:tezos_protocol_environment_sigs.cmi}
+       %{lib:tezos-protocol-environment-sigs:tezos_protocol_environment_sigs__V1.cmi})))
+
+(library
+ (name tezos_protocol_registerer)
+ (public_name tezos-protocol-compiler.registerer)
+ (libraries tezos-base
+            tezos-protocol-environment-sigs)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -opaque
+                   -open Tezos_base__TzPervasives))
+ (modules Registerer))
+
+(library
+ (name tezos_protocol_compiler)
+ (public_name tezos-protocol-compiler)
+ (libraries tezos-base
+            tezos-protocol-environment-sigs
+            tezos-stdlib-unix
+            compiler-libs.common
+            lwt.unix
+            ocplib-endian
+            ocplib-ocamlres
+            unix)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix))
+ (modules Embedded_cmis Packer Compiler))
+
+(library
+ (name tezos_protocol_compiler_byte)
+ (public_name tezos-protocol-compiler.byte)
+ (libraries tezos-base
+            tezos-protocol-compiler
+            compiler-libs.bytecomp)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_protocol_compiler))
+ (modules Byte))
+
+(library
+ (name tezos_protocol_compiler_native)
+ (public_name tezos-protocol-compiler.native)
+ (libraries tezos-base
+            tezos-protocol-compiler
+            compiler-libs.optcomp)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_protocol_compiler))
+ (modules Native))
+
+(executable
+ (name main_byte)
+ (public_name tezos-protocol-compiler-byte)
+ (modes native)
+ (libraries tezos_protocol_compiler_byte)
+ (flags (:standard -linkall))
+ (modules Main_byte))
+
+(executable
+ (name main_native)
+ (public_name tezos-protocol-compiler)
+ (modes native)
+ (libraries tezos_protocol_compiler_native)
+ (flags (:standard -linkall))
+ (modules Main_native))
+
+(executable
+ (name main_packer)
+ (public_name tezos-protocol-compiler.tezos-protocol-packer)
+ (libraries tezos-base
+            tezos-protocol-compiler
+            tezos-stdlib-unix)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_protocol_compiler))
+ (modules Main_packer))
+
+(executable
+ (name main_embedded_packer)
+ (public_name tezos-embedded-protocol-packer)
+ (modes native)
+ (libraries tezos-base
+            tezos-stdlib-unix)
+ (flags (:standard -linkall
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix))
+ (modules Main_embedded_packer))
+
+(executable
+ (name replace)
+ (libraries tezos-base tezos-stdlib-unix str)
+ (flags (:standard -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix))
+ (modules Replace))
+
+(install
+ (section share)
+ (files jbuild_protocol_template
+        jbuild_embedded_protocol_template))
+
+(install
+ (section libexec)
+ (files (replace.exe as replace)
+        dune_protocol
+        dune_protocol.template))
+
+(alias
+ (name runtest_indent)
+ ;; we would like (deps ((glob_files *.ml \ embedded_cmis.ml)))
+ ;; meanwhile, we hardcode the module list
+ (deps "embedded_cmis.mli"
+       "main_embedded_packer.ml"
+       "main_embedded_packer.mli"
+       "main_byte.ml"
+       "main_native.ml"
+       "native.ml"
+       "native.mli"
+       "byte.ml"
+       "byte.mli"
+       "packer.ml"
+       "packer.mli"
+       "registerer.ml"
+       "registerer.mli"
+       )
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol b/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol
new file mode 100644
index 000000000..8d24dd8cb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol
@@ -0,0 +1,19 @@
+
+(include dune.inc)
+
+(rule
+ (targets "dune.inc.gen")
+ (deps TEZOS_PROTOCOL (glob_files *.ml) (glob_files *.mli))
+ (action
+  (run
+    %{libexec:tezos-protocol-compiler:replace}
+    %{libexec:tezos-protocol-compiler:dune_protocol.template}
+    "dune.inc.gen")))
+
+(alias
+ (name   runtest_dune_template)
+ (action (diff dune.inc dune.inc.gen)))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_dune_template)))
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol.template b/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol.template
new file mode 100644
index 000000000..7e7d5e8e5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/dune_protocol.template
@@ -0,0 +1,70 @@
+
+(rule
+ (targets environment.ml)
+ (action
+  (write-file %{targets}
+              "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"%%VERSION%%\" end)()
+      module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
+")))
+
+(rule
+ (targets registerer.ml)
+ (deps tezos_embedded_protocol_environment_%%LIB_VERSION%%.cmxa
+       (:src_dir TEZOS_PROTOCOL))
+ (action
+  (with-stdout-to %{targets}
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "%%LIB_VERSION%%")))))
+
+
+(rule
+ (targets functor.ml)
+ (deps %%SOURCES%%
+       (:src_dir TEZOS_PROTOCOL))
+ (action (with-stdout-to %{targets}
+                         (chdir %{workspace_root}
+                                (run %{bin:tezos-protocol-compiler.tezos-protocol-packer} %{src_dir})))))
+
+(library
+ (name tezos_protocol_%%LIB_VERSION%%)
+ (public_name tezos-protocol-%%VERSION%%)
+ (libraries tezos-protocol-environment-sigs)
+ (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
+        -warn-error "-a+8"
+        -safe-string -nopervasives)
+ (modules Functor))
+
+(library
+ (name tezos_embedded_protocol_environment_%%LIB_VERSION%%)
+ (public_name tezos-embedded-protocol-%%VERSION%%.environment)
+ (library_flags (:standard -linkall))
+ (libraries tezos-protocol-environment-shell)
+ (modules Environment))
+
+(library
+ (name tezos_embedded_raw_protocol_%%LIB_VERSION%%)
+ (public_name tezos-embedded-protocol-%%VERSION%%.raw)
+ (libraries tezos_embedded_protocol_environment_%%LIB_VERSION%%)
+ (library_flags (:standard -linkall))
+ (flags (:standard -nopervasives -nostdlib -safe-string
+                   -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8
+                   -open Tezos_embedded_protocol_environment_%%LIB_VERSION%%__Environment
+                   -open Pervasives
+                   -open Error_monad))
+ (modules %%MODULES%%))
+
+(library
+ (name tezos_embedded_protocol_%%LIB_VERSION%%)
+ (public_name tezos-embedded-protocol-%%VERSION%%)
+ (library_flags (:standard -linkall))
+ (libraries tezos_embedded_raw_protocol_%%LIB_VERSION%%
+            tezos-protocol-updater
+            tezos-protocol-environment-shell)
+ (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8))
+ (modules Registerer))
+
+(alias
+ (name runtest_sandbox)
+ (deps .tezos_protocol_%%LIB_VERSION%%.objs/tezos_protocol_%%LIB_VERSION%%.cmx))
+
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/embedded_cmis.mli b/vendors/tezos-modded/src/lib_protocol_compiler/embedded_cmis.mli
new file mode 100644
index 000000000..a4759b727
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/embedded_cmis.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 camlinternalFormatBasics_cmi: string
+val tezos_protocol_environment_sigs_cmi: string
+val tezos_protocol_environment_sigs__V1_cmi: string
+val tezos_protocol_registerer__Registerer_cmi: string
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_embedded_protocol_template b/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_embedded_protocol_template
new file mode 100644
index 000000000..7d5eebb82
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_embedded_protocol_template
@@ -0,0 +1,71 @@
+(* -*- tuareg -*- *)
+
+let prefix = "proto_"
+let dirname = Filename.basename @@ Filename.dirname @@ Filename.dirname @@ Sys.getcwd ()
+
+let predefined_version = None (* to be substituted in opam packages *)
+
+let lib_version =
+  match predefined_version with
+  | Some version -> version
+  | None ->
+    let x = String.length prefix in
+    let n = String.length dirname in
+    if not (n >= x && String.sub dirname 0 x = prefix) then
+      failwith "unexpected directory name" ;
+    String.sub dirname x (n - x)
+
+let version = String.concat "-" (String.split_on_char '_' lib_version)
+
+let () = Format.kasprintf Jbuild_plugin.V1.send {|
+
+(rule
+ (targets environment.ml)
+ (action
+  (write-file %%{targets}
+              "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"%s\" end)()
+      module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
+")))
+
+(rule
+ (targets registerer.ml)
+ (deps tezos_embedded_protocol_environment_%s.cmxa
+       (:src_dir TEZOS_PROTOCOL))
+ (action
+  (with-stdout-to %%{targets}
+                  (chdir %%{workspace_root} (run %%{bin:tezos-embedded-protocol-packer} "%%{src_dir}" "%s")))))
+
+(library
+ (name tezos_embedded_protocol_environment_%s)
+ (public_name tezos-embedded-protocol-%s.environment)
+ (library_flags (:standard -linkall))
+ (libraries tezos-protocol-environment-shell)
+ (modules Environment))
+
+(library
+ (name tezos_embedded_raw_protocol_%s)
+ (public_name tezos-embedded-protocol-%s.raw)
+ (libraries tezos_embedded_protocol_environment_%s)
+ (library_flags (:standard -linkall))
+ (flags (:standard -nopervasives -nostdlib -safe-string
+                   -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8
+                   -open Tezos_embedded_protocol_environment_%s__Environment
+                   -open Pervasives
+                   -open Error_monad))
+ (modules :standard \ Environment Registerer))
+
+(library
+ (name tezos_embedded_protocol_%s)
+ (public_name tezos-embedded-protocol-%s)
+ (library_flags (:standard -linkall))
+ (libraries tezos_embedded_raw_protocol_%s
+            tezos-protocol-updater
+            tezos-protocol-environment-shell)
+ (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8))
+ (modules Registerer))
+|}
+    version lib_version lib_version lib_version
+    version lib_version version lib_version
+    lib_version lib_version version lib_version
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_protocol_template b/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_protocol_template
new file mode 100644
index 000000000..ae9a6c2d8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/jbuild_protocol_template
@@ -0,0 +1,61 @@
+(* -*- tuareg -*- *)
+
+let prefix = "proto_"
+let dirname = Filename.basename @@ Filename.dirname @@ Sys.getcwd ()
+
+let predefined_version = None (* to be substituted in opam packages *)
+
+let lib_version =
+  match predefined_version with
+  | Some version -> version
+  | None ->
+    let x = String.length prefix in
+    let n = String.length dirname in
+    if not (n >= x && String.sub dirname 0 x = prefix) then
+      failwith "unexpected directory name" ;
+    String.sub dirname x (n - x)
+
+let version = String.concat "-" (String.split_on_char '_' lib_version)
+
+let path =
+  match predefined_version with
+  | None -> "src/proto_" ^ version ^ "/lib_protocol"
+  | Some _ -> "."
+
+let sources =
+  Format.kasprintf
+    Jbuild_plugin.V1.run_and_read_lines
+    "find src -name \\*.ml -or -name \\*.mli"
+
+let () = Format.kasprintf Jbuild_plugin.V1.send {|
+
+(rule
+ (targets functor.ml)
+ (deps (glob_files src/*.ml{,i})
+       (:src_dir src/TEZOS_PROTOCOL))
+ (action (with-stdout-to %%{targets}
+                         (chdir %%{workspace_root}
+                                (run %%{bin:tezos-protocol-compiler.tezos-protocol-packer} %%{src_dir})))))
+
+(library
+ (name tezos_protocol_%s)
+ (public_name tezos-protocol-%s)
+ (libraries tezos-protocol-environment-sigs)
+ (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
+        -warn-error "-a+8"
+        -safe-string -nopervasives)
+ (modules Functor))
+
+(alias
+ (name runtest_sandbox)
+ (deps .tezos_protocol_%s.objs/tezos_protocol_%s.cmx))
+
+(alias
+ (name runtest_indent)
+ (deps @[<v>%a@])
+ (action (run bash %%{libexec:tezos-stdlib:test-ocp-indent.sh} %%{deps})))
+
+|}
+    lib_version version lib_version lib_version
+    Format.(pp_print_list (fun ppf -> Format.fprintf ppf "%S"))
+    sources
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/main_byte.ml b/vendors/tezos-modded/src/lib_protocol_compiler/main_byte.ml
new file mode 100644
index 000000000..a5c99cec3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/main_byte.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  try
+    Tezos_protocol_compiler.Compiler.main
+      Tezos_protocol_compiler_byte.Byte.driver ;
+    Pervasives.exit 0
+  with exn ->
+    Format.eprintf "%a\n%!" Errors.report_error exn;
+    Pervasives.exit 1
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.ml b/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.ml
new file mode 100644
index 000000000..7cdc23082
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.ml
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 srcdir = Sys.argv.(1)
+let version = Sys.argv.(2)
+
+let srcdir =
+  if Filename.basename srcdir = "TEZOS_PROTOCOL" then
+    Filename.dirname srcdir
+  else
+    srcdir
+
+let hash, sources =
+  match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir srcdir) with
+  | Ok (None, proto) ->
+      (Protocol.hash proto, proto)
+  | Ok (Some hash, proto) ->
+      (hash, proto)
+  | Error err ->
+      Format.kasprintf Pervasives.failwith
+        "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err
+
+let () =
+  Format.printf {|
+module Source = struct
+  let hash =
+    Some (Tezos_crypto.Protocol_hash.of_b58check_exn %S)
+  let sources = Tezos_base.Protocol.%a
+end
+@.|}
+    (Protocol_hash.to_b58check hash)
+    Protocol.pp_ocaml sources
+
+let () =
+  Format.printf {|
+module Registered =
+  Tezos_protocol_updater.Registered_protocol.Register_embedded
+    (Tezos_embedded_protocol_environment_%s.Environment)
+    (Tezos_embedded_raw_protocol_%s.Main)
+    (Source)
+@.|}
+    version version
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.mli b/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.mli
new file mode 100644
index 000000000..f36053c81
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/main_embedded_packer.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* empty *)
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/main_native.ml b/vendors/tezos-modded/src/lib_protocol_compiler/main_native.ml
new file mode 100644
index 000000000..5c11b6783
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/main_native.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  try
+    Tezos_protocol_compiler.Compiler.main
+      Tezos_protocol_compiler_native.Native.driver ;
+    Pervasives.exit 0
+  with exn ->
+    Format.eprintf "%a\n%!" Opterrors.report_error exn;
+    Pervasives.exit 1
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/main_packer.ml b/vendors/tezos-modded/src/lib_protocol_compiler/main_packer.ml
new file mode 100644
index 000000000..80212dcab
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/main_packer.ml
@@ -0,0 +1,57 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 (//) = Filename.concat
+
+let () =
+  Random.self_init () ;
+  let anonymous = ref [] in
+  let args_spec = [ ] in
+  let usage_msg =
+    Printf.sprintf "Usage: %s [options] <srcdir>" Sys.argv.(0) in
+  Arg.parse args_spec (fun s -> anonymous := s :: !anonymous) usage_msg ;
+  let source_dir =
+    match List.rev !anonymous with
+    | [ source_dir ] when Filename.basename source_dir = "TEZOS_PROTOCOL"->
+        Filename.dirname source_dir
+    | [ source_dir ] -> source_dir
+    | _ -> Arg.usage args_spec usage_msg ; Pervasives.exit 1 in
+  let hash, protocol =
+    match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with
+    | Ok (None, proto) ->
+        (Protocol.hash proto, proto)
+    | Ok (Some hash, proto) ->
+        (hash, proto)
+    | Error err ->
+        Format.kasprintf Pervasives.failwith
+          "Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in
+  (* Generate the 'functor' *)
+  Packer.dump stdout hash
+    (Array.map
+       begin fun { Protocol.name ; _ }  ->
+         let name_lowercase = String.uncapitalize_ascii name in
+         source_dir // name_lowercase ^ ".ml"
+       end
+       (Array.of_list protocol.components))
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/native.ml b/vendors/tezos-modded/src/lib_protocol_compiler/native.ml
new file mode 100644
index 000000000..75e723c73
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/native.ml
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The OCaml compiler not being implemented with Lwt, the compilation
+    take place in a separated process (by using [Lwt_process.exec]).
+
+    The [main] function is the entry point for the forked process.
+    While [Updater.compile] is the 'forking' function to be called by
+    the [tezos-node] process.
+
+*)
+
+open Compiler
+
+(* TODO: fail in the presence of "external" *)
+
+module Backend = struct
+  (* See backend_intf.mli. *)
+
+  let symbol_for_global' = Compilenv.symbol_for_global'
+  let closure_symbol = Compilenv.closure_symbol
+
+  let really_import_approx = Import_approx.really_import_approx
+  let import_symbol = Import_approx.import_symbol
+
+  let size_int = Arch.size_int
+  let big_endian = Arch.big_endian
+
+  let max_sensible_number_of_arguments =
+    (* The "-1" is to allow for a potential closure environment parameter. *)
+    Proc.max_arguments_for_tailcalls - 1
+end
+
+let backend = (module Backend : Backend_intf.S)
+
+(** Semi-generic compilation functions *)
+
+let pack_objects output objects =
+  let output = output ^ ".cmx" in
+  Compmisc.init_path true;
+  Asmpackager.package_files
+    ~backend Format.err_formatter Env.initial_safe_string objects output ;
+  Warnings.check_fatal () ;
+  output
+
+let link_shared output objects =
+  Compenv.(readenv Format.err_formatter Before_link) ;
+  Compmisc.init_path true;
+  Asmlink.link_shared Format.err_formatter objects output ;
+  Warnings.check_fatal ()
+
+let compile_ml ?for_pack ml =
+  let target = Filename.chop_extension ml in
+  Clflags.for_package := for_pack ;
+  Compenv.(readenv Format.err_formatter (Before_compile ml));
+  Optcompile.implementation ~backend Format.err_formatter ml target ;
+  Clflags.for_package := None ;
+  target ^ ".cmx"
+
+let () =
+  Clflags.native_code := true
+
+let driver = { compile_ml ; link_shared ; pack_objects }
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/native.mli b/vendors/tezos-modded/src/lib_protocol_compiler/native.mli
new file mode 100644
index 000000000..ab47182b4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/native.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 driver: Compiler.driver
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/packer.ml b/vendors/tezos-modded/src/lib_protocol_compiler/packer.ml
new file mode 100644
index 000000000..855dc6044
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/packer.ml
@@ -0,0 +1,80 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 dump_file oc file =
+  let ic = open_in file in
+  let buflen = 8096 in
+  let buf = Bytes.create buflen in
+  let rec loop () =
+    let len = input ic buf 0 buflen in
+    if len <> 0 then begin
+      Printf.fprintf oc "%s"
+        (if len = buflen then Bytes.unsafe_to_string buf else Bytes.sub_string buf 0 len) ;
+      loop ()
+    end
+  in
+  loop () ;
+  close_in ic
+
+let include_ml oc file =
+  let unit =
+    String.capitalize_ascii
+      (Filename.chop_extension (Filename.basename file)) in
+  (* FIXME insert .mli... *)
+  Printf.fprintf oc "module %s " unit ;
+  if Sys.file_exists (file ^ "i") then begin
+    Printf.fprintf oc ": sig\n" ;
+    Printf.fprintf oc "# 1 %S\n" (file ^ "i");
+    dump_file oc (file ^ "i") ;
+    Printf.fprintf oc "end " ;
+  end ;
+  Printf.fprintf oc "= struct\n" ;
+  Printf.fprintf oc "# 1 %S\n" file ;
+  dump_file oc file ;
+  Printf.fprintf oc "end\n%!"
+
+let opened_modules = [
+  "Tezos_protocol_environment" ;
+  "Pervasives" ;
+  "Error_monad" ;
+  "Logging" ;
+]
+
+let dump oc hash files =
+  Printf.fprintf oc
+    "module Make (Tezos_protocol_environment : Tezos_protocol_environment_sigs__V1.T) = struct\n" ;
+  Printf.fprintf oc "[@@@ocaml.warning \"-33\"]\n" ;
+  List.iter (Printf.fprintf oc "open %s\n") opened_modules ;
+  Printf.fprintf oc "[@@@ocaml.warning \"+33\"]\n" ;
+  Printf.fprintf oc "let hash = Protocol_hash.of_b58check_exn %S;;\n"
+    (Protocol_hash.to_b58check hash) ;
+  for i = 0 to Array.length files - 1 do
+    include_ml oc files.(i) ;
+  done ;
+  Printf.fprintf oc "  include %s\n"
+    (String.capitalize_ascii
+       (Filename.basename
+          (Filename.chop_extension files.(Array.length files - 1)))) ;
+  Printf.fprintf oc "end\n%!"
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/packer.mli b/vendors/tezos-modded/src/lib_protocol_compiler/packer.mli
new file mode 100644
index 000000000..1822ef528
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/packer.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 dump: out_channel -> Protocol_hash.t -> string array -> unit
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/registerer.ml b/vendors/tezos-modded/src/lib_protocol_compiler/registerer.ml
new file mode 100644
index 000000000..375df655f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/registerer.ml
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type PROTOCOL_V1 =
+  functor (Env : Tezos_protocol_environment_sigs.V1.T) -> Env.Updater.PROTOCOL
+
+module VersionTable = Protocol_hash.Table
+
+let versions : (module PROTOCOL_V1) VersionTable.t =
+  VersionTable.create 20
+
+let register hash proto =
+  let hash = Protocol_hash.of_b58check_exn hash in
+  VersionTable.add versions hash proto
+
+let mem hash = VersionTable.mem versions hash
+
+let get_exn hash = VersionTable.find versions hash
+let get hash =
+  try Some (get_exn hash)
+  with Not_found -> None
+
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/registerer.mli b/vendors/tezos-modded/src/lib_protocol_compiler/registerer.mli
new file mode 100644
index 000000000..45e322e8e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/registerer.mli
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type PROTOCOL_V1 =
+  functor (Env : Tezos_protocol_environment_sigs.V1.T) -> Env.Updater.PROTOCOL
+
+val register: string -> (module PROTOCOL_V1) -> unit
+
+val mem: Protocol_hash.t -> bool
+val get: Protocol_hash.t -> (module PROTOCOL_V1) option
+val get_exn: Protocol_hash.t -> (module PROTOCOL_V1)
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/replace.ml b/vendors/tezos-modded/src/lib_protocol_compiler/replace.ml
new file mode 100644
index 000000000..b6a5b8ce6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/replace.ml
@@ -0,0 +1,136 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module StringMap = Map.Make(String)
+
+let regexp = Str.regexp "%%[^%]*%%"
+
+let current_dir = Sys.getcwd ()
+
+let guess_version () =
+  let prefix = "proto_" in
+  let rec loop dir =
+    let dirname = Filename.basename dir in
+    let x = String.length prefix in
+    let n = String.length dirname in
+    if n >= x && String.sub dirname 0 x = prefix then
+      String.sub dirname x (n - x)
+    else
+      let updir = Filename.dirname dir in
+      if updir = dir then begin
+        Format.eprintf
+          "Cannot guess protocol version in path!@.Looking for `%s*` in `%s`@."
+          prefix current_dir ;
+        exit 1
+      end;
+      loop updir in
+  loop (Sys.getcwd ())
+
+let warning_message = {|
+
+;
+;        /!\ /!\ Do not modify this file /!\ /!\
+;
+; but the original template in `tezos-protocol-compiler`
+;
+
+|}
+
+let replace ~template ~destination vars =
+  let inch = open_in template in
+  let outch = open_out destination in
+  output_string outch warning_message ;
+  try
+    while true do
+      let line = input_line inch in
+      let line =
+        Str.global_substitute regexp begin fun s ->
+          let matched = Str.matched_string s in
+          let var = String.sub matched 2 (String.length matched - 4) in
+          match StringMap.find_opt var vars with
+          | Some value -> value
+          | None ->
+              prerr_endline ("Unknown variable: " ^ var) ;
+              exit 1
+        end line in
+      output_string outch line ;
+      output_string outch "\n" ;
+    done ;
+  with End_of_file ->
+    flush outch ;
+    close_out outch ;
+    ()
+
+let module_name (c : Protocol.component) =
+  String.capitalize_ascii c.name
+let sources_name (c : Protocol.component) =
+  let name = String.lowercase_ascii c.name in
+  match c.interface with
+  | None ->
+      Printf.sprintf "%s.ml" name
+  | Some _ ->
+      Printf.sprintf "%s.mli %s.ml" name name
+
+let process ~template ~destination (protocol : Protocol.t) lib_version =
+  let version = String.concat "-" (String.split_on_char '_' lib_version) in
+  let vars =
+    StringMap.empty |>
+    StringMap.add "VERSION" version |>
+    StringMap.add "LIB_VERSION" lib_version |>
+    StringMap.add "MODULES"
+      (String.concat " " (List.map module_name protocol.components)) |>
+    StringMap.add "SOURCES"
+      (String.concat " " (List.map sources_name protocol.components)) in
+  replace ~template ~destination vars
+
+let read_proto destination =
+  let source_dir =
+    if Filename.is_relative destination then
+      Filename.concat
+        current_dir (Filename.dirname destination)
+    else
+      Filename.dirname destination in
+  match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with
+  | Ok (None, proto) ->
+      (Protocol.hash proto, proto)
+  | Ok (Some hash, proto) ->
+      (hash, proto)
+  | Error err ->
+      Format.kasprintf Pervasives.failwith
+        "Failed to read TEZOS_PROTOCOL in %s:@ %a"
+        source_dir
+        pp_print_error err
+
+let main () =
+  let template = Sys.argv.(1) in
+  let destination = Sys.argv.(2) in
+  let version =
+    try Sys.argv.(3)
+    with _ -> guess_version () in
+  let _hash, proto = read_proto destination in
+  process ~template ~destination proto version
+
+let () =
+  main ()
diff --git a/vendors/tezos-modded/src/lib_protocol_compiler/tezos-protocol-compiler.opam b/vendors/tezos-modded/src/lib_protocol_compiler/tezos-protocol-compiler.opam
new file mode 100644
index 000000000..f7a494c94
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_compiler/tezos-protocol-compiler.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  ## ocaml should be in sync with `script/version.sh`
+  "ocaml" { = "4.06.1" }
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "base-unix"
+  "tezos-base"
+  "tezos-protocol-environment-sigs"
+  "tezos-stdlib-unix"
+  "ocplib-endian"
+  "ocp-ocamlres" { >= "0.4" }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/dune b/vendors/tezos-modded/src/lib_protocol_environment/dune
new file mode 100644
index 000000000..c229c166d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/dune
@@ -0,0 +1,29 @@
+(library
+ (name tezos_protocol_environment)
+ (public_name tezos-protocol-environment)
+ (libraries tezos-base
+            tezos-protocol-environment-sigs
+            tezos-micheline)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_micheline))
+ (wrapped false)
+ (modules Tezos_protocol_environment
+          Tezos_protocol_environment_faked
+          Tezos_protocol_environment_memory))
+
+(library
+ (name tezos_protocol_environment_shell)
+ (public_name tezos-protocol-environment-shell)
+ (libraries tezos-base
+            tezos-protocol-environment
+            tezos-storage)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string))
+ (modules Tezos_protocol_environment_shell))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/dune b/vendors/tezos-modded/src/lib_protocol_environment/sigs/dune
new file mode 100644
index 000000000..17555c733
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/dune
@@ -0,0 +1,71 @@
+(rule
+ (targets v1.ml)
+ (deps
+
+  ;; Part of OCaml stdlib
+  v1/pervasives.mli
+  v1/list.mli
+  v1/string.mli
+  v1/int32.mli
+  v1/int64.mli
+  v1/format.mli
+
+  ;; Part of external libraries
+  v1/mBytes.mli
+  v1/z.mli
+  v1/lwt.mli
+  v1/lwt_list.mli
+  v1/raw_hashes.mli
+
+  ;; Tezos extended stdlib
+  v1/compare.mli
+  v1/data_encoding.mli
+  v1/error_monad.mli
+  v1/logging.mli
+  v1/time.mli
+  v1/option.mli
+
+  v1/RPC_arg.mli
+  v1/RPC_path.mli
+  v1/RPC_query.mli
+  v1/RPC_service.mli
+  v1/RPC_answer.mli
+  v1/RPC_directory.mli
+
+  v1/base58.mli
+  v1/s.mli
+  v1/set.mli
+  v1/map.mli
+  v1/blake2B.mli
+  v1/ed25519.mli
+  v1/secp256k1.mli
+  v1/p256.mli
+  v1/chain_id.mli
+  v1/signature.mli
+  v1/block_hash.mli
+  v1/operation_hash.mli
+  v1/operation_list_hash.mli
+  v1/operation_list_list_hash.mli
+  v1/protocol_hash.mli
+  v1/context_hash.mli
+
+  ;; Tezos specifics
+  v1/micheline.mli
+  v1/block_header.mli
+  v1/fitness.mli
+  v1/operation.mli
+  v1/protocol.mli
+  v1/context.mli
+  v1/updater.mli
+  v1/RPC_context.mli
+
+  )
+ (action
+  (with-stdout-to %{targets}
+                  (chdir %{workspace_root}} (run %{exe:../sigs_packer/sigs_packer.exe} %{deps})))))
+
+(library
+ (name tezos_protocol_environment_sigs)
+ (public_name tezos-protocol-environment-sigs)
+ (flags (:standard -nopervasives -safe-string))
+ (modules ("V1")))
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_answer.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_answer.mli
new file mode 100644
index 000000000..1632702ea
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_answer.mli
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Return type for service handler *)
+type 'o t =
+  [ `Ok of 'o (* 200 *)
+  | `OkStream of 'o stream (* 200 *)
+  | `Created of string option (* 201 *)
+  | `No_content (* 204 *)
+  | `Unauthorized of error list option (* 401 *)
+  | `Forbidden of error list option (* 403 *)
+  | `Not_found of error list option (* 404 *)
+  | `Conflict of error list option (* 409 *)
+  | `Error of error list option (* 500 *)
+  ]
+
+and 'a stream = {
+  next: unit -> 'a option Lwt.t ;
+  shutdown: unit -> unit ;
+}
+
+val return: 'o -> 'o t Lwt.t
+val return_stream: 'o stream -> 'o t Lwt.t
+val not_found: 'o t Lwt.t
+val fail: error list -> 'a t Lwt.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_arg.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_arg.mli
new file mode 100644
index 000000000..98218d427
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_arg.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a t
+type 'a arg = 'a t
+val make:
+  ?descr:string ->
+  name:string ->
+  destruct:(string -> ('a, string) result) ->
+  construct:('a -> string) ->
+  unit -> 'a arg
+
+type descr = {
+  name: string ;
+  descr: string option ;
+}
+val descr: 'a arg -> descr
+
+val int: int arg
+val int32: int32 arg
+val int64: int64 arg
+val float: float arg
+val string: string arg
+
+val like: 'a arg -> ?descr:string -> string -> 'a arg
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+val eq: 'a arg -> 'b arg -> ('a, 'b) eq option
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_context.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_context.mli
new file mode 100644
index 000000000..83d8013c5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_context.mli
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Updater.rpc_context
+
+class type ['pr] simple = object
+  method call_proto_service0 :
+    'm 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t ->
+    'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+  method call_proto_service1 :
+    'm 'a 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t ->
+    'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+  method call_proto_service2 :
+    'm 'a 'b 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+    'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+  method call_proto_service3 :
+    'm 'a 'b 'c 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+    'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+end
+
+val make_call0:
+  ([< RPC_service.meth ], t, t, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'q -> 'i -> 'o shell_tzresult Lwt.t
+
+val make_call1:
+  ([< RPC_service.meth ], t, t * 'a, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'q -> 'i -> 'o shell_tzresult Lwt.t
+
+val make_call2:
+  ([< RPC_service.meth ], t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'b -> 'q -> 'i -> 'o shell_tzresult Lwt.t
+
+val make_call3:
+  ([< RPC_service.meth ], t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o shell_tzresult Lwt.t
+
+
+val make_opt_call0:
+  ([< RPC_service.meth ], t, t, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'q -> 'i -> 'o option shell_tzresult Lwt.t
+
+val make_opt_call1:
+  ([< RPC_service.meth ], t, t * 'a, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'q -> 'i -> 'o option shell_tzresult Lwt.t
+
+val make_opt_call2:
+  ([< RPC_service.meth ], t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'b -> 'q -> 'i -> 'o option shell_tzresult Lwt.t
+
+val make_opt_call3:
+  ([< RPC_service.meth ], t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+  'pr #simple -> 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o option shell_tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_directory.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_directory.mli
new file mode 100644
index 000000000..17b15c6de
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_directory.mli
@@ -0,0 +1,227 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Dispatch tree *)
+type 'prefix t
+type 'prefix directory = 'prefix t
+
+(** Empty list of dispatch trees *)
+val empty: 'prefix directory
+
+val map: ('a -> 'b Lwt.t) -> 'b directory -> 'a directory
+
+val prefix: ('pr, 'p) RPC_path.path -> 'p directory -> 'pr directory
+val merge: 'a directory -> 'a directory -> 'a directory
+
+(** Possible error while registring services. *)
+type step =
+  | Static of string
+  | Dynamic of RPC_arg.descr
+  | DynamicTail of RPC_arg.descr
+
+type conflict =
+  | CService of RPC_service.meth | CDir | CBuilder | CTail
+  | CTypes of RPC_arg.descr *
+              RPC_arg.descr
+  | CType of RPC_arg.descr * string list
+exception Conflict of step list * conflict
+
+(** Registring handler in service tree. *)
+val register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> 'output tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> 'output option tzresult Lwt.t) ->
+  'prefix directory
+
+val gen_register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val lwt_register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> 'output Lwt.t) ->
+  'prefix directory
+
+(** Registring handler in service tree. Curryfied variant.  *)
+
+val register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o tzresult Lwt.t) ->
+  unit directory
+
+val register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o option tzresult Lwt.t) ->
+  unit directory
+
+val opt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val gen_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  unit directory
+
+val gen_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val lwt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o Lwt.t) ->
+  unit directory
+
+val lwt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+(** Registring dynamic subtree. *)
+val register_dynamic_directory:
+  ?descr:string ->
+  'prefix directory ->
+  ('prefix, 'a) RPC_path.t -> ('a -> 'a directory Lwt.t) ->
+  'prefix directory
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_path.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_path.mli
new file mode 100644
index 000000000..be5d2b36c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_path.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('prefix, 'params) t
+type ('prefix, 'params) path = ('prefix, 'params) t
+type 'prefix context = ('prefix, 'prefix) path
+
+val root: unit context
+val open_root: 'a context
+
+val add_suffix:
+  ('prefix, 'params) path -> string -> ('prefix, 'params) path
+val (/):
+  ('prefix, 'params) path -> string -> ('prefix, 'params) path
+
+val add_arg:
+  ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a) path
+val (/:):
+  ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a) path
+
+val add_final_args:
+  ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path
+val (/:*):
+  ('prefix, 'params) path -> 'a RPC_arg.t -> ('prefix, 'params * 'a list) path
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_query.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_query.mli
new file mode 100644
index 000000000..76573c0df
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_query.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a t
+type 'a query = 'a t
+
+val empty: unit query
+
+type ('a, 'b) field
+val field:
+  ?descr: string ->
+  string -> 'a RPC_arg.t -> 'a -> ('b -> 'a) -> ('b, 'a) field
+val opt_field:
+  ?descr: string ->
+  string -> 'a RPC_arg.t -> ('b -> 'a option) -> ('b, 'a option) field
+val flag:
+  ?descr: string ->
+  string -> ('b -> bool) -> ('b, bool) field
+val multi_field:
+  ?descr: string ->
+  string -> 'a RPC_arg.t -> ('b -> 'a list) -> ('b, 'a list) field
+
+type ('a, 'b, 'c) open_query
+val query: 'b -> ('a, 'b, 'b) open_query
+val (|+):
+  ('a, 'b, 'c -> 'd) open_query ->
+  ('a, 'c) field -> ('a, 'b, 'd) open_query
+val seal: ('a, 'b, 'a) open_query -> 'a t
+
+type untyped = (string * string) list
+exception Invalid of string
+val parse: 'a query -> untyped -> 'a
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_service.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_service.mli
new file mode 100644
index 000000000..bf61a15a4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/RPC_service.mli
@@ -0,0 +1,76 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** HTTP methods. *)
+type meth = [
+  | `GET
+  | `POST
+  | `DELETE
+  | `PUT
+  | `PATCH
+]
+
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t
+  constraint 'meth = [< meth ]
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) t
+
+val get_service:
+  ?description: string ->
+  query: 'query RPC_query.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `GET ], 'prefix, 'params, 'query, unit, 'output) service
+
+val post_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `POST ], 'prefix, 'params, 'query, 'input, 'output) service
+
+val delete_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `DELETE ], 'prefix, 'params, 'query, unit, 'output) service
+
+val patch_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `PATCH ], 'prefix, 'params, 'query, 'input, 'output) service
+
+val put_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output) service
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/base58.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/base58.mli
new file mode 100644
index 000000000..3d7198c7c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/base58.mli
@@ -0,0 +1,43 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a encoding
+
+val simple_decode: 'a encoding -> string -> 'a option
+val simple_encode: 'a encoding -> 'a -> string
+
+type data = ..
+
+val register_encoding:
+  prefix: string ->
+  length: int ->
+  to_raw: ('a -> string) ->
+  of_raw: (string -> 'a option) ->
+  wrap: ('a -> data) ->
+  'a encoding
+
+val check_encoded_prefix: 'a encoding -> string -> int -> unit
+
+val decode: string -> data option
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/blake2B.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/blake2B.mli
new file mode 100644
index 000000000..b1b53be8d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/blake2B.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Builds a new Hash type using Blake2B. *)
+
+(** The parameters for creating a new Hash type using
+    {!Make_Blake2B}. Both {!name} and {!title} are only informative,
+    used in error messages and serializers. *)
+
+module type Name = sig
+  val name : string
+  val title : string
+  val size : int option
+end
+
+module type PrefixedName = sig
+  include Name
+  val b58check_prefix : string
+end
+
+module Make_minimal (Name : Name) : S.MINIMAL_HASH
+module Make
+    (Register : sig
+       val register_encoding:
+         prefix: string ->
+         length: int ->
+         to_raw: ('a -> string) ->
+         of_raw: (string -> 'a option) ->
+         wrap: ('a -> Base58.data) ->
+         'a Base58.encoding
+     end)
+    (Name : PrefixedName) : S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_hash.mli
new file mode 100644
index 000000000..701c94cbb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Blocks hashes / IDs. *)
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_header.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_header.mli
new file mode 100644
index 000000000..2b250d696
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/block_header.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type shell_header = {
+  level: Int32.t ;
+  (** The number of preceding block in this chain, i.e. the genesis
+      has level 0. *)
+  proto_level: int ;
+  (** The number of preceding protocol change in the chain (modulo 256),
+      i.e the genesis has proto_level 0. *)
+  predecessor: Block_hash.t ;
+  timestamp: Time.t ;
+  validation_passes: int ;
+  operations_hash: Operation_list_list_hash.t ;
+  fitness: MBytes.t list ;
+  context: Context_hash.t ;
+}
+
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  protocol_data: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Block_hash.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/chain_id.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/chain_id.mli
new file mode 100644
index 000000000..2203c82e6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/chain_id.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/compare.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/compare.mli
new file mode 100644
index 000000000..8a67a866e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/compare.mli
@@ -0,0 +1,59 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type S = sig
+  type t
+  val (=) : t -> t -> bool
+  val (<>) : t -> t -> bool
+  val (<) : t -> t -> bool
+  val (<=) : t -> t -> bool
+  val (>=) : t -> t -> bool
+  val (>) : t -> t -> bool
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val max : t -> t -> t
+  val min : t -> t -> t
+end
+
+module Make (P : COMPARABLE) : S with type t := P.t
+
+module Char : S with type t = char
+module Bool : S with type t = bool
+module Int : S with type t = int
+module Int32 : S with type t = int32
+module Uint32 : S with type t = int32
+module Int64 : S with type t = int64
+module Uint64 : S with type t = int64
+module Float : S with type t = float
+module String : S with type t = string
+module Z : S with type t = Z.t
+
+module List (P : COMPARABLE) : S with type t = P.t list
+module Option (P : COMPARABLE) : S with type t = P.t option
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context.mli
new file mode 100644
index 000000000..df262e1ec
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context.mli
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** View over the context store, restricted to types, access and
+    functional manipulation of an existing context. *)
+
+type t
+
+(** Keys in (kex x value) database implementations *)
+type key = string list
+
+(** Values in (kex x value) database implementations *)
+type value = MBytes.t
+
+val mem: t -> key -> bool Lwt.t
+val dir_mem: t -> key -> bool Lwt.t
+
+val get: t -> key -> value option Lwt.t
+
+val set: t -> key -> value -> t Lwt.t
+
+(** [copy] returns None if the [from] key is not bound *)
+val copy: t -> from:key -> to_:key -> t option Lwt.t
+
+val del: t -> key -> t Lwt.t
+val remove_rec: t -> key -> t Lwt.t
+
+val fold:
+  t -> key -> init:'a ->
+  f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+  'a Lwt.t
+
+val keys: t -> key -> key list Lwt.t
+val fold_keys:
+  t -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+val register_resolver:
+  'a Base58.encoding -> (t -> string -> 'a list Lwt.t) -> unit
+
+val complete: t -> string -> string list Lwt.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context_hash.mli
new file mode 100644
index 000000000..4916f18fc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/context_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Commited context hashes / IDs. *)
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/data_encoding.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/data_encoding.mli
new file mode 100644
index 000000000..68c8b6ac4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/data_encoding.mli
@@ -0,0 +1,290 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** In memory JSON data *)
+type json =
+  [ `O of (string * json) list
+  | `Bool of bool
+  | `Float of float
+  | `A of json list
+  | `Null
+  | `String of string ]
+
+type json_schema
+
+type 'a t
+type 'a encoding = 'a t
+
+val classify : 'a encoding -> [ `Fixed of int | `Dynamic | `Variable ]
+
+val splitted : json:'a encoding -> binary:'a encoding -> 'a encoding
+
+val null : unit encoding
+val empty : unit encoding
+val unit : unit encoding
+val constant : string -> unit encoding
+val int8 : int encoding
+val uint8 : int encoding
+val int16 : int encoding
+val uint16 : int encoding
+val int31 : int encoding
+val int32 : int32 encoding
+val int64 : int64 encoding
+val n : Z.t encoding
+val z : Z.t encoding
+val bool : bool encoding
+val string : string encoding
+val bytes : MBytes.t encoding
+val float : float encoding
+val option : 'a encoding -> 'a option encoding
+val string_enum : (string * 'a) list -> 'a encoding
+
+module Fixed : sig
+  val string : int -> string encoding
+  val bytes : int -> MBytes.t encoding
+  val add_padding : 'a encoding -> int -> 'a encoding
+end
+
+module Variable : sig
+  val string : string encoding
+  val bytes : MBytes.t encoding
+  val array : ?max_length: int -> 'a encoding -> 'a array encoding
+  val list : ?max_length: int -> 'a encoding -> 'a list encoding
+end
+
+module Bounded : sig
+  val string : int -> string encoding
+  val bytes : int -> MBytes.t encoding
+end
+
+val dynamic_size :
+  ?kind: [ `Uint30 | `Uint16 | `Uint8 ] ->
+  'a encoding -> 'a encoding
+
+val json : json encoding
+val json_schema : json_schema encoding
+
+type 'a field
+val req :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't field
+val opt :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't option field
+val varopt :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't option field
+val dft :
+  ?title:string -> ?description:string ->
+  string -> 't encoding -> 't -> 't field
+
+val obj1 :
+  'f1 field -> 'f1 encoding
+val obj2 :
+  'f1 field -> 'f2 field -> ('f1 * 'f2) encoding
+val obj3 :
+  'f1 field -> 'f2 field -> 'f3 field -> ('f1 * 'f2 * 'f3) encoding
+val obj4 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+val obj5 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+val obj6 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+val obj7 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+val obj8 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+val obj9 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+val obj10 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field -> 'f10 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+val tup1 :
+  'f1 encoding ->
+  'f1 encoding
+val tup2 :
+  'f1 encoding -> 'f2 encoding ->
+  ('f1 * 'f2) encoding
+val tup3 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding ->
+  ('f1 * 'f2 * 'f3) encoding
+val tup4 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+val tup5 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+val tup6 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+val tup7 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+val tup8 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+val tup9 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  'f9 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+val tup10 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  'f5 encoding -> 'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  'f9 encoding -> 'f10 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+val merge_objs : 'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding
+val merge_tups : 'a1 encoding -> 'a2 encoding -> ('a1 * 'a2) encoding
+
+val array : ?max_length: int -> 'a encoding -> 'a array encoding
+val list : ?max_length: int -> 'a encoding -> 'a list encoding
+
+val assoc : 'a encoding -> (string * 'a) list encoding
+
+type case_tag = Tag of int | Json_only
+
+type 't case
+val case :
+  title:string ->
+  ?description:string ->
+  case_tag -> 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
+
+val union :
+  ?tag_size:[ `Uint8 | `Uint16 ] -> 't case list -> 't encoding
+
+val def :
+  string ->
+  ?title:string ->
+  ?description:string ->
+  't encoding ->'t encoding
+
+val conv :
+  ('a -> 'b) -> ('b -> 'a) ->
+  ?schema:json_schema ->
+  'b encoding -> 'a encoding
+
+val mu :
+  string ->
+  ?title:string ->
+  ?description:string ->
+  ('a encoding -> 'a encoding) -> 'a encoding
+
+type 'a lazy_t
+
+val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+val force_decode : 'a lazy_t -> 'a option
+val force_bytes : 'a lazy_t -> MBytes.t
+val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+val apply_lazy :
+  fun_value:('a -> 'b) -> fun_bytes:(MBytes.t -> 'b) -> fun_combine:('b -> 'b -> 'b) ->
+  'a lazy_t -> 'b
+
+module Json : sig
+
+  val schema : ?definitions_path:string -> 'a encoding -> json_schema
+  val construct : 't encoding -> 't -> json
+  val destruct : 't encoding -> json -> 't
+
+  (** JSON Error *)
+
+  type path = path_item list
+  and path_item =
+    [ `Field of string
+    (** A field in an object. *)
+    | `Index of int
+    (** An index in an array. *)
+    | `Star
+    (** Any / every field or index. *)
+    | `Next
+      (** The next element after an array. *) ]
+
+  (** Exception raised by destructors, with the location in the original
+      JSON structure and the specific error. *)
+  exception Cannot_destruct of (path * exn)
+
+  (** Unexpected kind of data encountered (w/ the expectation). *)
+  exception Unexpected of string * string
+
+  (** Some {!union} couldn't be destructed, w/ the reasons for each {!case}. *)
+  exception No_case_matched of exn list
+
+  (** Array of unexpected size encountered  (w/ the expectation). *)
+  exception Bad_array_size of int * int
+
+  (** Missing field in an object. *)
+  exception Missing_field of string
+
+  (** Supernumerary field in an object. *)
+  exception Unexpected_field of string
+
+  val print_error :
+    ?print_unknown: (Format.formatter -> exn -> unit) ->
+    Format.formatter -> exn -> unit
+
+  (** Helpers for writing encoders. *)
+  val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a
+  val wrap_error : ('a -> 'b) -> 'a -> 'b
+
+  val pp : Format.formatter -> json -> unit
+
+end
+
+module Binary : sig
+
+  val length : 'a encoding -> 'a -> int
+  val fixed_length : 'a encoding -> int option
+  val read : 'a encoding -> MBytes.t -> int -> int -> (int * 'a) option
+  val write : 'a encoding -> 'a -> MBytes.t -> int -> int -> int option
+  val to_bytes : 'a encoding -> 'a -> MBytes.t option
+  val to_bytes_exn : 'a encoding -> 'a -> MBytes.t
+  val of_bytes : 'a encoding -> MBytes.t -> 'a option
+
+  type write_error
+  exception Write_error of write_error
+
+end
+
+(** [check_size size encoding] ensures that the binary encoding
+    of a value will not be allowed to exceed [size] bytes. The reader
+    and the writer fails otherwise. This function do not modify
+    the JSON encoding. *)
+val check_size : int -> 'a encoding -> 'a encoding
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/ed25519.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/ed25519.mli
new file mode 100644
index 000000000..f61d72c87
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/ed25519.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Ed25519 cryptography *)
+
+include S.SIGNATURE with type watermark := MBytes.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/error_monad.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/error_monad.mli
new file mode 100644
index 000000000..1e6c9e4b8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/error_monad.mli
@@ -0,0 +1,181 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Error Monad *)
+
+(** {2 Error classification} *************************************************)
+
+(** Categories of error *)
+type error_category =
+  [ `Branch (** Errors that may not happen in another context *)
+  | `Temporary (** Errors that may not happen in a later context *)
+  | `Permanent (** Errors that will happen no matter the context *)
+  ]
+
+(** Custom error handling for economic protocols. *)
+
+type error = ..
+
+val pp : Format.formatter -> error -> unit
+
+(** A JSON error serializer *)
+val error_encoding : error Data_encoding.t
+val json_of_error : error -> Data_encoding.json
+val error_of_json : Data_encoding.json -> error
+
+(** Error information *)
+type error_info =
+  { category : error_category ;
+    id: string ;
+    title : string ;
+    description : string ;
+    schema : Data_encoding.json_schema }
+
+val pp_info: Format.formatter -> error_info -> unit
+
+(** Retrieves information of registered errors *)
+val get_registered_errors : unit -> error_info list
+
+(** For other modules to register specialized error serializers *)
+val register_error_kind :
+  error_category ->
+  id:string -> title:string -> description:string ->
+  ?pp:(Format.formatter -> 'err -> unit) ->
+  'err Data_encoding.t ->
+  (error -> 'err option) -> ('err -> error) ->
+  unit
+
+(** Classify an error using the registered kinds *)
+val classify_errors : error list -> error_category
+
+(** {2 Monad definition} *****************************************************)
+
+(** The error monad wrapper type, the error case holds a stack of
+    error, initialized by the first call to {!fail} and completed by
+    each call to {!trace} as the stack is rewinded. The most general
+    error is thus at the top of the error stack, going down to the
+    specific error that actually caused the failure. *)
+type 'a tzresult = ('a, error list) result
+
+(** A JSON serializer for result of a given type *)
+val result_encoding : 'a Data_encoding.t -> 'a tzresult Data_encoding.encoding
+
+(** Sucessful result *)
+val ok : 'a -> 'a tzresult
+
+(** Sucessful return *)
+val return : 'a -> 'a tzresult Lwt.t
+
+(** Sucessful return of [()] *)
+val return_unit : unit tzresult Lwt.t
+
+(** Sucessful return of [None] *)
+val return_none : 'a option tzresult Lwt.t
+
+(** [return_some x] is a sucessful return of [Some x] *)
+val return_some : 'a -> 'a option tzresult Lwt.t
+
+(** Sucessful return of [[]] *)
+val return_nil : 'a list tzresult Lwt.t
+
+(** Sucessful return of [true] *)
+val return_true : bool tzresult Lwt.t
+
+(** Sucessful return of [false] *)
+val return_false : bool tzresult Lwt.t
+
+(** Erroneous result *)
+val error : error -> 'a tzresult
+
+(** Erroneous return *)
+val fail : error -> 'a tzresult Lwt.t
+
+(** Non-Lwt bind operator *)
+val (>>?) : 'a tzresult -> ('a -> 'b tzresult) -> 'b tzresult
+
+(** Bind operator *)
+val (>>=?) : 'a tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t
+
+(** Lwt's bind reexported *)
+val (>>=) : 'a Lwt.t -> ('a -> 'b Lwt.t) -> 'b Lwt.t
+val (>|=) : 'a Lwt.t -> ('a -> 'b) -> 'b Lwt.t
+
+(** To operator *)
+val (>>|?) : 'a tzresult Lwt.t -> ('a -> 'b) -> 'b tzresult Lwt.t
+
+(** Non-Lwt to operator *)
+val (>|?) : 'a tzresult -> ('a -> 'b) -> 'b tzresult
+
+(** Enrich an error report (or do nothing on a successful result) manually *)
+val record_trace : error -> 'a tzresult -> 'a tzresult
+
+(** Automatically enrich error reporting on stack rewind *)
+val trace : error -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
+
+(** Same as record_trace, for unevaluated error *)
+val record_trace_eval : (unit -> error tzresult) -> 'a tzresult -> 'a tzresult
+
+(** Same as trace, for unevaluated Lwt error *)
+val trace_eval : (unit -> error tzresult Lwt.t) -> 'b tzresult Lwt.t -> 'b tzresult Lwt.t
+
+(** Erroneous return on failed assertion *)
+val fail_unless : bool -> error -> unit tzresult Lwt.t
+
+(** Erroneous return on successful assertion *)
+val fail_when : bool -> error -> unit tzresult Lwt.t
+
+(** {2 In-monad list iterators} **********************************************)
+
+(** A {!List.iter} in the monad *)
+val iter_s : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
+val iter_p : ('a -> unit tzresult Lwt.t) -> 'a list -> unit tzresult Lwt.t
+
+(** A {!List.map} in the monad *)
+val map_s : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+val map_p : ('a -> 'b tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+
+(** A {!List.map2} in the monad *)
+val map2 :
+  ('a -> 'b -> 'c tzresult) -> 'a list -> 'b list -> 'c list tzresult
+
+(** A {!List.map2} in the monad *)
+val map2_s :
+  ('a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
+  'c list tzresult Lwt.t
+
+(** A {!List.filter_map} in the monad *)
+val filter_map_s : ('a -> 'b option tzresult Lwt.t) -> 'a list -> 'b list tzresult Lwt.t
+
+(** A {!List.fold_left} in the monad *)
+val fold_left_s : ('a -> 'b -> 'a tzresult Lwt.t) -> 'a -> 'b list -> 'a tzresult Lwt.t
+
+(** A {!List.fold_right} in the monad *)
+val fold_right_s : ('a -> 'b -> 'b tzresult Lwt.t) -> 'a list -> 'b -> 'b tzresult Lwt.t
+
+
+(**/**)
+
+type shell_error
+type 'a shell_tzresult = ('a, shell_error list) result
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/fitness.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/fitness.mli
new file mode 100644
index 000000000..426e3adce
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/fitness.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The fitness of a block is defined as a list of bytes,
+    compared in a lexicographical order (longer list are greater). *)
+include S.T with type t = MBytes.t list
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/format.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/format.mli
new file mode 100644
index 000000000..73cc075b8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/format.mli
@@ -0,0 +1,756 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Pierre Weis, projet Cristal, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TEZOS CHANGES
+
+   * Import version 4.06.1
+   * Remove channel functions
+   * Remove toplevel effect based functions
+   * Remove deprecated functions
+   * Remove redirecting the standard formatter output
+   * Remove redefining formatter output and output functions
+   * Remove redefining semantic tag operations (too complex and
+     imperative for the need of error message generation)
+   * Remove defining formatters and symbolic pretty printing
+*)
+
+(** Pretty-printing.
+
+    This module implements a pretty-printing facility to format values
+    within {{!boxes}'pretty-printing boxes'} and {{!tags}'semantic tags'}
+    combined with a set of {{!fpp}printf-like functions}.
+    The pretty-printer splits lines at specified {{!breaks}break hints},
+    and indents lines according to the box structure.
+    Similarly, {{!tags}semantic tags} can be used to decouple text
+    presentation from its contents.
+
+    This pretty-printing facility is implemented as an overlay on top of
+    abstract {{!section:formatter}formatters} which provide basic output
+    functions.
+    Some formatters are predefined, notably:
+    - {!std_formatter} outputs to {{!Pervasives.stdout}stdout}
+    - {!err_formatter} outputs to {{!Pervasives.stderr}stderr}
+
+    Most functions in the {!Format} module come in two variants:
+    a short version that operates on {!std_formatter} and the
+    generic version prefixed by [pp_] that takes a formatter
+    as its first argument.
+
+    More formatters can be created with {!formatter_of_out_channel},
+    {!formatter_of_buffer}, {!formatter_of_symbolic_output_buffer}
+    or using {{!section:formatter}custom formatters}.
+
+*)
+
+(** {1 Introduction}
+    For a gentle introduction to the basics of pretty-printing using
+    [Format], read
+    {{:http://caml.inria.fr/resources/doc/guides/format.en.html}
+    http://caml.inria.fr/resources/doc/guides/format.en.html}.
+
+    You may consider this module as providing an extension to the
+    [printf] facility to provide automatic line splitting. The addition of
+    pretty-printing annotations to your regular [printf] format strings gives
+    you fancy indentation and line breaks.
+    Pretty-printing annotations are described below in the documentation of
+    the function {!Format.fprintf}.
+
+    You may also use the explicit pretty-printing box management and printing
+    functions provided by this module. This style is more basic but more
+    verbose than the concise [fprintf] format strings.
+
+    For instance, the sequence
+    [open_box 0; print_string "x ="; print_space ();
+    print_int 1; close_box (); print_newline ()]
+    that prints [x = 1] within a pretty-printing box, can be
+    abbreviated as [printf "@[%s@ %i@]@." "x =" 1], or even shorter
+    [printf "@[x =@ %i@]@." 1].
+
+    Rule of thumb for casual users of this library:
+    - use simple pretty-printing boxes (as obtained by [open_box 0]);
+    - use simple break hints as obtained by [print_cut ()] that outputs a
+    simple break hint, or by [print_space ()] that outputs a space
+    indicating a break hint;
+    - once a pretty-printing box is open, display its material with basic
+    printing functions (e. g. [print_int] and [print_string]);
+    - when the material for a pretty-printing box has been printed, call
+    [close_box ()] to close the box;
+    - at the end of pretty-printing, flush the pretty-printer to display all
+    the remaining material, e.g. evaluate [print_newline ()].
+
+    The behavior of pretty-printing commands is unspecified
+    if there is no open pretty-printing box. Each box opened by
+    one of the [open_] functions below must be closed using [close_box]
+    for proper formatting. Otherwise, some of the material printed in the
+    boxes may not be output, or may be formatted incorrectly.
+
+    In case of interactive use, each phrase is executed in the initial state
+    of the standard pretty-printer: after each phrase execution, the
+    interactive system closes all open pretty-printing boxes, flushes all
+    pending text, and resets the standard pretty-printer.
+
+    Warning: mixing calls to pretty-printing functions of this module with
+    calls to {!Pervasives} low level output functions is error prone.
+
+    The pretty-printing functions output material that is delayed in the
+    pretty-printer queue and stacks in order to compute proper line
+    splitting. In contrast, basic I/O output functions write directly in
+    their output device. As a consequence, the output of a basic I/O function
+    may appear before the output of a pretty-printing function that has been
+    called before. For instance,
+    [
+    Pervasives.print_string "<";
+    Format.print_string "PRETTY";
+    Pervasives.print_string ">";
+    Format.print_string "TEXT";
+    ]
+    leads to output [<>PRETTYTEXT].
+
+*)
+
+type formatter
+(** Abstract data corresponding to a pretty-printer (also called a
+    formatter) and all its machinery. See also {!section:formatter}. *)
+
+(** {1:boxes Pretty-printing boxes} *)
+
+(** The pretty-printing engine uses the concepts of pretty-printing box and
+    break hint to drive indentation and line splitting behavior of the
+    pretty-printer.
+
+    Each different pretty-printing box kind introduces a specific line splitting
+    policy:
+
+    - within an {e horizontal} box, break hints never split the line (but the
+    line may be split in a box nested deeper),
+    - within a {e vertical} box, break hints always split the line,
+    - within an {e horizontal/vertical} box, if the box fits on the current line
+    then break hints never split the line, otherwise break hint always split
+    the line,
+    - within a {e compacting} box, a break hint never splits the line,
+    unless there is no more room on the current line.
+
+    Note that line splitting policy is box specific: the policy of a box does
+    not rule the policy of inner boxes. For instance, if a vertical box is
+    nested in an horizontal box, all break hints within the vertical box will
+    split the line.
+*)
+
+val pp_open_box : formatter -> int -> unit
+(** [pp_open_box ppf d] opens a new compacting pretty-printing box with
+    offset [d] in the formatter [ppf].
+
+    Within this box, the pretty-printer prints as much as possible material on
+    every line.
+
+    A break hint splits the line if there is no more room on the line to
+    print the remainder of the box.
+
+    Within this box, the pretty-printer emphasizes the box structure: a break
+    hint also splits the line if the splitting ``moves to the left''
+    (i.e. the new line gets an indentation smaller than the one of the current
+    line).
+
+    This box is the general purpose pretty-printing box.
+
+    If the pretty-printer splits the line in the box, offset [d] is added to
+    the current indentation.
+*)
+
+
+val pp_close_box : formatter -> unit -> unit
+(** Closes the most recently open pretty-printing box. *)
+
+val pp_open_hbox : formatter -> unit -> unit
+(** [pp_open_hbox ppf ()] opens a new 'horizontal' pretty-printing box.
+
+    This box prints material on a single line.
+
+    Break hints in a horizontal box never split the line.
+    (Line splitting may still occur inside boxes nested deeper).
+*)
+
+val pp_open_vbox : formatter -> int -> unit
+(** [pp_open_vbox ppf d] opens a new 'vertical' pretty-printing box
+    with offset [d].
+
+    This box prints material on as many lines as break hints in the box.
+
+    Every break hint in a vertical box splits the line.
+
+    If the pretty-printer splits the line in the box, [d] is added to the
+    current indentation.
+*)
+
+val pp_open_hvbox : formatter -> int -> unit
+(** [pp_open_hvbox ppf d] opens a new 'horizontal/vertical' pretty-printing box
+    with offset [d].
+
+    This box behaves as an horizontal box if it fits on a single line,
+    otherwise it behaves as a vertical box.
+
+    If the pretty-printer splits the line in the box, [d] is added to the
+    current indentation.
+*)
+
+val pp_open_hovbox : formatter -> int -> unit
+(** [pp_open_hovbox ppf d] opens a new 'horizontal-or-vertical'
+    pretty-printing box with offset [d].
+
+    This box prints material as much as possible on every line.
+
+    A break hint splits the line if there is no more room on the line to
+    print the remainder of the box.
+
+    If the pretty-printer splits the line in the box, [d] is added to the
+    current indentation.
+*)
+
+(** {1 Formatting functions} *)
+
+val pp_print_string : formatter -> string -> unit
+(** [pp_print_string ppf s] prints [s] in the current pretty-printing box. *)
+
+val pp_print_as : formatter -> int -> string -> unit
+(** [pp_print_as ppf len s] prints [s] in the current pretty-printing box.
+    The pretty-printer formats [s] as if it were of length [len].
+*)
+
+val pp_print_int : formatter -> int -> unit
+(** Print an integer in the current pretty-printing box. *)
+
+val pp_print_float : formatter -> float -> unit
+(** Print a floating point number in the current pretty-printing box. *)
+
+val pp_print_char : formatter -> char -> unit
+(** Print a character in the current pretty-printing box. *)
+
+val pp_print_bool : formatter -> bool -> unit
+(** Print a boolean in the current pretty-printing box. *)
+
+(** {1:breaks Break hints} *)
+
+(** A 'break hint' tells the pretty-printer to output some space or split the
+    line whichever way is more appropriate to the current pretty-printing box
+    splitting rules.
+
+    Break hints are used to separate printing items and are mandatory to let
+    the pretty-printer correctly split lines and indent items.
+
+    Simple break hints are:
+    - the 'space': output a space or split the line if appropriate,
+    - the 'cut': split the line if appropriate.
+
+    Note: the notions of space and line splitting are abstract for the
+    pretty-printing engine, since those notions can be completely redefined
+    by the programmer.
+    However, in the pretty-printer default setting, ``output a space'' simply
+    means printing a space character (ASCII code 32) and ``split the line''
+    means printing a newline character (ASCII code 10).
+*)
+
+val pp_print_space : formatter -> unit -> unit
+(** [pp_print_space ppf ()] emits a 'space' break hint:
+    the pretty-printer may split the line at this point,
+    otherwise it prints one space.
+
+    [pp_print_space ppf ()] is equivalent to [pp_print_break ppf 1 0].
+*)
+
+val pp_print_cut : formatter -> unit -> unit
+(** [pp_print_cut ppf ()] emits a 'cut' break hint:
+    the pretty-printer may split the line at this point,
+    otherwise it prints nothing.
+
+    [pp_print_cut ppf ()] is equivalent to [pp_print_break ppf 0 0].
+*)
+
+val pp_print_break : formatter -> int -> int -> unit
+(** [pp_print_break ppf nspaces offset] emits a 'full' break hint:
+    the pretty-printer may split the line at this point,
+    otherwise it prints [nspaces] spaces.
+
+    If the pretty-printer splits the line, [offset] is added to
+    the current indentation.
+*)
+
+val pp_force_newline : formatter -> unit -> unit
+(** Force a new line in the current pretty-printing box.
+
+    The pretty-printer must split the line at this point,
+
+    Not the normal way of pretty-printing, since imperative line splitting may
+    interfere with current line counters and box size calculation.
+    Using break hints within an enclosing vertical box is a better
+    alternative.
+*)
+
+val pp_print_if_newline : formatter -> unit -> unit
+(** Execute the next formatting command if the preceding line
+    has just been split. Otherwise, ignore the next formatting
+    command.
+*)
+
+(** {1 Pretty-printing termination} *)
+
+val pp_print_flush : formatter -> unit -> unit
+(** End of pretty-printing: resets the pretty-printer to initial state.
+
+    All open pretty-printing boxes are closed, all pending text is printed.
+    In addition, the pretty-printer low level output device is flushed to
+    ensure that all pending text is really displayed.
+
+    Note: never use [print_flush] in the normal course of a pretty-printing
+    routine, since the pretty-printer uses a complex buffering machinery to
+    properly indent the output; manually flushing those buffers at random
+    would conflict with the pretty-printer strategy and result to poor
+    rendering.
+
+    Only consider using [print_flush] when displaying all pending material is
+    mandatory (for instance in case of interactive use when you want the user
+    to read some text) and when resetting the pretty-printer state will not
+    disturb further pretty-printing.
+
+    Warning: If the output device of the pretty-printer is an output channel,
+    repeated calls to [print_flush] means repeated calls to {!Pervasives.flush}
+    to flush the out channel; these explicit flush calls could foil the
+    buffering strategy of output channels and could dramatically impact
+    efficiency.
+*)
+
+val pp_print_newline : formatter -> unit -> unit
+(** End of pretty-printing: resets the pretty-printer to initial state.
+
+    All open pretty-printing boxes are closed, all pending text is printed.
+
+    Equivalent to {!print_flush} followed by a new line.
+    See corresponding words of caution for {!print_flush}.
+
+    Note: this is not the normal way to output a new line;
+    the preferred method is using break hints within a vertical pretty-printing
+    box.
+*)
+
+(** {1 Margin} *)
+
+val pp_set_margin : formatter -> int -> unit
+(** [pp_set_margin ppf d] sets the right margin to [d] (in characters):
+    the pretty-printer splits lines that overflow the right margin according to
+    the break hints given.
+    Nothing happens if [d] is smaller than 2.
+    If [d] is too large, the right margin is set to the maximum
+    admissible value (which is greater than [10 ^ 9]).
+    If [d] is less than the current maximum indentation limit, the
+    maximum indentation limit is decreased while trying to preserve
+    a minimal ratio [max_indent/margin>=50%] and if possible
+    the current difference [margin - max_indent].
+*)
+
+val pp_get_margin : formatter -> unit -> int
+(** Returns the position of the right margin. *)
+
+(** {1 Maximum indentation limit} *)
+
+val pp_set_max_indent : formatter -> int -> unit
+(** [pp_set_max_indent ppf d] sets the maximum indentation limit of lines
+    to [d] (in characters):
+    once this limit is reached, new pretty-printing boxes are rejected to the
+    left, if they do not fit on the current line.
+
+    Nothing happens if [d] is smaller than 2.
+    If [d] is too large, the limit is set to the maximum
+    admissible value (which is greater than [10 ^ 9]).
+
+    If [d] is greater or equal than the current margin, it is ignored,
+    and the current maximum indentation limit is kept.
+*)
+
+val pp_get_max_indent : formatter -> unit -> int
+(** Return the maximum indentation limit (in characters). *)
+
+(** {1 Maximum formatting depth} *)
+
+(** The maximum formatting depth is the maximum number of pretty-printing
+    boxes simultaneously open.
+
+    Material inside boxes nested deeper is printed as an ellipsis (more
+    precisely as the text returned by {!get_ellipsis_text} [()]).
+*)
+
+val pp_set_max_boxes : formatter -> int -> unit
+(** [pp_set_max_boxes ppf max] sets the maximum number of pretty-printing
+    boxes simultaneously open.
+
+    Material inside boxes nested deeper is printed as an ellipsis (more
+    precisely as the text returned by {!get_ellipsis_text} [()]).
+
+    Nothing happens if [max] is smaller than 2.
+*)
+
+val pp_get_max_boxes : formatter -> unit -> int
+(** Returns the maximum number of pretty-printing boxes allowed before
+    ellipsis.
+*)
+
+val pp_over_max_boxes : formatter -> unit -> bool
+(** Tests if the maximum number of pretty-printing boxes allowed have already
+    been opened.
+*)
+
+(** {1 Tabulation boxes} *)
+
+(**
+
+   A {e tabulation box} prints material on lines divided into cells of fixed
+   length. A tabulation box provides a simple way to display vertical columns
+   of left adjusted text.
+
+   This box features command [set_tab] to define cell boundaries, and command
+   [print_tab] to move from cell to cell and split the line when there is no
+   more cells to print on the line.
+
+   Note: printing within tabulation box is line directed, so arbitrary line
+   splitting inside a tabulation box leads to poor rendering. Yet, controlled
+   use of tabulation boxes allows simple printing of columns within
+   module {!Format}.
+*)
+
+val pp_open_tbox : formatter -> unit -> unit
+(** [open_tbox ()] opens a new tabulation box.
+
+    This box prints lines separated into cells of fixed width.
+
+    Inside a tabulation box, special {e tabulation markers} defines points of
+    interest on the line (for instance to delimit cell boundaries).
+    Function {!Format.set_tab} sets a tabulation marker at insertion point.
+
+    A tabulation box features specific {e tabulation breaks} to move to next
+    tabulation marker or split the line. Function {!Format.print_tbreak} prints
+    a tabulation break.
+*)
+
+val pp_close_tbox : formatter -> unit -> unit
+(** Closes the most recently opened tabulation box. *)
+
+val pp_set_tab : formatter -> unit -> unit
+(** Sets a tabulation marker at current insertion point. *)
+
+val pp_print_tab : formatter -> unit -> unit
+(** [print_tab ()] emits a 'next' tabulation break hint: if not already set on
+    a tabulation marker, the insertion point moves to the first tabulation
+    marker on the right, or the pretty-printer splits the line and insertion
+    point moves to the leftmost tabulation marker.
+
+    It is equivalent to [print_tbreak 0 0]. *)
+
+val pp_print_tbreak : formatter -> int -> int -> unit
+(** [print_tbreak nspaces offset] emits a 'full' tabulation break hint.
+
+    If not already set on a tabulation marker, the insertion point moves to the
+    first tabulation marker on the right and the pretty-printer prints
+    [nspaces] spaces.
+
+    If there is no next tabulation marker on the right, the pretty-printer
+    splits the line at this point, then insertion point moves to the leftmost
+    tabulation marker of the box.
+
+    If the pretty-printer splits the line, [offset] is added to
+    the current indentation.
+*)
+
+(** {1 Ellipsis} *)
+
+val pp_set_ellipsis_text : formatter -> string -> unit
+(** Set the text of the ellipsis printed when too many pretty-printing boxes
+    are open (a single dot, [.], by default).
+*)
+
+val pp_get_ellipsis_text : formatter -> unit -> string
+(** Return the text of the ellipsis. *)
+
+(** {1:tags Semantic tags} *)
+
+type tag = string
+
+(** {i Semantic tags} (or simply {e tags}) are user's defined delimiters
+    to associate user's specific operations to printed entities.
+
+    Common usage of semantic tags is text decoration to get specific font or
+    text size rendering for a display device, or marking delimitation of
+    entities (e.g. HTML or TeX elements or terminal escape sequences).
+    More sophisticated usage of semantic tags could handle dynamic
+    modification of the pretty-printer behavior to properly print the material
+    within some specific tags.
+
+    In order to properly delimit printed entities, a semantic tag must be
+    opened before and closed after the entity. Semantic tags must be properly
+    nested like parentheses.
+
+    Tag specific operations occur any time a tag is opened or closed, At each
+    occurrence, two kinds of operations are performed {e tag-marking} and
+    {e tag-printing}:
+    - The tag-marking operation is the simpler tag specific operation: it simply
+    writes a tag specific string into the output device of the
+    formatter. Tag-marking does not interfere with line-splitting computation.
+    - The tag-printing operation is the more involved tag specific operation: it
+    can print arbitrary material to the formatter. Tag-printing is tightly
+    linked to the current pretty-printer operations.
+
+    Roughly speaking, tag-marking is commonly used to get a better rendering of
+    texts in the rendering device, while tag-printing allows fine tuning of
+    printing routines to print the same entity differently according to the
+    semantic tags (i.e. print additional material or even omit parts of the
+    output).
+
+    More precisely: when a semantic tag is opened or closed then both and
+    successive 'tag-printing' and 'tag-marking' operations occur:
+    - Tag-printing a semantic tag means calling the formatter specific function
+    [print_open_tag] (resp. [print_close_tag]) with the name of the tag as
+    argument: that tag-printing function can then print any regular material
+    to the formatter (so that this material is enqueued as usual in the
+    formatter queue for further line splitting computation).
+    - Tag-marking a semantic tag means calling the formatter specific function
+    [mark_open_tag] (resp. [mark_close_tag]) with the name of the tag as
+    argument: that tag-marking function can then return the 'tag-opening
+    marker' (resp. `tag-closing marker') for direct output into the output
+    device of the formatter.
+
+    Being written directly into the output device of the formatter, semantic
+    tag marker strings are not considered as part of the printing material that
+    drives line splitting (in other words, the length of the strings
+    corresponding to tag markers is considered as zero for line splitting).
+
+    Thus, semantic tag handling is in some sense transparent to pretty-printing
+    and does not interfere with usual indentation. Hence, a single
+    pretty-printing routine can output both simple 'verbatim' material or
+    richer decorated output depending on the treatment of tags. By default,
+    tags are not active, hence the output is not decorated with tag
+    information. Once [set_tags] is set to [true], the pretty-printer engine
+    honors tags and decorates the output accordingly.
+
+    Default tag-marking functions behave the HTML way: tags are enclosed in "<"
+    and ">"; hence, opening marker for tag [t] is ["<t>"] and closing marker is
+    ["</t>"].
+
+    Default tag-printing functions just do nothing.
+
+    Tag-marking and tag-printing functions are user definable and can
+    be set by calling {!set_formatter_tag_functions}.
+
+    Semantic tag operations may be set on or off with {!set_tags}.
+    Tag-marking operations may be set on or off with {!set_mark_tags}.
+    Tag-printing operations may be set on or off with {!set_print_tags}.
+*)
+
+val pp_open_tag : formatter -> string -> unit
+(** [pp_open_tag ppf t] opens the semantic tag named [t].
+
+    The [print_open_tag] tag-printing function of the formatter is called with
+    [t] as argument; then the opening tag marker for [t], as given by
+    [mark_open_tag t], is written into the output device of the formatter.
+*)
+
+val pp_close_tag : formatter -> unit -> unit
+(** [pp_close_tag ppf ()] closes the most recently opened semantic tag [t].
+
+    The closing tag marker, as given by [mark_close_tag t], is written into the
+    output device of the formatter; then the [print_close_tag] tag-printing
+    function of the formatter is called with [t] as argument.
+*)
+
+val pp_set_tags : formatter -> bool -> unit
+(** [pp_set_tags ppf b] turns on or off the treatment of semantic tags
+    (default is off).
+*)
+
+val pp_set_print_tags : formatter -> bool -> unit
+(** [pp_set_print_tags ppf b] turns on or off the tag-printing operations. *)
+
+val pp_set_mark_tags : formatter -> bool -> unit
+(** [pp_set_mark_tags ppf b] turns on or off the tag-marking operations. *)
+
+val pp_get_print_tags : formatter -> unit -> bool
+(** Return the current status of tag-printing operations. *)
+
+val pp_get_mark_tags : formatter -> unit -> bool
+(** Return the current status of tag-marking operations. *)
+
+(** {1 Convenience formatting functions.} *)
+
+val pp_print_list:
+  ?pp_sep:(formatter -> unit -> unit) ->
+  (formatter -> 'a -> unit) -> (formatter -> 'a list -> unit)
+(** [pp_print_list ?pp_sep pp_v ppf l] prints items of list [l],
+    using [pp_v] to print each item, and calling [pp_sep]
+    between items ([pp_sep] defaults to {!pp_print_cut}.
+    Does nothing on empty lists.
+
+    @since 4.02.0
+*)
+
+val pp_print_text : formatter -> string -> unit
+(** [pp_print_text ppf s] prints [s] with spaces and newlines respectively
+    printed using {!pp_print_space} and {!pp_force_newline}.
+
+    @since 4.02.0
+*)
+
+(** {1:fpp Formatted pretty-printing} *)
+
+(**
+   Module [Format] provides a complete set of [printf] like functions for
+   pretty-printing using format string specifications.
+
+   Specific annotations may be added in the format strings to give
+   pretty-printing commands to the pretty-printing engine.
+
+   Those annotations are introduced in the format strings using the [@]
+   character. For instance, [@ ] means a space break, [@,] means a cut,
+   [@\[] opens a new box, and [@\]] closes the last open box.
+
+*)
+
+val fprintf : formatter -> ('a, formatter, unit) format -> 'a
+
+(** [fprintf ff fmt arg1 ... argN] formats the arguments [arg1] to [argN]
+    according to the format string [fmt], and outputs the resulting string on
+    the formatter [ff].
+
+    The format string [fmt] is a character string which contains three types of
+    objects: plain characters and conversion specifications as specified in
+    the {!Printf} module, and pretty-printing indications specific to the
+    [Format] module.
+
+    The pretty-printing indication characters are introduced by
+    a [@] character, and their meanings are:
+    - [@\[]: open a pretty-printing box. The type and offset of the
+    box may be optionally specified with the following syntax:
+    the [<] character, followed by an optional box type indication,
+    then an optional integer offset, and the closing [>] character.
+    Pretty-printing box type is one of [h], [v], [hv], [b], or [hov].
+    '[h]' stands for an 'horizontal' pretty-printing box,
+    '[v]' stands for a 'vertical' pretty-printing box,
+    '[hv]' stands for an 'horizontal/vertical' pretty-printing box,
+    '[b]' stands for an 'horizontal-or-vertical' pretty-printing box
+    demonstrating indentation,
+    '[hov]' stands a simple 'horizontal-or-vertical' pretty-printing box.
+    For instance, [@\[<hov 2>] opens an 'horizontal-or-vertical'
+    pretty-printing box with indentation 2 as obtained with [open_hovbox 2].
+    For more details about pretty-printing boxes, see the various box opening
+    functions [open_*box].
+    - [@\]]: close the most recently opened pretty-printing box.
+    - [@,]: output a 'cut' break hint, as with [print_cut ()].
+    - [@ ]: output a 'space' break hint, as with [print_space ()].
+    - [@;]: output a 'full' break hint as with [print_break]. The
+    [nspaces] and [offset] parameters of the break hint may be
+    optionally specified with the following syntax:
+    the [<] character, followed by an integer [nspaces] value,
+    then an integer [offset], and a closing [>] character.
+    If no parameters are provided, the good break defaults to a
+    'space' break hint.
+    - [@.]: flush the pretty-printer and split the line, as with
+    [print_newline ()].
+    - [@<n>]: print the following item as if it were of length [n].
+    Hence, [printf "@<0>%s" arg] prints [arg] as a zero length string.
+    If [@<n>] is not followed by a conversion specification,
+    then the following character of the format is printed as if
+    it were of length [n].
+    - [@\{]: open a semantic tag. The name of the tag may be optionally
+    specified with the following syntax:
+    the [<] character, followed by an optional string
+    specification, and the closing [>] character. The string
+    specification is any character string that does not contain the
+    closing character ['>']. If omitted, the tag name defaults to the
+    empty string.
+    For more details about semantic tags, see the functions {!open_tag} and
+    {!close_tag}.
+    - [@\}]: close the most recently opened semantic tag.
+    - [@?]: flush the pretty-printer as with [print_flush ()].
+    This is equivalent to the conversion [%!].
+    - [@\n]: force a newline, as with [force_newline ()], not the normal way
+    of pretty-printing, you should prefer using break hints inside a vertical
+    pretty-printing box.
+
+    Note: To prevent the interpretation of a [@] character as a
+    pretty-printing indication, escape it with a [%] character.
+    Old quotation mode [@@] is deprecated since it is not compatible with
+    formatted input interpretation of character ['@'].
+
+    Example: [printf "@[%s@ %d@]@." "x =" 1] is equivalent to
+    [open_box (); print_string "x ="; print_space ();
+    print_int 1; close_box (); print_newline ()].
+    It prints [x = 1] within a pretty-printing 'horizontal-or-vertical' box.
+
+*)
+
+val sprintf : ('a, unit, string) format -> 'a
+(** Same as [printf] above, but instead of printing on a formatter,
+    returns a string containing the result of formatting the arguments.
+    Note that the pretty-printer queue is flushed at the end of {e each
+    call} to [sprintf].
+
+    In case of multiple and related calls to [sprintf] to output
+    material on a single string, you should consider using [fprintf]
+    with the predefined formatter [str_formatter] and call
+    [flush_str_formatter ()] to get the final result.
+
+    Alternatively, you can use [Format.fprintf] with a formatter writing to a
+    buffer of your own: flushing the formatter and the buffer at the end of
+    pretty-printing returns the desired string.
+*)
+
+val asprintf : ('a, formatter, unit, string) format4 -> 'a
+(** Same as [printf] above, but instead of printing on a formatter,
+    returns a string containing the result of formatting the arguments.
+    The type of [asprintf] is general enough to interact nicely with [%a]
+    conversions.
+
+    @since 4.01.0
+*)
+
+val ifprintf : formatter -> ('a, formatter, unit) format -> 'a
+(** Same as [fprintf] above, but does not print anything.
+    Useful to ignore some material when conditionally printing.
+
+    @since 3.10.0
+*)
+
+(** Formatted Pretty-Printing with continuations. *)
+
+val kfprintf :
+  (formatter -> 'a) -> formatter ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [fprintf] above, but instead of returning immediately,
+    passes the formatter to its first argument at the end of printing. *)
+
+val ikfprintf :
+  (formatter -> 'a) -> formatter ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [kfprintf] above, but does not print anything.
+    Useful to ignore some material when conditionally printing.
+
+    @since 3.12.0
+*)
+
+val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
+(** Same as [sprintf] above, but instead of returning the string,
+    passes it to the first argument. *)
+
+val kasprintf : (string -> 'a) -> ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as [asprintf] above, but instead of returning the string,
+    passes it to the first argument.
+
+    @since 4.03
+*)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int32.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int32.mli
new file mode 100644
index 000000000..4b85af947
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int32.mli
@@ -0,0 +1,188 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TEZOS CHANGES
+
+   * Import version 4.06.1
+   * Remove deprecated functions
+
+*)
+
+(** 32-bit integers.
+
+    This module provides operations on the type [int32]
+    of signed 32-bit integers.  Unlike the built-in [int] type,
+    the type [int32] is guaranteed to be exactly 32-bit wide on all
+    platforms.  All arithmetic operations over [int32] are taken
+    modulo 2{^32}.
+
+    Performance notice: values of type [int32] occupy more memory
+    space than values of type [int], and arithmetic operations on
+    [int32] are generally slower than those on [int].  Use [int32]
+    only when the application requires exact 32-bit arithmetic. *)
+
+val zero : int32
+(** The 32-bit integer 0. *)
+
+val one : int32
+(** The 32-bit integer 1. *)
+
+val minus_one : int32
+(** The 32-bit integer -1. *)
+
+external neg : int32 -> int32 = "%int32_neg"
+(** Unary negation. *)
+
+external add : int32 -> int32 -> int32 = "%int32_add"
+(** Addition. *)
+
+external sub : int32 -> int32 -> int32 = "%int32_sub"
+(** Subtraction. *)
+
+external mul : int32 -> int32 -> int32 = "%int32_mul"
+(** Multiplication. *)
+
+external div : int32 -> int32 -> int32 = "%int32_div"
+(** Integer division.  Raise [Division_by_zero] if the second
+    argument is zero.  This division rounds the real quotient of
+    its arguments towards zero, as specified for {!Pervasives.(/)}. *)
+
+external rem : int32 -> int32 -> int32 = "%int32_mod"
+(** Integer remainder.  If [y] is not zero, the result
+    of [Int32.rem x y] satisfies the following property:
+    [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)].
+    If [y = 0], [Int32.rem x y] raises [Division_by_zero]. *)
+
+val succ : int32 -> int32
+(** Successor.  [Int32.succ x] is [Int32.add x Int32.one]. *)
+
+val pred : int32 -> int32
+(** Predecessor.  [Int32.pred x] is [Int32.sub x Int32.one]. *)
+
+val abs : int32 -> int32
+(** Return the absolute value of its argument. *)
+
+val max_int : int32
+(** The greatest representable 32-bit integer, 2{^31} - 1. *)
+
+val min_int : int32
+(** The smallest representable 32-bit integer, -2{^31}. *)
+
+
+external logand : int32 -> int32 -> int32 = "%int32_and"
+(** Bitwise logical and. *)
+
+external logor : int32 -> int32 -> int32 = "%int32_or"
+(** Bitwise logical or. *)
+
+external logxor : int32 -> int32 -> int32 = "%int32_xor"
+(** Bitwise logical exclusive or. *)
+
+val lognot : int32 -> int32
+(** Bitwise logical negation. *)
+
+external shift_left : int32 -> int -> int32 = "%int32_lsl"
+(** [Int32.shift_left x y] shifts [x] to the left by [y] bits.
+    The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external shift_right : int32 -> int -> int32 = "%int32_asr"
+(** [Int32.shift_right x y] shifts [x] to the right by [y] bits.
+    This is an arithmetic shift: the sign bit of [x] is replicated
+    and inserted in the vacated bits.
+    The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
+(** [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits.
+    This is a logical shift: zeroes are inserted in the vacated bits
+    regardless of the sign of [x].
+    The result is unspecified if [y < 0] or [y >= 32]. *)
+
+external of_int : int -> int32 = "%int32_of_int"
+(** Convert the given integer (type [int]) to a 32-bit integer
+    (type [int32]). *)
+
+external to_int : int32 -> int = "%int32_to_int"
+(** Convert the given 32-bit integer (type [int32]) to an
+    integer (type [int]).  On 32-bit platforms, the 32-bit integer
+    is taken modulo 2{^31}, i.e. the high-order bit is lost
+    during the conversion.  On 64-bit platforms, the conversion
+    is exact. *)
+
+external of_float : float -> int32
+  = "caml_int32_of_float" "caml_int32_of_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Convert the given floating-point number to a 32-bit integer,
+    discarding the fractional part (truncate towards 0).
+    The result of the conversion is undefined if, after truncation,
+    the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. *)
+
+external to_float : int32 -> float
+  = "caml_int32_to_float" "caml_int32_to_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Convert the given 32-bit integer to a floating-point number. *)
+
+external of_string : string -> int32 = "caml_int32_of_string"
+(** Convert the given string to a 32-bit integer.
+    The string is read in decimal (by default, or if the string
+    begins with [0u]) or in hexadecimal, octal or binary if the
+    string begins with [0x], [0o] or [0b] respectively.
+
+    The [0u] prefix reads the input as an unsigned integer in the range
+    [[0, 2*Int32.max_int+1]].  If the input exceeds {!Int32.max_int}
+    it is converted to the signed integer
+    [Int32.min_int + input - Int32.max_int - 1].
+
+    The [_] (underscore) character can appear anywhere in the string
+    and is ignored.
+    Raise [Failure "Int32.of_string"] if the given string is not
+    a valid representation of an integer, or if the integer represented
+    exceeds the range of integers representable in type [int32]. *)
+
+val of_string_opt: string -> int32 option
+(** Same as [of_string], but return [None] instead of raising.
+    @since 4.05 *)
+
+
+val to_string : int32 -> string
+(** Return the string representation of its argument, in signed decimal. *)
+
+external bits_of_float : float -> int32
+  = "caml_int32_bits_of_float" "caml_int32_bits_of_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Return the internal representation of the given float according
+    to the IEEE 754 floating-point 'single format' bit layout.
+    Bit 31 of the result represents the sign of the float;
+    bits 30 to 23 represent the (biased) exponent; bits 22 to 0
+    represent the mantissa. *)
+
+external float_of_bits : int32 -> float
+  = "caml_int32_float_of_bits" "caml_int32_float_of_bits_unboxed"
+[@@unboxed] [@@noalloc]
+(** Return the floating-point number whose internal representation,
+    according to the IEEE 754 floating-point 'single format' bit layout,
+    is the given [int32]. *)
+
+type t = int32
+(** An alias for the type of 32-bit integers. *)
+
+val compare: t -> t -> int
+(** The comparison function for 32-bit integers, with the same specification as
+    {!Pervasives.compare}.  Along with the type [t], this function [compare]
+    allows the module [Int32] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for int32s.
+    @since 4.03.0 *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int64.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int64.mli
new file mode 100644
index 000000000..0ea0ec32c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/int64.mli
@@ -0,0 +1,208 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TEZOS CHANGES
+
+   * Import version 4.06.1
+   * Remove deprecated functions
+
+*)
+(** 64-bit integers.
+
+    This module provides operations on the type [int64] of
+    signed 64-bit integers.  Unlike the built-in [int] type,
+    the type [int64] is guaranteed to be exactly 64-bit wide on all
+    platforms.  All arithmetic operations over [int64] are taken
+    modulo 2{^64}
+
+    Performance notice: values of type [int64] occupy more memory
+    space than values of type [int], and arithmetic operations on
+    [int64] are generally slower than those on [int].  Use [int64]
+    only when the application requires exact 64-bit arithmetic.
+*)
+
+val zero : int64
+(** The 64-bit integer 0. *)
+
+val one : int64
+(** The 64-bit integer 1. *)
+
+val minus_one : int64
+(** The 64-bit integer -1. *)
+
+external neg : int64 -> int64 = "%int64_neg"
+(** Unary negation. *)
+
+external add : int64 -> int64 -> int64 = "%int64_add"
+(** Addition. *)
+
+external sub : int64 -> int64 -> int64 = "%int64_sub"
+(** Subtraction. *)
+
+external mul : int64 -> int64 -> int64 = "%int64_mul"
+(** Multiplication. *)
+
+external div : int64 -> int64 -> int64 = "%int64_div"
+(** Integer division.  Raise [Division_by_zero] if the second
+    argument is zero.  This division rounds the real quotient of
+    its arguments towards zero, as specified for {!Pervasives.(/)}. *)
+
+external rem : int64 -> int64 -> int64 = "%int64_mod"
+(** Integer remainder.  If [y] is not zero, the result
+    of [Int64.rem x y] satisfies the following property:
+    [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)].
+    If [y = 0], [Int64.rem x y] raises [Division_by_zero]. *)
+
+val succ : int64 -> int64
+(** Successor.  [Int64.succ x] is [Int64.add x Int64.one]. *)
+
+val pred : int64 -> int64
+(** Predecessor.  [Int64.pred x] is [Int64.sub x Int64.one]. *)
+
+val abs : int64 -> int64
+(** Return the absolute value of its argument. *)
+
+val max_int : int64
+(** The greatest representable 64-bit integer, 2{^63} - 1. *)
+
+val min_int : int64
+(** The smallest representable 64-bit integer, -2{^63}. *)
+
+external logand : int64 -> int64 -> int64 = "%int64_and"
+(** Bitwise logical and. *)
+
+external logor : int64 -> int64 -> int64 = "%int64_or"
+(** Bitwise logical or. *)
+
+external logxor : int64 -> int64 -> int64 = "%int64_xor"
+(** Bitwise logical exclusive or. *)
+
+val lognot : int64 -> int64
+(** Bitwise logical negation. *)
+
+external shift_left : int64 -> int -> int64 = "%int64_lsl"
+(** [Int64.shift_left x y] shifts [x] to the left by [y] bits.
+    The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external shift_right : int64 -> int -> int64 = "%int64_asr"
+(** [Int64.shift_right x y] shifts [x] to the right by [y] bits.
+    This is an arithmetic shift: the sign bit of [x] is replicated
+    and inserted in the vacated bits.
+    The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external shift_right_logical : int64 -> int -> int64 = "%int64_lsr"
+(** [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits.
+    This is a logical shift: zeroes are inserted in the vacated bits
+    regardless of the sign of [x].
+    The result is unspecified if [y < 0] or [y >= 64]. *)
+
+external of_int : int -> int64 = "%int64_of_int"
+(** Convert the given integer (type [int]) to a 64-bit integer
+    (type [int64]). *)
+
+external to_int : int64 -> int = "%int64_to_int"
+(** Convert the given 64-bit integer (type [int64]) to an
+    integer (type [int]).  On 64-bit platforms, the 64-bit integer
+    is taken modulo 2{^63}, i.e. the high-order bit is lost
+    during the conversion.  On 32-bit platforms, the 64-bit integer
+    is taken modulo 2{^31}, i.e. the top 33 bits are lost
+    during the conversion. *)
+
+external of_float : float -> int64
+  = "caml_int64_of_float" "caml_int64_of_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Convert the given floating-point number to a 64-bit integer,
+    discarding the fractional part (truncate towards 0).
+    The result of the conversion is undefined if, after truncation,
+    the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. *)
+
+external to_float : int64 -> float
+  = "caml_int64_to_float" "caml_int64_to_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Convert the given 64-bit integer to a floating-point number. *)
+
+
+external of_int32 : int32 -> int64 = "%int64_of_int32"
+(** Convert the given 32-bit integer (type [int32])
+    to a 64-bit integer (type [int64]). *)
+
+external to_int32 : int64 -> int32 = "%int64_to_int32"
+(** Convert the given 64-bit integer (type [int64]) to a
+    32-bit integer (type [int32]). The 64-bit integer
+    is taken modulo 2{^32}, i.e. the top 32 bits are lost
+    during the conversion.  *)
+
+external of_nativeint : nativeint -> int64 = "%int64_of_nativeint"
+(** Convert the given native integer (type [nativeint])
+    to a 64-bit integer (type [int64]). *)
+
+external to_nativeint : int64 -> nativeint = "%int64_to_nativeint"
+(** Convert the given 64-bit integer (type [int64]) to a
+    native integer.  On 32-bit platforms, the 64-bit integer
+    is taken modulo 2{^32}.  On 64-bit platforms,
+    the conversion is exact. *)
+
+external of_string : string -> int64 = "caml_int64_of_string"
+(** Convert the given string to a 64-bit integer.
+    The string is read in decimal (by default, or if the string
+    begins with [0u]) or in hexadecimal, octal or binary if the
+    string begins with [0x], [0o] or [0b] respectively.
+
+    The [0u] prefix reads the input as an unsigned integer in the range
+    [[0, 2*Int64.max_int+1]].  If the input exceeds {!Int64.max_int}
+    it is converted to the signed integer
+    [Int64.min_int + input - Int64.max_int - 1].
+
+    The [_] (underscore) character can appear anywhere in the string
+    and is ignored.
+    Raise [Failure "Int64.of_string"] if the given string is not
+    a valid representation of an integer, or if the integer represented
+    exceeds the range of integers representable in type [int64]. *)
+
+val of_string_opt: string -> int64 option
+(** Same as [of_string], but return [None] instead of raising.
+    @since 4.05 *)
+
+val to_string : int64 -> string
+(** Return the string representation of its argument, in decimal. *)
+
+external bits_of_float : float -> int64
+  = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed"
+[@@unboxed] [@@noalloc]
+(** Return the internal representation of the given float according
+    to the IEEE 754 floating-point 'double format' bit layout.
+    Bit 63 of the result represents the sign of the float;
+    bits 62 to 52 represent the (biased) exponent; bits 51 to 0
+    represent the mantissa. *)
+
+external float_of_bits : int64 -> float
+  = "caml_int64_float_of_bits" "caml_int64_float_of_bits_unboxed"
+[@@unboxed] [@@noalloc]
+(** Return the floating-point number whose internal representation,
+    according to the IEEE 754 floating-point 'double format' bit layout,
+    is the given [int64]. *)
+
+type t = int64
+(** An alias for the type of 64-bit integers. *)
+
+val compare: t -> t -> int
+(** The comparison function for 64-bit integers, with the same specification as
+    {!Pervasives.compare}.  Along with the type [t], this function [compare]
+    allows the module [Int64] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for int64s.
+    @since 4.03.0 *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/json.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/json.mli
new file mode 100644
index 000000000..c84efdaca
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/json.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** In memory JSON data *)
+type json =
+  [ `O of (string * json) list
+  | `Bool of bool
+  | `Float of float
+  | `A of json list
+  | `Null
+  | `String of string ]
+
+(** Read a JSON document from a string. *)
+val from_string : string -> (json, string) result
+
+(** Write a JSON document to a string. This goes via an intermediate
+    buffer and so may be slow on large documents. *)
+val to_string : json -> string
+
+(** Helpers for [Data_encoding] *)
+val cannot_destruct : ('a, Format.formatter, unit, 'b) format4 -> 'a
+val wrap_error : ('a -> 'b) -> 'a -> 'b
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/list.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/list.mli
new file mode 100644
index 000000000..1e37377d8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/list.mli
@@ -0,0 +1,323 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** List operations.
+
+    Some functions are flagged as not tail-recursive.  A tail-recursive
+    function uses constant stack space, while a non-tail-recursive function
+    uses stack space proportional to the length of its list argument, which
+    can be a problem with very long lists.  When the function takes several
+    list arguments, an approximate formula giving stack usage (in some
+    unspecified constant unit) is shown in parentheses.
+
+    The above considerations can usually be ignored if your lists are not
+    longer than about 10000 elements.
+*)
+
+val length : 'a list -> int
+(** Return the length (number of elements) of the given list. *)
+
+val compare_lengths : 'a list -> 'b list -> int
+(** Compare the lengths of two lists. [compare_lengths l1 l2] is
+    equivalent to [compare (length l1) (length l2)], except that
+    the computation stops after itering on the shortest list.
+    @since 4.05.0
+*)
+
+val compare_length_with : 'a list -> int -> int
+(** Compare the length of a list to an integer. [compare_length_with l n] is
+    equivalent to [compare (length l) n], except that
+    the computation stops after at most [n] iterations on the list.
+    @since 4.05.0
+*)
+
+val cons : 'a -> 'a list -> 'a list
+(** [cons x xs] is [x :: xs]
+    @since 4.03.0
+*)
+
+val hd : 'a list -> 'a
+(** Return the first element of the given list. Raise
+    [Failure "hd"] if the list is empty. *)
+
+val tl : 'a list -> 'a list
+(** Return the given list without its first element. Raise
+    [Failure "tl"] if the list is empty. *)
+
+val nth_opt : 'a list -> int -> 'a option
+(** Return the [n]-th element of the given list.
+    The first element (head of the list) is at position 0.
+    Return [None] if the list is too short.
+    Raise [Invalid_argument "List.nth"] if [n] is negative.
+    @since 4.05
+*)
+
+val rev : 'a list -> 'a list
+(** List reversal. *)
+
+val init : int -> (int -> 'a) -> 'a list
+(** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right.
+
+    @raise Invalid_argument if len < 0.
+    @since 4.06.0
+*)
+
+val append : 'a list -> 'a list -> 'a list
+(** Concatenate two lists.  Same as the infix operator [@].
+    Not tail-recursive (length of the first argument).  *)
+
+val rev_append : 'a list -> 'a list -> 'a list
+(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2].
+    This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is
+    tail-recursive and more efficient. *)
+
+val concat : 'a list list -> 'a list
+(** Concatenate a list of lists.  The elements of the argument are all
+    concatenated together (in the same order) to give the result.
+    Not tail-recursive
+    (length of the argument + length of the longest sub-list). *)
+
+val flatten : 'a list list -> 'a list
+(** An alias for [concat]. *)
+
+
+(** {1 Iterators} *)
+
+
+val iter : ('a -> unit) -> 'a list -> unit
+(** [List.iter f [a1; ...; an]] applies function [f] in turn to
+    [a1; ...; an]. It is equivalent to
+    [begin f a1; f a2; ...; f an; () end]. *)
+
+val iteri : (int -> 'a -> unit) -> 'a list -> unit
+(** Same as {!List.iter}, but the function is applied to the index of
+    the element as first argument (counting from 0), and the element
+    itself as second argument.
+    @since 4.00.0
+*)
+
+val map : ('a -> 'b) -> 'a list -> 'b list
+(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+    and builds the list [[f a1; ...; f an]]
+    with the results returned by [f].  Not tail-recursive. *)
+
+val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
+(** Same as {!List.map}, but the function is applied to the index of
+    the element as first argument (counting from 0), and the element
+    itself as second argument.  Not tail-recursive.
+    @since 4.00.0
+*)
+
+val rev_map : ('a -> 'b) -> 'a list -> 'b list
+(** [List.rev_map f l] gives the same result as
+    {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and
+    more efficient. *)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
+(** [List.fold_left f a [b1; ...; bn]] is
+    [f (... (f (f a b1) b2) ...) bn]. *)
+
+val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
+(** [List.fold_right f [a1; ...; an] b] is
+    [f a1 (f a2 (... (f an b) ...))].  Not tail-recursive. *)
+
+
+(** {1 Iterators on two lists} *)
+
+
+val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
+(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn
+    [f a1 b1; ...; f an bn].
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths. *)
+
+val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is
+    [[f a1 b1; ...; f an bn]].
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths.  Not tail-recursive. *)
+
+val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
+(** [List.rev_map2 f l1 l2] gives the same result as
+    {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
+    more efficient. *)
+
+val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is
+    [f (... (f (f a b1 c1) b2 c2) ...) bn cn].
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths. *)
+
+val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c
+(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is
+    [f a1 b1 (f a2 b2 (... (f an bn c) ...))].
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths.  Not tail-recursive. *)
+
+
+(** {1 List scanning} *)
+
+
+val for_all : ('a -> bool) -> 'a list -> bool
+(** [for_all p [a1; ...; an]] checks if all elements of the list
+    satisfy the predicate [p]. That is, it returns
+    [(p a1) && (p a2) && ... && (p an)]. *)
+
+val exists : ('a -> bool) -> 'a list -> bool
+(** [exists p [a1; ...; an]] checks if at least one element of
+    the list satisfies the predicate [p]. That is, it returns
+    [(p a1) || (p a2) || ... || (p an)]. *)
+
+val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.for_all}, but for a two-argument predicate.
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths. *)
+
+val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
+(** Same as {!List.exists}, but for a two-argument predicate.
+    Raise [Invalid_argument] if the two lists are determined
+    to have different lengths. *)
+
+val mem : 'a -> 'a list -> bool
+(** [mem a l] is true if and only if [a] is equal
+    to an element of [l]. *)
+
+val memq : 'a -> 'a list -> bool
+(** Same as {!List.mem}, but uses physical equality instead of structural
+    equality to compare list elements. *)
+
+
+(** {1 List searching} *)
+
+
+val find_opt: ('a -> bool) -> 'a list -> 'a option
+(** [find_opt p l] returns the first element of the list [l] that
+    satisfies the predicate [p], or [None] if there is no value that
+    satisfies [p] in the list [l].
+    @since 4.05 *)
+
+val filter : ('a -> bool) -> 'a list -> 'a list
+(** [filter p l] returns all the elements of the list [l]
+    that satisfy the predicate [p].  The order of the elements
+    in the input list is preserved.  *)
+
+val find_all : ('a -> bool) -> 'a list -> 'a list
+(** [find_all] is another name for {!List.filter}. *)
+
+val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
+(** [partition p l] returns a pair of lists [(l1, l2)], where
+    [l1] is the list of all the elements of [l] that
+    satisfy the predicate [p], and [l2] is the list of all the
+    elements of [l] that do not satisfy [p].
+    The order of the elements in the input list is preserved. *)
+
+
+(** {1 Association lists} *)
+
+
+val assoc_opt: 'a -> ('a * 'b) list -> 'b option
+(** [assoc_opt a l] returns the value associated with key [a] in the list of
+    pairs [l]. That is,
+    [assoc_opt a [ ...; (a,b); ...] = b]
+    if [(a,b)] is the leftmost binding of [a] in list [l].
+    Returns [None] if there is no value associated with [a] in the
+    list [l].
+    @since 4.05 *)
+
+val assq_opt : 'a -> ('a * 'b) list -> 'b option
+(** Same as {!List.assoc_opt}, but uses physical equality instead of structural
+    equality to compare keys.
+    @since 4.05 *)
+
+val mem_assoc : 'a -> ('a * 'b) list -> bool
+(** Same as {!List.assoc}, but simply return true if a binding exists,
+    and false if no bindings exist for the given key. *)
+
+val mem_assq : 'a -> ('a * 'b) list -> bool
+(** Same as {!List.mem_assoc}, but uses physical equality instead of
+    structural equality to compare keys. *)
+
+val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** [remove_assoc a l] returns the list of
+    pairs [l] without the first pair with key [a], if any.
+    Not tail-recursive. *)
+
+val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list
+(** Same as {!List.remove_assoc}, but uses physical equality instead
+    of structural equality to compare keys.  Not tail-recursive. *)
+
+
+(** {1 Lists of pairs} *)
+
+
+val split : ('a * 'b) list -> 'a list * 'b list
+(** Transform a list of pairs into a pair of lists:
+    [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])].
+    Not tail-recursive.
+*)
+
+val combine : 'a list -> 'b list -> ('a * 'b) list
+(** Transform a pair of lists into a list of pairs:
+    [combine [a1; ...; an] [b1; ...; bn]] is
+    [[(a1,b1); ...; (an,bn)]].
+    Raise [Invalid_argument] if the two lists
+    have different lengths.  Not tail-recursive. *)
+
+
+(** {1 Sorting} *)
+
+
+val sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Sort a list in increasing order according to a comparison
+    function.  The comparison function must return 0 if its arguments
+    compare as equal, a positive integer if the first is greater,
+    and a negative integer if the first is smaller (see Array.sort for
+    a complete specification).  For example,
+    {!Pervasives.compare} is a suitable comparison function.
+    The resulting list is sorted in increasing order.
+    [List.sort] is guaranteed to run in constant heap space
+    (in addition to the size of the result list) and logarithmic
+    stack space.
+
+    The current implementation uses Merge Sort. It runs in constant
+    heap space and logarithmic stack space.
+*)
+
+val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but the sorting algorithm is guaranteed to
+    be stable (i.e. elements that compare equal are kept in their
+    original order) .
+
+    The current implementation uses Merge Sort. It runs in constant
+    heap space and logarithmic stack space.
+*)
+
+val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster
+    on typical input. *)
+
+val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list
+(** Same as {!List.sort}, but also remove duplicates.
+    @since 4.02.0 *)
+
+val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
+(** Merge two lists:
+    Assuming that [l1] and [l2] are sorted according to the
+    comparison function [cmp], [merge cmp l1 l2] will return a
+    sorted list containing all the elements of [l1] and [l2].
+    If several elements compare equal, the elements of [l1] will be
+    before the elements of [l2].
+    Not tail-recursive (sum of the lengths of the arguments).
+*)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/logging.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/logging.mli
new file mode 100644
index 000000000..2432fe4c1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/logging.mli
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 debug: ('a, Format.formatter, unit, unit) format4 -> 'a
+val log_info: ('a, Format.formatter, unit, unit) format4 -> 'a
+val log_notice: ('a, Format.formatter, unit, unit) format4 -> 'a
+val warn: ('a, Format.formatter, unit, unit) format4 -> 'a
+val log_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+val fatal_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+
+val lwt_debug: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val lwt_log_info: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val lwt_log_notice: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val lwt_warn: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+val lwt_log_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt.mli
new file mode 100644
index 000000000..97fafb14c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt.mli
@@ -0,0 +1,469 @@
+(* Lightweight thread library for OCaml
+ * http://www.ocsigen.org/lwt
+ * Interface Lwt
+ * Copyright (C) 2005-2008 J�r�me Vouillon
+ * Laboratoire PPS - CNRS Universit� Paris Diderot
+ *               2009-2012 J�r�mie Dimino
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as
+ * published by the Free Software Foundation, with linking exceptions;
+ * either version 2.1 of the License, or (at your option) any later
+ * version. See COPYING file for details.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ * 02111-1307, USA.
+*)
+
+(* TEZOS CHANGES
+
+   * import version 2.4.5
+   * Comment a few function that shouldn't be used in the protocol:
+     * choose: scheduling may be system dependent.
+     * wait/wakeup
+     * state
+     * cancel
+     * pause
+     * async
+     * thread storage
+     * lwt exceptions
+*)
+
+
+(** Module [Lwt]: cooperative light-weight threads. *)
+
+(** This module defines {e cooperative light-weight threads} with
+    their primitives. A {e light-weight thread} represent a
+    computation that may be not terminated, for example because it is
+    waiting for some event to happen.
+
+    Lwt threads are cooperative in the sense that switching to another
+    thread is awlays explicit (with {!wakeup} or {!wakeup_exn}). When a
+    thread is running, it executes as much as possible, and then
+    returns (a value or an eror) or sleeps.
+
+    Note that inside a Lwt thread, exceptions must be raised with
+    {!fail} instead of [raise]. Also the [try ... with ...]
+    construction will not catch Lwt errors. You must use {!catch}
+    instead. You can also use {!wrap} for functions that may raise
+    normal exception.
+
+    Lwt also provides the syntax extension {!Pa_lwt} to make code
+    using Lwt more readable.
+*)
+
+(** {2 Definitions and basics} *)
+
+type +'a t
+(** The type of threads returning a result of type ['a]. *)
+
+val return : 'a -> 'a t
+(** [return e] is a thread whose return value is the value of the
+    expression [e]. *)
+
+(* val fail : exn -> 'a t *)
+(*   (\** [fail e] is a thread that fails with the exception [e]. *\) *)
+
+val bind : 'a t -> ('a -> 'b t) -> 'b t
+(** [bind t f] is a thread which first waits for the thread [t] to
+    terminate and then, if the thread succeeds, behaves as the
+    application of function [f] to the return value of [t].  If the
+    thread [t] fails, [bind t f] also fails, with the same
+    exception.
+
+    The expression [bind t (fun x -> t')] can intuitively be read as
+    [let x = t in t'], and if you use the {e lwt.syntax} syntax
+    extension, you can write a bind operation like that: [lwt x = t in t'].
+
+    Note that [bind] is also often used just for synchronization
+    purpose: [t'] will not execute before [t] is terminated.
+
+    The result of a thread can be bound several time. *)
+
+val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+(** [t >>= f] is an alternative notation for [bind t f]. *)
+
+val (=<<) : ('a -> 'b t) -> 'a t -> 'b t
+(** [f =<< t] is [t >>= f] *)
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** [map f m] map the result of a thread. This is the same as [bind
+    m (fun x -> return (f x))] *)
+
+val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+(** [m >|= f] is [map f m] *)
+
+val (=|<) : ('a -> 'b) -> 'a t -> 'b t
+(** [f =|< m] is [map f m] *)
+
+(** {3 Pre-allocated threads} *)
+
+val return_unit : unit t
+(** [return_unit = return ()] *)
+
+val return_none : 'a option t
+(** [return_none = return None] *)
+
+val return_nil : 'a list t
+(** [return_nil = return \[\]] *)
+
+val return_true : bool t
+(** [return_true = return true] *)
+
+val return_false : bool t
+(** [return_false = return false] *)
+
+(* (\** {2 Thread storage} *\) *)
+
+(* type 'a key *)
+(*   (\** Type of a key. Keys are used to store local values into *)
+(*       threads *\) *)
+
+(* val new_key : unit -> 'a key *)
+(*   (\** [new_key ()] creates a new key. *\) *)
+
+(* val get : 'a key -> 'a option *)
+(*   (\** [get key] returns the value associated with [key] in the current *)
+(*       thread. *\) *)
+
+(* val with_value : 'a key -> 'a option -> (unit -> 'b) -> 'b *)
+(*   (\** [with_value key value f] executes [f] with [value] associated to *)
+(*       [key]. The previous value associated to [key] is restored after *)
+(*       [f] terminates. *\) *)
+
+(* (\** {2 Exceptions handling} *\) *)
+
+(* val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t *)
+(*   (\** [catch t f] is a thread that behaves as the thread [t ()] if *)
+(*       this thread succeeds.  If the thread [t ()] fails with some *)
+(*       exception, [catch t f] behaves as the application of [f] to this *)
+(*       exception. *\) *)
+
+(* val try_bind : (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t *)
+(*   (\** [try_bind t f g] behaves as [bind (t ()) f] if [t] does not *)
+(*       fail.  Otherwise, it behaves as the application of [g] to the *)
+(*       exception associated to [t ()]. *\) *)
+
+(* val finalize : (unit -> 'a t) -> (unit -> unit t) -> 'a t *)
+(*   (\** [finalize f g] returns the same result as [f ()] whether it *)
+(*       fails or not. In both cases, [g ()] is executed after [f]. *\) *)
+
+(* val wrap : (unit -> 'a) -> 'a t *)
+(*   (\** [wrap f] calls [f] and transform the result into a monad. If [f] *)
+(*       raise an exception, it is catched by Lwt. *)
+
+(*       This is actually the same as: *)
+
+(*       {[ *)
+(*         try *)
+(*           return (f ()) *)
+(*         with exn -> *)
+(*           fail exn *)
+(*       ]} *)
+(*   *\) *)
+
+(* val wrap1 : ('a -> 'b) -> 'a -> 'b t *)
+(*   (\** [wrap1 f x] applies [f] on [x] and returns the result as a *)
+(*       thread. If the application of [f] to [x] raise an exception it *)
+(*       is catched and a thread is returned. *)
+
+(*       Note that you must use {!wrap} instead of {!wrap1} if the *)
+(*       evaluation of [x] may raise an exception. *)
+
+(*       for example the following code is not ok: *)
+
+(*       {[ *)
+(*         wrap1 f (Hashtbl.find table key) *)
+(*       ]} *)
+
+(*       you should write instead: *)
+
+(*       {[ *)
+(*         wrap (fun () -> f (Hashtbl.find table key)) *)
+(*       ]} *)
+(*   *\) *)
+
+(* val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t *)
+(* val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd t *)
+(* val wrap4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a -> 'b -> 'c -> 'd -> 'e t *)
+(* val wrap5 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) -> 'a -> 'b -> 'c -> 'd -> 'e -> 'f t *)
+(* val wrap6 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) -> 'a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g t *)
+(* val wrap7 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h) -> 'a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g -> 'h t *)
+
+(** {2 Multi-threads composition} *)
+
+(* we shouldn't use choose: the scheduling may be system dependent *)
+
+(* val choose : 'a t list -> 'a t *)
+(*   (\** [choose l] behaves as the first thread in [l] to terminate.  If *)
+(*       several threads are already terminated, one is choosen at *)
+(*       random. *)
+
+(*       Note: {!choose} leaves the local values of the current thread *)
+(*       unchanged. *\) *)
+
+(* val nchoose : 'a t list -> 'a list t *)
+(*   (\** [nchoose l] returns the value of all that have succcessfully *)
+(*       terminated. If all threads are sleeping, it waits for at least *)
+(*       one to terminates. If one the threads of [l] fails, [nchoose] *)
+(*       fails with the same exception. *)
+
+(*       Note: {!nchoose} leaves the local values of the current thread *)
+(*       unchanged. *\) *)
+
+(* val nchoose_split : 'a t list -> ('a list * 'a t list) t *)
+(*   (\** [nchoose_split l] does the same as {!nchoose} but also retrurns *)
+(*       the list of threads that have not yet terminated. *\) *)
+
+val join : unit t list -> unit t
+(** [join l] waits for all threads in [l] to terminate. If one of
+    the threads fails, then [join l] will fails with the same
+    exception as the first one to terminate.
+
+    Note: {!join} leaves the local values of the current thread
+    unchanged. *)
+
+(* val ( <?> ) : 'a t -> 'a t -> 'a t *)
+(*   (\** [t <?> t'] is the same as [choose [t; t']] *\) *)
+
+val ( <&> ) : unit t -> unit t -> unit t
+(** [t <&> t'] is the same as [join [t; t']] *)
+
+(* val async : (unit -> 'a t) -> unit *)
+(*   (\** [async f] starts a thread without waiting for the result. If it *)
+(*       fails (now or later), the exception is given to *)
+(*       {!async_exception_hook}. *)
+
+(*       You should use this function if you want to start a thread that *)
+(*       might fail and don't care what its return value is, nor when it *)
+(*       terminates (for instance, because it is looping). *\) *)
+
+(* val ignore_result : 'a t -> unit *)
+(*   (\** [ignore_result t] is like [Pervasives.ignore t] except that: *)
+
+(*       - if [t] already failed, it raises the exception now, *)
+(*       - if [t] is sleeping and fails later, the exception will be *)
+(*         given to {!async_exception_hook}. *\) *)
+
+(* val async_exception_hook : (exn -> unit) ref *)
+(*   (\** Function called when a asynchronous exception is thrown. *)
+
+(*       The default behavior is to print an error message with a *)
+(*       backtrace if available and to exit the program. *)
+
+(*       The behavior is undefined if this function raise an *)
+(*       exception. *\) *)
+
+(* (\** {2 Sleeping and resuming} *\) *)
+
+(* type 'a u *)
+(*   (\** The type of thread wakeners. *\) *)
+
+(* val wait : unit -> 'a t * 'a u *)
+(*   (\** [wait ()] is a pair of a thread which sleeps forever (unless it *)
+(*       is resumed by one of the functions [wakeup], [wakeup_exn] below) *)
+(*       and the corresponding wakener.  This thread does not block the *)
+(*       execution of the remainder of the program (except of course, if *)
+(*       another thread tries to wait for its termination). *\) *)
+
+(* val wakeup : 'a u -> 'a -> unit *)
+(*   (\** [wakeup t e] makes the sleeping thread [t] terminate and return *)
+(*       the value of the expression [e]. *\) *)
+
+(* val wakeup_exn : 'a u -> exn -> unit *)
+(*   (\** [wakeup_exn t e] makes the sleeping thread [t] fail with the *)
+(*       exception [e]. *\) *)
+
+(* val wakeup_later : 'a u -> 'a -> unit *)
+(*   (\** Same as {!wakeup} but it is not guaranteed that the thread will *)
+(*       be woken up immediately. *\) *)
+
+(* val wakeup_later_exn : 'a u -> exn -> unit *)
+(*   (\** Same as {!wakeup_exn} but it is not guaranteed that the thread *)
+(*       will be woken up immediately. *\) *)
+
+(* val waiter_of_wakener : 'a u -> 'a t *)
+(*   (\** Returns the thread associated to a wakener. *\) *)
+
+(* type +'a result *)
+(*   (\** Either a value of type ['a], either an exception. *\) *)
+
+(* val make_value : 'a -> 'a result *)
+(*   (\** [value x] creates a result containing the value [x]. *\) *)
+
+(* val make_error : exn -> 'a result *)
+(*   (\** [error e] creates a result containing the exception [e]. *\) *)
+
+(* val of_result : 'a result -> 'a t *)
+(*   (\** Returns a thread from a result. *\) *)
+
+(* val wakeup_result : 'a u -> 'a result -> unit *)
+(*   (\** [wakeup_result t r] makes the sleeping thread [t] terminate with *)
+(*       the result [r]. *\) *)
+
+(* val wakeup_later_result : 'a u -> 'a result -> unit *)
+(*   (\** Same as {!wakeup_result} but it is not guaranteed that the *)
+(*       thread will be woken up immediately. *\) *)
+
+(* (\** {2 Threads state} *\) *)
+
+(* (\** State of a thread *\) *)
+(* type 'a state = *)
+(*   | Return of 'a *)
+(*       (\** The thread which has successfully terminated *\) *)
+(*   | Fail of exn *)
+(*       (\** The thread raised an exception *\) *)
+(*   | Sleep *)
+(*       (\** The thread is sleeping *\) *)
+
+(* val state : 'a t -> 'a state *)
+(*   (\** [state t] returns the state of a thread *\) *)
+
+(* val is_sleeping : 'a t -> bool *)
+(*   (\** [is_sleeping t] returns [true] iff [t] is sleeping. *\) *)
+
+(* (\** {2 Cancelable threads} *\) *)
+
+(* (\** Cancelable threads are the same as regular threads except that *)
+(*     they can be canceled. *\) *)
+
+(* exception Canceled *)
+(*   (\** Canceled threads fails with this exception *\) *)
+
+(* val task : unit -> 'a t * 'a u *)
+(*   (\** [task ()] is the same as [wait ()] except that threads created *)
+(*       with [task] can be canceled. *\) *)
+
+(* val on_cancel : 'a t -> (unit -> unit) -> unit *)
+(*   (\** [on_cancel t f] executes [f] when [t] is canceled. [f] will be *)
+(*       executed before all other threads waiting on [t]. *)
+
+(*       If [f] raises an exception it is given to *)
+(*       {!async_exception_hook}. *\) *)
+
+(* val add_task_r : 'a u Lwt_sequence.t -> 'a t *)
+(*   (\** [add_task_r seq] creates a sleeping thread, adds its wakener to *)
+(*       the right of [seq] and returns its waiter. When the thread is *)
+(*       canceled, it is removed from [seq]. *\) *)
+
+(* val add_task_l : 'a u Lwt_sequence.t -> 'a t *)
+(*   (\** [add_task_l seq] creates a sleeping thread, adds its wakener to *)
+(*       the left of [seq] and returns its waiter. When the thread is *)
+(*       canceled, it is removed from [seq]. *\) *)
+
+(* val cancel : 'a t -> unit *)
+(*   (\** [cancel t] cancels the threads [t]. This means that the deepest *)
+(*       sleeping thread created with [task] and connected to [t] is *)
+(*       woken up with the exception {!Canceled}. *)
+
+(*       For example, in the following code: *)
+
+(*       {[ *)
+(*         let waiter, wakener = task () in *)
+(*         cancel (waiter >> printl "plop") *)
+(*       ]} *)
+
+(*       [waiter] will be woken up with {!Canceled}. *)
+(*   *\) *)
+
+(* val pick : 'a t list -> 'a t *)
+(*   (\** [pick l] is the same as {!choose}, except that it cancels all *)
+(*       sleeping threads when one terminates. *)
+
+(*       Note: {!pick} leaves the local values of the current thread *)
+(*       unchanged. *\) *)
+
+(* val npick : 'a t list -> 'a list t *)
+(*   (\** [npick l] is the same as {!nchoose}, except that it cancels all *)
+(*       sleeping threads when one terminates. *)
+
+(*       Note: {!npick} leaves the local values of the current thread *)
+(*       unchanged. *\) *)
+
+(* val protected : 'a t -> 'a t *)
+(*   (\** [protected thread] creates a new cancelable thread which behave *)
+(*       as [thread] except that cancelling it does not cancel *)
+(*       [thread]. *\) *)
+
+(* val no_cancel : 'a t -> 'a t *)
+(*   (\** [no_cancel thread] creates a thread which behave as [thread] *)
+(*       except that it cannot be canceled. *\) *)
+
+(* (\** {2 Pause} *\) *)
+
+(* val pause : unit -> unit t *)
+(*   (\** [pause ()] is a sleeping thread which is wake up on the next *)
+(*       call to {!wakeup_paused}. A thread created with [pause] can be *)
+(*       canceled. *\) *)
+
+(* val wakeup_paused : unit -> unit *)
+(*   (\** [wakeup_paused ()] wakes up all threads which suspended *)
+(*       themselves with {!pause}. *)
+
+(*       This function is called by the scheduler, before entering the *)
+(*       main loop. You usually do not have to call it directly, except *)
+(*       if you are writing a custom scheduler. *)
+
+(*       Note that if a paused thread resumes and pauses again, it will not *)
+(*       be woken up at this point. *\) *)
+
+(* val paused_count : unit -> int *)
+(*   (\** [paused_count ()] returns the number of currently paused *)
+(*       threads. *\) *)
+
+(* val register_pause_notifier : (int -> unit) -> unit *)
+(*   (\** [register_pause_notifier f] register a function [f] that will be *)
+(*       called each time pause is called. The parameter passed to [f] is *)
+(*       the new number of threads paused. It is usefull to be able to *)
+(*       call {!wakeup_paused} when there is no scheduler *\) *)
+
+(* (\** {2 Misc} *\) *)
+
+(* val on_success : 'a t -> ('a -> unit) -> unit *)
+(*   (\** [on_success t f] executes [f] when [t] terminates without *)
+(*       failing. If [f] raises an exception it is given to *)
+(*       {!async_exception_hook}. *\) *)
+
+(* val on_failure : 'a t -> (exn -> unit) -> unit *)
+(*   (\** [on_failure t f] executes [f] when [t] terminates and fails. If *)
+(*       [f] raises an exception it is given to *)
+(*       {!async_exception_hook}. *\) *)
+
+(* val on_termination : 'a t -> (unit -> unit) -> unit *)
+(*   (\** [on_termination t f] executes [f] when [t] terminates. If [f] *)
+(*       raises an exception it is given to {!async_exception_hook}. *\) *)
+
+(* val on_any : 'a t -> ('a -> unit) -> (exn -> unit) -> unit *)
+(*   (\** [on_any t f g] executes [f] or [g] when [t] terminates. If [f] *)
+(*       or [g] raises an exception it is given to *)
+(*       {!async_exception_hook}. *\) *)
+
+(* (\**/**\) *)
+
+(* (\* The functions below are probably not useful for the casual user. *)
+(*    They provide the basic primitives on which can be built multi- *)
+(*    threaded libraries such as Lwt_unix. *\) *)
+
+(* val poll : 'a t -> 'a option *)
+(*       (\* [poll e] returns [Some v] if the thread [e] is terminated and *)
+(*          returned the value [v].  If the thread failed with some *)
+(*          exception, this exception is raised.  If the thread is still *)
+(*          running, [poll e] returns [None] without blocking. *\) *)
+
+(* val apply : ('a -> 'b t) -> 'a -> 'b t *)
+(*       (\* [apply f e] apply the function [f] to the expression [e].  If *)
+(*          an exception is raised during this application, it is caught *)
+(*          and the resulting thread fails with this exception. *\) *)
+(* (\* Q: Could be called 'glue' or 'trap' or something? *\) *)
+
+(* val backtrace_bind : (exn -> exn) -> 'a t -> ('a -> 'b t) -> 'b t *)
+(* val backtrace_catch : (exn -> exn) -> (unit -> 'a t) -> (exn -> 'a t) -> 'a t *)
+(* val backtrace_try_bind : (exn -> exn) -> (unit -> 'a t) -> ('a -> 'b t) -> (exn -> 'b t) -> 'b t *)
+(* val backtrace_finalize : (exn -> exn) -> (unit -> 'a t) -> (unit -> unit t) -> 'a t *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt_list.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt_list.mli
new file mode 100644
index 000000000..40282d776
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/lwt_list.mli
@@ -0,0 +1,68 @@
+(* Lightweight thread library for OCaml
+ * http://www.ocsigen.org/lwt
+ * Interface Lwt_list
+ * Copyright (C) 2010 Jérémie Dimino
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as
+ * published by the Free Software Foundation, with linking exceptions;
+ * either version 2.1 of the License, or (at your option) any later
+ * version. See COPYING file for details.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ * 02111-1307, USA.
+*)
+
+(** List helpers *)
+
+(* TEZOS CHANGES
+
+   * import version 2.4.5
+   * Remove iter/iteri
+*)
+
+(** Note: this module use the same naming convention as
+    {!Lwt_stream}. *)
+
+(** {2 List iterators} *)
+
+val map_s : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+val map_p : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+
+val mapi_s : (int -> 'a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+val mapi_p : (int -> 'a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+
+val rev_map_s : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+val rev_map_p : ('a -> 'b Lwt.t) -> 'a list -> 'b list Lwt.t
+
+val fold_left_s : ('a -> 'b -> 'a Lwt.t) -> 'a -> 'b list -> 'a Lwt.t
+
+val fold_right_s : ('a -> 'b -> 'b Lwt.t) -> 'a list -> 'b -> 'b Lwt.t
+
+(** {2 List scanning} *)
+
+val for_all_s : ('a -> bool Lwt.t) -> 'a list -> bool Lwt.t
+val for_all_p : ('a -> bool Lwt.t) -> 'a list -> bool Lwt.t
+
+val exists_s : ('a -> bool Lwt.t) -> 'a list -> bool Lwt.t
+val exists_p : ('a -> bool Lwt.t) -> 'a list -> bool Lwt.t
+
+(** {2 List searching} *)
+
+val find_s : ('a -> bool Lwt.t) -> 'a list -> 'a Lwt.t
+
+val filter_s : ('a -> bool Lwt.t) -> 'a list -> 'a list Lwt.t
+val filter_p : ('a -> bool Lwt.t) -> 'a list -> 'a list Lwt.t
+
+val filter_map_s : ('a -> 'b option Lwt.t) -> 'a list -> 'b list Lwt.t
+val filter_map_p : ('a -> 'b option Lwt.t) -> 'a list -> 'b list Lwt.t
+
+val partition_s : ('a -> bool Lwt.t) -> 'a list -> ('a list * 'a list) Lwt.t
+val partition_p : ('a -> bool Lwt.t) -> 'a list -> ('a list * 'a list) Lwt.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/mBytes.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/mBytes.mli
new file mode 100644
index 000000000..fcfac0f76
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/mBytes.mli
@@ -0,0 +1,148 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+val create: int -> t
+
+val length: t -> int
+
+val copy: t -> t
+
+val sub: t -> int -> int -> t
+(** [sub src ofs len] extract a sub-array of [src] starting at [ofs]
+    and of length [len]. No copying of elements is involved: the
+    sub-array and the original array share the same storage space. *)
+
+val blit: t -> int -> t -> int -> int -> unit
+(** [blit src ofs_src dst ofs_dst len] copy [len] bytes from [src]
+    starting at [ofs_src] into [dst] starting at [ofs_dst]. *)
+
+val blit_of_string: string -> int -> t -> int -> int -> unit
+(** See [blit] *)
+
+val blit_to_bytes: t -> int -> bytes -> int -> int -> unit
+(** See [blit] *)
+
+val of_string: string -> t
+(** [of_string s] create an byte array filled with the same content than [s]. *)
+
+val to_string: t -> string
+(** [to_string b] dump the array content in a [string]. *)
+
+val sub_string: t -> int -> int -> string
+(** [sub_string b ofs len] is equivalent to [to_string (sub b ofs len)]. *)
+
+
+
+(** Functions reading and writing bytes  *)
+
+val get_char: t -> int -> char
+(** [get_char buff i] reads 1 byte at offset i as a char *)
+
+val get_uint8: t -> int -> int
+(** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
+    bits. i.e. It returns a value between 0 and 2^8-1 *)
+
+val get_int8: t -> int -> int
+(** [get_int8 buff i] reads 1 byte at offset i as a signed int of 8
+    bits. i.e. It returns a value between -2^7 and 2^7-1 *)
+
+val set_char: t -> int -> char -> unit
+(** [set_char buff i v] writes [v] to [buff] at offset [i] *)
+
+val set_int8: t -> int -> int -> unit
+(** [set_int8 buff i v] writes the least significant 8 bits of [v]
+    to [buff] at offset [i] *)
+
+(** Functions reading according to Big Endian byte order *)
+
+val get_uint16: t -> int -> int
+(** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+val get_int16: t -> int -> int
+(** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+val get_int32: t -> int -> int32
+(** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+val get_int64: t -> int -> int64
+(** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+val set_int16: t -> int -> int -> unit
+(** [set_int16 buff i v] writes the least significant 16 bits of [v]
+      to [buff] at offset [i] *)
+
+val set_int32: t -> int -> int32 -> unit
+(** [set_int32 buff i v] writes [v] to [buff] at offset [i] *)
+
+val set_int64: t -> int -> int64 -> unit
+(** [set_int64 buff i v] writes [v] to [buff] at offset [i] *)
+
+
+module LE: sig
+
+  (** Functions reading according to Little Endian byte order *)
+
+  val get_uint16: t -> int -> int
+  (** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+  val get_int16: t -> int -> int
+  (** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+  val get_int32: t -> int -> int32
+  (** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+  val get_int64: t -> int -> int64
+  (** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+  val set_int16: t -> int -> int -> unit
+  (** [set_int16 buff i v] writes the least significant 16 bits of [v]
+      to [buff] at offset [i] *)
+
+  val set_int32: t -> int -> int32 -> unit
+  (** [set_int32 buff i v] writes [v] to [buff] at offset [i] *)
+
+  val set_int64: t -> int -> int64 -> unit
+  (** [set_int64 buff i v] writes [v] to [buff] at offset [i] *)
+
+end
+
+val (=) : t -> t -> bool
+val (<>) : t -> t -> bool
+val (<) : t -> t -> bool
+val (<=) : t -> t -> bool
+val (>=) : t -> t -> bool
+val (>) : t -> t -> bool
+val compare : t -> t -> int
+
+val concat: string -> t list -> t
+
+val to_hex: t -> [ `Hex of string ]
+val of_hex: [ `Hex of string ] -> t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/map.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/map.mli
new file mode 100644
index 000000000..754fdba48
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/map.mli
@@ -0,0 +1,64 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Association tables over ordered types.
+
+    This module implements applicative association tables, also known as
+    finite maps or dictionaries, given a total ordering function
+    over the keys.
+    All operations over maps are purely applicative (no side-effects).
+    The implementation uses balanced binary trees, and therefore searching
+    and insertion take time logarithmic in the size of the map.
+
+    For instance:
+    {[
+      module IntPairs =
+      struct
+        type t = int * int
+        let compare (x0,y0) (x1,y1) =
+          match Pervasives.compare x0 x1 with
+            0 -> Pervasives.compare y0 y1
+          | c -> c
+      end
+
+      module PairsMap = Map.Make(IntPairs)
+
+      let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world")
+    ]}
+
+    This creates a new module [PairsMap], with a new type ['a PairsMap.t]
+    of maps from [int * int] to ['a]. In this example, [m] contains [string]
+    values so its type is [string PairsMap.t].
+*)
+
+module type OrderedType =
+sig
+  type t
+  (** The type of the map keys. *)
+
+  val compare : t -> t -> int
+  (** A total ordering function over the keys.
+      This is a two-argument function [f] such that
+      [f e1 e2] is zero if the keys [e1] and [e2] are equal,
+      [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+      and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+      Example: a suitable ordering function is the generic structural
+      comparison function {!Pervasives.compare}. *)
+end
+(** Input signature of the functor {!Map.Make}. *)
+
+module Make (Ord : OrderedType) : S.MAP with type key = Ord.t
+(** Functor building an implementation of the map structure
+    given a totally ordered type. *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/micheline.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/micheline.mli
new file mode 100644
index 000000000..26885894f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/micheline.mli
@@ -0,0 +1,184 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type annot = string list
+
+type ('l, 'p) node =
+  | Int of 'l * Z.t
+  | String of 'l * string
+  | Bytes of 'l * MBytes.t
+  | Prim of 'l * 'p * ('l, 'p) node list * annot
+  | Seq of 'l * ('l, 'p) node list
+
+type 'p canonical
+type canonical_location = int
+
+val root : 'p canonical -> (canonical_location, 'p) node
+val canonical_location_encoding : canonical_location Data_encoding.encoding
+val canonical_encoding : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+val canonical_encoding_v1 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+(*
+val erased_encoding : variant:string -> 'l -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
+val table_encoding : variant:string -> 'l Data_encoding.encoding -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
+*)
+val location : ('l, 'p) node -> 'l
+val annotations : ('l, 'p) node -> string list
+
+val strip_locations : (_, 'p) node -> 'p canonical
+val extract_locations : ('l, 'p) node -> 'p canonical * (canonical_location * 'l) list
+val inject_locations : (canonical_location -> 'l) -> 'p canonical -> ('l, 'p) node
+
+module Michelson_primitives : sig
+  type prim =
+  | K_parameter
+  | K_storage
+  | K_code
+  | D_False
+  | D_Elt
+  | D_Left
+  | D_None
+  | D_Pair
+  | D_Right
+  | D_Some
+  | D_True
+  | D_Unit
+  | I_PACK
+  | I_UNPACK
+  | I_BLAKE2B
+  | I_SHA256
+  | I_SHA512
+  | I_ABS
+  | I_ADD
+  | I_AMOUNT
+  | I_AND
+  | I_BALANCE
+  | I_CAR
+  | I_CDR
+  | I_CHECK_SIGNATURE
+  | I_COMPARE
+  | I_CONCAT
+  | I_CONS
+  | I_CREATE_ACCOUNT
+  | I_CREATE_CONTRACT
+  | I_IMPLICIT_ACCOUNT
+  | I_DIP
+  | I_DROP
+  | I_DUP
+  | I_EDIV
+  | I_EMPTY_MAP
+  | I_EMPTY_SET
+  | I_EQ
+  | I_EXEC
+  | I_FAILWITH
+  | I_GE
+  | I_GET
+  | I_GT
+  | I_HASH_KEY
+  | I_IF
+  | I_IF_CONS
+  | I_IF_LEFT
+  | I_IF_NONE
+  | I_INT
+  | I_LAMBDA
+  | I_LE
+  | I_LEFT
+  | I_LOOP
+  | I_LSL
+  | I_LSR
+  | I_LT
+  | I_MAP
+  | I_MEM
+  | I_MUL
+  | I_NEG
+  | I_NEQ
+  | I_NIL
+  | I_NONE
+  | I_NOP
+  | I_NOT
+  | I_NOW
+  | I_OR
+  | I_PAIR
+  | I_PUSH
+  | I_RIGHT
+  | I_SIZE
+  | I_SOME
+  | I_SOURCE
+  | I_SENDER
+  | I_SELF
+  | I_SLICE
+  | I_STEPS_TO_QUOTA
+  | I_SUB
+  | I_SWAP
+  | I_TRANSFER_TOKENS
+  | I_SET_DELEGATE
+  | I_UNIT
+  | I_UPDATE
+  | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
+  | I_ADDRESS
+  | I_CONTRACT
+  | I_ISNAT
+  | I_CAST
+  | I_RENAME
+  | T_bool
+  | T_contract
+  | T_int
+  | T_key
+  | T_key_hash
+  | T_lambda
+  | T_list
+  | T_map
+  | T_big_map
+  | T_nat
+  | T_option
+  | T_or
+  | T_pair
+  | T_set
+  | T_signature
+  | T_string
+  | T_bytes
+  | T_mutez
+  | T_timestamp
+  | T_unit
+  | T_operation
+  | T_address
+
+  val prim_encoding : prim Data_encoding.encoding
+
+  val string_of_prim : prim -> string
+
+  type failure =
+      Unknown_primitive_name of string
+    | Invalid_case of string
+    | Invalid_primitive_name of string canonical * canonical_location
+
+
+  val prim_of_string : string -> (prim , failure) result
+
+  val prims_of_strings : string canonical -> (prim canonical , failure) result
+
+  val strings_of_prims : prim canonical -> string canonical
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation.mli
new file mode 100644
index 000000000..6a594ce57
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation.mli
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos operations. *)
+
+type shell_header = {
+  branch: Block_hash.t ;
+  (** The operation is only valid in a branch containing the
+      block [branch]. *)
+}
+val shell_header_encoding: shell_header Data_encoding.t
+
+type t = {
+  shell: shell_header ;
+  proto: MBytes.t ;
+}
+
+include S.HASHABLE with type t := t
+                    and type hash := Operation_hash.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_hash.mli
new file mode 100644
index 000000000..15967e9d7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Operations hashes / IDs. *)
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_hash.mli
new file mode 100644
index 000000000..a020291ba
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_hash.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Blocks hashes / IDs. *)
+include S.MERKLE_TREE with type elt = Operation_hash.t
+
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli
new file mode 100644
index 000000000..949a19783
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Blocks hashes / IDs. *)
+include S.MERKLE_TREE with type elt = Operation_list_hash.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/option.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/option.mli
new file mode 100644
index 000000000..e7cbdc224
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/option.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 map: f:('a -> 'b) -> 'a option -> 'b option
+
+val apply: f:('a -> 'b option) -> 'a option -> 'b option
+
+val iter: f:('a -> unit) -> 'a option -> unit
+
+val unopt: default:'a -> 'a option -> 'a
+
+val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b
+
+val first_some: 'a option -> 'a option -> 'a option
+
+val try_with : (unit -> 'a) -> 'a option
+
+val some : 'a -> 'a option
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/p256.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/p256.mli
new file mode 100644
index 000000000..c97b0d417
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/p256.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - P256 cryptography *)
+
+include S.SIGNATURE with type watermark := MBytes.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/pervasives.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/pervasives.mli
new file mode 100644
index 000000000..ccf079c51
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/pervasives.mli
@@ -0,0 +1,484 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TEZOS CHANGES
+
+   * Import version 4.06.1
+   * Remove [channel], [exit], ...
+   * Remove polymorphic comparisons
+   * Remove floating-point arithmetic
+   * Remove string conversion functions for float
+   * Remove deprecated functions
+
+*)
+
+
+(** The initially opened module.
+
+    This module provides the basic operations over the built-in types
+    (numbers, booleans, byte sequences, strings, exceptions, references,
+    lists, arrays, input-output channels, ...).
+
+    This module is automatically opened at the beginning of each compilation.
+    All components of this module can therefore be referred by their short
+    name, without prefixing them by [Pervasives].
+*)
+
+
+(** {1 Exceptions} *)
+
+external raise : exn -> 'a = "%raise"
+(** Raise the given exception value *)
+
+external raise_notrace : exn -> 'a = "%raise_notrace"
+(** A faster version [raise] which does not record the backtrace.
+    @since 4.02.0
+*)
+
+val invalid_arg : string -> 'a
+(** Raise exception [Invalid_argument] with the given string. *)
+
+val failwith : string -> 'a
+(** Raise exception [Failure] with the given string. *)
+
+exception Exit
+(** The [Exit] exception is not raised by any library function.  It is
+    provided for use in your programs. *)
+
+
+(** {1 Boolean operations} *)
+
+external not : bool -> bool = "%boolnot"
+(** The boolean negation. *)
+
+external ( && ) : bool -> bool -> bool = "%sequand"
+(** The boolean 'and'. Evaluation is sequential, left-to-right:
+    in [e1 && e2], [e1] is evaluated first, and if it returns [false],
+    [e2] is not evaluated at all.
+    Right-associative operator at precedence level 3/11. *)
+
+
+external ( || ) : bool -> bool -> bool = "%sequor"
+(** The boolean 'or'. Evaluation is sequential, left-to-right:
+    in [e1 || e2], [e1] is evaluated first, and if it returns [true],
+    [e2] is not evaluated at all.
+    Right-associative operator at precedence level 2/11.
+*)
+
+(** {1 Debugging} *)
+
+external __LOC__ : string = "%loc_LOC"
+(** [__LOC__] returns the location at which this expression appears in
+    the file currently being parsed by the compiler, with the standard
+    error format of OCaml: "File %S, line %d, characters %d-%d".
+    @since 4.02.0
+*)
+
+external __FILE__ : string = "%loc_FILE"
+(** [__FILE__] returns the name of the file currently being
+    parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __LINE__ : int = "%loc_LINE"
+(** [__LINE__] returns the line number at which this expression
+    appears in the file currently being parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __MODULE__ : string = "%loc_MODULE"
+(** [__MODULE__] returns the module name of the file being
+    parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __POS__ : string * int * int * int = "%loc_POS"
+(** [__POS__] returns a tuple [(file,lnum,cnum,enum)], corresponding
+    to the location at which this expression appears in the file
+    currently being parsed by the compiler. [file] is the current
+    filename, [lnum] the line number, [cnum] the character position in
+    the line and [enum] the last character position in the line.
+    @since 4.02.0
+*)
+
+external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC"
+(** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the
+    location of [expr] in the file currently being parsed by the
+    compiler, with the standard error format of OCaml: "File %S, line
+    %d, characters %d-%d".
+    @since 4.02.0
+*)
+
+external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE"
+(** [__LINE__ expr] returns a pair [(line, expr)], where [line] is the
+    line number at which the expression [expr] appears in the file
+    currently being parsed by the compiler.
+    @since 4.02.0
+*)
+
+external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS"
+(** [__POS_OF__ expr] returns a pair [(loc,expr)], where [loc] is a
+    tuple [(file,lnum,cnum,enum)] corresponding to the location at
+    which the expression [expr] appears in the file currently being
+    parsed by the compiler. [file] is the current filename, [lnum] the
+    line number, [cnum] the character position in the line and [enum]
+    the last character position in the line.
+    @since 4.02.0
+*)
+
+(** {1 Composition operators} *)
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** Reverse-application operator: [x |> f |> g] is exactly equivalent
+    to [g (f (x))].
+    Left-associative operator at precedence level 4/11.
+    @since 4.01
+*)
+
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Application operator: [g @@ f @@ x] is exactly equivalent to
+    [g (f (x))].
+    Right-associative operator at precedence level 5/11.
+    @since 4.01
+*)
+
+(** {1 Integer arithmetic} *)
+
+(** Integers are 31 bits wide (or 63 bits on 64-bit processors).
+    All operations are taken modulo 2{^31} (or 2{^63}).
+    They do not fail on overflow. *)
+
+external ( ~- ) : int -> int = "%negint"
+(** Unary negation. You can also write [- e] instead of [~- e].
+    Unary operator at precedence level 9/11 for [- e]
+    and 11/11 for [~- e]. *)
+
+external ( ~+ ) : int -> int = "%identity"
+(** Unary addition. You can also write [+ e] instead of [~+ e].
+    Unary operator at precedence level 9/11 for [+ e]
+    and 11/11 for [~+ e].
+    @since 3.12.0
+*)
+
+external succ : int -> int = "%succint"
+(** [succ x] is [x + 1]. *)
+
+external pred : int -> int = "%predint"
+(** [pred x] is [x - 1]. *)
+
+external ( + ) : int -> int -> int = "%addint"
+(** Integer addition.
+    Left-associative operator at precedence level 6/11. *)
+
+external ( - ) : int -> int -> int = "%subint"
+(** Integer subtraction.
+    Left-associative operator at precedence level 6/11. *)
+
+external ( * ) : int -> int -> int = "%mulint"
+(** Integer multiplication.
+    Left-associative operator at precedence level 7/11. *)
+
+external ( / ) : int -> int -> int = "%divint"
+(** Integer division.
+    Raise [Division_by_zero] if the second argument is 0.
+    Integer division rounds the real quotient of its arguments towards zero.
+    More precisely, if [x >= 0] and [y > 0], [x / y] is the greatest integer
+    less than or equal to the real quotient of [x] by [y].  Moreover,
+    [(- x) / y = x / (- y) = - (x / y)].
+    Left-associative operator at precedence level 7/11. *)
+
+external ( mod ) : int -> int -> int = "%modint"
+(** Integer remainder.  If [y] is not zero, the result
+    of [x mod y] satisfies the following properties:
+    [x = (x / y) * y + x mod y] and
+    [abs(x mod y) <= abs(y) - 1].
+    If [y = 0], [x mod y] raises [Division_by_zero].
+    Note that [x mod y] is negative only if [x < 0].
+    Raise [Division_by_zero] if [y] is zero.
+    Left-associative operator at precedence level 7/11. *)
+
+val abs : int -> int
+(** Return the absolute value of the argument.  Note that this may be
+    negative if the argument is [min_int]. *)
+
+val max_int : int
+(** The greatest representable integer. *)
+
+val min_int : int
+(** The smallest representable integer. *)
+
+
+(** {2 Bitwise operations} *)
+
+external ( land ) : int -> int -> int = "%andint"
+(** Bitwise logical and.
+    Left-associative operator at precedence level 7/11. *)
+
+external ( lor ) : int -> int -> int = "%orint"
+(** Bitwise logical or.
+    Left-associative operator at precedence level 7/11. *)
+
+external ( lxor ) : int -> int -> int = "%xorint"
+(** Bitwise logical exclusive or.
+    Left-associative operator at precedence level 7/11. *)
+
+val lnot : int -> int
+(** Bitwise logical negation. *)
+
+external ( lsl ) : int -> int -> int = "%lslint"
+(** [n lsl m] shifts [n] to the left by [m] bits.
+    The result is unspecified if [m < 0] or [m >= bitsize],
+    where [bitsize] is [32] on a 32-bit platform and
+    [64] on a 64-bit platform.
+    Right-associative operator at precedence level 8/11. *)
+
+external ( lsr ) : int -> int -> int = "%lsrint"
+(** [n lsr m] shifts [n] to the right by [m] bits.
+    This is a logical shift: zeroes are inserted regardless of
+    the sign of [n].
+    The result is unspecified if [m < 0] or [m >= bitsize].
+    Right-associative operator at precedence level 8/11. *)
+
+external ( asr ) : int -> int -> int = "%asrint"
+(** [n asr m] shifts [n] to the right by [m] bits.
+    This is an arithmetic shift: the sign bit of [n] is replicated.
+    The result is unspecified if [m < 0] or [m >= bitsize].
+    Right-associative operator at precedence level 8/11. *)
+
+
+(** {1 String operations}
+
+    More string operations are provided in module {!String}.
+*)
+
+val ( ^ ) : string -> string -> string
+(** String concatenation.
+    Right-associative operator at precedence level 5/11. *)
+
+
+(** {1 Character operations}
+
+    More character operations are provided in module {!Char}.
+*)
+
+external int_of_char : char -> int = "%identity"
+(** Return the ASCII code of the argument. *)
+
+val char_of_int : int -> char
+(** Return the character with the given ASCII code.
+    Raise [Invalid_argument "char_of_int"] if the argument is
+    outside the range 0--255. *)
+
+
+(** {1 Unit operations} *)
+
+external ignore : 'a -> unit = "%ignore"
+(** Discard the value of its argument and return [()].
+    For instance, [ignore(f x)] discards the result of
+    the side-effecting function [f].  It is equivalent to
+    [f x; ()], except that the latter may generate a
+    compiler warning; writing [ignore(f x)] instead
+    avoids the warning. *)
+
+
+(** {1 String conversion functions} *)
+
+val string_of_bool : bool -> string
+(** Return the string representation of a boolean. As the returned values
+    may be shared, the user should not modify them directly.
+*)
+
+val bool_of_string_opt: string -> bool option
+(** Convert the given string to a boolean.
+    Return [None] if the string is not
+    ["true"] or ["false"].
+    @since 4.05
+*)
+
+val string_of_int : int -> string
+(** Return the string representation of an integer, in decimal. *)
+
+val int_of_string_opt: string -> int option
+(** Convert the given string to an integer.
+    The string is read in decimal (by default, or if the string
+    begins with [0u]), in hexadecimal (if it begins with [0x] or
+    [0X]), in octal (if it begins with [0o] or [0O]), or in binary
+    (if it begins with [0b] or [0B]).
+
+    The [0u] prefix reads the input as an unsigned integer in the range
+    [[0, 2*max_int+1]].  If the input exceeds {!max_int}
+    it is converted to the signed integer
+    [min_int + input - max_int - 1].
+
+    The [_] (underscore) character can appear anywhere in the string
+    and is ignored.
+
+    Return [None] if the given string is not a valid representation of
+    an integer, or if the integer represented exceeds the range of
+    integers representable in type [int].
+    @since 4.05
+*)
+
+(** {1 Pair operations} *)
+
+external fst : 'a * 'b -> 'a = "%field0"
+(** Return the first component of a pair. *)
+
+external snd : 'a * 'b -> 'b = "%field1"
+(** Return the second component of a pair. *)
+
+
+(** {1 List operations}
+
+    More list operations are provided in module {!List}.
+*)
+
+val ( @ ) : 'a list -> 'a list -> 'a list
+(** List concatenation.  Not tail-recursive (length of the first argument).
+    Right-associative operator at precedence level 5/11. *)
+
+
+(** {1 References} *)
+
+type 'a ref = { mutable contents : 'a }
+(** The type of references (mutable indirection cells) containing
+    a value of type ['a]. *)
+
+external ref : 'a -> 'a ref = "%makemutable"
+(** Return a fresh reference containing the given value. *)
+
+external ( ! ) : 'a ref -> 'a = "%field0"
+(** [!r] returns the current contents of reference [r].
+    Equivalent to [fun r -> r.contents].
+    Unary operator at precedence level 11/11.*)
+
+external ( := ) : 'a ref -> 'a -> unit = "%setfield0"
+(** [r := a] stores the value of [a] in reference [r].
+    Equivalent to [fun r v -> r.contents <- v].
+    Right-associative operator at precedence level 1/11. *)
+
+external incr : int ref -> unit = "%incr"
+(** Increment the integer contained in the given reference.
+    Equivalent to [fun r -> r := succ !r]. *)
+
+external decr : int ref -> unit = "%decr"
+(** Decrement the integer contained in the given reference.
+    Equivalent to [fun r -> r := pred !r]. *)
+
+(** {1 Result type} *)
+
+(** @since 4.03.0 *)
+type ('a,'b) result = Ok of 'a | Error of 'b
+
+(** {1 Operations on format strings} *)
+
+(** Format strings are character strings with special lexical conventions
+    that defines the functionality of formatted input/output functions. Format
+    strings are used to read data with formatted input functions from module
+    {!Scanf} and to print data with formatted output functions from modules
+    {!Printf} and {!Format}.
+
+    Format strings are made of three kinds of entities:
+    - {e conversions specifications}, introduced by the special character ['%']
+    followed by one or more characters specifying what kind of argument to
+    read or print,
+    - {e formatting indications}, introduced by the special character ['@']
+    followed by one or more characters specifying how to read or print the
+    argument,
+    - {e plain characters} that are regular characters with usual lexical
+    conventions. Plain characters specify string literals to be read in the
+    input or printed in the output.
+
+    There is an additional lexical rule to escape the special characters ['%']
+    and ['@'] in format strings: if a special character follows a ['%']
+    character, it is treated as a plain character. In other words, ["%%"] is
+    considered as a plain ['%'] and ["%@"] as a plain ['@'].
+
+    For more information about conversion specifications and formatting
+    indications available, read the documentation of modules {!Scanf},
+    {!Printf} and {!Format}.
+*)
+
+(** Format strings have a general and highly polymorphic type
+    [('a, 'b, 'c, 'd, 'e, 'f) format6].
+    The two simplified types, [format] and [format4] below are
+    included for backward compatibility with earlier releases of
+    OCaml.
+
+    The meaning of format string type parameters is as follows:
+
+    - ['a] is the type of the parameters of the format for formatted output
+      functions ([printf]-style functions);
+      ['a] is the type of the values read by the format for formatted input
+      functions ([scanf]-style functions).
+
+    - ['b] is the type of input source for formatted input functions and the
+      type of output target for formatted output functions.
+      For [printf]-style functions from module {!Printf}, ['b] is typically
+      [out_channel];
+      for [printf]-style functions from module {!Format}, ['b] is typically
+      {!Format.formatter};
+      for [scanf]-style functions from module {!Scanf}, ['b] is typically
+      {!Scanf.Scanning.in_channel}.
+
+      Type argument ['b] is also the type of the first argument given to
+      user's defined printing functions for [%a] and [%t] conversions,
+      and user's defined reading functions for [%r] conversion.
+
+    - ['c] is the type of the result of the [%a] and [%t] printing
+      functions, and also the type of the argument transmitted to the
+      first argument of [kprintf]-style functions or to the
+      [kscanf]-style functions.
+
+    - ['d] is the type of parameters for the [scanf]-style functions.
+
+    - ['e] is the type of the receiver function for the [scanf]-style functions.
+
+    - ['f] is the final result type of a formatted input/output function
+      invocation: for the [printf]-style functions, it is typically [unit];
+      for the [scanf]-style functions, it is typically the result type of the
+      receiver function.
+*)
+
+type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+
+type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
+
+val string_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+(** Converts a format string into a string. *)
+
+external format_of_string :
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity"
+(** [format_of_string s] returns a format string read from the string
+    literal [s].
+    Note: [format_of_string] can not convert a string argument that is not a
+    literal. If you need this functionality, use the more general
+    {!Scanf.format_from_string} function.
+*)
+
+val ( ^^ ) :
+  ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+  ('f, 'b, 'c, 'e, 'g, 'h) format6 ->
+  ('a, 'b, 'c, 'd, 'g, 'h) format6
+(** [f1 ^^ f2] catenates format strings [f1] and [f2]. The result is a
+    format string that behaves as the concatenation of format strings [f1] and
+    [f2]: in case of formatted output, it accepts arguments from [f1], then
+    arguments from [f2]; in case of formatted input, it returns results from
+    [f1], then results from [f2].
+    Right-associative operator at precedence level 5/11. *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol.mli
new file mode 100644
index 000000000..9a8fb6541
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol.mli
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  expected_env: env_version ;
+  components: component list ;
+}
+
+(** An OCaml source component of a protocol implementation. *)
+and component = {
+  (* The OCaml module name. *)
+  name : string ;
+  (* The OCaml interface source code *)
+  interface : string option ;
+  (* The OCaml source code *)
+  implementation : string ;
+}
+
+and env_version = V1
+
+val component_encoding: component Data_encoding.t
+val env_version_encoding: env_version Data_encoding.t
+
+include S.HASHABLE with type t := t
+                    and type hash := Protocol_hash.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol_hash.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol_hash.mli
new file mode 100644
index 000000000..4b50414f8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/protocol_hash.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Protocol hashes / IDs. *)
+include S.HASH
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/raw_hashes.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/raw_hashes.mli
new file mode 100644
index 000000000..db3f2464b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/raw_hashes.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 blake2b : MBytes.t -> MBytes.t
+
+val sha256 : MBytes.t -> MBytes.t
+
+val sha512 : MBytes.t -> MBytes.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/s.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/s.mli
new file mode 100644
index 000000000..598264554
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/s.mli
@@ -0,0 +1,269 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Generic interface for a datatype with comparison, pretty-printer
+    and serialization functions. *)
+module type T = sig
+
+  type t
+  include Compare.S with type t := t
+
+  val pp: Format.formatter -> t -> unit
+
+  val encoding: t Data_encoding.t
+  val to_bytes: t -> MBytes.t
+  val of_bytes: MBytes.t -> t option
+
+end
+
+(** Generic interface for a datatype with comparison, pretty-printer,
+    serialization functions and a hashing function. *)
+module type HASHABLE = sig
+
+  include T
+
+  type hash
+  val hash: t -> hash
+  val hash_raw: MBytes.t -> hash
+
+end
+
+(** {2 Hash Types} ************************************************************)
+
+(** The signature of an abstract hash type, as produced by functor
+    {!Make_SHA256}. The {!t} type is abstracted for separating the
+    various kinds of hashes in the system at typing time. Each type is
+    equipped with functions to use it as is of as keys in the database
+    or in memory sets and maps. *)
+
+module type MINIMAL_HASH = sig
+
+  type t
+
+  val name: string
+  val title: string
+
+  val pp: Format.formatter -> t -> unit
+  val pp_short: Format.formatter -> t -> unit
+
+  include Compare.S with type t := t
+
+  val hash_bytes: ?key:MBytes.t -> MBytes.t list -> t
+  val hash_string: ?key:string -> string list -> t
+
+  val zero: t
+
+end
+
+module type RAW_DATA = sig
+  type t
+  val size: int (* in bytes *)
+  val to_bytes: t -> MBytes.t
+  val of_bytes_opt: MBytes.t -> t option
+  val of_bytes_exn: MBytes.t -> t
+end
+
+module type B58_DATA = sig
+
+  type t
+
+  val to_b58check: t -> string
+  val to_short_b58check: t -> string
+
+  val of_b58check_exn: string -> t
+  val of_b58check_opt: string -> t option
+
+  type Base58.data += Data of t
+  val b58check_encoding: t Base58.encoding
+
+end
+
+module type ENCODER = sig
+  type t
+  val encoding: t Data_encoding.t
+  val rpc_arg: t RPC_arg.t
+end
+
+module type SET = sig
+  type elt
+  type t
+  val empty: t
+  val is_empty: t -> bool
+  val mem: elt -> t -> bool
+  val add: elt -> t -> t
+  val singleton: elt -> t
+  val remove: elt -> t -> t
+  val union: t -> t -> t
+  val inter: t -> t -> t
+  val diff: t -> t -> t
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
+  val subset: t -> t -> bool
+  val iter: (elt -> unit) -> t -> unit
+  val map: (elt -> elt) -> t -> t
+  val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a
+  val for_all: (elt -> bool) -> t -> bool
+  val exists: (elt -> bool) -> t -> bool
+  val filter: (elt -> bool) -> t -> t
+  val partition: (elt -> bool) -> t -> t * t
+  val cardinal: t -> int
+  val elements: t -> elt list
+  val min_elt_opt: t -> elt option
+  val max_elt_opt: t -> elt option
+  val choose_opt: t -> elt option
+  val split: elt -> t -> t * bool * t
+  val find_opt: elt -> t -> elt option
+  val find_first_opt: (elt -> bool) -> t -> elt option
+  val find_last_opt: (elt -> bool) -> t -> elt option
+  val of_list: elt list -> t
+end
+
+module type MAP = sig
+  type key
+  type (+'a) t
+  val empty: 'a t
+  val is_empty: 'a t -> bool
+  val mem: key -> 'a t -> bool
+  val add: key -> 'a -> 'a t -> 'a t
+  val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
+  val singleton: key -> 'a -> 'a t
+  val remove: key -> 'a t -> 'a t
+  val merge:
+    (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+  val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
+  val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+  val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+  val iter: (key -> 'a -> unit) -> 'a t -> unit
+  val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  val for_all: (key -> 'a -> bool) -> 'a t -> bool
+  val exists: (key -> 'a -> bool) -> 'a t -> bool
+  val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+  val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+  val cardinal: 'a t -> int
+  val bindings: 'a t -> (key * 'a) list
+  val min_binding_opt: 'a t -> (key * 'a) option
+  val max_binding_opt: 'a t -> (key * 'a) option
+  val choose_opt: 'a t -> (key * 'a) option
+  val split: key -> 'a t -> 'a t * 'a option * 'a t
+  val find_opt: key -> 'a t -> 'a option
+  val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option
+  val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option
+  val map: ('a -> 'b) -> 'a t -> 'b t
+  val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+end
+
+module type INDEXES = sig
+
+  type t
+
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  val of_path_exn: string list -> t
+
+  val prefix_path: string -> string list
+  val path_length: int
+
+  module Set : sig
+    include Set.S with type elt = t
+    val encoding: t Data_encoding.t
+  end
+
+  module Map : sig
+    include Map.S with type key = t
+    val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t
+  end
+
+end
+
+module type HASH = sig
+  include MINIMAL_HASH
+  include RAW_DATA with type t := t
+  include B58_DATA with type t := t
+  include ENCODER with type t := t
+  include INDEXES with type t := t
+end
+
+module type MERKLE_TREE = sig
+  type elt
+  include HASH
+  val compute: elt list -> t
+  val empty: t
+  type path =
+    | Left of path * t
+    | Right of t * path
+    | Op
+  val compute_path: elt list -> int -> path
+  val check_path: path -> elt -> t * int
+  val path_encoding: path Data_encoding.t
+end
+
+module type SIGNATURE = sig
+
+  module Public_key_hash : sig
+
+    type t
+
+    val pp: Format.formatter -> t -> unit
+    val pp_short: Format.formatter -> t -> unit
+    include Compare.S with type t := t
+    include RAW_DATA with type t := t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+    include INDEXES with type t := t
+
+    val zero: t
+
+  end
+
+  module Public_key : sig
+
+    type t
+
+    val pp: Format.formatter -> t -> unit
+    include Compare.S with type t := t
+    include B58_DATA with type t := t
+    include ENCODER with type t := t
+
+    val hash: t -> Public_key_hash.t
+
+  end
+
+  type t
+
+  val pp: Format.formatter -> t -> unit
+  include RAW_DATA with type t := t
+  include Compare.S with type t := t
+  include B58_DATA with type t := t
+  include ENCODER with type t := t
+
+  val zero: t
+
+  type watermark
+
+  (** Check a signature *)
+  val check: ?watermark:watermark -> Public_key.t -> t -> MBytes.t -> bool
+
+end
+
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/secp256k1.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/secp256k1.mli
new file mode 100644
index 000000000..9a2f84ada
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/secp256k1.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Secp256k1 cryptography *)
+
+include S.SIGNATURE with type watermark := MBytes.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/set.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/set.mli
new file mode 100644
index 000000000..c4c20d4a7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/set.mli
@@ -0,0 +1,65 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Sets over ordered types.
+
+    This module implements the set data structure, given a total ordering
+    function over the set elements. All operations over sets
+    are purely applicative (no side-effects).
+    The implementation uses balanced binary trees, and is therefore
+    reasonably efficient: insertion and membership take time
+    logarithmic in the size of the set, for instance.
+
+    The {!Make} functor constructs implementations for any type, given a
+    [compare] function.
+    For instance:
+    {[
+      module IntPairs =
+      struct
+        type t = int * int
+        let compare (x0,y0) (x1,y1) =
+          match Pervasives.compare x0 x1 with
+            0 -> Pervasives.compare y0 y1
+          | c -> c
+      end
+
+      module PairsSet = Set.Make(IntPairs)
+
+      let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13))
+    ]}
+
+    This creates a new module [PairsSet], with a new type [PairsSet.t]
+    of sets of [int * int].
+*)
+
+module type OrderedType =
+sig
+  type t
+  (** The type of the set elements. *)
+
+  val compare : t -> t -> int
+  (** A total ordering function over the set elements.
+      This is a two-argument function [f] such that
+      [f e1 e2] is zero if the elements [e1] and [e2] are equal,
+      [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+      and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+      Example: a suitable ordering function is the generic structural
+      comparison function {!Pervasives.compare}. *)
+end
+(** Input signature of the functor {!Set.Make}. *)
+
+module Make (Ord : OrderedType) : S.SET with type elt = Ord.t
+(** Functor building an implementation of the set structure
+    given a totally ordered type. *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/signature.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/signature.mli
new file mode 100644
index 000000000..9ad324566
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/signature.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type public_key_hash =
+  | Ed25519 of Ed25519.Public_key_hash.t
+  | Secp256k1 of Secp256k1.Public_key_hash.t
+  | P256 of P256.Public_key_hash.t
+
+type public_key =
+  | Ed25519 of Ed25519.Public_key.t
+  | Secp256k1 of Secp256k1.Public_key.t
+  | P256 of P256.Public_key.t
+
+type watermark =
+  | Block_header of Chain_id.t
+  | Endorsement of Chain_id.t
+  | Generic_operation
+  | Custom of MBytes.t
+
+include S.SIGNATURE with type Public_key_hash.t = public_key_hash
+                     and type Public_key.t = public_key
+                     and type watermark := watermark
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/string.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/string.mli
new file mode 100644
index 000000000..2113f9ffa
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/string.mli
@@ -0,0 +1,302 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* TEZOS CHANGES
+
+   * Import version 4.06.1
+   * Remove unsafe functions
+   * Remove deprecated functions (enforcing string immutability)
+   * Add binary data extraction functions
+
+*)
+
+(** String operations.
+
+    A string is an immutable data structure that contains a
+    fixed-length sequence of (single-byte) characters. Each character
+    can be accessed in constant time through its index.
+
+    Given a string [s] of length [l], we can access each of the [l]
+    characters of [s] via its index in the sequence. Indexes start at
+    [0], and we will call an index valid in [s] if it falls within the
+    range [[0...l-1]] (inclusive). A position is the point between two
+    characters or at the beginning or end of the string.  We call a
+    position valid in [s] if it falls within the range [[0...l]]
+    (inclusive). Note that the character at index [n] is between
+    positions [n] and [n+1].
+
+    Two parameters [start] and [len] are said to designate a valid
+    substring of [s] if [len >= 0] and [start] and [start+len] are
+    valid positions in [s].
+
+    OCaml strings used to be modifiable in place, for instance via the
+    {!String.set} and {!String.blit} functions described below. This
+    usage is deprecated and only possible when the compiler is put in
+    "unsafe-string" mode by giving the [-unsafe-string] command-line
+    option (which is currently the default for reasons of backward
+    compatibility). This is done by making the types [string] and
+    [bytes] (see module {!Bytes}) interchangeable so that functions
+    expecting byte sequences can also accept strings as arguments and
+    modify them.
+
+    All new code should avoid this feature and be compiled with the
+    [-safe-string] command-line option to enforce the separation between
+    the types [string] and [bytes].
+
+*)
+
+external length : string -> int = "%string_length"
+(** Return the length (number of characters) of the given string. *)
+
+external get : string -> int -> char = "%string_safe_get"
+(** [String.get s n] returns the character at index [n] in string [s].
+    You can also write [s.[n]] instead of [String.get s n].
+
+    Raise [Invalid_argument] if [n] not a valid index in [s]. *)
+
+
+val make : int -> char -> string
+(** [String.make n c] returns a fresh string of length [n],
+    filled with the character [c].
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *)
+
+val init : int -> (int -> char) -> string
+(** [String.init n f] returns a string of length [n], with character
+    [i] initialized to the result of [f i] (called in increasing
+    index order).
+
+    Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}.
+
+    @since 4.02.0
+*)
+
+val sub : string -> int -> int -> string
+(** [String.sub s start len] returns a fresh string of length [len],
+    containing the substring of [s] that starts at position [start] and
+    has length [len].
+
+    Raise [Invalid_argument] if [start] and [len] do not
+    designate a valid substring of [s]. *)
+
+val blit : string -> int -> bytes -> int -> int -> unit
+(** Same as {!Bytes.blit_string}. *)
+
+val concat : string -> string list -> string
+(** [String.concat sep sl] concatenates the list of strings [sl],
+    inserting the separator string [sep] between each.
+
+    Raise [Invalid_argument] if the result is longer than
+    {!Sys.max_string_length} bytes. *)
+
+val iter : (char -> unit) -> string -> unit
+(** [String.iter f s] applies function [f] in turn to all
+    the characters of [s].  It is equivalent to
+    [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *)
+
+val iteri : (int -> char -> unit) -> string -> unit
+(** Same as {!String.iter}, but the
+    function is applied to the index of the element as first argument
+    (counting from 0), and the character itself as second argument.
+    @since 4.00.0 *)
+
+val map : (char -> char) -> string -> string
+(** [String.map f s] applies function [f] in turn to all the
+    characters of [s] (in increasing index order) and stores the
+    results in a new string that is returned.
+    @since 4.00.0 *)
+
+val mapi : (int -> char -> char) -> string -> string
+(** [String.mapi f s] calls [f] with each character of [s] and its
+    index (in increasing index order) and stores the results in a new
+    string that is returned.
+    @since 4.02.0 *)
+
+val trim : string -> string
+(** Return a copy of the argument, without leading and trailing
+    whitespace.  The characters regarded as whitespace are: [' '],
+    ['\012'], ['\n'], ['\r'], and ['\t'].  If there is neither leading nor
+    trailing whitespace character in the argument, return the original
+    string itself, not a copy.
+    @since 4.00.0 *)
+
+val escaped : string -> string
+(** Return a copy of the argument, with special characters
+    represented by escape sequences, following the lexical
+    conventions of OCaml.
+    All characters outside the ASCII printable range (32..126) are
+    escaped, as well as backslash and double-quote.
+
+    If there is no special character in the argument that needs
+    escaping, return the original string itself, not a copy.
+
+    Raise [Invalid_argument] if the result is longer than
+    {!Sys.max_string_length} bytes.
+
+    The function {!Scanf.unescaped} is a left inverse of [escaped],
+    i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless
+    [escape s] fails). *)
+
+val index_opt: string -> char -> int option
+(** [String.index_opt s c] returns the index of the first
+    occurrence of character [c] in string [s], or
+    [None] if [c] does not occur in [s].
+    @since 4.05 *)
+
+val rindex_opt: string -> char -> int option
+(** [String.rindex_opt s c] returns the index of the last occurrence
+    of character [c] in string [s], or [None] if [c] does not occur in
+    [s].
+    @since 4.05 *)
+
+val index_from_opt: string -> int -> char -> int option
+(** [String.index_from_opt s i c] returns the index of the
+    first occurrence of character [c] in string [s] after position [i]
+    or [None] if [c] does not occur in [s] after position [i].
+
+    [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c].
+    Raise [Invalid_argument] if [i] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val rindex_from_opt: string -> int -> char -> int option
+(** [String.rindex_from_opt s i c] returns the index of the
+    last occurrence of character [c] in string [s] before position [i+1]
+    or [None] if [c] does not occur in [s] before position [i+1].
+
+    [String.rindex_opt s c] is equivalent to
+    [String.rindex_from_opt s (String.length s - 1) c].
+
+    Raise [Invalid_argument] if [i+1] is not a valid position in [s].
+
+    @since 4.05
+*)
+
+val contains : string -> char -> bool
+(** [String.contains s c] tests if character [c]
+    appears in the string [s]. *)
+
+val contains_from : string -> int -> char -> bool
+(** [String.contains_from s start c] tests if character [c]
+    appears in [s] after position [start].
+    [String.contains s c] is equivalent to
+    [String.contains_from s 0 c].
+
+    Raise [Invalid_argument] if [start] is not a valid position in [s]. *)
+
+val rcontains_from : string -> int -> char -> bool
+(** [String.rcontains_from s stop c] tests if character [c]
+    appears in [s] before position [stop+1].
+
+    Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid
+    position in [s]. *)
+
+val uppercase_ascii : string -> string
+(** Return a copy of the argument, with all lowercase letters
+    translated to uppercase, using the US-ASCII character set.
+    @since 4.03.0 *)
+
+val lowercase_ascii : string -> string
+(** Return a copy of the argument, with all uppercase letters
+    translated to lowercase, using the US-ASCII character set.
+    @since 4.03.0 *)
+
+val capitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to uppercase,
+    using the US-ASCII character set.
+    @since 4.03.0 *)
+
+val uncapitalize_ascii : string -> string
+(** Return a copy of the argument, with the first character set to lowercase,
+    using the US-ASCII character set.
+    @since 4.03.0 *)
+
+type t = string
+(** An alias for the type of strings. *)
+
+val compare: t -> t -> int
+(** The comparison function for strings, with the same specification as
+    {!Pervasives.compare}.  Along with the type [t], this function [compare]
+    allows the module [String] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for strings.
+    @since 4.03.0 *)
+
+val split_on_char: char -> string -> string list
+(** [String.split_on_char sep s] returns the list of all (possibly empty)
+    substrings of [s] that are delimited by the [sep] character.
+
+    The function's output is specified by the following invariants:
+
+    - The list is not empty.
+    - Concatenating its elements using [sep] as a separator returns a
+      string equal to the input ([String.concat (String.make 1 sep)
+      (String.split_on_char sep s) = s]).
+    - No string in the result contains the [sep] character.
+
+    @since 4.04.0
+*)
+
+(** Functions reading bytes  *)
+
+val get_char: t -> int -> char
+(** [get_char buff i] reads 1 byte at offset i as a char *)
+
+val get_uint8: t -> int -> int
+(** [get_uint8 buff i] reads 1 byte at offset i as an unsigned int of 8
+    bits. i.e. It returns a value between 0 and 2^8-1 *)
+
+val get_int8: t -> int -> int
+(** [get_int8 buff i] reads 1 byte at offset i as a signed int of 8
+    bits. i.e. It returns a value between -2^7 and 2^7-1 *)
+
+(** Functions reading according to Big Endian byte order *)
+
+val get_uint16: t -> int -> int
+(** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+val get_int16: t -> int -> int
+(** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+val get_int32: t -> int -> int32
+(** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+val get_int64: t -> int -> int64
+(** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+module LE: sig
+
+  (** Functions reading according to Little Endian byte order *)
+
+  val get_uint16: t -> int -> int
+  (** [get_uint16 buff i] reads 2 bytes at offset i as an unsigned int
+      of 16 bits. i.e. It returns a value between 0 and 2^16-1 *)
+
+  val get_int16: t -> int -> int
+  (** [get_int16 buff i] reads 2 byte at offset i as a signed int of
+      16 bits. i.e. It returns a value between -2^15 and 2^15-1 *)
+
+  val get_int32: t -> int -> int32
+  (** [get_int32 buff i] reads 4 bytes at offset i as an int32. *)
+
+  val get_int64: t -> int -> int64
+  (** [get_int64 buff i] reads 8 bytes at offset i as an int64. *)
+
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/tezos_data.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/tezos_data.mli
new file mode 100644
index 000000000..3ba261040
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/tezos_data.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Protocol : sig
+
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/time.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/time.mli
new file mode 100644
index 000000000..54a8e1347
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/time.mli
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+include Compare.S with type t := t
+
+val add : t -> int64 -> t
+val diff : t -> t -> int64
+
+val of_seconds : int64 -> t
+val to_seconds : t -> int64
+
+val of_notation : string -> t option
+val of_notation_exn : string -> t
+val to_notation : t -> string
+
+val encoding : t Data_encoding.t
+val rfc_encoding : t Data_encoding.t
+
+val pp_hum : Format.formatter -> t -> unit
+
+
+
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/updater.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/updater.mli
new file mode 100644
index 000000000..252fc531e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/updater.mli
@@ -0,0 +1,242 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Environment - Protocol updater. *)
+
+(** Validation result: the record returned by the protocol
+    on the successfull validation of a block. *)
+type validation_result = {
+
+  context: Context.t ;
+  (** The resulting context, it will be used for the next block. *)
+
+  fitness: Fitness.t ;
+  (** The effective fitness of the block (to be compared with
+      the 'announced' one in the block header. *)
+
+  message: string option ;
+  (** An optional informative message to be used as in the 'git
+      commit' of the block's context. *)
+
+  max_operations_ttl: int ;
+  (** The "time-to-live" of operation for the next block: any
+      operations whose 'branch' is older than 'ttl' blocks in the
+      past cannot be included in the next block. *)
+
+  last_allowed_fork_level: Int32.t ;
+  (** The level of the last block for which the node might consider an
+      alternate branch. The shell should consider as invalid any
+      branch whose fork point is older than the given level *)
+
+}
+
+type quota = {
+  max_size: int ;
+  (** The maximum size (in bytes) of the serialized list of
+      operations. *)
+  max_op: int option ;
+  (** The maximum number of operation.
+      [None] means no limit. *)
+}
+
+type rpc_context = {
+  block_hash: Block_hash.t ;
+  block_header: Block_header.shell_header ;
+  context: Context.t ;
+}
+
+(** This is the signature of a Tezos protocol implementation. It has
+    access to the standard library and the Environment module. *)
+module type PROTOCOL = sig
+
+  (** The maximum size of a block header in bytes. *)
+  val max_block_length: int
+
+  (** The maximum size of an operation in bytes. *)
+  val max_operation_data_length: int
+
+  (** The number of validation passes (length of the list) and the
+      operation's quota for each pass. *)
+  val validation_passes: quota list
+
+  (** The version specific type of blocks. *)
+  type block_header_data
+
+  (** Encoding for version specific part of block headers.  *)
+  val block_header_data_encoding: block_header_data Data_encoding.t
+
+  (** A fully parsed block header. *)
+  type block_header = {
+    shell: Block_header.shell_header ;
+    protocol_data: block_header_data ;
+  }
+
+  (** Version-specific side information computed by the protocol
+      during the validation of a block. Should not include information
+      about the evaluation of operations which is handled separately by
+      {!operation_metadata}. To be used as an execution trace by tools
+      (client, indexer). Not necessary for validation. *)
+  type block_header_metadata
+
+  (** Encoding for version-specific block metadata. *)
+  val block_header_metadata_encoding: block_header_metadata Data_encoding.t
+
+  (** The version specific type of operations. *)
+  type operation_data
+
+  (** Version-specific side information computed by the protocol
+      during the validation of each operation, to be used conjointly
+      with {!block_header_metadata}. *)
+  type operation_receipt
+
+  (** A fully parsed operation. *)
+  type operation = {
+    shell: Operation.shell_header ;
+    protocol_data: operation_data ;
+  }
+
+  (** Encoding for version-specific operation data. *)
+  val operation_data_encoding: operation_data Data_encoding.t
+
+  (** Encoding for version-specific operation receipts. *)
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+
+  (** Encoding that mixes an operation data and its receipt. *)
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
+
+  (** The Validation passes in which an operation can appear.
+      For instance [[0]] if it only belongs to the first pass.
+      An answer of [[]] means that the operation is ill-formed
+      and cannot be included at all. *)
+  val acceptable_passes: operation -> int list
+
+  (** Basic ordering of operations. [compare_operations op1 op2] means
+      that [op1] should appear before [op2] in a block. *)
+  val compare_operations: operation -> operation -> int
+
+  (** A functional state that is transmitted through the steps of a
+      block validation sequence. It must retain the current state of
+      the store (that can be extracted from the outside using
+      {!current_context}, and whose final value is produced by
+      {!finalize_block}). It can also contain the information that
+      must be remembered during the validation, which must be
+      immutable (as validator or baker implementations are allowed to
+      pause, replay or backtrack during the validation process). *)
+  type validation_state
+
+  (** Access the context at a given validation step. *)
+  val current_context: validation_state -> Context.t tzresult Lwt.t
+
+  (** Checks that a block is well formed in a given context. This
+      function should run quickly, as its main use is to reject bad
+      blocks from the chain as early as possible. The input context
+      is the one resulting of an ancestor block of same protocol
+      version. This ancestor of the current head is guaranteed to be
+      more recent than `last_allowed_fork_level`.
+
+      The resulting `validation_state` will be used for multi-pass
+      validation. *)
+  val begin_partial_application:
+    chain_id: Chain_id.t ->
+    ancestor_context: Context.t ->
+    predecessor_timestamp: Time.t ->
+    predecessor_fitness: Fitness.t ->
+    block_header ->
+    validation_state tzresult Lwt.t
+
+  (** The first step in a block validation sequence. Initializes a
+      validation context for validating a block. Takes as argument the
+      {!Block_header.t} to initialize the context for this block. The
+      function {!precheck_block} may not have been called before
+      [begin_application], so all the check performed by the former
+      must be repeated in the latter. *)
+  val begin_application:
+    chain_id: Chain_id.t ->
+    predecessor_context: Context.t ->
+    predecessor_timestamp: Time.t ->
+    predecessor_fitness: Fitness.t ->
+    block_header ->
+    validation_state tzresult Lwt.t
+
+  (** Initializes a validation context for constructing a new block
+      (as opposed to validating an existing block). When the
+      [protocol_data] argument is specified, it should contains a
+      'prototype' of a the protocol specific part of a block header,
+      and the function should produce the exact same effect on the
+      context than would produce the validation of a block containing
+      an "equivalent" (but complete) header. For instance, if the
+      block header usually includes a signature, the header provided
+      to {!begin_construction} should includes a faked signature. *)
+  val begin_construction:
+    chain_id: Chain_id.t ->
+    predecessor_context: Context.t ->
+    predecessor_timestamp: Time.t ->
+    predecessor_level: Int32.t ->
+    predecessor_fitness: Fitness.t ->
+    predecessor: Block_hash.t ->
+    timestamp: Time.t ->
+    ?protocol_data: block_header_data ->
+    unit -> validation_state tzresult Lwt.t
+
+  (** Called after {!begin_application} (or {!begin_construction}) and
+      before {!finalize_block}, with each operation in the block. *)
+  val apply_operation:
+    validation_state ->
+    operation ->
+    (validation_state * operation_receipt) tzresult Lwt.t
+
+  (** The last step in a block validation sequence. It produces the
+      context that will be used as input for the validation of its
+      successor block candidates. *)
+  val finalize_block:
+    validation_state ->
+    (validation_result * block_header_metadata) tzresult Lwt.t
+
+  (** The list of remote procedures exported by this implementation *)
+  val rpc_services: rpc_context RPC_directory.t
+
+  (** Initialize the context (or upgrade the context after a protocol
+      amendment). This function receives the context resulting of the
+      application of a block that triggered the amendment. It also
+      receives the header of the block that triggered the amendment. *)
+  val init:
+    Context.t -> Block_header.shell_header -> validation_result tzresult Lwt.t
+
+end
+
+(** Activates a given protocol version from a given context. This
+    means that the context used for the next block will use this
+    version (this is not an immediate change). The version must have
+    been previously compiled successfully. *)
+val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
+
+(** Fork a test chain. The forkerd chain will use the current block
+    as genesis, and [protocol] as economic protocol. The chain will
+    be destroyed when a (successor) block will have a timestamp greater
+    than [expiration]. The protocol must have been previously compiled
+    successfully. *)
+val fork_test_chain:
+  Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/z.mli b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/z.mli
new file mode 100644
index 000000000..48fd674f6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs/v1/z.mli
@@ -0,0 +1,122 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Environment - Arbitrary precision arithmetic. *)
+
+type t
+val zero: t
+val one: t
+
+val succ: t -> t
+(** Returns its argument plus one. *)
+
+val abs: t -> t
+(** Absolute value. *)
+
+val neg: t -> t
+(** Unary negation. *)
+
+val add: t -> t -> t
+(** Addition. *)
+
+val sub: t -> t -> t
+(** Subtraction. *)
+
+val mul: t -> t -> t
+(** Multiplication. *)
+
+val ediv_rem: t -> t -> (t * t)
+(** Euclidean division and remainder.  [ediv_rem a b] returns a pair [(q, r)]
+    such that [a = b * q + r] and [0 <= r < |b|].
+    Raises [Division_by_zero] if [b = 0].
+*)
+
+val logand: t -> t -> t
+(** Bitwise logical and. *)
+
+val logor: t -> t -> t
+(** Bitwise logical or. *)
+
+val logxor: t -> t -> t
+(** Bitwise logical exclusive or. *)
+
+val lognot: t -> t
+(** Bitwise logical negation.
+    The identity [lognot a]=[-a-1] always hold.
+*)
+
+val shift_left: t -> int -> t
+(** Shifts to the left.
+    Equivalent to a multiplication by a power of 2.
+    The second argument must be non-negative.
+*)
+
+val shift_right: t -> int -> t
+(** Shifts to the right.
+    This is an arithmetic shift,
+    equivalent to a division by a power of 2 with rounding towards -oo.
+    The second argument must be non-negative.
+*)
+
+val to_string: t -> string
+(** Gives a human-readable, decimal string representation of the argument. *)
+
+val of_string: string -> t
+(** Converts a string to an integer.
+    An optional [-] prefix indicates a negative number, while a [+]
+    prefix is ignored.
+    An optional prefix [0x], [0o], or [0b] (following the optional [-]
+    or [+] prefix) indicates that the number is,
+    represented, in hexadecimal, octal, or binary, respectively.
+    Otherwise, base 10 is assumed.
+    (Unlike C, a lone [0] prefix does not denote octal.)
+    Raises an [Invalid_argument] exception if the string is not a
+    syntactically correct representation of an integer.
+*)
+
+val to_int64: t -> int64
+(** Converts to a 64-bit integer. May raise [Overflow]. *)
+
+val of_int64: int64 -> t
+(** Converts from a 64-bit integer. *)
+
+val to_int: t -> int
+(** Converts to a base integer. May raise an [Overflow]. *)
+
+val of_int: int -> t
+(** Converts from a base integer. *)
+
+val to_bits: ?pad_to:int -> t -> MBytes.t
+val of_bits: MBytes.t -> t
+
+val equal: t -> t -> bool
+val compare: t -> t -> int
+
+val numbits: t -> int
+(** Returns the number of significant bits in the given number.
+    If [x] is zero, [numbits x] returns 0.  Otherwise,
+    [numbits x] returns a positive integer [n] such that
+    [2^{n-1} <= |x| < 2^n].  Note that [numbits] is defined
+    for negative arguments, and that [numbits (-x) = numbits x]. *)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/dune b/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/dune
new file mode 100644
index 000000000..0f0785367
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/dune
@@ -0,0 +1,9 @@
+(executable
+ (name sigs_packer)
+ (public_name tezos-protocol-environment-sigs.packer)
+ (package tezos-protocol-environment-sigs))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/sigs_packer.ml b/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/sigs_packer.ml
new file mode 100644
index 000000000..98f3ffaa8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/sigs_packer/sigs_packer.ml
@@ -0,0 +1,65 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 dump_file oc file =
+  let ic = open_in file in
+  let buflen = 8096 in
+  let buf = Bytes.create buflen in
+  let rec loop () =
+    let len = input ic buf 0 buflen in
+    if len <> 0 then begin
+      Printf.fprintf oc "%s" (Bytes.to_string (if len = buflen then buf else Bytes.sub buf 0 len)) ;
+      loop ()
+    end
+  in
+  loop () ;
+  close_in ic
+
+let opened_modules = [
+  "Pervasives" ;
+  "Error_monad" ;
+]
+
+let include_mli oc file =
+  let unit =
+    String.capitalize_ascii
+      (Filename.chop_extension (Filename.basename file)) in
+  Printf.fprintf oc "module %s : sig\n" unit ;
+  Printf.fprintf oc "# 1 %S\n" file ;
+  dump_file oc file ;
+  Printf.fprintf oc "end\n" ;
+  if unit = "Result" then
+    Printf.fprintf oc
+      "type ('a, 'b) result = ('a, 'b) Result.result = \
+      \ Ok of 'a | Error of 'b\n" ;
+  if List.mem unit opened_modules then Printf.fprintf oc "open %s\n" unit
+
+let () =
+  Printf.fprintf stdout "module type T = sig\n" ;
+  for i = 1 to Array.length Sys.argv - 1 do
+    let file = Sys.argv.(i) in
+    include_mli stdout file ;
+  done ;
+  Printf.fprintf stdout "end\n%!"
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/test/assert.ml b/vendors/tezos-modded/src/lib_protocol_environment/test/assert.ml
new file mode 100644
index 000000000..8e8fc024c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/test/assert.ml
@@ -0,0 +1,66 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fail expected given msg =
+  Format.kasprintf Pervasives.failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+let fail_msg fmt = Format.kasprintf (fail "" "") fmt
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (prn x) (prn y) msg
+
+let equal_string_option ?msg o1 o2 =
+  let prn = function
+    | None -> "None"
+    | Some s -> s in
+  equal ?msg ~prn o1 o2
+
+let is_none ?(msg="") x =
+  if x <> None then fail "None" "Some _" msg
+
+let make_equal_list eq prn ?(msg="") x y =
+  let rec iter i x y =
+    match x, y with
+    | hd_x :: tl_x, hd_y :: tl_y ->
+        if eq hd_x hd_y then
+          iter (succ i) tl_x tl_y
+        else
+          let fm = Printf.sprintf "%s (at index %d)" msg i in
+          fail (prn hd_x) (prn hd_y) fm
+    | _ :: _, [] | [], _ :: _ ->
+        let fm = Printf.sprintf "%s (lists of different sizes)" msg in
+        fail_msg "%s" fm
+    | [], [] ->
+        () in
+  iter 0 x y
+
+let equal_string_list_list ?msg l1 l2 =
+  let pr_persist l =
+    let res =
+      String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
+    Printf.sprintf "[%s]" res in
+  make_equal_list ?msg (=) pr_persist l1 l2
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/test/dune b/vendors/tezos-modded/src/lib_protocol_environment/test/dune
new file mode 100644
index 000000000..19a1b6a4c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/test/dune
@@ -0,0 +1,23 @@
+(executables
+ (names test)
+ (libraries tezos-base
+            tezos-protocol-environment
+            alcotest-lwt)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_protocol_environment)))
+
+(alias
+ (name buildtest)
+ (deps test.exe))
+
+(alias
+ (name runtest)
+ (package tezos-protocol-environment)
+ (action (run %{exe:test.exe})))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/test/test.ml b/vendors/tezos-modded/src/lib_protocol_environment/test/test.ml
new file mode 100644
index 000000000..c671d778a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/test/test.ml
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Alcotest.run "tezos-protocol-environment-shell" [
+    "mem_context", Test_mem_context.tests ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/test/test_mem_context.ml b/vendors/tezos-modded/src/lib_protocol_environment/test/test_mem_context.ml
new file mode 100644
index 000000000..2351ed2cc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/test/test_mem_context.ml
@@ -0,0 +1,165 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Tezos_protocol_environment_memory
+
+(** Context creation *)
+
+let create_block2 ctxt =
+  Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
+  Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
+  Context.set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt ->
+  Lwt.return ctxt
+
+let create_block3a ctxt =
+  Context.del ctxt ["a"; "b"] >>= fun ctxt ->
+  Context.set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt ->
+  Lwt.return ctxt
+
+let create_block3b ctxt =
+  Context.del ctxt ["a"; "c"] >>= fun ctxt ->
+  Context.set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt ->
+  Lwt.return ctxt
+
+type t = {
+  genesis: Context.t ;
+  block2: Context.t ;
+  block3a: Context.t ;
+  block3b: Context.t ;
+}
+
+let wrap_context_init f _ () =
+  let genesis = Context.empty in
+  create_block2 genesis >>= fun block2 ->
+  create_block3a block2 >>= fun block3a ->
+  create_block3b block2 >>= fun block3b ->
+  f { genesis; block2 ; block3a; block3b } >>= fun result ->
+  Lwt.return result
+
+(** Simple test *)
+
+let c = function
+  | None -> None
+  | Some s -> Some (MBytes.to_string s)
+
+let test_simple { block2 = ctxt } =
+  Context.get ctxt ["version"] >>= fun version ->
+  Assert.equal_string_option ~msg:__LOC__ (c version) (Some "0.0") ;
+  Context.get ctxt ["a";"b"] >>= fun novembre ->
+  Assert.equal_string_option (Some "Novembre") (c novembre) ;
+  Context.get ctxt ["a";"c"] >>= fun juin ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
+  Lwt.return_unit
+
+let test_continuation { block3a = ctxt } =
+  Context.get ctxt ["version"] >>= fun version ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
+  Context.get ctxt ["a";"b"] >>= fun novembre ->
+  Assert.is_none ~msg:__LOC__ (c novembre) ;
+  Context.get ctxt ["a";"c"] >>= fun juin ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
+  Context.get ctxt ["a";"d"] >>= fun mars ->
+  Assert.equal_string_option ~msg:__LOC__  (Some "Mars") (c mars) ;
+  Lwt.return_unit
+
+let test_fork { block3b = ctxt } =
+  Context.get ctxt ["version"] >>= fun version ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
+  Context.get ctxt ["a";"b"] >>= fun novembre ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+  Context.get ctxt ["a";"c"] >>= fun juin ->
+  Assert.is_none ~msg:__LOC__ (c juin) ;
+  Context.get ctxt ["a";"d"] >>= fun mars ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ;
+  Lwt.return_unit
+
+let test_replay { genesis = ctxt0 }  =
+  Context.set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 ->
+  Context.set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 ->
+  Context.set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 ->
+  Context.set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a ->
+  Context.set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b ->
+  Context.set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a ->
+  Context.get ctxt4a ["a";"b"] >>= fun novembre ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+  Context.get ctxt5a ["a";"b"] >>= fun november ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "November") (c november) ;
+  Context.get ctxt5a ["a";"d"] >>= fun july ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "July") (c july) ;
+  Context.get ctxt4b ["a";"b"] >>= fun novembre ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+  Context.get ctxt4b ["a";"d"] >>= fun juillet ->
+  Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ;
+  Lwt.return_unit
+
+let fold_keys s k ~init ~f =
+  let rec loop k acc =
+    Context.fold s k ~init:acc
+      ~f:(fun file acc ->
+          match file with
+          | `Key k -> f k acc
+          | `Dir k -> loop k acc) in
+  loop k init
+let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
+
+let test_fold { genesis = ctxt } =
+  Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
+  Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
+  Context.set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt ->
+  Context.set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt ->
+  Context.set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt ->
+  keys ctxt [] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__
+    [["a";"b"];
+     ["a";"c"];
+     ["a";"d";"e"];
+     ["f"];
+     ["g";"h"]] (List.sort compare l) ;
+  keys ctxt ["a"] >>= fun l ->
+  Assert.equal_string_list_list
+    ~msg:__LOC__ [["a";"b"]; ["a";"c"]; ["a";"d";"e"]]
+    (List.sort compare l) ;
+  keys ctxt ["f"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+  keys ctxt ["g"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [["g";"h"]] l ;
+  keys ctxt ["i"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+  Lwt.return_unit
+
+(******************************************************************************)
+
+let tests = [
+  "simple", test_simple ;
+  "continuation", test_continuation ;
+  "fork", test_fork ;
+  "replay", test_replay ;
+  "fold", test_fold ;
+]
+
+let tests =
+  List.map
+    (fun (n, f) -> Alcotest_lwt.test_case n `Quick (wrap_context_init f))
+    tests
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-shell.opam b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-shell.opam
new file mode 100644
index 000000000..8a4934186
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-shell.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-storage"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-sigs.opam b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-sigs.opam
new file mode 100644
index 000000000..ac88e68d3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment-sigs.opam
@@ -0,0 +1,18 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-stdlib" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment.opam b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment.opam
new file mode 100644
index 000000000..a3350d924
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos-protocol-environment.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment-sigs"
+  "alcotest-lwt" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.ml b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.ml
new file mode 100644
index 000000000..343ff9f34
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.ml
@@ -0,0 +1,783 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+module type CONTEXT = sig
+  type t
+  type key = string list
+  type value = MBytes.t
+  val mem: t -> key -> bool Lwt.t
+  val dir_mem: t -> key -> bool Lwt.t
+  val get: t -> key -> value option Lwt.t
+  val set: t -> key -> value -> t Lwt.t
+  val copy: t -> from:key -> to_:key -> t option Lwt.t
+  val del: t -> key -> t Lwt.t
+  val remove_rec: t -> key -> t Lwt.t
+  val fold:
+    t -> key -> init:'a ->
+    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+    'a Lwt.t
+  val set_protocol: t -> Protocol_hash.t -> t Lwt.t
+  val fork_test_chain:
+    t -> protocol:Protocol_hash.t -> expiration:Time.t -> t Lwt.t
+end
+
+module Make (Context : CONTEXT) = struct
+
+  type validation_result = {
+    context: Context.t ;
+    fitness: Fitness.t ;
+    message: string option ;
+    max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
+  }
+
+  type quota = {
+    max_size: int ;
+    max_op: int option ;
+  }
+
+  type rpc_context = {
+    block_hash: Block_hash.t ;
+    block_header: Block_header.shell_header ;
+    context: Context.t ;
+  }
+
+  module type T = sig
+    type context
+    type quota
+    type validation_result
+    type rpc_context
+    type 'a tzresult
+    val max_block_length: int
+    val max_operation_data_length: int
+    val validation_passes: quota list
+    type block_header_data
+    val block_header_data_encoding: block_header_data Data_encoding.t
+    type block_header = {
+      shell: Block_header.shell_header ;
+      protocol_data: block_header_data ;
+    }
+    type block_header_metadata
+    val block_header_metadata_encoding: block_header_metadata Data_encoding.t
+    type operation_data
+    type operation_receipt
+    type operation = {
+      shell: Operation.shell_header ;
+      protocol_data: operation_data ;
+    }
+    val operation_data_encoding: operation_data Data_encoding.t
+    val operation_receipt_encoding: operation_receipt Data_encoding.t
+    val operation_data_and_receipt_encoding:
+      (operation_data * operation_receipt) Data_encoding.t
+    val acceptable_passes: operation -> int list
+    val compare_operations: operation -> operation -> int
+    type validation_state
+    val current_context: validation_state -> context tzresult Lwt.t
+    val begin_partial_application:
+      chain_id: Chain_id.t ->
+      ancestor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
+      block_header ->
+      validation_state tzresult Lwt.t
+    val begin_application:
+      chain_id: Chain_id.t ->
+      predecessor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
+      block_header ->
+      validation_state tzresult Lwt.t
+    val begin_construction:
+      chain_id: Chain_id.t ->
+      predecessor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_level: Int32.t ->
+      predecessor_fitness: Fitness.t ->
+      predecessor: Block_hash.t ->
+      timestamp: Time.t ->
+      ?protocol_data: block_header_data ->
+      unit -> validation_state tzresult Lwt.t
+    val apply_operation:
+      validation_state -> operation ->
+      (validation_state * operation_receipt) tzresult Lwt.t
+    val finalize_block:
+      validation_state ->
+      (validation_result * block_header_metadata) tzresult Lwt.t
+    val rpc_services: rpc_context RPC_directory.t
+    val init:
+      context -> Block_header.shell_header -> validation_result tzresult Lwt.t
+  end
+
+  module type PROTOCOL =
+    T with type context := Context.t
+       and type quota := quota
+       and type validation_result := validation_result
+       and type rpc_context := rpc_context
+       and type 'a tzresult := 'a Error_monad.tzresult
+
+  module type V1 = sig
+
+    include Tezos_protocol_environment_sigs.V1.T
+      with type Format.formatter = Format.formatter
+       and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
+       and type 'a Lwt.t = 'a Lwt.t
+       and type ('a, 'b) Pervasives.result = ('a, 'b) result
+       and type Chain_id.t = Chain_id.t
+       and type Block_hash.t = Block_hash.t
+       and type Operation_hash.t = Operation_hash.t
+       and type Operation_list_hash.t = Operation_list_hash.t
+       and type Operation_list_list_hash.t = Operation_list_list_hash.t
+       and type Context.t = Context.t
+       and type Context_hash.t = Context_hash.t
+       and type Protocol_hash.t = Protocol_hash.t
+       and type Time.t = Time.t
+       and type MBytes.t = MBytes.t
+       and type Operation.shell_header = Operation.shell_header
+       and type Operation.t = Operation.t
+       and type Block_header.shell_header = Block_header.shell_header
+       and type Block_header.t = Block_header.t
+       and type 'a RPC_directory.t = 'a RPC_directory.t
+       and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t
+       and type Ed25519.Public_key.t = Ed25519.Public_key.t
+       and type Ed25519.t = Ed25519.t
+       and type Secp256k1.Public_key_hash.t = Secp256k1.Public_key_hash.t
+       and type Secp256k1.Public_key.t = Secp256k1.Public_key.t
+       and type Secp256k1.t = Secp256k1.t
+       and type P256.Public_key_hash.t = P256.Public_key_hash.t
+       and type P256.Public_key.t = P256.Public_key.t
+       and type P256.t = P256.t
+       and type Signature.public_key_hash = Signature.public_key_hash
+       and type Signature.public_key = Signature.public_key
+       and type Signature.t = Signature.t
+       and type Signature.watermark = Signature.watermark
+       and type 'a Micheline.canonical = 'a Micheline.canonical
+       and type Micheline.Michelson_primitives.prim = Micheline.Michelson_primitives.prim
+       and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t
+       and type Z.t = Z.t
+       and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node
+       and type Data_encoding.json_schema = Data_encoding.json_schema
+       and type RPC_service.meth = RPC_service.meth
+       and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t
+       and type Error_monad.shell_error = Error_monad.error
+       and type Z.t = Z.t
+
+    type error += Ecoproto_error of Error_monad.error
+    val wrap_error : 'a Error_monad.tzresult -> 'a tzresult
+
+    module Lift (P : Updater.PROTOCOL) : PROTOCOL
+      with type block_header_data = P.block_header_data
+       and type block_header = P.block_header
+       and type operation_data = P.operation_data
+       and type operation_receipt = P.operation_receipt
+       and type operation = P.operation
+       and type validation_state = P.validation_state
+
+    class ['chain, 'block] proto_rpc_context :
+      Tezos_rpc.RPC_context.t -> (unit, (unit * 'chain) * 'block) RPC_path.t ->
+      [('chain * 'block)] RPC_context.simple
+
+    class ['block] proto_rpc_context_of_directory :
+      ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
+      ['block] RPC_context.simple
+
+  end
+
+  module MakeV1 (Param : sig val name: string end) () = struct
+
+    include Pervasives
+    module Pervasives = Pervasives
+    module Compare = Compare
+    module Array = Array
+    module List = List
+    module Bytes = struct
+      include Bytes
+      include EndianBytes.BigEndian
+      module LE = EndianBytes.LittleEndian
+    end
+    module String = struct
+      include String
+      include EndianString.BigEndian
+      module LE = EndianString.LittleEndian
+    end
+    module Set = Set
+    module Map = Map
+    module Int32 = Int32
+    module Int64 = Int64
+    module Nativeint = Nativeint
+    module Buffer = Buffer
+    module Format = Format
+    module Option = Option
+    module MBytes = MBytes
+    module Raw_hashes = struct
+      let sha256 msg = Hacl.Hash.SHA256.digest msg
+      let sha512 msg = Hacl.Hash.SHA512.digest msg
+      let blake2b msg = Blake2B.to_bytes (Blake2B.hash_bytes [ msg ])
+    end
+    module Z = struct
+      include Z
+      let to_bits ?(pad_to = 0) z =
+        let bits = to_bits z in
+        let len = Pervasives.((numbits z + 7) / 8) in
+        let full_len = Compare.Int.max pad_to len in
+        if full_len = 0 then
+          MBytes.empty
+        else
+          let res = MBytes.make full_len '\000' in
+          MBytes.blit_of_string bits 0 res 0 len ;
+          res
+      let of_bits bytes =
+        of_bits (MBytes.to_string bytes)
+    end
+    module Lwt_sequence = Lwt_sequence
+    module Lwt = Lwt
+    module Lwt_list = Lwt_list
+    module Uri = Uri
+    module Data_encoding = Data_encoding
+    module Time = Time
+    module Ed25519 = Ed25519
+    module Secp256k1 = Secp256k1
+    module P256 = P256
+    module Signature = Signature
+    module S = struct
+      module type T = Tezos_base.S.T
+      module type HASHABLE = Tezos_base.S.HASHABLE
+      module type MINIMAL_HASH = S.MINIMAL_HASH
+      module type B58_DATA = sig
+
+        type t
+
+        val to_b58check: t -> string
+        val to_short_b58check: t -> string
+
+        val of_b58check_exn: string -> t
+        val of_b58check_opt: string -> t option
+
+        type Base58.data += Data of t
+        val b58check_encoding: t Base58.encoding
+
+      end
+      module type RAW_DATA = sig
+        type t
+        val size: int (* in bytes *)
+        val to_bytes: t -> MBytes.t
+        val of_bytes_opt: MBytes.t -> t option
+        val of_bytes_exn: MBytes.t -> t
+      end
+      module type ENCODER = sig
+        type t
+        val encoding: t Data_encoding.t
+        val rpc_arg: t RPC_arg.t
+      end
+      module type SET = Tezos_base.S.SET
+      module type MAP = Tezos_base.S.MAP
+      module type INDEXES = sig
+
+        type t
+
+        val to_path: t -> string list -> string list
+        val of_path: string list -> t option
+        val of_path_exn: string list -> t
+
+        val prefix_path: string -> string list
+        val path_length: int
+
+        module Set : sig
+          include Set.S with type elt = t
+          val encoding: t Data_encoding.t
+        end
+
+        module Map : sig
+          include Map.S with type key = t
+          val encoding: 'a Data_encoding.t -> 'a t Data_encoding.t
+        end
+
+      end
+      module type HASH = sig
+        include MINIMAL_HASH
+        include RAW_DATA with type t := t
+        include B58_DATA with type t := t
+        include ENCODER with type t := t
+        include INDEXES with type t := t
+      end
+
+      module type MERKLE_TREE = sig
+        type elt
+        include HASH
+        val compute: elt list -> t
+        val empty: t
+        type path =
+          | Left of path * t
+          | Right of t * path
+          | Op
+        val compute_path: elt list -> int -> path
+        val check_path: path -> elt -> t * int
+        val path_encoding: path Data_encoding.t
+      end
+
+      module type SIGNATURE = sig
+
+        module Public_key_hash : sig
+
+          type t
+
+          val pp: Format.formatter -> t -> unit
+          val pp_short: Format.formatter -> t -> unit
+          include Compare.S with type t := t
+          include RAW_DATA with type t := t
+          include B58_DATA with type t := t
+          include ENCODER with type t := t
+          include INDEXES with type t := t
+
+          val zero: t
+
+        end
+
+        module Public_key : sig
+
+          type t
+
+          val pp: Format.formatter -> t -> unit
+          include Compare.S with type t := t
+          include B58_DATA with type t := t
+          include ENCODER with type t := t
+
+          val hash: t -> Public_key_hash.t
+
+        end
+
+        type t
+
+        val pp: Format.formatter -> t -> unit
+        include RAW_DATA with type t := t
+        include Compare.S with type t := t
+        include B58_DATA with type t := t
+        include ENCODER with type t := t
+
+        val zero: t
+
+        type watermark
+
+        (** Check a signature *)
+        val check: ?watermark:watermark -> Public_key.t -> t -> MBytes.t -> bool
+
+      end
+
+    end
+    module Error_monad = struct
+      type 'a shell_tzresult = 'a Error_monad.tzresult
+      type shell_error = Error_monad.error = ..
+      type error_category = [ `Branch | `Temporary | `Permanent ]
+      include Error_monad.Make(struct let id = Format.asprintf "proto.%s." Param.name end)
+    end
+
+    type error += Ecoproto_error of Error_monad.error
+
+    module Wrapped_error_monad = struct
+      type unwrapped = Error_monad.error = ..
+      include (Error_monad : Error_monad_sig.S with type error := unwrapped)
+      let unwrap = function
+        | Ecoproto_error ecoerror -> Some ecoerror
+        | _ -> None
+      let wrap ecoerror =
+        Ecoproto_error ecoerror
+    end
+
+    let () =
+      let id = Format.asprintf "proto.%s.wrapper" Param.name in
+      register_wrapped_error_kind
+        (module Wrapped_error_monad)
+        ~id ~title: ("Error returned by protocol " ^ Param.name)
+        ~description: ("Wrapped error for economic protocol " ^ Param.name ^ ".")
+
+    let wrap_error = function
+      | Ok _ as ok -> ok
+      | Error errors -> Error (List.map (fun error -> Ecoproto_error error) errors)
+
+    module Chain_id = Chain_id
+    module Block_hash = Block_hash
+    module Operation_hash = Operation_hash
+    module Operation_list_hash = Operation_list_hash
+    module Operation_list_list_hash = Operation_list_list_hash
+    module Context_hash = Context_hash
+    module Protocol_hash = Protocol_hash
+    module Blake2B = Blake2B
+    module Fitness = Fitness
+    module Operation = Operation
+    module Block_header = Block_header
+    module Protocol = Protocol
+    module RPC_arg = RPC_arg
+    module RPC_path = RPC_path
+    module RPC_query = RPC_query
+    module RPC_service = RPC_service
+    module RPC_answer = struct
+
+      type 'o t =
+        [ `Ok of 'o (* 200 *)
+        | `OkStream of 'o stream (* 200 *)
+        | `Created of string option (* 201 *)
+        | `No_content (* 204 *)
+        | `Unauthorized of Error_monad.error list option (* 401 *)
+        | `Forbidden of Error_monad.error list option (* 403 *)
+        | `Not_found of Error_monad.error list option (* 404 *)
+        | `Conflict of Error_monad.error list option (* 409 *)
+        | `Error of Error_monad.error list option (* 500 *)
+        ]
+
+      and 'a stream = 'a Resto_directory.Answer.stream = {
+        next: unit -> 'a option Lwt.t ;
+        shutdown: unit -> unit ;
+      }
+
+      let return x = Lwt.return (`Ok x)
+      let return_stream x = Lwt.return (`OkStream x)
+      let not_found = Lwt.return (`Not_found None)
+
+      let fail err = Lwt.return (`Error (Some err))
+    end
+    module RPC_directory = struct
+      include RPC_directory
+      let gen_register dir service handler =
+        gen_register dir service
+          (fun p q i ->
+             handler p q i >>= function
+             | `Ok o -> RPC_answer.return o
+             | `OkStream s -> RPC_answer.return_stream s
+             | `Created s -> Lwt.return (`Created s)
+             | `No_content -> Lwt.return (`No_content)
+             | `Unauthorized e ->
+                 let e = Option.map e ~f:(List.map (fun e -> Ecoproto_error e)) in
+                 Lwt.return (`Unauthorized e)
+             | `Forbidden e ->
+                 let e = Option.map e ~f:(List.map (fun e -> Ecoproto_error e)) in
+                 Lwt.return (`Forbidden e)
+             | `Not_found e ->
+                 let e = Option.map e ~f:(List.map (fun e -> Ecoproto_error e)) in
+                 Lwt.return (`Not_found e)
+             | `Conflict e ->
+                 let e = Option.map e ~f:(List.map (fun e -> Ecoproto_error e)) in
+                 Lwt.return (`Conflict e)
+             | `Error e ->
+                 let e = Option.map e ~f:(List.map (fun e -> Ecoproto_error e)) in
+                 Lwt.return (`Error e))
+
+      let register dir service handler =
+        gen_register dir service
+          (fun p q i ->
+             handler p q i >>= function
+             | Ok o -> RPC_answer.return o
+             | Error e -> RPC_answer.fail e)
+
+      let opt_register dir service handler =
+        gen_register dir service
+          (fun p q i ->
+             handler p q i >>= function
+             | Ok (Some o) -> RPC_answer.return o
+             | Ok None -> RPC_answer.not_found
+             | Error e -> RPC_answer.fail e)
+
+      let lwt_register dir service handler =
+        gen_register dir service
+          (fun p q i ->
+             handler p q i >>= fun o ->
+             RPC_answer.return o)
+
+      open Curry
+
+      let register0 root s f = register root s (curry Z f)
+      let register1 root s f = register root s (curry (S Z) f)
+      let register2 root s f = register root s (curry (S (S Z)) f)
+      let register3 root s f = register root s (curry (S (S (S Z))) f)
+      let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
+      let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
+
+      let opt_register0 root s f = opt_register root s (curry Z f)
+      let opt_register1 root s f = opt_register root s (curry (S Z) f)
+      let opt_register2 root s f = opt_register root s (curry (S (S Z)) f)
+      let opt_register3 root s f = opt_register root s (curry (S (S (S Z))) f)
+      let opt_register4 root s f = opt_register root s (curry (S (S (S (S Z)))) f)
+      let opt_register5 root s f = opt_register root s (curry (S (S (S (S (S Z))))) f)
+
+      let gen_register0 root s f = gen_register root s (curry Z f)
+      let gen_register1 root s f = gen_register root s (curry (S Z) f)
+      let gen_register2 root s f = gen_register root s (curry (S (S Z)) f)
+      let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f)
+      let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f)
+      let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f)
+
+      let lwt_register0 root s f = lwt_register root s (curry Z f)
+      let lwt_register1 root s f = lwt_register root s (curry (S Z) f)
+      let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f)
+      let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f)
+      let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f)
+      let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f)
+
+    end
+    module RPC_context = struct
+
+      type t = rpc_context
+
+      class type ['pr] simple = object
+        method call_proto_service0 :
+          'm 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t ->
+          'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+        method call_proto_service1 :
+          'm 'a 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t ->
+          'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+        method call_proto_service2 :
+          'm 'a 'b 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+          'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+        method call_proto_service3 :
+          'm 'a 'b 'c 'q 'i 'o.
+          ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+          'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t
+      end
+
+      let make_call0 s (ctxt : _ simple) =
+        ctxt#call_proto_service0 s
+      let make_call0 = (make_call0 : _ -> _ simple -> _ :> _ -> _ #simple -> _)
+
+      let make_call1 s (ctxt: _ simple) =
+        ctxt#call_proto_service1 s
+      let make_call1 = (make_call1 : _ -> _ simple -> _ :> _ -> _ #simple -> _)
+
+      let make_call2 s (ctxt: _ simple) =
+        ctxt#call_proto_service2 s
+      let make_call2 = (make_call2 : _ -> _ simple -> _ :> _ -> _ #simple -> _)
+
+      let make_call3 s (ctxt: _ simple) =
+        ctxt#call_proto_service3 s
+      let make_call3 = (make_call3 : _ -> _ simple -> _ :> _ -> _ #simple -> _)
+
+      let make_opt_call0 s ctxt block q i =
+        make_call0 s ctxt block q i >>= function
+        | Error [RPC_context.Not_found _] -> Lwt.return (Ok None)
+        | Error _ as v -> Lwt.return v
+        | Ok v -> Lwt.return (Ok (Some v))
+
+      let make_opt_call1 s ctxt block a1 q i =
+        make_call1 s ctxt block a1 q i >>= function
+        | Error [RPC_context.Not_found _] -> Lwt.return (Ok None)
+        | Error _ as v -> Lwt.return v
+        | Ok v -> Lwt.return (Ok (Some v))
+
+      let make_opt_call2 s ctxt block a1 a2 q i =
+        make_call2 s ctxt block a1 a2 q i >>= function
+        | Error [RPC_context.Not_found _] -> Lwt.return (Ok None)
+        | Error _ as v -> Lwt.return v
+        | Ok v -> Lwt.return (Ok (Some v))
+
+      let make_opt_call3 s ctxt block a1 a2 a3 q i =
+        make_call3 s ctxt block a1 a2 a3 q i >>= function
+        | Error [RPC_context.Not_found _] -> Lwt.return (Ok None)
+        | Error _ as v -> Lwt.return v
+        | Ok v -> Lwt.return (Ok (Some v))
+
+    end
+    module Micheline = struct
+      include Micheline
+      let canonical_encoding_v1 = canonical_encoding_v1
+      let canonical_encoding = canonical_encoding_v0
+    end
+    module Logging = Logging.Make(Param)
+
+    module Updater = struct
+
+      type nonrec validation_result = validation_result = {
+        context: Context.t ;
+        fitness: Fitness.t ;
+        message: string option ;
+        max_operations_ttl: int ;
+        last_allowed_fork_level: Int32.t ;
+      }
+
+      type nonrec quota = quota = {
+        max_size: int ;
+        max_op: int option ;
+      }
+
+      type nonrec rpc_context = rpc_context = {
+        block_hash: Block_hash.t ;
+        block_header: Block_header.shell_header ;
+        context: Context.t ;
+      }
+
+      let activate = Context.set_protocol
+      let fork_test_chain = Context.fork_test_chain
+
+      module type PROTOCOL =
+        T with type context := Context.t
+           and type quota := quota
+           and type validation_result := validation_result
+           and type rpc_context := rpc_context
+           and type 'a tzresult := 'a Error_monad.tzresult
+
+    end
+    module Base58 = struct
+      include Tezos_crypto.Base58
+      let simple_encode enc s = simple_encode enc s
+      let simple_decode enc s = simple_decode enc s
+      include Make(struct type context = Context.t end)
+      let decode s = decode s
+    end
+    module Context = struct
+      include Context
+
+      let fold_keys s k ~init ~f =
+        let rec loop k acc =
+          fold s k ~init:acc
+            ~f:(fun file acc ->
+                match file with
+                | `Key k -> f k acc
+                | `Dir k -> loop k acc) in
+        loop k init
+
+      let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
+
+      let register_resolver = Base58.register_resolver
+      let complete ctxt s = Base58.complete ctxt s
+    end
+
+    module Lift(P : Updater.PROTOCOL) = struct
+      include P
+      let begin_partial_application
+          ~chain_id ~ancestor_context ~predecessor_timestamp ~predecessor_fitness
+          raw_block =
+        begin_partial_application
+          ~chain_id ~ancestor_context ~predecessor_timestamp ~predecessor_fitness
+          raw_block >|= wrap_error
+      let begin_application
+          ~chain_id ~predecessor_context ~predecessor_timestamp
+          ~predecessor_fitness
+          raw_block =
+        begin_application
+          ~chain_id ~predecessor_context ~predecessor_timestamp
+          ~predecessor_fitness
+          raw_block >|= wrap_error
+      let begin_construction
+          ~chain_id ~predecessor_context ~predecessor_timestamp
+          ~predecessor_level ~predecessor_fitness
+          ~predecessor ~timestamp ?protocol_data () =
+        begin_construction
+          ~chain_id ~predecessor_context ~predecessor_timestamp
+          ~predecessor_level ~predecessor_fitness
+          ~predecessor ~timestamp ?protocol_data () >|= wrap_error
+      let current_context c =
+        current_context c >|= wrap_error
+      let apply_operation c o =
+        apply_operation c o >|= wrap_error
+      let finalize_block c = finalize_block c >|= wrap_error
+      let init c bh = init c bh >|= wrap_error
+    end
+
+    class ['chain, 'block] proto_rpc_context
+        (t : Tezos_rpc.RPC_context.t)
+        (prefix : (unit, (unit * 'chain) * 'block) RPC_path.t) =
+      object
+        method call_proto_service0
+          : 'm 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+            ('chain * 'block) -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s (chain, block) q i ->
+            let s = RPC_service.subst0 s in
+            let s = RPC_service.prefix prefix s in
+            t#call_service s (((), chain), block) q i
+        method call_proto_service1
+          : 'm 'a 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+            ('chain * 'block) -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s (chain, block) a1 q i ->
+            let s = RPC_service.subst1 s in
+            let s = RPC_service.prefix prefix s in
+            t#call_service s ((((), chain), block), a1) q i
+        method call_proto_service2
+          : 'm 'a 'b 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+            ('chain * 'block) -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s (chain, block) a1 a2 q i ->
+            let s = RPC_service.subst2 s in
+            let s = RPC_service.prefix prefix s in
+            t#call_service s (((((), chain), block), a1), a2) q i
+        method call_proto_service3
+          : 'm 'a 'b 'c 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             ((RPC_context.t * 'a) * 'b) * 'c,
+             'q, 'i, 'o) RPC_service.t ->
+            ('chain * 'block) -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s (chain, block) a1 a2 a3 q i ->
+            let s = RPC_service.subst3 s in
+            let s = RPC_service.prefix prefix s in
+            t#call_service s ((((((), chain), block), a1), a2), a3) q i
+      end
+
+    class ['block] proto_rpc_context_of_directory conv dir : ['block] RPC_context.simple =
+      let lookup = new Tezos_rpc.RPC_context.of_directory dir in
+      object
+        method call_proto_service0
+          : 'm 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+            'block -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s block q i ->
+            let rpc_context = conv block in
+            lookup#call_service s rpc_context q i
+        method call_proto_service1
+          : 'm 'a 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+            'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s block a1 q i ->
+            let rpc_context = conv block in
+            lookup#call_service s (rpc_context, a1) q i
+        method call_proto_service2
+          : 'm 'a 'b 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+            'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s block a1 a2 q i ->
+            let rpc_context = conv block in
+            lookup#call_service s ((rpc_context, a1), a2) q i
+        method call_proto_service3
+          : 'm 'a 'b 'c 'q 'i 'o.
+            ([< RPC_service.meth ] as 'm, RPC_context.t,
+             ((RPC_context.t * 'a) * 'b) * 'c,
+             'q, 'i, 'o) RPC_service.t ->
+            'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+          = fun s block a1 a2 a3 q i ->
+            let rpc_context = conv block in
+            lookup#call_service s (((rpc_context, a1), a2), a3) q i
+      end
+
+  end
+
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.mli b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.mli
new file mode 100644
index 000000000..3bd0465e8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment.mli
@@ -0,0 +1,193 @@
+
+open Error_monad
+
+
+module type CONTEXT = sig
+  type t
+  type key = string list
+  type value = MBytes.t
+  val mem: t -> key -> bool Lwt.t
+  val dir_mem: t -> key -> bool Lwt.t
+  val get: t -> key -> value option Lwt.t
+  val set: t -> key -> value -> t Lwt.t
+  val copy: t -> from:key -> to_:key -> t option Lwt.t
+  val del: t -> key -> t Lwt.t
+  val remove_rec: t -> key -> t Lwt.t
+  val fold:
+    t -> key -> init:'a ->
+    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+    'a Lwt.t
+  val set_protocol: t -> Protocol_hash.t -> t Lwt.t
+  val fork_test_chain:
+    t -> protocol:Protocol_hash.t -> expiration:Time.t -> t Lwt.t
+end
+
+module Make (Context : CONTEXT) : sig
+
+  type validation_result = {
+    context: Context.t ;
+    fitness: Fitness.t ;
+    message: string option ;
+    max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
+  }
+
+  type quota = {
+    max_size: int ;
+    max_op: int option ;
+  }
+
+  type rpc_context = {
+    block_hash: Block_hash.t ;
+    block_header: Block_header.shell_header ;
+    context: Context.t ;
+  }
+
+  module type T = sig
+    type context
+    type quota
+    type validation_result
+    type rpc_context
+    type 'a tzresult
+    val max_block_length: int
+    val max_operation_data_length: int
+    val validation_passes: quota list
+    type block_header_data
+    val block_header_data_encoding: block_header_data Data_encoding.t
+    type block_header = {
+      shell: Block_header.shell_header ;
+      protocol_data: block_header_data ;
+    }
+    type block_header_metadata
+    val block_header_metadata_encoding: block_header_metadata Data_encoding.t
+    type operation_data
+    type operation_receipt
+    type operation = {
+      shell: Operation.shell_header ;
+      protocol_data: operation_data ;
+    }
+    val operation_data_encoding: operation_data Data_encoding.t
+    val operation_receipt_encoding: operation_receipt Data_encoding.t
+    val operation_data_and_receipt_encoding:
+      (operation_data * operation_receipt) Data_encoding.t
+    val acceptable_passes: operation -> int list
+    val compare_operations: operation -> operation -> int
+    type validation_state
+    val current_context: validation_state -> context tzresult Lwt.t
+    val begin_partial_application:
+      chain_id: Chain_id.t ->
+      ancestor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
+      block_header ->
+      validation_state tzresult Lwt.t
+    val begin_application:
+      chain_id: Chain_id.t ->
+      predecessor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
+      block_header ->
+      validation_state tzresult Lwt.t
+    val begin_construction:
+      chain_id: Chain_id.t ->
+      predecessor_context: context ->
+      predecessor_timestamp: Time.t ->
+      predecessor_level: Int32.t ->
+      predecessor_fitness: Fitness.t ->
+      predecessor: Block_hash.t ->
+      timestamp: Time.t ->
+      ?protocol_data: block_header_data ->
+      unit -> validation_state tzresult Lwt.t
+    val apply_operation:
+      validation_state -> operation ->
+      (validation_state * operation_receipt) tzresult Lwt.t
+    val finalize_block:
+      validation_state ->
+      (validation_result * block_header_metadata) tzresult Lwt.t
+    val rpc_services: rpc_context RPC_directory.t
+    val init:
+      context -> Block_header.shell_header -> validation_result tzresult Lwt.t
+  end
+
+  module type PROTOCOL =
+    T with type context := Context.t
+       and type quota := quota
+       and type validation_result := validation_result
+       and type rpc_context := rpc_context
+       and type 'a tzresult := 'a Error_monad.tzresult
+
+  module type V1 = sig
+
+    include Tezos_protocol_environment_sigs.V1.T
+      with type Format.formatter = Format.formatter
+       and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
+       and type 'a Lwt.t = 'a Lwt.t
+       and type ('a, 'b) Pervasives.result = ('a, 'b) result
+       and type Chain_id.t = Chain_id.t
+       and type Block_hash.t = Block_hash.t
+       and type Operation_hash.t = Operation_hash.t
+       and type Operation_list_hash.t = Operation_list_hash.t
+       and type Operation_list_list_hash.t = Operation_list_list_hash.t
+       and type Context.t = Context.t
+       and type Context_hash.t = Context_hash.t
+       and type Protocol_hash.t = Protocol_hash.t
+       and type Time.t = Time.t
+       and type MBytes.t = MBytes.t
+       and type Operation.shell_header = Operation.shell_header
+       and type Operation.t = Operation.t
+       and type Block_header.shell_header = Block_header.shell_header
+       and type Block_header.t = Block_header.t
+       and type 'a RPC_directory.t = 'a RPC_directory.t
+       and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t
+       and type Ed25519.Public_key.t = Ed25519.Public_key.t
+       and type Ed25519.t = Ed25519.t
+       and type Secp256k1.Public_key_hash.t = Secp256k1.Public_key_hash.t
+       and type Secp256k1.Public_key.t = Secp256k1.Public_key.t
+       and type Secp256k1.t = Secp256k1.t
+       and type P256.Public_key_hash.t = P256.Public_key_hash.t
+       and type P256.Public_key.t = P256.Public_key.t
+       and type P256.t = P256.t
+       and type Signature.public_key_hash = Signature.public_key_hash
+       and type Signature.public_key = Signature.public_key
+       and type Signature.t = Signature.t
+       and type Signature.watermark = Signature.watermark
+       and type 'a Micheline.canonical = 'a Micheline.canonical
+       and type Z.t = Z.t
+       and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node
+       and type Micheline.Michelson_primitives.prim = Micheline.Michelson_primitives.prim
+       and type Data_encoding.json_schema = Data_encoding.json_schema
+       and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t
+       and type RPC_service.meth = RPC_service.meth
+       and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t
+       and type Error_monad.shell_error = Error_monad.error
+       and type Z.t = Z.t
+
+    type error += Ecoproto_error of Error_monad.error
+    val wrap_error : 'a Error_monad.tzresult -> 'a tzresult
+
+    module Lift (P : Updater.PROTOCOL) : PROTOCOL
+      with type block_header_data = P.block_header_data
+       and type block_header = P.block_header
+       and type operation_data = P.operation_data
+       and type operation_receipt = P.operation_receipt
+       and type operation = P.operation
+       and type validation_state = P.validation_state
+
+    class ['chain, 'block] proto_rpc_context :
+      Tezos_rpc.RPC_context.t -> (unit, (unit * 'chain) * 'block) RPC_path.t ->
+      [('chain * 'block)] RPC_context.simple
+
+    class ['block] proto_rpc_context_of_directory :
+      ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t ->
+      ['block] RPC_context.simple
+
+  end
+
+  module MakeV1 (Param : sig val name: string end)()
+    : V1 with type Context.t = Context.t
+          and type Updater.validation_result = validation_result
+          and type Updater.quota = quota
+          and type Updater.rpc_context = rpc_context
+
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_faked.ml b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_faked.ml
new file mode 100644
index 000000000..fc0cbbc57
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_faked.ml
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Context = struct
+  type t
+
+  type key = string list
+  type value = MBytes.t
+  let mem _ _ = assert false
+  let dir_mem _ _ = assert false
+  let get _ _ = assert false
+  let set _ _ _ = assert false
+  let copy _ ~from:_ ~to_:_ = assert false
+  let del _ _ = assert false
+  let remove_rec _ _ = assert false
+  let fold _ _ ~init:_ ~f:_ = assert false
+  let keys _ _ = assert false
+  let fold_keys _ _ ~init:_ ~f:_ = assert false
+
+  let set_protocol _ _ = assert false
+  let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false
+
+end
+
+include Tezos_protocol_environment.Make(Context)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_memory.ml b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_memory.ml
new file mode 100644
index 000000000..0a0d8e0b6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_memory.ml
@@ -0,0 +1,147 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Context = struct
+
+  module StringMap = Map.Make(String)
+
+  type key = string list
+  type value = MBytes.t
+
+  type t =
+    | Dir of t StringMap.t
+    | Key of value
+
+  let empty = Dir StringMap.empty
+
+  let rec raw_get m k =
+    match k, m with
+    | [], m -> Some m
+    | n :: k, Dir m -> begin
+        match StringMap.find_opt n m with
+        | Some res -> raw_get res k
+        | None -> None
+      end
+    | _ :: _, Key _ -> None
+
+  let rec raw_set m k v =
+    match k, m, v with
+    | [], (Key _ as m), Some v ->
+        if m = v then None else Some v
+    | [], (Dir _ as m), Some v ->
+        if m == v then None else Some v
+    | [], (Key _ | Dir _), None -> Some empty
+    | n :: k, Dir m, _ -> begin
+        match raw_set (Option.unopt ~default:empty
+                         (StringMap.find_opt n m)) k v with
+        | None -> None
+        | Some rm when rm = empty ->
+            Some (Dir (StringMap.remove n m))
+        | Some rm ->
+            Some (Dir (StringMap.add n rm m))
+      end
+    | _ :: _, Key _, None -> None
+    | _ :: _, Key _, Some _ ->
+        Pervasives.failwith "Mem_context.set"
+
+  let mem m k =
+    match raw_get m k with
+    | Some (Key _) -> Lwt.return_true
+    | Some (Dir _) | None -> Lwt.return_false
+
+  let dir_mem m k =
+    match raw_get m k with
+    | Some (Dir _) -> Lwt.return_true
+    | Some (Key _) | None -> Lwt.return_false
+
+  let get m k =
+    match raw_get m k with
+    | Some (Key v) -> Lwt.return_some v
+    | Some (Dir _) | None -> Lwt.return_none
+
+  let set m k v =
+    match raw_set m k (Some (Key v)) with
+    | None -> Lwt.return m
+    | Some m -> Lwt.return m
+  let del m k =
+    (* TODO assert key *)
+    match raw_set m k None with
+    | None -> Lwt.return m
+    | Some m -> Lwt.return m
+  let remove_rec m k =
+    match raw_set m k None with
+    | None -> Lwt.return m
+    | Some m -> Lwt.return m
+  let copy m ~from ~to_ =
+    match raw_get m from with
+    | None -> Lwt.return_none
+    | Some v -> Lwt.return (raw_set m to_ (Some v))
+
+  let fold m k ~init ~f =
+    match raw_get m k with
+    | None -> Lwt.return init
+    | Some (Key _) -> Lwt.return init
+    | Some (Dir m) ->
+        StringMap.fold
+          (fun n m acc ->
+             acc >>= fun acc ->
+             match m with
+             | Key _ -> f (`Key (k @ [n])) acc
+             | Dir _ -> f (`Dir (k @ [n])) acc)
+          m (Lwt.return init)
+
+  let rec pp ppf m =
+    match m with
+    | Key s -> Format.fprintf ppf "%s" (MBytes.to_string s)
+    | Dir m ->
+        StringMap.iter
+          (fun n m ->
+             match m with
+             | Key s ->
+                 Format.fprintf ppf "- %s: %s@ " n (MBytes.to_string s)
+             | Dir m ->
+                 Format.fprintf ppf "- %s:@[<v 2>@ %a@]@ " n pp (Dir m))
+          m
+
+  let dump m = Format.eprintf "@[<v>%a@]" pp m
+
+  let current_protocol_key = ["protocol"]
+
+  let get_protocol v =
+    raw_get v current_protocol_key |> function
+    | Some (Key data) -> Lwt.return (Protocol_hash.of_bytes_exn data)
+    | _ -> assert false
+
+  let set_protocol v key =
+    raw_set v current_protocol_key (Some (Key (Protocol_hash.to_bytes key))) |> function
+    | Some m -> Lwt.return m
+    | None -> assert false
+
+
+  let fork_test_chain c ~protocol:_ ~expiration:_ = Lwt.return c
+
+end
+
+include Tezos_protocol_environment.Make(Context)
diff --git a/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_shell.ml b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_shell.ml
new file mode 100644
index 000000000..cad98cd65
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_environment/tezos_protocol_environment_shell.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_protocol_environment.Make(Tezos_storage.Context)
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/dune b/vendors/tezos-modded/src/lib_protocol_updater/dune
new file mode 100644
index 000000000..17c71553d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/dune
@@ -0,0 +1,24 @@
+(library
+ (name tezos_protocol_updater)
+ (public_name tezos-protocol-updater)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-micheline
+            tezos-shell-services
+            tezos-protocol-environment-shell
+            tezos-protocol-compiler.registerer
+            tezos-protocol-compiler.native
+            tezos-storage
+            dynlink)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_micheline
+                   -open Tezos_shell_services
+                   -open Tezos_storage)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.ml b/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.ml
new file mode 100644
index 000000000..9e33edecd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.ml
@@ -0,0 +1,123 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type T = sig
+  module P : sig
+    val hash: Protocol_hash.t
+    include Tezos_protocol_environment_shell.PROTOCOL
+  end
+  include (module type of (struct include P end))
+  module Block_services :
+    (module type of (struct include Block_services.Make(P)(P) end))
+  val complete_b58prefix : Context.t -> string -> string list Lwt.t
+end
+
+type t = (module T)
+
+let build_v1 hash =
+  let (module F) = Tezos_protocol_registerer.Registerer.get_exn hash in
+  let module Name = struct
+    let name = Protocol_hash.to_b58check hash
+  end in
+  let module Env = Tezos_protocol_environment_shell.MakeV1(Name)() in
+  (module struct
+    module Raw = F(Env)
+    module P = struct
+      let hash = hash
+      include Env.Lift(Raw)
+    end
+    include P
+    module Block_services = Block_services.Make(P)(P)
+    let complete_b58prefix = Env.Context.complete
+  end : T)
+
+module VersionTable = Protocol_hash.Table
+
+let versions : (module T) VersionTable.t =
+  VersionTable.create 20
+
+let sources : Protocol.t VersionTable.t =
+  VersionTable.create 20
+
+let mem hash =
+  VersionTable.mem versions hash ||
+  Tezos_protocol_registerer.Registerer.mem hash
+
+let get_exn hash =
+  try VersionTable.find versions hash
+  with Not_found ->
+    let proto = build_v1 hash in
+    VersionTable.add versions hash proto ;
+    proto
+
+let get hash =
+  try Some (get_exn hash)
+  with Not_found -> None
+
+let list () =
+  VersionTable.fold (fun _ p acc -> p :: acc) versions []
+
+let list_embedded () =
+  VersionTable.fold (fun k _ acc -> k :: acc) sources []
+
+let get_embedded_sources_exn hash =
+  VersionTable.find sources hash
+
+let get_embedded_sources hash =
+  try Some (get_embedded_sources_exn hash)
+  with Not_found -> None
+
+module Register_embedded
+    (Env : Tezos_protocol_environment_shell.V1)
+    (Proto : Env.Updater.PROTOCOL)
+    (Source : sig
+       val hash: Protocol_hash.t option
+       val sources: Protocol.t
+     end) = struct
+
+  let hash =
+    match Source.hash with
+    | None -> Protocol.hash Source.sources
+    | Some hash -> hash
+  module Name = struct
+    let name = Protocol_hash.to_b58check hash
+  end
+  module Self = struct
+    module P = struct
+      let hash = hash
+      include Env.Lift(Proto)
+    end
+    include P
+    module Block_services = Block_services.Make(P)(P)
+    let complete_b58prefix = Env.Context.complete
+  end
+  let () =
+    VersionTable.add
+      sources hash Source.sources ;
+    VersionTable.add
+      versions hash (module Self : T)
+
+  include Self
+end
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.mli b/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.mli
new file mode 100644
index 000000000..040dd6aae
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/registered_protocol.mli
@@ -0,0 +1,61 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type T = sig
+  module P : sig
+    val hash: Protocol_hash.t
+    include Tezos_protocol_environment_shell.PROTOCOL
+  end
+  include (module type of (struct include P end))
+  module Block_services :
+    (module type of (struct include Block_services.Make(P)(P) end))
+  val complete_b58prefix : Context.t -> string -> string list Lwt.t
+end
+
+type t = (module T)
+
+val mem: Protocol_hash.t -> bool
+
+val list: unit -> t list
+
+val get: Protocol_hash.t -> t option
+val get_exn: Protocol_hash.t -> t
+
+val list_embedded: unit -> Protocol_hash.t list
+
+val get_embedded_sources: Protocol_hash.t -> Protocol.t option
+val get_embedded_sources_exn: Protocol_hash.t -> Protocol.t
+
+module Register_embedded
+    (Env : Tezos_protocol_environment_shell.V1)
+    (Proto : Env.Updater.PROTOCOL)
+    (Source : sig
+       val hash: Protocol_hash.t option
+       val sources: Protocol.t
+     end) :
+  T with type P.block_header_data = Proto.block_header_data
+     and type P.operation_data = Proto.operation_data
+     and type P.operation_receipt = Proto.operation_receipt
+     and type P.validation_state = Proto.validation_state
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/tezos-protocol-updater.opam b/vendors/tezos-modded/src/lib_protocol_updater/tezos-protocol-updater.opam
new file mode 100644
index 000000000..49cd2a8d2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/tezos-protocol-updater.opam
@@ -0,0 +1,24 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-micheline"
+  "tezos-shell-services"
+  "tezos-protocol-compiler"
+  "tezos-protocol-environment-shell"
+  "tezos-stdlib-unix"
+  "tezos-storage"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/updater.ml b/vendors/tezos-modded/src/lib_protocol_updater/updater.ml
new file mode 100644
index 000000000..3d8d9a0dd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/updater.ml
@@ -0,0 +1,88 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Updater_logging
+
+let (//) = Filename.concat
+
+(** Compiler *)
+
+let datadir = ref None
+let get_datadir () =
+  match !datadir with
+  | None ->
+      fatal_error "Node not initialized" ;
+      Lwt_exit.exit 1
+  | Some m -> m
+
+let init dir =
+  datadir := Some dir
+
+let compiler_name = "tezos-protocol-compiler"
+
+let do_compile hash p =
+  assert (p.Protocol.expected_env = V1) ;
+  let datadir = get_datadir () in
+  let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in
+  let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in
+  let plugin_file = datadir // Protocol_hash.to_short_b58check hash //
+                    Format.asprintf "protocol_%a" Protocol_hash.pp hash
+  in
+  begin
+    Lwt_utils_unix.Protocol.write_dir source_dir ~hash p >>=? fun () ->
+    let compiler_command =
+      (Sys.executable_name,
+       Array.of_list [ compiler_name ; "-register" ; "-o" ; plugin_file ; source_dir]) in
+    let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in
+    Lwt_process.exec
+      ~stdin:`Close ~stdout:(`FD_copy fd) ~stderr:(`FD_move fd)
+      compiler_command >>= return
+  end >>= function
+  | Error err ->
+      log_error "Error %a" pp_print_error err ;
+      Lwt.return_false
+  | Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
+      log_error "INTERRUPTED COMPILATION (%s)" log_file;
+      Lwt.return_false
+  | Ok (Unix.WEXITED x) when x <> 0 ->
+      log_error "COMPILATION ERROR (%s)" log_file;
+      Lwt.return_false
+  | Ok (Unix.WEXITED _) ->
+      try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return_true
+      with Dynlink.Error err ->
+        log_error "Can't load plugin: %s (%s)"
+          (Dynlink.error_message err) plugin_file;
+        Lwt.return_false
+
+let compile hash p =
+  if Tezos_protocol_registerer.Registerer.mem hash then
+    Lwt.return_true
+  else begin
+    do_compile hash p >>= fun success ->
+    let loaded = Tezos_protocol_registerer.Registerer.mem hash in
+    if success && not loaded then
+      log_error "Internal error while compiling %a" Protocol_hash.pp hash;
+    Lwt.return loaded
+  end
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/updater.mli b/vendors/tezos-modded/src/lib_protocol_updater/updater.mli
new file mode 100644
index 000000000..f39051970
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/updater.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t
+
+val init: string -> unit
+
+val compiler_name: string
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.ml b/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.ml
new file mode 100644
index 000000000..7178afd62
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make(struct let name = "updater" end)
diff --git a/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.mli b/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.mli
new file mode 100644
index 000000000..ede719e2c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_protocol_updater/updater_logging.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.LOG
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_answer.ml b/vendors/tezos-modded/src/lib_rpc/RPC_answer.ml
new file mode 100644
index 000000000..873bde1ae
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_answer.ml
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Return type for service handler *)
+type 'o t =
+  [ `Ok of 'o (* 200 *)
+  | `OkStream of 'o stream (* 200 *)
+  | `Created of string option (* 201 *)
+  | `No_content (* 204 *)
+  | `Unauthorized of RPC_service.error option (* 401 *)
+  | `Forbidden of RPC_service.error option (* 403 *)
+  | `Not_found of RPC_service.error option (* 404 *)
+  | `Conflict of RPC_service.error option (* 409 *)
+  | `Error of RPC_service.error option (* 500 *)
+  ]
+
+and 'a stream = 'a Resto_directory.Answer.stream = {
+  next: unit -> 'a option Lwt.t ;
+  shutdown: unit -> unit ;
+}
+
+let return x = Lwt.return (`Ok x)
+let return_unit = Lwt.return (`Ok ())
+let return_stream x = Lwt.return (`OkStream x)
+
+let not_found = Lwt.return (`Not_found None)
+let fail err = Lwt.return (`Error (Some err))
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_answer.mli b/vendors/tezos-modded/src/lib_rpc/RPC_answer.mli
new file mode 100644
index 000000000..26bbc359f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_answer.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Return type for service handler *)
+type 'o t =
+  [ `Ok of 'o (* 200 *)
+  | `OkStream of 'o stream (* 200 *)
+  | `Created of string option (* 201 *)
+  | `No_content (* 204 *)
+  | `Unauthorized of RPC_service.error option (* 401 *)
+  | `Forbidden of RPC_service.error option (* 403 *)
+  | `Not_found of RPC_service.error option (* 404 *)
+  | `Conflict of RPC_service.error option (* 409 *)
+  | `Error of RPC_service.error option (* 500 *)
+  ]
+
+and 'a stream = 'a Resto_directory.Answer.stream = {
+  next: unit -> 'a option Lwt.t ;
+  shutdown: unit -> unit ;
+}
+
+val return: 'o -> 'o t Lwt.t
+val return_unit: unit t Lwt.t
+val return_stream: 'o stream -> 'o t Lwt.t
+val not_found: 'o t Lwt.t
+
+val fail: Error_monad.error list -> 'a t Lwt.t
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_arg.ml b/vendors/tezos-modded/src/lib_rpc/RPC_arg.ml
new file mode 100644
index 000000000..1255a33b3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_arg.ml
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('i, 'j) eq = ('i, 'j) Resto.eq = Eq : ('a, 'a) eq
+include Resto.Arg
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_arg.mli b/vendors/tezos-modded/src/lib_rpc/RPC_arg.mli
new file mode 100644
index 000000000..49c341437
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_arg.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('i, 'j) eq = ('i, 'j) Resto.eq = Eq : ('a, 'a) eq
+include (module type of struct include Resto.Arg end)
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_context.ml b/vendors/tezos-modded/src/lib_rpc/RPC_context.ml
new file mode 100644
index 000000000..e540ff1b8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_context.ml
@@ -0,0 +1,187 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+class type ['pr] gen_simple = object
+  method call_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t
+end
+
+class type ['pr] gen_streamed = object
+  method call_streamed_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
+end
+
+class type ['pr] gen = object
+  inherit ['pr] gen_simple
+  inherit ['pr] gen_streamed
+end
+
+class type simple = object
+  inherit [unit] gen_simple
+end
+
+class type streamed = object
+  inherit [unit] gen_streamed
+end
+
+class type t = object
+  inherit simple
+  inherit streamed
+end
+
+type ('o, 'e) rest_result =
+  [ `Ok of 'o
+  | `Conflict of 'e
+  | `Error of 'e
+  | `Forbidden of 'e
+  | `Not_found of 'e
+  | `Unauthorized of 'e ] tzresult
+
+class type json = object
+  inherit t
+  method generic_json_call :
+    RPC_service.meth ->
+    ?body:Data_encoding.json ->
+    Uri.t ->
+    (Data_encoding.json, Data_encoding.json option)
+      rest_result Lwt.t
+  method base : Uri.t
+end
+
+
+type error +=
+  | Not_found of { meth: RPC_service.meth ;
+                   uri: Uri.t }
+  | Generic_error of { meth: RPC_service.meth ;
+                       uri: Uri.t }
+
+let base = Uri.make ~scheme:"ocaml" ()
+let not_found s p q =
+  let { RPC_service.meth ; uri ; _ } =
+    RPC_service.forge_partial_request s ~base p q in
+  fail (Not_found { meth ; uri })
+
+let generic_error s p q =
+  let { RPC_service.meth ; uri ; _ } =
+    RPC_service.forge_partial_request s ~base p q in
+  fail (Generic_error { meth ; uri })
+
+class ['pr] of_directory (dir : 'pr RPC_directory.t) = object
+  method call_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s p q i ->
+      RPC_directory.transparent_lookup dir s p q i >>= function
+      | `Ok v -> return v
+      | `OkStream { next ; shutdown } -> begin
+          next () >>= function
+          | Some v -> shutdown () ; return v
+          | None -> shutdown () ; not_found s p q
+        end
+      | `Not_found None -> not_found s p q
+      | `Unauthorized (Some err)
+      | `Forbidden (Some err)
+      | `Not_found (Some err)
+      | `Conflict (Some err)
+      | `Error (Some err) -> Lwt.return_error err
+      | `Unauthorized None
+      | `Error None
+      | `Forbidden None
+      | `Created _
+      | `Conflict None
+      | `No_content -> generic_error s p q
+  method call_streamed_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t =
+    fun s ~on_chunk ~on_close p q i ->
+      RPC_directory.transparent_lookup dir s p q i >>= function
+      | `OkStream { next; shutdown } ->
+          let rec loop () =
+            next () >>= function
+            | None -> on_close () ; Lwt.return_unit
+            | Some v -> on_chunk v ; loop () in
+          let _ = loop () in
+          return shutdown
+      | `Ok v ->
+          on_chunk v ; on_close () ;
+          return (fun () -> ())
+      | `Not_found None -> not_found s p q
+      | `Unauthorized (Some err)
+      | `Forbidden (Some err)
+      | `Not_found (Some err)
+      | `Conflict (Some err)
+      | `Error (Some err) -> Lwt.return_error err
+      | `Unauthorized None
+      | `Error None
+      | `Forbidden None
+      | `Created _
+      | `Conflict None
+      | `No_content -> generic_error s p q
+end
+
+let make_call s (ctxt : #simple) = ctxt#call_service s
+let make_call1 s ctxt x = make_call s ctxt ((), x)
+let make_call2 s ctxt x y = make_call s ctxt (((), x), y)
+let make_call3 s ctxt x y z = make_call s ctxt ((((), x), y), z)
+
+type stopper = unit -> unit
+
+let make_streamed_call s (ctxt : #streamed) p q i =
+  let stream, push = Lwt_stream.create () in
+  let on_chunk v = push (Some v)
+  and on_close () = push None in
+  ctxt#call_streamed_service s ~on_chunk ~on_close p q i >>=? fun close ->
+  return (stream, close)
+
+let () =
+  let open Data_encoding in
+  let uri_encoding =
+    conv
+      Uri.to_string
+      Uri.of_string
+      string in
+  register_error_kind
+    `Branch
+    ~id:"RPC_context.Not_found"
+    ~title:"RPC lookup failed"
+    ~description:"RPC lookup failed. No RPC exists at the URL or the RPC tried to access non-existent data."
+    (obj2
+       (req "method" RPC_service.meth_encoding)
+       (req "uri" uri_encoding))
+    ~pp:(fun ppf (meth, uri) ->
+        Format.fprintf ppf "Did not find service: %s %a" (RPC_service.string_of_meth meth) Uri.pp_hum uri)
+    (function Not_found { meth ; uri } -> Some (meth, uri)
+            | _ -> None)
+    (fun (meth, uri) -> Not_found { meth ; uri })
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_context.mli b/vendors/tezos-modded/src/lib_rpc/RPC_context.mli
new file mode 100644
index 000000000..d85f3b8e9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_context.mli
@@ -0,0 +1,111 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+class type ['pr] gen_simple = object
+  method call_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t
+end
+
+class type ['pr] gen_streamed = object
+  method call_streamed_service :
+    'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, 'pr, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
+end
+
+class type ['pr] gen = object
+  inherit ['pr] gen_simple
+  inherit ['pr] gen_streamed
+end
+
+class type simple = object
+  inherit [unit] gen_simple
+end
+
+class type streamed = object
+  inherit [unit] gen_streamed
+end
+
+class type t = object
+  inherit simple
+  inherit streamed
+end
+
+type ('o, 'e) rest_result =
+  [ `Ok of 'o
+  | `Conflict of 'e
+  | `Error of 'e
+  | `Forbidden of 'e
+  | `Not_found of 'e
+  | `Unauthorized of 'e ] tzresult
+
+class type json = object
+  inherit t
+  method generic_json_call :
+    RPC_service.meth ->
+    ?body:Data_encoding.json ->
+    Uri.t ->
+    (Data_encoding.json, Data_encoding.json option)
+      rest_result Lwt.t
+  method base : Uri.t
+end
+
+class ['pr] of_directory : 'pr RPC_directory.t -> ['pr] gen
+
+type error +=
+  | Not_found of { meth: RPC_service.meth ;
+                   uri: Uri.t }
+  | Generic_error of { meth: RPC_service.meth ;
+                       uri: Uri.t }
+
+val make_call :
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'p -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call1 :
+  ([< Resto.meth ], unit, unit * 'a, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call2 :
+  ([< Resto.meth ], unit, (unit * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val make_call3 :
+  ([< Resto.meth ], unit, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+  #simple -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
+
+type stopper = unit -> unit
+
+val make_streamed_call :
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+  #streamed -> 'p -> 'q ->  'i ->
+  ('o Lwt_stream.t * stopper) tzresult Lwt.t
+
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_description.ml b/vendors/tezos-modded/src/lib_rpc/RPC_description.ml
new file mode 100644
index 000000000..b50dd708b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_description.ml
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Resto.Description
+
+let describe ctxt ?(recurse = false) path =
+  RPC_context.make_call1
+    RPC_service.description_service ctxt path { recurse } ()
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_description.mli b/vendors/tezos-modded/src/lib_rpc/RPC_description.mli
new file mode 100644
index 000000000..ba3703aed
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_description.mli
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+include (module type of struct include Resto.Description end)
+
+val describe:
+  #RPC_context.simple ->
+  ?recurse:bool ->
+  string list ->
+  RPC_encoding.schema directory tzresult Lwt.t
+
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_directory.ml b/vendors/tezos-modded/src/lib_rpc/RPC_directory.ml
new file mode 100644
index 000000000..912beb47c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_directory.ml
@@ -0,0 +1,93 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+include Resto_directory.Make(RPC_encoding)
+
+let gen_register dir service handler =
+  register dir service
+    (fun p q i ->
+       Lwt.catch
+         (fun () -> handler p q i)
+         (function
+           | Not_found -> RPC_answer.not_found
+           | exn -> RPC_answer.fail [Exn exn]))
+
+let gen_register =
+  (gen_register
+   : _ -> _ -> (_ -> _ -> _ -> _ RPC_answer.t Lwt.t) -> _
+   :> _ -> _ -> (_ -> _ -> _ -> [< _ RPC_answer.t ] Lwt.t) -> _)
+
+let register dir service handler =
+  gen_register dir service
+    (fun p q i ->
+       handler p q i >>= function
+       | Ok o -> RPC_answer.return o
+       | Error e -> RPC_answer.fail e)
+
+let opt_register dir service handler =
+  gen_register dir service
+    (fun p q i ->
+       handler p q i >>= function
+       | Ok (Some o) -> RPC_answer.return o
+       | Ok None -> RPC_answer.not_found
+       | Error e -> RPC_answer.fail e)
+
+let lwt_register dir service handler =
+  gen_register dir service
+    (fun p q i ->
+       handler p q i >>= fun o ->
+       RPC_answer.return o)
+
+open Curry
+
+let register0 root s f = register root s (curry Z f)
+let register1 root s f = register root s (curry (S Z) f)
+let register2 root s f = register root s (curry (S (S Z)) f)
+let register3 root s f = register root s (curry (S (S (S Z))) f)
+let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
+let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
+
+let opt_register0 root s f = opt_register root s (curry Z f)
+let opt_register1 root s f = opt_register root s (curry (S Z) f)
+let opt_register2 root s f = opt_register root s (curry (S (S Z)) f)
+let opt_register3 root s f = opt_register root s (curry (S (S (S Z))) f)
+let opt_register4 root s f = opt_register root s (curry (S (S (S (S Z)))) f)
+let opt_register5 root s f = opt_register root s (curry (S (S (S (S (S Z))))) f)
+
+let gen_register0 root s f = gen_register root s (curry Z f)
+let gen_register1 root s f = gen_register root s (curry (S Z) f)
+let gen_register2 root s f = gen_register root s (curry (S (S Z)) f)
+let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f)
+let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f)
+let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f)
+
+let lwt_register0 root s f = lwt_register root s (curry Z f)
+let lwt_register1 root s f = lwt_register root s (curry (S Z) f)
+let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f)
+let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f)
+let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f)
+let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f)
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_directory.mli b/vendors/tezos-modded/src/lib_rpc/RPC_directory.mli
new file mode 100644
index 000000000..1d94618ca
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_directory.mli
@@ -0,0 +1,204 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+include module type of (struct include Resto_directory.Make(RPC_encoding) end)
+
+(** Registring handler in service tree. *)
+val register:
+  'prefix directory ->
+  ([< Resto.meth ], 'prefix, 'p, 'q, 'i, 'o) RPC_service.t ->
+  ('p -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register:
+  'prefix directory ->
+  ([< Resto.meth ], 'prefix, 'p, 'q, 'i, 'o) RPC_service.t ->
+  ('p -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val gen_register:
+  'prefix directory ->
+  ('meth, 'prefix, 'params, 'query, 'input, 'output) RPC_service.t ->
+  ('params -> 'query -> 'input -> [< 'output RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val lwt_register:
+  'prefix directory ->
+  ([< Resto.meth ], 'prefix, 'p, 'q, 'i, 'o) RPC_service.t ->
+  ('p -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+(** Registring handler in service tree. Curryfied variant.  *)
+
+val register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o tzresult Lwt.t) ->
+  unit directory
+
+val register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+val register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o tzresult Lwt.t) ->
+  'prefix directory
+
+
+val opt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o option tzresult Lwt.t) ->
+  unit directory
+
+val opt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+val opt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o option tzresult Lwt.t) ->
+  'prefix directory
+
+
+val gen_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  unit directory
+
+val gen_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+val gen_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> [< 'o RPC_answer.t ] Lwt.t) ->
+  'prefix directory
+
+
+val lwt_register0:
+  unit directory ->
+  ('m, unit, unit, 'q, 'i, 'o) RPC_service.t ->
+  ('q -> 'i -> 'o Lwt.t) ->
+  unit directory
+
+val lwt_register1:
+  'prefix directory ->
+  ('m, 'prefix, unit * 'a, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register2:
+  'prefix directory ->
+  ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register3:
+  'prefix directory ->
+  ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register4:
+  'prefix directory ->
+  ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+val lwt_register5:
+  'prefix directory ->
+  ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q , 'i, 'o) RPC_service.t ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> 'o Lwt.t) ->
+  'prefix directory
+
+
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_encoding.ml b/vendors/tezos-modded/src/lib_rpc/RPC_encoding.ml
new file mode 100644
index 000000000..40bc43cc9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_encoding.ml
@@ -0,0 +1,207 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a t = 'a Data_encoding.t
+type schema = Data_encoding.json_schema * Data_encoding.Binary_schema.t
+let unit = Data_encoding.empty
+let untyped = Data_encoding.(obj1 (req "untyped" string))
+let conv f g t = Data_encoding.conv ~schema:(Data_encoding.Json.schema t) f g t
+let schema ?definitions_path t =
+  (Data_encoding.Json.schema ?definitions_path t,
+   Data_encoding.Binary.describe t)
+
+let schema_encoding =
+  let open Data_encoding in
+  obj2
+    (req "json_schema" json_schema)
+    (req "binary_schema" Data_encoding.Binary_schema.encoding)
+
+module StringMap = Resto.StringMap
+
+let arg_encoding =
+  let open Data_encoding in
+  conv
+    (fun {Resto.Arg.name; descr} -> ((),name, descr))
+    (fun ((),name, descr) -> {name; descr})
+    (obj3 (req "id" (constant "single")) (req "name" string) (opt "descr" string))
+
+let multi_arg_encoding =
+  let open Data_encoding in
+  conv
+    (fun {Resto.Arg.name; descr} -> ((),name, descr))
+    (fun ((),name, descr) -> {name; descr})
+    (obj3 (req "id" (constant "multiple")) (req "name" string) (opt "descr" string))
+
+open Resto.Description
+
+let meth_encoding =
+  Data_encoding.string_enum
+    [ "GET", `GET ;
+      "POST", `POST ;
+      "DELETE", `DELETE ;
+      "PUT", `PUT ;
+      "PATCH", `PATCH ]
+
+let path_item_encoding =
+  let open Data_encoding in
+  union [
+    case (Tag 0) string
+      ~title:"PStatic"
+      (function PStatic s -> Some s | _ -> None)
+      (fun s -> PStatic s) ;
+    case (Tag 1) arg_encoding
+      ~title:"PDynamic"
+      (function PDynamic s -> Some s | _ -> None)
+      (fun s -> PDynamic s) ;
+    case (Tag 2) multi_arg_encoding
+      ~title:"PDynamicTail"
+      (function PDynamicTail s -> Some s | _ -> None)
+      (fun s -> PDynamicTail s) ;
+  ]
+
+let query_kind_encoding =
+  let open Data_encoding in
+  union [
+    case (Tag 0)
+      ~title:"Single"
+      (obj1 (req "single" arg_encoding))
+      (function Single s -> Some s | _ -> None)
+      (fun s -> Single s) ;
+    case (Tag 1)
+      ~title:"Optional"
+      (obj1 (req "optional" arg_encoding))
+      (function Optional s -> Some s | _ -> None)
+      (fun s -> Optional s) ;
+    case (Tag 2)
+      ~title:"Flag"
+      (obj1 (req "flag" empty))
+      (function Flag -> Some () | _ -> None)
+      (fun () -> Flag) ;
+    case (Tag 3)
+      ~title:"Multi"
+      (obj1 (req "multi" arg_encoding))
+      (function Multi s -> Some s | _ -> None)
+      (fun s -> Multi s) ;
+  ]
+
+let query_item_encoding =
+  let open Data_encoding in
+  conv
+    (fun { name ; description ; kind } -> (name, description, kind))
+    (fun (name, description, kind) -> { name ; description ; kind })
+    (obj3
+       (req "name" string)
+       (opt "description" string)
+       (req "kind" query_kind_encoding))
+
+let service_descr_encoding =
+  let open Data_encoding in
+  conv
+    (fun { meth ; path ; description ; query ; input ; output ; error } ->
+       (meth, path, description, query, input, output, error))
+    (fun (meth, path, description, query, input, output, error) ->
+       { meth ; path ; description ; query ; input ; output ; error })
+    (obj7
+       (req "meth" meth_encoding)
+       (req "path" (list path_item_encoding))
+       (opt "description" string)
+       (req "query" (list query_item_encoding))
+       (opt "input" schema_encoding)
+       (req "output" schema_encoding)
+       (req "error" schema_encoding))
+
+let directory_descr_encoding =
+  let open Data_encoding in
+  mu "service_tree" @@ fun directory_descr_encoding ->
+  let static_subdirectories_descr_encoding =
+    union [
+      case (Tag 0)
+        ~title:"Suffixes"
+        (obj1 (req  "suffixes"
+                 (list (obj2 (req "name" string)
+                          (req "tree" directory_descr_encoding)))))
+        (function Suffixes map ->
+           Some (StringMap.bindings map) | _ -> None)
+        (fun m ->
+           let add acc (n,t) =  StringMap.add n t acc in
+           Suffixes (List.fold_left add StringMap.empty m)) ;
+      case (Tag 1)
+        ~title:"Arg"
+        (obj1 (req "dynamic_dispatch"
+                 (obj2
+                    (req "arg" arg_encoding)
+                    (req "tree" directory_descr_encoding))))
+        (function Arg (ty, tree) -> Some (ty, tree) | _ -> None)
+        (fun (ty, tree) -> Arg (ty, tree))
+    ] in
+
+  let static_directory_descr_encoding =
+    conv
+      (fun { services ; subdirs } ->
+         let find s =
+           try Some (Resto.MethMap.find s services) with Not_found -> None in
+         (find `GET, find `POST, find `DELETE,
+          find `PUT, find `PATCH, subdirs))
+      (fun (get, post, delete, put, patch, subdirs) ->
+         let add meth s services =
+           match s with
+           | None -> services
+           | Some s -> Resto.MethMap.add meth s services in
+         let services =
+           Resto.MethMap.empty
+           |> add `GET get
+           |> add `POST post
+           |> add `DELETE delete
+           |> add `PUT put
+           |> add `PATCH patch in
+         { services ; subdirs })
+      (obj6
+         (opt "get_service" service_descr_encoding)
+         (opt "post_service" service_descr_encoding)
+         (opt "delete_service" service_descr_encoding)
+         (opt "put_service" service_descr_encoding)
+         (opt "patch_service" service_descr_encoding)
+         (opt "subdirs" static_subdirectories_descr_encoding)) in
+  union [
+    case (Tag 0)
+      ~title:"Static"
+      (obj1 (req "static" static_directory_descr_encoding))
+      (function Static descr -> Some descr | _ -> None)
+      (fun descr -> Static descr) ;
+    case (Tag 1)
+      ~title:"Dynamic"
+      (obj1 (req "dynamic" (option string)))
+      (function Dynamic descr -> Some descr | _ -> None)
+      (fun descr -> Dynamic descr) ;
+  ]
+
+let description_request_encoding =
+  let open Data_encoding in
+  conv
+    (fun { recurse } -> recurse)
+    (function recurse -> { recurse })
+    (obj1 (dft "recursive" bool false))
+
+let description_answer_encoding = directory_descr_encoding
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_encoding.mli b/vendors/tezos-modded/src/lib_rpc/RPC_encoding.mli
new file mode 100644
index 000000000..7e48521df
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_encoding.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type schema = Data_encoding.json_schema * Data_encoding.Binary_schema.t
+
+include Resto.ENCODING with type 'a t = 'a Data_encoding.t
+                        and type schema := schema
+
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_error.ml b/vendors/tezos-modded/src/lib_rpc/RPC_error.ml
new file mode 100644
index 000000000..94cb6ca84
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_error.ml
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 list ctxt =
+  RPC_context.make_call RPC_service.error_service ctxt () () ()
+
+let encoding = RPC_service.error_encoding
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_error.mli b/vendors/tezos-modded/src/lib_rpc/RPC_error.mli
new file mode 100644
index 000000000..9a8fc13f1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_error.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+val list: #RPC_context.simple -> Json_schema.schema tzresult Lwt.t
+
+val encoding: error list Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_path.ml b/vendors/tezos-modded/src/lib_rpc/RPC_path.ml
new file mode 100644
index 000000000..06b83f8f1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_path.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Resto.Path
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_path.mli b/vendors/tezos-modded/src/lib_rpc/RPC_path.mli
new file mode 100644
index 000000000..e43ea6e48
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_path.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include (module type of struct include Resto.Path end)
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_query.ml b/vendors/tezos-modded/src/lib_rpc/RPC_query.ml
new file mode 100644
index 000000000..7cd1e8542
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_query.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Resto.Query
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_query.mli b/vendors/tezos-modded/src/lib_rpc/RPC_query.mli
new file mode 100644
index 000000000..648623a93
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_query.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include (module type of struct include Resto.Query end)
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_service.ml b/vendors/tezos-modded/src/lib_rpc/RPC_service.ml
new file mode 100644
index 000000000..437bd5cd2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_service.ml
@@ -0,0 +1,106 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+
+let string_of_meth = Resto.string_of_meth
+let meth_of_string = Resto.meth_of_string
+
+let meth_encoding =
+  let open Data_encoding in
+  conv
+    string_of_meth
+    (fun m ->
+       match meth_of_string m with
+       | None -> Pervasives.failwith "Cannot parse methods"
+       | Some s -> s)
+    string
+
+module MethMap = Resto.MethMap
+
+type (+'m,'pr,'p,'q,'i,'o, 'e) raw =
+  ('m,'pr,'p,'q,'i,'o, 'e) Resto.MakeService(RPC_encoding).t
+  constraint 'meth = [< meth ]
+
+type error = Error_monad.error list
+
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t =
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
+  constraint 'meth = [< meth ]
+
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
+  constraint 'meth = [< meth ]
+
+include (Resto.MakeService(RPC_encoding)
+         : (module type of struct include Resto.MakeService(RPC_encoding) end
+             with type (+'m,'pr,'p,'q,'i,'o, 'e) t := ('m,'pr,'p,'q,'i,'o, 'e) raw
+              and type (+'m,'pr,'p,'q,'i,'o, 'e) service := ('m,'pr,'p,'q,'i,'o, 'e) raw)
+        )
+
+
+let error_path = ref None
+
+let error_encoding =
+  let open Data_encoding in
+  delayed begin fun () ->
+    let { meth ; uri ; _ } =
+      match !error_path with
+      | None -> assert false
+      | Some p -> p in
+    def
+      "error"
+      ~description:
+        (Printf.sprintf
+           "The full list of error is available with \
+            the global RPC `%s %s`"
+           (string_of_meth meth) (Uri.path_and_query uri)) @@
+    conv
+      ~schema:Json_schema.any
+      (fun exn -> `A (List.map Error_monad.json_of_error exn))
+      (function `A exns -> List.map Error_monad.error_of_json exns | _ -> [])
+      json
+  end
+
+let get_service = get_service ~error:error_encoding
+let post_service = post_service ~error:error_encoding
+let delete_service = delete_service ~error:error_encoding
+let patch_service = patch_service ~error:error_encoding
+let put_service = put_service ~error:error_encoding
+
+let error_service =
+  get_service
+    ~description: "Schema for all the RPC errors from the shell"
+    ~query: RPC_query.empty
+    ~output: Data_encoding.json_schema
+    RPC_path.(root / "errors")
+
+let () = error_path := Some (forge_request error_service () ())
+
+let description_service =
+  description_service
+    ~description: "RPCs documentation and input/output schema"
+    error_encoding
+    RPC_path.(root / "describe")
diff --git a/vendors/tezos-modded/src/lib_rpc/RPC_service.mli b/vendors/tezos-modded/src/lib_rpc/RPC_service.mli
new file mode 100644
index 000000000..a7b0ac934
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/RPC_service.mli
@@ -0,0 +1,100 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+
+val string_of_meth: [< meth ] -> string
+val meth_of_string: string -> [> meth ] option
+val meth_encoding: meth Data_encoding.t
+
+module MethMap = Resto.MethMap
+
+type (+'m,'pr,'p,'q,'i,'o, 'e) raw =
+  ('m,'pr,'p,'q,'i,'o, 'e) Resto.MakeService(RPC_encoding).t
+  constraint 'meth = [< meth ]
+
+type error = Error_monad.error list
+
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) t =
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
+  constraint 'meth = [< meth ]
+
+type (+'meth, 'prefix, 'params, 'query, 'input, 'output) service =
+  ('meth, 'prefix, 'params, 'query, 'input, 'output, error) raw
+  constraint 'meth = [< meth ]
+
+include (module type of struct include Resto.MakeService(RPC_encoding) end
+    with type (+'m,'pr,'p,'q,'i,'o, 'e) t := ('m,'pr,'p,'q,'i,'o, 'e) raw
+     and type (+'m,'pr,'p,'q,'i,'o, 'e) service := ('m,'pr,'p,'q,'i,'o, 'e) raw)
+
+val get_service:
+  ?description: string ->
+  query: 'query RPC_query.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `GET ], 'prefix, 'params, 'query, unit, 'output) service
+
+val post_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `POST ], 'prefix, 'params, 'query, 'input, 'output) service
+
+val delete_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `DELETE ], 'prefix, 'params, 'query, unit, 'output) service
+
+val patch_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `PATCH ], 'prefix, 'params, 'query, 'input, 'output) service
+
+val put_service:
+  ?description: string ->
+  query:'query RPC_query.t ->
+  input: 'input Data_encoding.t ->
+  output: 'output Data_encoding.t ->
+  ('prefix, 'params) RPC_path.t ->
+  ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output) service
+
+
+(**/**)
+
+val description_service:
+  ([ `GET ], unit, unit * string list, Resto.Description.request,
+   unit, RPC_encoding.schema Resto.Description.directory) service
+
+val error_service:
+  ([ `GET ], unit, unit, unit, unit, Json_schema.schema) service
+
+val error_encoding: error Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_rpc/dune b/vendors/tezos-modded/src/lib_rpc/dune
new file mode 100644
index 000000000..43fecce78
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/dune
@@ -0,0 +1,16 @@
+(library
+ (name tezos_rpc)
+ (public_name tezos-rpc)
+ (libraries tezos-data-encoding
+            tezos-error-monad
+            ocplib-resto
+            ocplib-resto-directory)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_data_encoding
+                   -open Tezos_error_monad)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_rpc/tezos-rpc.opam b/vendors/tezos-modded/src/lib_rpc/tezos-rpc.opam
new file mode 100644
index 000000000..74ea0e878
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc/tezos-rpc.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-error-monad"
+  "tezos-data-encoding"
+  "ocplib-resto"
+  "ocplib-resto-directory"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_client.ml b/vendors/tezos-modded/src/lib_rpc_http/RPC_client.ml
new file mode 100644
index 000000000..6ae27a2f9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_client.ml
@@ -0,0 +1,477 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Client = Resto_cohttp.Client.Make(RPC_encoding)
+
+module type LOGGER = Client.LOGGER
+type logger = (module LOGGER)
+let null_logger = Client.null_logger
+let timings_logger = Client.timings_logger
+let full_logger = Client.full_logger
+
+type rpc_error =
+  | Empty_answer
+  | Connection_failed of string
+  | Bad_request of string
+  | Method_not_allowed of RPC_service.meth list
+  | Unsupported_media_type of string option
+  | Not_acceptable of { proposed: string ; acceptable: string }
+  | Unexpected_status_code of { code: Cohttp.Code.status_code ;
+                                content: string ;
+                                media_type: string option }
+  | Unexpected_content_type of { received: string ;
+                                 acceptable: string list ;
+                                 body : string}
+  | Unexpected_content of { content: string ;
+                            media_type: string ;
+                            error: string }
+  | OCaml_exception of string
+  | Unauthorized_host of string option
+
+let rpc_error_encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag  0)
+        ~title:"Empty_answer"
+        (obj1
+           (req "kind" (constant "empty_answer")))
+        (function Empty_answer -> Some () | _ -> None)
+        (fun () -> Empty_answer) ;
+      case (Tag  1)
+        ~title:"Connection_failed"
+        (obj2
+           (req "kind" (constant "connection_failed"))
+           (req "message" string))
+        (function Connection_failed msg -> Some ((), msg) | _ -> None)
+        (function (), msg -> Connection_failed msg) ;
+      case (Tag  2)
+        ~title:"Bad_request"
+        (obj2
+           (req "kind" (constant "bad_request"))
+           (req "message" string))
+        (function Bad_request msg -> Some ((), msg) | _ -> None)
+        (function (), msg -> Bad_request msg) ;
+      case (Tag  3)
+        ~title:"Method_not_allowed"
+        (obj2
+           (req "kind" (constant "method_not_allowed"))
+           (req "allowed" (list RPC_service.meth_encoding)))
+        (function Method_not_allowed meths -> Some ((), meths) | _ -> None)
+        (function ((), meths) -> Method_not_allowed meths) ;
+      case (Tag  4)
+        ~title:"Unsupported_media_type"
+        (obj2
+           (req "kind" (constant "unsupported_media_type"))
+           (opt "content_type" string))
+        (function Unsupported_media_type m -> Some ((), m) | _ -> None)
+        (function ((), m) -> Unsupported_media_type m) ;
+      case (Tag  5)
+        ~title:"Not_acceptable"
+        (obj3
+           (req "kind" (constant "not_acceptable"))
+           (req "proposed" string)
+           (req "acceptable" string))
+        (function
+          | Not_acceptable { proposed ; acceptable } ->
+              Some ((), proposed, acceptable)
+          | _ -> None)
+        (function ((), proposed, acceptable) ->
+           Not_acceptable { proposed ; acceptable }) ;
+      case (Tag  6)
+        ~title:"Unexpected_status_code"
+        (obj4
+           (req "kind" (constant "unexpected_status_code"))
+           (req "code" uint16)
+           (req "content" string)
+           (opt "media_type" string))
+        (function
+          | Unexpected_status_code { code ; content ; media_type } ->
+              Some ((), Cohttp.Code.code_of_status code, content, media_type)
+          | _ -> None)
+        (function ((), code, content, media_type) ->
+           let code = Cohttp.Code.status_of_code code in
+           Unexpected_status_code { code ; content ; media_type }) ;
+      case (Tag  7)
+        ~title:"Unexpected_content_type"
+        (obj4
+           (req "kind" (constant "unexpected_content_type"))
+           (req "received" string)
+           (req "acceptable" (list string))
+           (req "body" string))
+        (function
+          | Unexpected_content_type { received ; acceptable ; body } ->
+              Some ((), received, acceptable, body)
+          | _ -> None)
+        (function ((), received, acceptable, body) ->
+           Unexpected_content_type { received ; acceptable ; body }) ;
+      case (Tag  8)
+        ~title:"Unexpected_content"
+        (obj4
+           (req "kind" (constant "unexpected_content"))
+           (req "content" string)
+           (req "media_type" string)
+           (req "error" string))
+        (function
+          | Unexpected_content { content ; media_type ; error  } ->
+              Some ((), content, media_type, error)
+          | _ -> None)
+        (function ((), content, media_type, error) ->
+           Unexpected_content { content ; media_type ; error  }) ;
+      case (Tag  9)
+        ~title:"OCaml_exception"
+        (obj2
+           (req "kind" (constant "ocaml_exception"))
+           (req "content" string))
+        (function OCaml_exception msg -> Some ((), msg) | _ -> None)
+        (function ((), msg) -> OCaml_exception msg) ;
+    ]
+
+let pp_rpc_error ppf err =
+  match err with
+  | Empty_answer ->
+      Format.fprintf ppf
+        "The server answered with an empty response."
+  | Connection_failed msg ->
+      Format.fprintf ppf
+        "Unable to connect to the node: \"%s\"" msg
+  | Bad_request msg ->
+      Format.fprintf ppf
+        "@[<v 2>Oups! It looks like we forged an invalid HTTP request.@,%s@]"
+        msg
+  | Method_not_allowed meths ->
+      Format.fprintf ppf
+        "@[<v 2>The requested service only accepts the following method:@ %a@]"
+        (Format.pp_print_list
+           (fun ppf m -> Format.pp_print_string ppf (RPC_service.string_of_meth m)))
+        meths
+  | Unsupported_media_type None ->
+      Format.fprintf ppf
+        "@[<v 2>The server wants to known the media type we used.@]"
+  | Unsupported_media_type (Some media) ->
+      Format.fprintf ppf
+        "@[<v 2>The server does not support the media type we used: %s.@]"
+        media
+  | Not_acceptable { proposed ; acceptable } ->
+      Format.fprintf ppf
+        "@[<v 2>No intersection between the media types we accept and \
+        \ the ones the server is able to send.@,\
+        \ We proposed: %s@,\
+        \ The server is only able to serve: %s."
+        proposed acceptable
+  | Unexpected_status_code { code ; content ; _ } ->
+      Format.fprintf ppf
+        "@[<v 2>Unexpected error %d:@,%S"
+        (Cohttp.Code.code_of_status code) content
+  | Unexpected_content_type { received ; acceptable = _ ; body } ->
+      Format.fprintf ppf
+        "@[<v 0>The server answered with a media type we do not understand: %s.@,\
+         The response body was:@,\
+         %s@]" received body
+  | Unexpected_content { content ; media_type ; error } ->
+      Format.fprintf ppf
+        "@[<v 2>Failed to parse the answer (%s):@,@[<v 2>error:@ %s@]@,@[<v 2>content:@ %S@]@]"
+        media_type error content
+  | OCaml_exception msg ->
+      Format.fprintf ppf
+        "@[<v 2>The server failed with an unexpected exception:@ %s@]"
+        msg
+  | Unauthorized_host host ->
+      Format.fprintf ppf
+        "@[<v 2>The server refused connection to host \"%s\", \
+         please check the node settings for CORS allowed origins.@]"
+        (Option.unopt ~default:"" host)
+
+type error +=
+  | Request_failed of { meth: RPC_service.meth ;
+                        uri: Uri.t ;
+                        error: rpc_error }
+
+let uri_encoding =
+  let open Data_encoding in
+  conv
+    Uri.to_string
+    Uri.of_string
+    string
+
+let () =
+  register_error_kind `Permanent
+    ~id:"rpc_client.request_failed"
+    ~title:""
+    ~description:""
+    ~pp:(fun ppf (meth, uri, error) ->
+        Format.fprintf ppf
+          "@[<v 2>Rpc request failed:@ \
+          \ - meth: %s@ \
+          \ - uri: %s@ \
+          \ - error: %a@]"
+          (RPC_service.string_of_meth meth)
+          (Uri.to_string uri)
+          pp_rpc_error error)
+    Data_encoding.(obj3
+                     (req "meth" RPC_service.meth_encoding)
+                     (req "uri" uri_encoding)
+                     (req "error" rpc_error_encoding))
+    (function
+      | Request_failed { uri ; error ; meth } -> Some (meth, uri, error)
+      | _ -> None)
+    (fun (meth, uri, error) -> Request_failed { uri ; meth ; error })
+
+let request_failed meth uri error =
+  let meth = ( meth : [< RPC_service.meth ] :> RPC_service.meth) in
+  fail (Request_failed { meth ; uri ; error })
+
+type content_type = (string * string)
+type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
+
+let generic_call ?logger ?headers ?accept ?body ?media meth uri : (content, content) RPC_context.rest_result Lwt.t =
+  Client.generic_call meth ?logger ?headers ?accept ?body ?media uri >>= function
+  | `Ok (Some v) -> return (`Ok v)
+  | `Ok None -> request_failed meth uri Empty_answer
+  | `Conflict _
+  | `Error _
+  | `Forbidden _
+  | `Unauthorized _
+  | `Not_found _ as v -> return v
+  | `Unexpected_status_code (code, (content, _, media_type)) ->
+      let media_type = Option.map media_type ~f:Media_type.name in
+      Cohttp_lwt.Body.to_string content >>= fun content ->
+      request_failed meth uri
+        (Unexpected_status_code { code ; content ; media_type })
+  | `Method_not_allowed allowed ->
+      let allowed = List.filter_map RPC_service.meth_of_string allowed in
+      request_failed meth uri (Method_not_allowed allowed)
+  | `Unsupported_media_type ->
+      let media = Option.map media ~f:Media_type.name in
+      request_failed meth uri (Unsupported_media_type media)
+  | `Not_acceptable acceptable ->
+      let proposed =
+        Option.unopt_map accept ~default:"" ~f:Media_type.accept_header in
+      request_failed meth uri (Not_acceptable { proposed ; acceptable })
+  | `Bad_request msg ->
+      request_failed meth uri (Bad_request msg)
+  | `Connection_failed msg ->
+      request_failed meth uri (Connection_failed msg)
+  | `OCaml_exception msg ->
+      request_failed meth uri (OCaml_exception msg)
+  | `Unauthorized_host host ->
+      request_failed meth uri (Unauthorized_host host)
+
+let handle_error meth uri (body, media, _) f =
+  Cohttp_lwt.Body.is_empty body >>= fun empty ->
+  if empty then
+    return (f None)
+  else
+    match media with
+    | Some ("application", "json") | None -> begin
+        Cohttp_lwt.Body.to_string body >>= fun body ->
+        match Data_encoding.Json.from_string body with
+        | Ok body -> return (f (Some body))
+        | Error msg ->
+            request_failed meth uri
+              (Unexpected_content { content = body ;
+                                    media_type = Media_type.(name json) ;
+                                    error = msg })
+      end
+    | Some (l, r) ->
+        Cohttp_lwt.Body.to_string body >>= fun body ->
+        request_failed meth uri
+          (Unexpected_content_type { received = l^"/"^r ;
+                                     acceptable = [Media_type.(name json)] ;
+                                     body })
+
+let generic_json_call ?logger ?headers ?body meth uri : (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t =
+  let body =
+    Option.map body ~f:begin fun b ->
+      (Cohttp_lwt.Body.of_string (Data_encoding.Json.to_string b))
+    end in
+  let media = Media_type.json in
+  generic_call meth ?logger ?headers ~accept:Media_type.[bson ; json] ?body ~media uri >>=? function
+  | `Ok (body, (Some ("application", "json") | None), _) -> begin
+      Cohttp_lwt.Body.to_string body >>= fun body ->
+      match Data_encoding.Json.from_string body with
+      | Ok json -> return (`Ok json)
+      | Error msg ->
+          request_failed meth uri
+            (Unexpected_content { content = body ;
+                                  media_type = Media_type.(name json) ;
+                                  error = msg })
+    end
+  | `Ok (body, Some ("application", "bson"), _) -> begin
+      Cohttp_lwt.Body.to_string body >>= fun body ->
+      match Json_repr_bson.bytes_to_bson ~laziness:false ~copy:false
+              (Bytes.unsafe_of_string body) with
+      | exception Json_repr_bson.Bson_decoding_error (msg, _, pos) ->
+          let error = Format.asprintf "(at offset: %d) %s" pos msg in
+          request_failed meth uri
+            (Unexpected_content { content = body ;
+                                  media_type = Media_type.(name bson) ;
+                                  error })
+      | bson ->
+          return (`Ok (Json_repr.convert
+                         (module Json_repr_bson.Repr)
+                         (module Json_repr.Ezjsonm)
+                         bson))
+    end
+  | `Ok (body, Some (l, r), _) ->
+      Cohttp_lwt.Body.to_string body >>= fun body ->
+      request_failed meth uri
+        (Unexpected_content_type { received = l^"/"^r ;
+                                   acceptable = [Media_type.(name json)] ;
+                                   body })
+  | `Conflict body ->
+      handle_error meth uri body (fun v -> `Conflict v)
+  | `Error body ->
+      handle_error meth uri body (fun v -> `Error v)
+  | `Forbidden body ->
+      handle_error meth uri body (fun v -> `Forbidden v)
+  | `Not_found body ->
+      handle_error meth uri body (fun v -> `Not_found v)
+  | `Unauthorized body ->
+      handle_error meth uri body (fun v -> `Unauthorized v)
+
+let handle accept (meth, uri, ans) =
+  match ans with
+  | `Ok (Some v) -> return v
+  | `Ok None -> request_failed meth uri Empty_answer
+  | `Not_found None -> fail (RPC_context.Not_found { meth ; uri })
+  | `Conflict (Some err) | `Error (Some err)
+  | `Forbidden (Some err) | `Unauthorized (Some err)
+  | `Not_found (Some err) -> Lwt.return_error err
+  | `Conflict None | `Error None | `Forbidden None | `Unauthorized None ->
+      fail (RPC_context.Generic_error { meth ; uri })
+  | `Unexpected_status_code (code, (content, _, media_type)) ->
+      let media_type = Option.map media_type ~f:Media_type.name in
+      Cohttp_lwt.Body.to_string content >>= fun content ->
+      request_failed meth uri (Unexpected_status_code { code ; content ; media_type })
+  | `Method_not_allowed allowed ->
+      let allowed = List.filter_map RPC_service.meth_of_string allowed in
+      request_failed meth uri (Method_not_allowed allowed)
+  | `Unsupported_media_type ->
+      let name =
+        match Media_type.first_complete_media accept with
+        | None -> None
+        | Some ((l, r), _) -> Some (l^"/"^r) in
+      request_failed meth uri (Unsupported_media_type name)
+  | `Not_acceptable acceptable ->
+      let proposed =
+        Option.unopt_map (Some accept) ~default:"" ~f:Media_type.accept_header in
+      request_failed meth uri (Not_acceptable { proposed ; acceptable })
+  | `Bad_request msg ->
+      request_failed meth uri (Bad_request msg)
+  | `Unexpected_content ((content, media_type), error)
+  | `Unexpected_error_content ((content, media_type), error) ->
+      let media_type = Media_type.name media_type in
+      request_failed meth uri (Unexpected_content { content ; media_type ; error })
+  | `Unexpected_error_content_type (body, media)
+  | `Unexpected_content_type (body, media) ->
+      Cohttp_lwt.Body.to_string body >>= fun body ->
+      let received =
+        Option.unopt_map media ~default:"" ~f:(fun (l, r) -> l^"/"^r) in
+      request_failed meth uri
+        (Unexpected_content_type { received ;
+                                   acceptable = List.map Media_type.name accept ;
+                                   body})
+  | `Connection_failed msg ->
+      request_failed meth uri (Connection_failed msg)
+  | `OCaml_exception msg ->
+      request_failed meth uri (OCaml_exception msg)
+  | `Unauthorized_host host ->
+      request_failed meth uri (Unauthorized_host host)
+
+let call_streamed_service
+    (type p q i o )
+    accept ?logger ?headers ~base (service : (_,_,p,q,i,o) RPC_service.t)
+    ~on_chunk ~on_close
+    (params : p) (query : q) (body : i) : (unit -> unit) tzresult Lwt.t =
+  Client.call_streamed_service
+    accept ?logger ?headers ~base ~on_chunk ~on_close
+    service params query body >>= fun ans ->
+  handle accept ans
+
+let call_service
+    (type p q i o )
+    accept ?logger ?headers ~base (service : (_,_,p,q,i,o) RPC_service.t)
+    (params : p)
+    (query : q) (body : i) : o tzresult Lwt.t =
+  Client.call_service
+    ?logger ?headers ~base accept service params query body >>= fun ans ->
+  handle accept ans
+
+type config = {
+  host : string ;
+  port : int ;
+  tls : bool ;
+  logger : logger ;
+}
+
+let config_encoding =
+  let open Data_encoding in
+  conv
+    (fun { host ; port ; tls } -> (host, port, tls))
+    (fun (host, port, tls) -> { host ; port ; tls ; logger = null_logger })
+    (obj3
+       (req "host" string)
+       (req "port" uint16)
+       (req "tls" bool))
+
+let default_config = {
+  host = "localhost" ;
+  port = 8732 ;
+  tls = false ;
+  logger = null_logger ;
+}
+
+class http_ctxt config media_types : RPC_context.json =
+  let base =
+    Uri.make
+      ~scheme:(if config.tls then "https" else "http")
+      ~host:config.host
+      ~port:config.port
+      () in
+  let logger = config.logger in
+  object
+    method generic_json_call meth ?body uri =
+      let path = Uri.path uri and query = Uri.query uri in
+      let uri = Uri.with_path base path in
+      let uri = Uri.with_query uri query in
+      generic_json_call ~logger meth ?body uri
+    method call_service
+      : 'm 'p 'q 'i 'o.
+        ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+        'p -> 'q -> 'i -> 'o tzresult Lwt.t =
+      fun service params query body ->
+        call_service media_types
+          ~logger ~base service params query body
+    method call_streamed_service
+      : 'm 'p 'q 'i 'o.
+        ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+        on_chunk: ('o -> unit) ->
+      on_close: (unit -> unit) ->
+      'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t =
+      fun service ~on_chunk ~on_close params query body ->
+        call_streamed_service media_types service
+          ~logger ~base ~on_chunk ~on_close params query body
+    method base = base
+  end
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_client.mli b/vendors/tezos-modded/src/lib_rpc_http/RPC_client.mli
new file mode 100644
index 000000000..1624efbfa
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_client.mli
@@ -0,0 +1,117 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type LOGGER = sig
+  type request
+  val log_empty_request: Uri.t -> request Lwt.t
+  val log_request:
+    ?media:Media_type.t -> 'a Data_encoding.t ->
+    Uri.t -> string -> request Lwt.t
+  val log_response:
+    request -> ?media:Media_type.t -> 'a Data_encoding.t ->
+    Cohttp.Code.status_code -> string Lwt.t Lazy.t -> unit Lwt.t
+end
+
+type logger = (module LOGGER)
+
+val null_logger: logger
+val timings_logger: Format.formatter -> logger
+val full_logger: Format.formatter -> logger
+
+type config = {
+  host : string ;
+  port : int ;
+  tls : bool ;
+  logger : logger ;
+}
+val config_encoding: config Data_encoding.t
+val default_config: config
+
+class http_ctxt : config -> Media_type.t list -> RPC_context.json
+
+type rpc_error =
+  | Empty_answer
+  | Connection_failed of string
+  | Bad_request of string
+  | Method_not_allowed of RPC_service.meth list
+  | Unsupported_media_type of string option
+  | Not_acceptable of { proposed: string ; acceptable: string }
+  | Unexpected_status_code of { code: Cohttp.Code.status_code ;
+                                content: string ;
+                                media_type: string option }
+  | Unexpected_content_type of { received: string ;
+                                 acceptable: string list ;
+                                 body : string }
+  | Unexpected_content of { content: string ;
+                            media_type: string ;
+                            error: string }
+  | OCaml_exception of string
+  | Unauthorized_host of string option
+
+type error +=
+  | Request_failed of { meth: RPC_service.meth ;
+                        uri: Uri.t ;
+                        error: rpc_error }
+
+(**/**)
+
+val call_service :
+  Media_type.t list ->
+  ?logger:logger ->
+  ?headers:(string * string) list ->
+  base:Uri.t ->
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+  'p -> 'q -> 'i -> 'o tzresult Lwt.t
+
+val call_streamed_service :
+  Media_type.t list ->
+  ?logger:logger ->
+  ?headers:(string * string) list ->
+  base:Uri.t ->
+  ([< Resto.meth ], unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+  on_chunk: ('o -> unit) ->
+  on_close: (unit -> unit) ->
+  'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t
+
+val generic_json_call :
+  ?logger:logger ->
+  ?headers:(string * string) list ->
+  ?body:Data_encoding.json ->
+  [< RPC_service.meth ] -> Uri.t ->
+  (Data_encoding.json, Data_encoding.json option) RPC_context.rest_result Lwt.t
+
+type content_type = (string * string)
+type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
+
+val generic_call :
+  ?logger:logger ->
+  ?headers:(string * string) list ->
+  ?accept:Media_type.t list ->
+  ?body:Cohttp_lwt.Body.t ->
+  ?media:Media_type.t ->
+  [< RPC_service.meth ] ->
+  Uri.t -> (content, content) RPC_context.rest_result Lwt.t
+
+val uri_encoding: Uri.t Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.ml b/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.ml
new file mode 100644
index 000000000..3c324264d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make(struct let name = "rpc" end)
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.mli b/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.mli
new file mode 100644
index 000000000..ede719e2c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_logging.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.LOG
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_server.ml b/vendors/tezos-modded/src/lib_rpc_http/RPC_server.ml
new file mode 100644
index 000000000..aaa9a7228
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_server.ml
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type cors = Resto_cohttp.Cors.t = {
+  allowed_headers : string list ;
+  allowed_origins : string list ;
+}
+
+include Resto_cohttp.Server.Make(RPC_encoding)(RPC_logging)
diff --git a/vendors/tezos-modded/src/lib_rpc_http/RPC_server.mli b/vendors/tezos-modded/src/lib_rpc_http/RPC_server.mli
new file mode 100644
index 000000000..9cce101d5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/RPC_server.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Typed RPC services: server implementation. *)
+
+type cors = {
+  allowed_headers : string list ;
+  allowed_origins : string list ;
+}
+
+(** A handle on the server worker. *)
+type server
+
+(** Promise a running RPC server.*)
+val launch :
+  ?host:string ->
+  ?cors:cors ->
+  media_types:Media_type.t list ->
+  Conduit_lwt_unix.server ->
+  unit RPC_directory.t ->
+  server Lwt.t
+
+(** Kill an RPC server. *)
+val shutdown : server -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_rpc_http/dune b/vendors/tezos-modded/src/lib_rpc_http/dune
new file mode 100644
index 000000000..b4d46d432
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/dune
@@ -0,0 +1,14 @@
+(library
+ (name tezos_rpc_http)
+ (public_name tezos-rpc-http)
+ (libraries tezos-base
+            ocplib-resto-cohttp)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_rpc_http/media_type.ml b/vendors/tezos-modded/src/lib_rpc_http/media_type.ml
new file mode 100644
index 000000000..f0c86b5f7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/media_type.ml
@@ -0,0 +1,118 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Resto_cohttp.Media_type.Make(RPC_encoding)
+
+let json  = {
+  name = Cohttp.Accept.MediaType ("application", "json") ;
+  q = Some 1000 ;
+  pp = begin fun _enc ppf raw ->
+    match Data_encoding.Json.from_string raw with
+    | Error err ->
+        Format.fprintf ppf
+          "@[Invalid JSON:@ \
+          \ - @[<v 2>Error:@ %s@]\
+          \ - @[<v 2>Raw data:@ %s@]@]"
+          err raw
+    | Ok json ->
+        Data_encoding.Json.pp ppf json
+  end ;
+  construct = begin fun enc v ->
+    Data_encoding.Json.to_string ~newline:true ~minify:true @@
+    Data_encoding.Json.construct enc v
+  end ;
+  destruct = begin fun enc body ->
+    match Data_encoding.Json.from_string body with
+    | Error _ as err -> err
+    | Ok json ->
+        try Ok (Data_encoding.Json.destruct enc json)
+        with Data_encoding.Json.Cannot_destruct (_, exn) ->
+          Error (Format.asprintf "%a"
+                   (fun fmt -> Data_encoding.Json.print_error fmt)
+                   exn)
+  end ;
+}
+
+
+let bson  = {
+  name = Cohttp.Accept.MediaType ("application", "bson") ;
+  q = Some 100 ;
+  pp = begin fun _enc ppf raw ->
+    match Json_repr_bson.bytes_to_bson ~laziness:false ~copy:false
+            (Bytes.unsafe_of_string raw) with
+    | exception Json_repr_bson.Bson_decoding_error (msg, _, _) ->
+        Format.fprintf ppf
+          "@[Invalid BSON:@ %s@]"
+          msg
+    | bson ->
+        let json =
+          Json_repr.convert
+            (module Json_repr_bson.Repr)
+            (module Json_repr.Ezjsonm)
+            bson in
+        Data_encoding.Json.pp ppf json
+  end ;
+  construct = begin fun enc v ->
+    Bytes.unsafe_to_string @@
+    Json_repr_bson.bson_to_bytes @@
+    Data_encoding.Bson.construct enc v
+  end ;
+  destruct = begin fun enc body ->
+    match Json_repr_bson.bytes_to_bson ~laziness:false ~copy:false
+            (Bytes.unsafe_of_string body) with
+    | exception Json_repr_bson.Bson_decoding_error (msg, _, pos) ->
+        Error (Format.asprintf "(at offset: %d) %s" pos msg)
+    | bson ->
+        try Ok (Data_encoding.Bson.destruct enc bson)
+        with Data_encoding.Json.Cannot_destruct (_, exn) ->
+          Error (Format.asprintf "%a"
+                   (fun fmt -> Data_encoding.Json.print_error fmt)
+                   exn)
+  end ;
+}
+
+let octet_stream = {
+  name = Cohttp.Accept.MediaType ("application", "octet-stream") ;
+  q = Some 200 ;
+  pp = begin fun enc ppf raw ->
+    match Data_encoding.Binary.of_bytes enc (MBytes.of_string raw) with
+    | None -> Format.fprintf ppf "Invalid binary data."
+    | Some v ->
+        Format.fprintf ppf
+          ";; binary equivalent of the following json@.%a"
+          Data_encoding.Json.pp (Data_encoding.Json.construct enc v)
+  end ;
+  construct = begin fun enc v ->
+    MBytes.to_string @@
+    Data_encoding.Binary.to_bytes_exn enc v
+  end ;
+  destruct = begin fun enc s ->
+    match Data_encoding.Binary.of_bytes enc (MBytes.of_string s) with
+    | None -> Error "Failed to parse binary data."
+    | Some data -> Ok data
+  end ;
+}
+
+let all_media_types = [ json ; bson ; octet_stream ]
diff --git a/vendors/tezos-modded/src/lib_rpc_http/media_type.mli b/vendors/tezos-modded/src/lib_rpc_http/media_type.mli
new file mode 100644
index 000000000..84203f112
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/media_type.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Resto_cohttp.Media_type.Make(RPC_encoding).t = {
+  name: Cohttp.Accept.media_range ;
+  q: int option ;
+  pp: 'a. 'a Data_encoding.t -> Format.formatter -> string -> unit ;
+  construct: 'a. 'a Data_encoding.t -> 'a -> string ;
+  destruct: 'a. 'a Data_encoding.t -> string -> ('a, string) result ;
+}
+
+val name : t -> string
+
+val json : t
+val bson : t
+val octet_stream : t
+
+val all_media_types : t list
+
+
+val accept_header : t list -> string
+val first_complete_media : t list -> ((string * string) * t) option
diff --git a/vendors/tezos-modded/src/lib_rpc_http/tezos-rpc-http.opam b/vendors/tezos-modded/src/lib_rpc_http/tezos-rpc-http.opam
new file mode 100644
index 000000000..eebcc0c9b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_rpc_http/tezos-rpc-http.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "ocplib-resto-directory"
+  "ocplib-resto-cohttp"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_shell/bench/bench_simple.ml b/vendors/tezos-modded/src/lib_shell/bench/bench_simple.ml
new file mode 100644
index 000000000..0c1f70880
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/bench_simple.ml
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 make_simple blocks =
+  let rec loop pred n =
+    if n <= 0 then
+      return pred
+    else
+      Block.bake pred >>=? fun block ->
+      loop block (n - 1) in
+  Context.init 5 >>=? fun (genesis, _) ->
+  loop genesis blocks
+
+type args = {
+  blocks : int ;
+  accounts : int ;
+}
+
+let default_args = {
+  blocks = 1000 ;
+  accounts = 5 ;
+}
+
+let set_blocks cf blocks =
+  cf := { !cf with blocks }
+
+let set_accounts cf accounts =
+  cf := { !cf with accounts }
+
+let read_args () =
+  let args = ref default_args in
+  let specific =
+    [
+      ("--blocks", Arg.Int (set_blocks args), "number of blocks");
+      ("--accounts", Arg.Int (set_accounts args), "number of acount");
+    ]
+  in
+  let usage = "Usage: [--blocks n] [--accounts n] " in
+  Arg.parse specific (fun _ -> ()) usage ;
+  !args
+
+let () =
+  let args = read_args () in
+  match Lwt_main.run (make_simple args.blocks) with
+  | Ok _head ->
+      Format.printf "Success.@." ;
+      exit 0
+  | Error err ->
+      Format.eprintf "%a@." pp_print_error err ;
+      exit 1
diff --git a/vendors/tezos-modded/src/lib_shell/bench/bench_tool.ml b/vendors/tezos-modded/src/lib_shell/bench/bench_tool.ml
new file mode 100644
index 000000000..6314f2473
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/bench_tool.ml
@@ -0,0 +1,369 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Helpers_Nonce = Nonce
+open Proto_alpha
+open Parameters_repr
+open Constants_repr
+open Alpha_context
+
+(** Args *)
+
+type args = {
+  mutable length : int ;
+  mutable seed : int ;
+  mutable accounts : int ;
+  mutable nb_commitments : int ;
+  mutable params : Parameters_repr.t;
+}
+
+let default_args = {
+  length = 100 ;
+  seed = 0;
+  accounts = 100 ;
+  nb_commitments = 200 ;
+  params = { bootstrap_accounts = [] ;
+             commitments = [] ;
+             bootstrap_contracts = [] ;
+             constants = default ;
+             security_deposit_ramp_up_cycles = None ;
+             no_reward_cycles = None ;
+           }
+}
+
+let debug = ref false
+
+let if_debug k =
+  if !debug then k ()
+
+let if_debug_s k =
+  if !debug then k () else return_unit
+
+let args = default_args
+
+let parse_param_file name =
+  if not (Sys.file_exists name) then
+    failwith "Parameters : Inexistent JSON file"
+  else begin
+    Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file name >>=? fun json ->
+    match Data_encoding.Json.destruct Parameters_repr.encoding json with
+    | exception exn ->
+        failwith "Parameters : Invalid JSON file - %a" Error_monad.pp_exn exn
+    | param -> return param
+  end
+
+let read_args () =
+  let parse_param name =
+    parse_param_file name >>= begin function
+      | Ok p -> Lwt.return p
+      | Error errs ->
+          Format.printf "Parameters parsing error : %a ==> using \
+                         default parameters\n%!" Error_monad.pp_print_error errs ;
+          Lwt.return default_args.params end |> Lwt_main.run
+  in
+
+  let specific =
+    [
+      ("--length", Arg.Int (fun n -> args.length <- n), "Length of the chain (nb of blocks)") ;
+      ("--seed",   Arg.Int (fun n -> args.seed <- n), "Used seed (default 0)") ;
+      ("--random-commitments", Arg.Int (fun n -> args.nb_commitments <- n),
+       "Number of randomly generated commitments. Defaults to 200. If \
+        less than 0, commitments in protocol parameter files are used.") ;
+      ("--accounts", Arg.Int (fun n -> args.accounts <- n),
+       "Number of initial randomly generated accounts. Still adds \
+        bootstrap account if present in the parameters file.") ;
+      ("--parameters", Arg.String (fun s -> args.params <- parse_param s), "JSON protocol parameters file") ;
+
+      ("--debug", Arg.Set debug, "Print more info") ;
+    ]
+  in
+  let usage = "Usage: [--length n] [--seed n] [--accounts n] [--parameters json_file]" in
+  Arg.parse specific (fun _ -> ()) usage
+
+(** Utils *)
+
+let choose_exp_nat n =
+  (* seems fine *)
+  let lambda = 1. /. (log (float n)) in
+  let u = Random.float 1. in
+  (-. (log u)) /. lambda |> int_of_float
+
+let pi = 3.1415926502
+let two_pi = 2. *. 3.1415926502
+let round x = x +. 0.5 |> int_of_float
+
+let rec choose_gaussian_nat (a, b) =
+  assert (b >= a);
+  let sigma = 4. in
+  let mu = ((b - a) / 2 + a) |> float in
+  let gauss () =
+    let u1 = Random.float 1. (* |> fun x -> 1. -. x *) in
+    let u2 = Random.float 1. in
+    let r = sqrt (-. (2. *. log u1)) in
+    let theta = cos (two_pi *. u2) in
+    r *. theta
+  in
+  let z = gauss () in
+  let z = z *. sigma +. mu |> round in
+  if z > a && z < b then z else choose_gaussian_nat (a, b)
+
+let list_shuffle l =
+  List.map (fun c -> (Random.bits (), c)) l |>
+  List.sort compare |> List.map snd
+
+(******************************************************************)
+
+type gen_state = { mutable possible_transfers : (Account.t * Account.t) list ;
+                   mutable remaining_transfers : (Account.t * Account.t) list ;
+                   mutable remaining_activations : (Account.t * Commitment_repr.t) list;
+                   mutable nonce_to_reveal : (Cycle.t * Raw_level.t * Nonce.t) list ;
+                 }
+
+let generate_random_endorsement ctxt n =
+  let slot = n in
+  Context.get_endorser ctxt slot >>=? fun delegate ->
+  Op.endorsement ~delegate ctxt [ slot ]
+
+let generate_and_add_random_endorsements inc =
+  let pred inc = Incremental.predecessor inc in
+  let nb_endorsements =
+    let n = args.params.constants.endorsers_per_block in
+    n - (choose_exp_nat n)
+  in
+  if_debug begin fun () ->
+    Format.printf "[DEBUG] Generating up to %d endorsements...\n%!" nb_endorsements end;
+
+  map_s (generate_random_endorsement (B (pred inc))) (0-- (nb_endorsements -1)) >>=? fun endorsements ->
+
+  let compare op1 op2 =
+    Operation_hash.compare (Operation.hash op1) (Operation.hash op2)
+  in
+
+  let endorsements = List.sort_uniq compare endorsements in
+  let endorsements = List.map Operation.pack endorsements in
+  fold_left_s Incremental.add_operation inc endorsements
+
+let regenerate_transfers = ref false
+let generate_random_activation ({ remaining_activations ; } as gen_state) inc =
+  regenerate_transfers := true ;
+  let open Account in
+  match remaining_activations with
+  | [] -> assert false
+  | (({ pkh ; _ } as account), _)::l ->
+      if_debug begin fun () ->
+        Format.printf "[DEBUG] Generating an activation.\n%!" end;
+      gen_state.remaining_activations <- l ;
+      add_account account;
+      Op.activation inc pkh Account.commitment_secret
+
+exception No_transfer_left
+let rec generate_random_transfer ({ remaining_transfers ; } as gen_state) ctxt =
+  if remaining_transfers = [] then raise No_transfer_left;
+  let (a1, a2) = List.hd remaining_transfers in
+  gen_state.remaining_transfers <- List.tl remaining_transfers;
+  let open Account in
+  let c1 = Alpha_context.Contract.implicit_contract a1.pkh in
+  let c2 = Alpha_context.Contract.implicit_contract a2.pkh in
+  Context.Contract.balance ctxt c1 >>=? fun b1 ->
+  if Tez.(b1 < Tez.one) then
+    generate_random_transfer gen_state ctxt
+  else
+    Op.transaction ctxt c1 c2 Tez.one
+
+
+let generate_random_operation (inc : Incremental.t) gen_state =
+  let rnd = Random.int 100 in
+  match rnd with
+  | x when x < 2 && gen_state.remaining_activations <> [] ->
+      generate_random_activation gen_state (I inc)
+  | _ -> generate_random_transfer gen_state (I inc)
+
+(* Build a random block *)
+let step gen_state blk : Block.t tzresult Lwt.t =
+  let priority = choose_exp_nat 5 in
+  (* let nb_operations_per_block = choose_gaussian_nat (10, List.length (Account.get_known_accounts ())) in *)
+  let nb_operations_per_block = choose_gaussian_nat (10, 100) in
+
+  if !regenerate_transfers then begin
+    let l = Signature.Public_key_hash.Table.fold
+        (fun _ v acc -> v::acc ) Account.known_accounts [] in
+    (* TODO : make possible transfer computations efficient.. *)
+    gen_state.possible_transfers <- List.product l l |> List.filter (fun (a,b) -> a <> b);
+    regenerate_transfers := false
+  end;
+  gen_state.remaining_transfers <- list_shuffle gen_state.possible_transfers ;
+
+  let nb_operations =
+    min nb_operations_per_block (List.length gen_state.remaining_transfers)
+  in
+  (* Nonce *)
+  begin Alpha_services.Helpers.current_level ~offset:1l (Block.rpc_ctxt) blk >>|? function
+    | Level.{ expected_commitment = true ; cycle ; level } ->
+        if_debug begin fun () -> Format.printf "[DEBUG] Commiting a nonce\n%!" end;
+        begin
+          let (hash, nonce) =
+            Helpers_Nonce.generate () in
+          gen_state.nonce_to_reveal <- (cycle, level, nonce) :: gen_state.nonce_to_reveal;
+          Some hash
+        end
+    | _ -> None
+  end >>=? fun seed_nonce_hash ->
+
+  Incremental.begin_construction ~priority ?seed_nonce_hash blk >>=? fun inc ->
+  let open Cycle in
+
+  if_debug begin fun () -> Format.printf "[DEBUG] Generating %d random operations...\n%!" nb_operations end;
+
+  (* Generate random operations *)
+  fold_left_s
+    (fun inc _ ->
+       try
+         generate_random_operation inc gen_state >>=? fun op ->
+         Incremental.add_operation inc op
+       with No_transfer_left -> return inc
+    )
+    inc (1 -- nb_operations) >>=? fun inc ->
+
+  (* Endorsements *)
+  generate_and_add_random_endorsements inc >>=? fun inc ->
+
+  (* Revelations *)
+  (* TODO debug cycle *)
+  begin Alpha_services.Helpers.current_level ~offset:1l Incremental.rpc_ctxt inc >>|? function { cycle ; level ; _ } ->
+      if_debug begin fun () -> Format.printf "[DEBUG] Current cycle : %a\n%!" Cycle.pp cycle end ;
+      if_debug begin fun () -> Format.printf "[DEBUG] Current level : %a\n%!" Raw_level.pp level end ;
+      begin match gen_state.nonce_to_reveal with
+        | ((pred_cycle, _, _)::_) as l when succ pred_cycle = cycle ->
+            if_debug begin fun () -> Format.printf "[DEBUG] Seed nonce revelation : %d nonces to reveal.\n%!"
+              @@ List.length l end;
+            gen_state.nonce_to_reveal <- [] ;
+            (* fold_left_s (fun inc (_, level, nonce) -> *)
+            (* Op.seed_nonce_revelation inc level nonce >>=? fun op ->
+             * Incremental.add_operation inc op *)
+            (* return *) inc (* TODO reactivate the seeds *)
+        (* ) inc l *)
+        | _ -> inc
+      end
+  end >>=? fun inc ->
+  (* (\* Shuffle the operations a bit (why not) *\)
+   * let operations = endorsements @ operations |> list_shuffle in *)
+
+  Incremental.finalize_block inc
+
+let init () =
+  Random.init args.seed ;
+  let parameters = args.params in
+
+  (* keys randomness is delegated to module Signature's bindings *)
+  (* TODO : distribute the tokens randomly *)
+  (* Right now, we split half of 80.000 rolls between generated accounts *)
+  (* TODO : ensure we don't overflow with the underlying commitments *)
+  Tez_repr.(
+    Lwt.return @@ Alpha_environment.wrap_error @@
+    args.params.Parameters_repr.constants.Constants_repr.tokens_per_roll
+    *? 80_000L >>=? fun total_amount ->
+    Lwt.return @@ Alpha_environment.wrap_error @@
+    total_amount /? 2L >>=? fun amount ->
+    Lwt.return @@ Alpha_environment.wrap_error @@
+    amount /? (Int64.of_int args.accounts) ) >>=? fun initial_amount ->
+
+  (* Ensure a deterministic run *)
+  let new_seed () : MBytes.t =
+    String.(make 32 '\000' |> map (fun _ -> Random.int 0x100 |> char_of_int)) |>
+    MBytes.of_string
+  in
+
+  map_s
+    (fun _ -> return (Account.new_account ~seed:(new_seed ()) (), initial_amount))
+    (1--args.accounts) >>=? fun initial_accounts ->
+  if_debug begin fun () ->
+    List.iter
+      (fun (Account.{pkh},_) -> Format.printf "[DEBUG] Account %a created\n%!" Signature.Public_key_hash.pp_short pkh )
+      initial_accounts end;
+
+  let possible_transfers =
+    let l = List.map fst initial_accounts in
+    List.product l l |> List.filter (fun (a,b) -> a <> b)
+  in
+
+  begin match args.nb_commitments with
+    | x when x < 0 -> return ([], parameters)
+    | x ->
+        map_s
+          (fun _ -> Account.new_commitment ~seed:(new_seed ()) ()) (1 -- x) >>=? fun commitments ->
+        return (commitments, { parameters with commitments = List.map snd commitments })
+  end >>=? fun (remaining_activations, { bootstrap_accounts=_ ; commitments ;
+                                         constants ; security_deposit_ramp_up_cycles ;
+                                         no_reward_cycles }) ->
+  let gen_state = { possible_transfers ; remaining_transfers = [] ;
+                    nonce_to_reveal = [] ; remaining_activations } in
+
+  Block.genesis_with_parameters constants
+    ~commitments
+    ~security_deposit_ramp_up_cycles
+    ~no_reward_cycles initial_accounts
+  >>=? fun genesis ->
+
+  if_debug_s begin fun () ->
+    iter_s (let open Account in fun ({ pkh } as acc, _) ->
+        let contract = Alpha_context.Contract.implicit_contract acc.pkh in
+        Context.Contract.manager (B genesis) contract >>=? fun { pkh = pkh' } ->
+        Context.Contract.balance (B genesis) contract >>=? fun balance ->
+        return @@ Format.printf "[DEBUG] %a's manager is %a with a balance of %a\n%!"
+          Signature.Public_key_hash.pp_short pkh
+          Signature.Public_key_hash.pp_short pkh'
+          Tez.pp balance
+      ) initial_accounts end >>=? fun () ->
+
+  if_debug begin fun () ->
+    Format.printf "[DEBUG] Constants : %a\n%!"
+      Data_encoding.Json.pp
+      (Data_encoding.Json.construct
+         Constants_repr.parametric_encoding parameters.Parameters_repr.constants)
+  end;
+
+  Format.printf "@[<v 2>Starting generation with :@ \
+                 @[length    = %d@]@ \
+                 @[seed      = %d@]@ \
+                 @[nb_commi. = %d@]@ \
+                 @[#accounts = %d@]@ @]@." args.length args.seed args.nb_commitments args.accounts;
+  let rec loop gen_state blk = function
+    | 0 ->  return (gen_state, blk)
+    | n -> begin
+        Block.print_block blk;
+        step gen_state blk >>=? fun blk' ->
+        loop gen_state blk' (n-1)
+      end
+  in
+  return (loop gen_state genesis args.length)
+
+let () =
+  Lwt_main.run (read_args (); init ()) |> function
+  | Ok _head ->
+      Format.printf "Success.@." ;
+      exit 0
+  | Error err ->
+      Format.eprintf "%a@." pp_print_error err ;
+      exit 1
diff --git a/vendors/tezos-modded/src/lib_shell/bench/dune b/vendors/tezos-modded/src/lib_shell/bench/dune
new file mode 100644
index 000000000..c704908be
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/dune
@@ -0,0 +1,29 @@
+(executables
+ (names bench_simple bench_tool)
+ (libraries tezos-base
+            tezos-shell
+            tezos_alpha_bench_helpers)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell
+                   -open Tezos_alpha_bench_helpers)))
+
+(alias
+ (name buildtest)
+ (deps bench_tool.exe bench_simple.exe))
+
+(alias
+ (name runbench_alpha_simple)
+ (deps bench_simple.exe)
+ (action (chdir %{workspace_root} (run %{exe:bench_simple.exe}))))
+
+(alias
+ (name runbench_alpha)
+ (deps bench_tool.exe)
+ (action (chdir %{workspace_root} (run %{exe:bench_tool.exe}))))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml*))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/account.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/account.ml
new file mode 100644
index 000000000..6acb5e5ba
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/account.ml
@@ -0,0 +1,89 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+type t = {
+  pkh : Signature.Public_key_hash.t ;
+  pk :  Signature.Public_key.t ;
+  sk :  Signature.Secret_key.t ;
+}
+type account = t
+
+let commitment_secret =
+  Proto_alpha.Blinded_public_key_hash.activation_code_of_hex
+    "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb"
+
+let known_accounts = Signature.Public_key_hash.Table.create 17
+
+let new_account ?seed () =
+  let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in
+  let account = { pkh ; pk ; sk } in
+  Signature.Public_key_hash.Table.add known_accounts pkh account ;
+  account
+
+let add_account ({ pkh ; _ } as account) =
+  Signature.Public_key_hash.Table.add known_accounts pkh account
+
+let dictator_account = new_account ()
+
+let find pkh =
+  try return (Signature.Public_key_hash.Table.find known_accounts pkh)
+  with Not_found ->
+    failwith "Missing account: %a" Signature.Public_key_hash.pp pkh
+
+let find_alternate pkh =
+  let exception Found of t in
+  try
+    Signature.Public_key_hash.Table.iter
+      (fun pkh' account ->
+         if not (Signature.Public_key_hash.equal pkh pkh') then
+           raise (Found account))
+      known_accounts ;
+    raise Not_found
+  with Found account -> account
+
+let dummy_account = new_account ()
+
+let new_commitment ?seed () =
+  let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in
+  let unactivated_account = { pkh; pk; sk } in
+  let open Proto_alpha in
+  let open Commitment_repr in
+  let pkh = match pkh with Ed25519 pkh -> pkh | _ -> assert false in
+  let bpkh = Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in
+  Lwt.return @@ Alpha_environment.wrap_error @@
+  Tez_repr.(one *? 4_000L) >>=? fun amount ->
+  return @@ (unactivated_account, { blinded_public_key_hash = bpkh ; amount })
+
+let generate_accounts n : (t * Tez_repr.t) list =
+  Signature.Public_key_hash.Table.clear known_accounts ;
+  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
+      Signature.Public_key_hash.Table.add known_accounts pkh account ;
+      account, amount)
+    (0--(n-1))
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/account.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/account.mli
new file mode 100644
index 000000000..0e8801147
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/account.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+type t = {
+  pkh : Signature.Public_key_hash.t ;
+  pk :  Signature.Public_key.t ;
+  sk :  Signature.Secret_key.t ;
+}
+type account = t
+
+val commitment_secret : Blinded_public_key_hash.activation_code
+
+val dictator_account: account
+val dummy_account: account
+
+val new_account: ?seed : MBytes.t -> unit -> account
+
+val new_commitment : ?seed:MBytes.t -> unit ->
+  (account * Commitment_repr.t) tzresult Lwt.t
+
+val add_account : t -> unit
+
+val known_accounts : t Signature.Public_key_hash.Table.t
+
+val find: Signature.Public_key_hash.t -> t tzresult Lwt.t
+val find_alternate: Signature.Public_key_hash.t -> t
+
+(** [generate_accounts n] : generates [n] random accounts with
+    4.000.000.000 tz and add them to the global account state *)
+val generate_accounts : int -> (t * Tez_repr.t) list
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/assert.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/assert.ml
new file mode 100644
index 000000000..1a5795def
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/assert.ml
@@ -0,0 +1,113 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let error ~loc v f =
+  match v with
+  | Error err when List.exists f err ->
+      return_unit
+  | Ok _ ->
+      failwith "Unexpected successful result (%s)" loc
+  | Error err ->
+      failwith "@[Unexpected error (%s): %a@]" loc pp_print_error err
+
+let proto_error ~loc v f =
+  error ~loc v
+    (function
+      | Alpha_environment.Ecoproto_error err -> f err
+      | _ -> false)
+
+let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b  =
+  if not (cmp a b) then
+    failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b
+  else
+    return_unit
+
+let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b  =
+  if cmp a b then
+    failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b
+  else
+    return_unit
+
+let equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) =
+  let open Alpha_context in
+  equal ~loc Tez.(=) "Tez aren't equal" Tez.pp a b
+
+let not_equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) =
+  let open Alpha_context in
+  not_equal ~loc Tez.(=) "Tez are equal" Tez.pp a b
+
+let equal_int ~loc (a:int) (b:int) =
+  equal ~loc (=) "Integers aren't equal" Format.pp_print_int a b
+
+let not_equal_int ~loc (a:int) (b:int) =
+  not_equal ~loc (=) "Integers are equal" Format.pp_print_int a b
+
+let equal_bool ~loc (a:bool) (b:bool) =
+  equal ~loc (=) "Booleans aren't equal" Format.pp_print_bool a b
+
+let not_equal_bool ~loc (a:bool) (b:bool) =
+  not_equal ~loc (=) "Booleans are equal" Format.pp_print_bool a b
+
+
+open Context
+(* Some asserts for account operations *)
+
+(** [balance_is b c amount] checks that the current balance of contract [c] is
+    [amount].
+    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
+    [Rewards] for the others. *)
+let balance_is ~loc b contract ?(kind = Contract.Main) expected =
+  Contract.balance b contract ~kind >>=? fun balance ->
+  equal_tez ~loc balance expected
+
+(** [balance_was_operated ~operand b c old_balance amount] checks that the
+    current balance of contract [c] is [operand old_balance amount] and
+    returns the current balance.
+    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
+    [Rewards] for the others. *)
+let balance_was_operated ~(operand) ~loc b contract ?(kind = Contract.Main) old_balance amount =
+  operand old_balance amount |>
+  Alpha_environment.wrap_error |> Lwt.return >>=? fun expected ->
+  balance_is ~loc b contract ~kind expected
+
+let balance_was_credited = balance_was_operated ~operand:Alpha_context.Tez.(+?)
+
+let balance_was_debited = balance_was_operated ~operand:Alpha_context.Tez.(-?)
+
+
+(* debug *)
+
+let print_balances ctxt id =
+  Contract.balance ~kind:Main ctxt id >>=? fun main ->
+  Contract.balance ~kind:Deposit ctxt id >>=? fun deposit ->
+  Contract.balance ~kind:Fees ctxt id >>=? fun fees ->
+  Contract.balance ~kind:Rewards ctxt id >>|? fun rewards ->
+  Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n"
+    (Alpha_context.Tez.to_string main)
+    (Alpha_context.Tez.to_string deposit)
+    (Alpha_context.Tez.to_string fees)
+    (Alpha_context.Tez.to_string rewards)
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/block.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/block.ml
new file mode 100644
index 000000000..6cee50468
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/block.ml
@@ -0,0 +1,411 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+module Proto_Nonce = Nonce (* Renamed otherwise is masked by Alpha_context *)
+open Alpha_context
+
+(* This type collects a block and the context that results from its application *)
+type t = {
+  hash : Block_hash.t ;
+  header : Block_header.t ;
+  operations : Operation.packed list ;
+  context : Tezos_protocol_environment_memory.Context.t ;
+}
+type block = t
+
+let rpc_context block = {
+  Alpha_environment.Updater.block_hash = block.hash ;
+  block_header = block.header.shell ;
+  context = block.context ;
+}
+
+let rpc_ctxt =
+  new Alpha_environment.proto_rpc_context_of_directory
+    rpc_context Proto_alpha.rpc_services
+
+(******** Policies ***********)
+
+(* Policies are functions that take a block and return a tuple
+   [(account, level, timestamp)] for the [forge_header] function. *)
+
+(* This type is used only to provide a simpler interface to the exterior. *)
+type baker_policy =
+  | By_priority of int
+  | By_account of public_key_hash
+  | Excluding of public_key_hash list
+
+let get_next_baker_by_priority priority block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~all:true
+    ~max_priority:(priority+1) block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp} = List.find (fun { Alpha_services.Delegate.Baking_rights.priority = p } -> p = priority)  bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let get_next_baker_by_account pkh block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~delegates:[pkh]
+    ~max_priority:256 block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp ; priority } = List.hd bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let get_next_baker_excluding excludes block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~max_priority:256 block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp ; priority } =
+    List.find
+      (fun { Alpha_services.Delegate.Baking_rights.delegate } ->
+         not (List.mem delegate excludes))
+      bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let dispatch_policy = function
+  | By_priority p -> get_next_baker_by_priority p
+  | By_account a -> get_next_baker_by_account a
+  | Excluding al -> get_next_baker_excluding al
+
+let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy
+
+module Forge = struct
+
+  type header = {
+    baker : public_key_hash ;   (* the signer of the block *)
+    shell : Block_header.shell_header ;
+    contents : Block_header.contents ;
+  }
+
+  let default_proof_of_work_nonce =
+    MBytes.create Constants.proof_of_work_nonce_size
+
+  let make_contents
+      ?(proof_of_work_nonce = default_proof_of_work_nonce)
+      ~priority ~seed_nonce_hash () =
+    Block_header.{ priority ;
+                   proof_of_work_nonce ;
+                   seed_nonce_hash }
+
+  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 = Context_hash.zero ;
+    }
+
+  let set_seed_nonce_hash seed_nonce_hash { baker ; shell ; contents } =
+    { baker ; shell ; contents = { contents with seed_nonce_hash } }
+
+  let set_baker baker header = { header with baker }
+
+  let sign_header { baker ; shell ; contents } =
+    Account.find baker >>=? fun delegate ->
+    let unsigned_bytes =
+      Data_encoding.Binary.to_bytes_exn
+        Block_header.unsigned_encoding
+        (shell, contents) in
+    let signature =
+      Signature.sign
+        ~watermark:(Signature.Block_header Chain_id.zero)
+        delegate.sk unsigned_bytes in
+    Block_header.{ shell ; protocol_data = { contents ; signature } } |>
+    return
+
+  let forge_header
+      ?(policy = By_priority 0)
+      ?(operations = []) pred =
+    dispatch_policy policy pred >>=? fun (pkh, priority, timestamp) ->
+    let level = Int32.succ pred.header.shell.level in
+    begin
+      match Fitness_repr.to_int64 pred.header.shell.fitness with
+      | Ok old_fitness ->
+          return (Fitness_repr.from_int64
+                    (Int64.add (Int64.of_int 1) old_fitness))
+      | Error _ -> assert false
+    end >>=? fun fitness ->
+    begin
+      Alpha_services.Helpers.current_level ~offset:1l (rpc_ctxt) pred >>|? function
+      | { expected_commitment = true } -> Some (fst (Proto_Nonce.generate ()))
+      | { expected_commitment = false } -> None
+    end >>=? fun seed_nonce_hash ->
+    let hashes = List.map Operation.hash_packed operations in
+    let operations_hash = Operation_list_list_hash.compute
+        [Operation_list_hash.compute hashes] in
+    let shell = make_shell ~level ~predecessor:pred.hash
+        ~timestamp ~fitness ~operations_hash in
+    let contents = make_contents ~priority ~seed_nonce_hash () in
+    return { baker = pkh ; shell ; contents }
+
+  (* compatibility only, needed by incremental *)
+  let contents
+      ?(proof_of_work_nonce = default_proof_of_work_nonce)
+      ?(priority = 0) ?seed_nonce_hash () =
+    { Block_header.priority ;
+      proof_of_work_nonce ;
+      seed_nonce_hash ;
+    }
+
+end
+
+(********* Genesis creation *************)
+
+(* Hard-coded context key *)
+let protocol_param_key = [ "protocol_parameters" ]
+
+let check_constants_consistency constants =
+  let open Constants_repr 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 bootstrap_accounts =
+    List.map (fun (Account.{ pk = public_key ; pkh = public_key_hash }, amount) ->
+        Parameters_repr.{ public_key = Some public_key ; public_key_hash ; 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 protocol_param_key proto_params
+  ) >>= fun ctxt ->
+  Main.init ctxt header
+  >|= Alpha_environment.wrap_error >>=? fun { context; _ } ->
+  return context
+
+let genesis_with_parameters
+    constants
+    ?(commitments = [])
+    ?(security_deposit_ramp_up_cycles = None)
+    ?(no_reward_cycles = None)
+    (initial_accounts : (Account.t * 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 *)
+  begin try
+      let open Test_utils in
+      fold_left_s (fun acc (_, amount) ->
+          Alpha_environment.wrap_error @@
+          Tez_repr.(+?) acc amount >>?= fun acc ->
+          if acc >= constants.Constants_repr.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 () ->
+  check_constants_consistency constants >>=? fun () ->
+  let hash =
+    Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
+  in
+  let shell = Forge.make_shell
+      ~level:0l
+      ~predecessor:hash
+      ~timestamp:Time.epoch
+      ~fitness: (Fitness_repr.from_int64 0L)
+      ~operations_hash: Operation_list_list_hash.zero in
+  let contents = Forge.make_contents
+      ~priority:0
+      ~seed_nonce_hash:None () in
+  initial_context
+    constants
+    shell
+    commitments
+    initial_accounts
+    security_deposit_ramp_up_cycles
+    no_reward_cycles
+  >>=? fun context ->
+  let block =
+    { hash ;
+      header = {
+        shell = shell ;
+        protocol_data = {
+          contents = contents ;
+          signature = Signature.zero ;
+        } ;
+      };
+      operations = [] ;
+      context ;
+    }
+  in
+  return block
+
+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)
+    (initial_accounts : (Account.t * Tez_repr.t) list) =
+  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
+  genesis_with_parameters constants initial_accounts
+
+(********* Baking *************)
+
+let apply header ?(operations = []) pred =
+  begin
+    let open Alpha_environment.Error_monad in
+    Proto_alpha.Main.begin_application
+      ~chain_id:Chain_id.zero
+      ~predecessor_context: pred.context
+      ~predecessor_fitness: pred.header.shell.fitness
+      ~predecessor_timestamp: pred.header.shell.timestamp
+      header >>=? fun vstate ->
+    fold_left_s
+      (fun vstate op ->
+         Proto_alpha.apply_operation vstate op >>=? fun (state, _result) ->
+         return state)
+      vstate operations >>=? fun vstate ->
+    Proto_alpha.Main.finalize_block vstate >>=? fun (validation, _result) ->
+    return validation.context
+  end >|= Alpha_environment.wrap_error >>|? fun context ->
+  let hash = Block_header.hash header in
+  { hash ; header ; operations ; context }
+
+let bake ?policy ?operation ?operations pred =
+  let operations =
+    match operation,operations with
+    | Some op, Some ops -> Some (op::ops)
+    | Some op, None -> Some [op]
+    | None, Some ops -> Some ops
+    | None, None -> None
+  in
+  Forge.forge_header ?policy ?operations pred >>=? fun header ->
+  Forge.sign_header header >>=? fun header ->
+  apply header ?operations pred
+
+(* This function is duplicated from Context to avoid a cyclic dependency *)
+let get_constants b =
+  Alpha_services.Constants.all rpc_ctxt b
+
+(********** Cycles ****************)
+
+let bake_n ?policy n b =
+  Error_monad.fold_left_s
+    (fun b _ -> bake ?policy b) b (1 -- n)
+
+let bake_until_cycle_end ?policy b =
+  get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } ->
+  let current_level = b.header.shell.level in
+  let current_level = Int32.rem current_level blocks_per_cycle in
+  let delta = Int32.sub blocks_per_cycle current_level in
+  bake_n ?policy (Int32.to_int delta) b
+
+let bake_until_n_cycle_end ?policy n b =
+  Error_monad.fold_left_s
+    (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n)
+
+let bake_until_cycle ?policy cycle (b:t) =
+  get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } ->
+  let rec loop (b:t) =
+    let current_cycle =
+      let current_level = b.header.shell.level in
+      let current_cycle = Int32.div current_level blocks_per_cycle in
+      current_cycle
+    in
+    if Int32.equal (Cycle.to_int32 cycle) current_cycle then
+      return b
+    else
+      bake_until_cycle_end ?policy b >>=? fun b ->
+      loop b
+  in
+  loop b
+
+let print_block block =
+  Format.printf "@[%6i %s@]\n%!"
+    (Int32.to_int (block.header.shell.level))
+    (Block_hash.to_b58check (block.hash))
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/block.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/block.mli
new file mode 100644
index 000000000..1ab691015
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/block.mli
@@ -0,0 +1,156 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t = {
+  hash : Block_hash.t ;
+  header : Block_header.t ;
+  operations : Operation.packed list ;
+  context : Tezos_protocol_environment_memory.Context.t ; (** Resulting context *)
+}
+type block = t
+
+val rpc_ctxt: t Alpha_environment.RPC_context.simple
+
+(** Policies to select the next baker:
+    - [By_priority p] selects the baker at priority [p]
+    - [By_account pkh] selects the first slot for baker [pkh]
+    - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs]
+*)
+type baker_policy =
+  | By_priority of int
+  | By_account of public_key_hash
+  | Excluding of public_key_hash list
+
+(** Returns (account, priority, timestamp) of the next baker given
+    a policy, defaults to By_priority 0. *)
+val get_next_baker:
+  ?policy:baker_policy ->
+  t -> (public_key_hash * int * Time.t) tzresult Lwt.t
+
+module Forge : sig
+
+  val contents:
+    ?proof_of_work_nonce:MBytes.t ->
+    ?priority:int ->
+    ?seed_nonce_hash: Nonce_hash.t ->
+    unit -> Block_header.contents
+
+  type header
+
+  (** Forges a correct header following the policy.
+      The header can then be modified and applied with [apply]. *)
+  val forge_header:
+    ?policy:baker_policy ->
+    ?operations: Operation.packed list ->
+    t -> header tzresult Lwt.t
+
+  (** Sets uniquely seed_nonce_hash of a header *)
+  val set_seed_nonce_hash:
+    Nonce_hash.t option -> header -> header
+
+  (** Sets the baker that will sign the header to an arbitrary pkh *)
+  val set_baker:
+    public_key_hash -> header -> header
+
+  (** Signs the header with the key of the baker configured in the header.
+      The header can no longer be modified, only applied. *)
+  val sign_header:
+    header ->
+    Block_header.block_header tzresult Lwt.t
+
+end
+
+val genesis_with_parameters :
+  Constants_repr.parametric ->
+  ?commitments: Commitment_repr.t list ->
+  ?security_deposit_ramp_up_cycles:int option ->
+  ?no_reward_cycles:int option ->
+  (Account.t * Proto_alpha.Tez_repr.t) list -> block tzresult Lwt.t
+
+(** [genesis <opts> accounts] : generates an initial block with the
+    given constants [<opts>] and initializes [accounts] with their
+    associated amounts.
+*)
+val genesis:
+  ?preserved_cycles:int ->
+  ?blocks_per_cycle:int32 ->
+  ?blocks_per_commitment:int32 ->
+  ?blocks_per_roll_snapshot:int32 ->
+  ?blocks_per_voting_period:int32 ->
+  ?time_between_blocks:Period_repr.t list ->
+  ?endorsers_per_block:int ->
+  ?hard_gas_limit_per_operation:Z.t ->
+  ?hard_gas_limit_per_block:Z.t ->
+  ?proof_of_work_threshold:int64 ->
+  ?tokens_per_roll:Tez_repr.tez ->
+  ?michelson_maximum_type_size:int ->
+  ?seed_nonce_revelation_tip:Tez_repr.tez ->
+  ?origination_size:int ->
+  ?block_security_deposit:Tez_repr.tez ->
+  ?endorsement_security_deposit:Tez_repr.tez ->
+  ?block_reward:Tez_repr.tez ->
+  ?endorsement_reward:Tez_repr.tez ->
+  ?cost_per_byte: Tez_repr.t ->
+  ?hard_storage_limit_per_operation: Z.t ->
+  (Account.t * Tez_repr.tez) list -> block tzresult Lwt.t
+
+(** Applies a signed header and its operations to a block and
+    obtains a new block *)
+val apply:
+  Block_header.block_header ->
+  ?operations: Operation.packed list ->
+  t -> t tzresult Lwt.t
+
+(**
+   [bake b] returns a block [b'] which has as predecessor block [b].
+   Optional parameter [policy] allows to pick the next baker in several ways.
+   This function bundles together [forge_header], [sign_header] and [apply].
+   These functions should be used instead of bake to craft unusual blocks for
+   testing together with setters for properties of the headers.
+   For examples see seed.ml or double_baking.ml
+*)
+val bake:
+  ?policy: baker_policy ->
+  ?operation: Operation.packed ->
+  ?operations: Operation.packed list ->
+  t -> t tzresult Lwt.t
+
+(** Bakes [n] blocks. *)
+val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t
+
+(** Given a block [b] at level [l] bakes enough blocks to complete a cycle,
+    that is [blocks_per_cycle - (l % blocks_per_cycle)]. *)
+val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t
+
+(** Bakes enough blocks to end [n] cycles. *)
+val bake_until_n_cycle_end : ?policy:baker_policy -> int -> t -> t tzresult Lwt.t
+
+(** Bakes enough blocks to reach the cycle. *)
+val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t
+
+val print_block: t -> unit
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/context.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/context.ml
new file mode 100644
index 000000000..0fc8dbac8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/context.ml
@@ -0,0 +1,194 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t =
+  | B of Block.t
+  | I of Incremental.t
+
+let branch = function
+  | B b -> b.hash
+  | I i -> (Incremental.predecessor i).hash
+
+let level = function
+  | B b -> b.header.shell.level
+  | I i -> (Incremental.level i)
+
+let get_level ctxt =
+  level ctxt
+  |> Raw_level.of_int32
+  |> Alpha_environment.wrap_error
+  |> Lwt.return
+
+let rpc_ctxt = object
+  method call_proto_service0 :
+    'm 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr q i ->
+      match pr with
+      | B b -> Block.rpc_ctxt#call_proto_service0 s b q i
+      | I b -> Incremental.rpc_ctxt#call_proto_service0 s b q i
+  method call_proto_service1 :
+    'm 'a 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service1 s bl a q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service1 s bl a q i
+  method call_proto_service2 :
+    'm 'a 'b 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, (Alpha_environment.RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a b q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service2 s bl a b q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service2 s bl a b q i
+  method call_proto_service3 :
+    'm 'a 'b 'c 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, ((Alpha_environment.RPC_context.t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a b c q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service3 s bl a b c q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service3 s bl a b c q i
+end
+
+let get_endorsers ctxt =
+  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
+
+let get_endorser ctxt slot =
+  Alpha_services.Delegate.Endorsing_rights.get
+    rpc_ctxt ctxt >>=? fun endorsers ->
+  try return (List.find (fun {Alpha_services.Delegate.Endorsing_rights.slots} -> List.mem slot slots) endorsers).delegate
+  with _ ->
+    failwith "Failed to lookup endorsers for ctxt %a, slot %d."
+      Block_hash.pp_short (branch ctxt) slot
+
+let get_bakers ctxt =
+  Alpha_services.Delegate.Baking_rights.get
+    ~max_priority:256
+    rpc_ctxt ctxt >>=? fun bakers ->
+  return (List.map
+            (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate)
+            bakers)
+
+let get_constants b =
+  Alpha_services.Constants.all rpc_ctxt b
+
+module Contract = struct
+
+  let pkh c = Alpha_context.Contract.is_implicit c |> function
+    | Some p -> return p
+    | None -> failwith "pkh: only for implicit contracts"
+
+  type balance_kind = Main | Deposit | Fees | Rewards
+
+  let balance ?(kind = Main) ctxt contract =
+    begin match kind with
+      | Main ->
+          Alpha_services.Contract.balance rpc_ctxt ctxt contract
+      | _ ->
+          match Alpha_context.Contract.is_implicit contract with
+          | None ->
+              invalid_arg
+                "get_balance: no frozen accounts for an originated contract."
+          | Some pkh ->
+              Alpha_services.Delegate.frozen_balance_by_cycle
+                rpc_ctxt ctxt pkh >>=? fun map ->
+              Lwt.return @@
+              Cycle.Map.fold
+                (fun _cycle { Delegate.deposit ; fees ; rewards } acc ->
+                   acc >>?fun acc ->
+                   match kind with
+                   | Deposit -> Test_tez.Tez.(acc +? deposit)
+                   | Fees -> Test_tez.Tez.(acc +? fees)
+                   | Rewards ->  Test_tez.Tez.(acc +? rewards)
+                   | _ -> assert false)
+                map
+                (Ok Tez.zero)
+    end
+
+  let counter ctxt contract =
+    Alpha_services.Contract.counter rpc_ctxt ctxt contract
+
+  let manager ctxt contract =
+    Alpha_services.Contract.manager rpc_ctxt ctxt contract >>=? fun pkh ->
+    Account.find pkh
+
+  let is_manager_key_revealed ctxt contract =
+    Alpha_services.Contract.manager_key rpc_ctxt ctxt contract >>=? fun (_, res) ->
+    return (res <> None)
+
+  let delegate_opt ctxt contract =
+    Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract
+
+end
+
+module Delegate = struct
+
+  type info = Delegate_services.info = {
+    balance: Tez.t ;
+    frozen_balance: Tez.t ;
+    frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+    staking_balance: Tez.t ;
+    delegated_contracts: Contract_hash.t list ;
+    delegated_balance: Tez.t ;
+    deactivated: bool ;
+    grace_period: Cycle.t ;
+  }
+
+  let info ctxt pkh =
+    Alpha_services.Delegate.info rpc_ctxt ctxt pkh
+
+end
+
+let init
+    ?(slow=false)
+    ?preserved_cycles
+    ?endorsers_per_block
+    n =
+  let accounts = Account.generate_accounts n in
+  let contracts = List.map (fun (a, _) ->
+      Alpha_context.Contract.implicit_contract Account.(a.pkh)) accounts in
+  begin
+    if slow then
+      Block.genesis
+        ?preserved_cycles
+        ?endorsers_per_block
+        accounts
+    else
+      Block.genesis
+        ?preserved_cycles
+        ~blocks_per_cycle:32l
+        ~blocks_per_commitment:4l
+        ~blocks_per_roll_snapshot:8l
+        ?endorsers_per_block
+        accounts
+  end >>=? fun blk ->
+  return (blk, contracts)
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/context.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/context.mli
new file mode 100644
index 000000000..e16b2d3b5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/context.mli
@@ -0,0 +1,88 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t =
+  | B of Block.t
+  | I of Incremental.t
+
+val branch: t -> Block_hash.t
+
+val get_level: t -> Raw_level.t tzresult Lwt.t
+
+val get_endorsers: t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t
+
+val get_endorser: t -> int -> public_key_hash tzresult Lwt.t
+
+val get_bakers: t -> public_key_hash list tzresult Lwt.t
+
+(** Returns all the constants of the protocol *)
+val get_constants: t -> Constants.t tzresult Lwt.t
+
+module Contract : sig
+
+  val pkh: Contract.t -> public_key_hash tzresult Lwt.t
+
+  type balance_kind = Main | Deposit | Fees | Rewards
+
+  (** Returns the balance of a contract, by default the main balance.
+      If the contract is implicit the frozen balances are available too:
+      deposit, fees ot rewards. *)
+  val balance: ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t
+
+  val counter: t -> Contract.t -> Z.t tzresult Lwt.t
+  val manager: t -> Contract.t -> Account.t tzresult Lwt.t
+  val is_manager_key_revealed: t -> Contract.t -> bool tzresult Lwt.t
+
+  val delegate_opt: t -> Contract.t -> public_key_hash option tzresult Lwt.t
+
+end
+
+module Delegate : sig
+
+  type info = Delegate_services.info = {
+    balance: Tez.t ;
+    frozen_balance: Tez.t ;
+    frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+    staking_balance: Tez.t ;
+    delegated_contracts: Contract_hash.t list ;
+    delegated_balance: Tez.t ;
+    deactivated: bool ;
+    grace_period: Cycle.t ;
+  }
+
+  val info: t -> public_key_hash -> Delegate_services.info tzresult Lwt.t
+
+end
+
+(** [init n] : returns an initial block with [n] initialized accounts
+    and the associated implicit contracts *)
+val init:
+  ?slow: bool ->
+  ?preserved_cycles:int ->
+  ?endorsers_per_block:int ->
+  int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/dune b/vendors/tezos-modded/src/lib_shell/bench/helpers/dune
new file mode 100644
index 000000000..314a92056
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/dune
@@ -0,0 +1,17 @@
+(library
+ (name tezos_alpha_bench_helpers)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-shell-services
+            tezos-protocol-environment
+            tezos-protocol-alpha
+            alcotest-lwt)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml*))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.ml
new file mode 100644
index 000000000..fbb711d6d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.ml
@@ -0,0 +1,122 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t = {
+  predecessor: Block.t ;
+  state: M.validation_state ;
+  rev_operations: Operation.packed list ;
+  header: Block_header.t ;
+  delegate: Account.t ;
+}
+type incremental = t
+
+let predecessor { predecessor ; _ } = predecessor
+
+let level st = st.header.shell.level
+
+let rpc_context st =
+  let result = Alpha_context.finalize st.state.ctxt in
+  {
+    Alpha_environment.Updater.block_hash = Block_hash.zero ;
+    block_header = { st.header.shell with fitness = result.fitness } ;
+    context = result.context ;
+  }
+
+let rpc_ctxt =
+  new Alpha_environment.proto_rpc_context_of_directory
+    rpc_context Proto_alpha.rpc_services
+
+let begin_construction ?(priority=0) ?timestamp ?seed_nonce_hash (predecessor : Block.t) =
+  Block.get_next_baker ~policy:(Block.By_priority priority)
+    predecessor >>=? fun (delegate, priority, real_timestamp) ->
+  Account.find delegate >>=? fun delegate ->
+  let timestamp = Option.unopt ~default:real_timestamp timestamp in
+  let contents = Block.Forge.contents ~priority ?seed_nonce_hash () in
+  let protocol_data = {
+    Block_header.contents ;
+    signature = Signature.zero ;
+  } in
+  let header = {
+    Block_header.shell = {
+      predecessor = predecessor.hash ;
+      proto_level = predecessor.header.shell.proto_level ;
+      validation_passes = predecessor.header.shell.validation_passes ;
+      fitness = predecessor.header.shell.fitness ;
+      timestamp ;
+      level = predecessor.header.shell.level ;
+      context = Context_hash.zero ;
+      operations_hash = Operation_list_list_hash.zero ;
+    } ;
+    protocol_data = {
+      contents ;
+      signature = Signature.zero ;
+    } ;
+  } in
+  M.begin_construction
+    ~chain_id:Chain_id.zero
+    ~predecessor_context: predecessor.context
+    ~predecessor_timestamp: predecessor.header.shell.timestamp
+    ~predecessor_fitness: predecessor.header.shell.fitness
+    ~predecessor_level: predecessor.header.shell.level
+    ~predecessor:predecessor.hash
+    ~timestamp
+    ~protocol_data
+    () >>=? fun state ->
+  return {
+    predecessor ;
+    state ;
+    rev_operations = [] ;
+    header ;
+    delegate ;
+  }
+
+let add_operation st op =
+  M.apply_operation st.state op >>=? fun (state, _result) ->
+  return { st with state ; rev_operations = op :: st.rev_operations }
+
+let finalize_block st =
+  M.finalize_block st.state >>=? fun (result, _) ->
+  let operations = List.rev st.rev_operations in
+  let operations_hash =
+    Operation_list_list_hash.compute [
+      Operation_list_hash.compute (List.map Operation.hash_packed operations)
+    ] in
+  let header =
+    { st.header with
+      shell = {
+        st.header.shell with
+        operations_hash ; fitness = result.fitness ;
+        level = Int32.succ st.header.shell.level
+      } } in
+  let hash = Block_header.hash header in
+  return {
+    Block.hash ;
+    header ;
+    operations ;
+    context = result.context ;
+  }
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.mli
new file mode 100644
index 000000000..edb5eef03
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/incremental.mli
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t
+type incremental = t
+
+val predecessor: incremental -> Block.t
+
+val level: incremental -> int32
+
+val begin_construction:
+  ?priority:int ->
+  ?timestamp:Time.t ->
+  ?seed_nonce_hash: Nonce_hash.t ->
+  Block.t -> incremental tzresult Lwt.t
+
+val add_operation:
+  incremental -> Operation.packed -> incremental tzresult Lwt.t
+
+val finalize_block: incremental -> Block.t tzresult Lwt.t
+
+val rpc_ctxt: incremental Alpha_environment.RPC_context.simple
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.ml
new file mode 100644
index 000000000..c5a42bf92
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.ml
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+module Table = Hashtbl.Make(struct
+    type t = Nonce_hash.t
+    let hash h =
+      Int32.to_int (MBytes.get_int32 (Nonce_hash.to_bytes h) 0)
+    let equal = Nonce_hash.equal
+  end)
+
+let known_nonces = Table.create 17
+
+let generate () =
+  match
+    Alpha_context.Nonce.of_bytes @@
+    Rand.generate Alpha_context.Constants.nonce_length
+  with
+  | Ok nonce ->
+      let hash = Alpha_context.Nonce.hash nonce in
+      Table.add known_nonces hash nonce ;
+      (hash, nonce)
+  | Error _ -> assert false
+
+let forget_all () = Table.clear known_nonces
+let get hash = Table.find known_nonces hash
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.mli
new file mode 100644
index 000000000..d95991157
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/nonce.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+(** Returns a fresh nonce and its corresponding hash (and stores them). *)
+val generate: unit -> Nonce_hash.t * Alpha_context.Nonce.t
+val get: Nonce_hash.t -> Alpha_context.Nonce.t
+val forget_all: unit -> unit
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/op.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/op.ml
new file mode 100644
index 000000000..b478c45a0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/op.ml
@@ -0,0 +1,224 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+let sign ?(watermark = Signature.Generic_operation)
+    sk ctxt contents =
+  let branch = Context.branch ctxt in
+  let unsigned =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.unsigned_encoding
+      ({ branch }, Contents_list contents) in
+  let signature = Some (Signature.sign ~watermark sk unsigned) in
+  ({ shell = { branch } ;
+     protocol_data = {
+       contents ;
+       signature ;
+     } ;
+   } : _ Operation.t)
+
+let endorsement ?delegate ?level ctxt =
+  fun ?(signing_context=ctxt) slots ->
+    begin
+      match delegate with
+      | None -> Context.get_endorser ctxt (List.hd slots)
+      | Some delegate -> return delegate
+    end >>=? fun delegate_pkh ->
+    Account.find delegate_pkh >>=? fun delegate ->
+    begin
+      match level with
+      | None -> Context.get_level ctxt
+      | Some level -> return level
+    end >>=? fun level ->
+    let op =
+      Single
+        (Endorsement { level }) in
+    return (sign ~watermark:(Signature.Endorsement Chain_id.zero)
+              delegate.sk signing_context op)
+
+let sign ?watermark sk ctxt (Contents_list contents) =
+  Operation.pack (sign ?watermark sk ctxt contents)
+
+let manager_operation
+    ?(fee = Tez.zero)
+    ?(gas_limit = Constants_repr.default.hard_gas_limit_per_operation)
+    ?(storage_limit = Constants_repr.default.hard_storage_limit_per_operation)
+    ?public_key ~source ctxt operation =
+  Context.Contract.counter ctxt source >>=? fun counter ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let public_key = Option.unopt ~default:account.pk public_key in
+  let counter = Z.succ counter in
+  Context.Contract.is_manager_key_revealed ctxt source >>=? function
+  | true ->
+      let op =
+        Manager_operation {
+          source ;
+          fee ;
+          counter ;
+          operation ;
+          gas_limit ;
+          storage_limit ;
+        } in
+      return (Contents_list (Single op))
+  | false ->
+      let op_reveal =
+        Manager_operation {
+          source ;
+          fee = Tez.zero ;
+          counter ;
+          operation = Reveal public_key ;
+          gas_limit = Z.of_int 20 ;
+          storage_limit = Z.zero ;
+        } in
+      let op =
+        Manager_operation {
+          source ;
+          fee ;
+          counter = Z.succ counter ;
+          operation ;
+          gas_limit ;
+          storage_limit ;
+        } in
+      return (Contents_list (Cons (op_reveal, Single op)))
+
+let revelation ctxt public_key =
+  let pkh = Signature.Public_key.hash public_key in
+  let source = Contract.implicit_contract pkh in
+  Context.Contract.counter ctxt source >>=? fun counter ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let counter = Z.succ counter in
+  let sop =
+    Contents_list
+      (Single
+         (Manager_operation {
+             source ;
+             fee = Tez.zero ;
+             counter ;
+             operation = Reveal public_key ;
+             gas_limit = Z.of_int 20 ;
+             storage_limit = Z.zero ;
+           })) in
+  return @@ sign account.sk ctxt sop
+
+let originated_contract (op: Operation.packed) =
+  let nonce = Contract.initial_origination_nonce (Operation.hash_packed op) in
+  Contract.originated_contract nonce
+
+exception Impossible
+
+let origination ?delegate ?script
+    ?(spendable = true) ?(delegatable = true) ?(preorigination = None)
+    ?public_key ?manager ?credit ?fee ?gas_limit ?storage_limit ctxt source =
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let manager = Option.unopt ~default:account.pkh manager in
+  let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in
+  let default_credit = Option.unopt_exn Impossible default_credit in
+  let credit = Option.unopt ~default:default_credit credit in
+  let operation =
+    Origination {
+      manager ;
+      delegate ;
+      script ;
+      spendable ;
+      delegatable ;
+      credit ;
+      preorigination ;
+    } in
+  manager_operation ?public_key ?fee ?gas_limit ?storage_limit
+    ~source ctxt operation >>=? fun sop ->
+  let op = sign account.sk ctxt sop in
+  return (op , originated_contract op)
+
+let miss_signed_endorsement ?level ctxt slot =
+  begin
+    match level with
+    | None -> Context.get_level ctxt
+    | Some level -> return level
+  end >>=? fun level ->
+  Context.get_endorser ctxt slot >>=? fun real_delegate_pkh ->
+  let delegate = Account.find_alternate real_delegate_pkh in
+  endorsement ~delegate:delegate.pkh ~level ctxt [slot]
+
+let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt
+    (src:Contract.t) (dst:Contract.t)
+    (amount:Tez.t) =
+  let top = Transaction {
+      amount;
+      parameters;
+      destination=dst;
+    } in
+  manager_operation ?fee ?gas_limit ?storage_limit
+    ~source:src ctxt top >>=? fun sop ->
+  Context.Contract.manager ctxt src >>=? fun account ->
+  return @@ sign account.sk ctxt sop
+
+let delegation ?fee ctxt source dst =
+  let top = Delegation dst in
+  manager_operation ?fee ~source ctxt top >>=? fun sop ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  return @@ sign account.sk ctxt sop
+
+let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code =
+  begin match pkh with
+    | Ed25519 edpkh -> return edpkh
+    | _ -> failwith "Wrong public key hash : %a - Commitments must be activated with an Ed25519 \
+                     encrypted public key hash" Signature.Public_key_hash.pp pkh
+  end >>=? fun id ->
+  let contents =
+    Single (Activate_account { id ; activation_code } ) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
+
+let double_endorsement ctxt op1 op2 =
+  let contents =
+    Single (Double_endorsement_evidence {op1 ; op2}) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
+
+let double_baking ctxt bh1 bh2 =
+  let contents =
+    Single (Double_baking_evidence {bh1 ; bh2}) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/op.mli b/vendors/tezos-modded/src/lib_shell/bench/helpers/op.mli
new file mode 100644
index 000000000..d32266c8e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/op.mli
@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val endorsement:
+  ?delegate:public_key_hash ->
+  ?level:Raw_level.t ->
+  Context.t -> ?signing_context:Context.t ->
+  int list -> Kind.endorsement Operation.t tzresult Lwt.t
+
+val miss_signed_endorsement:
+  ?level:Raw_level.t ->
+  Context.t -> int -> Kind.endorsement Operation.t tzresult Lwt.t
+
+val transaction:
+  ?fee:Tez.tez ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  ?parameters:Script.lazy_expr ->
+  Context.t ->
+  Contract.t ->
+  Contract.t ->
+  Tez.t ->
+  Operation.packed tzresult Lwt.t
+
+val delegation:
+  ?fee:Tez.tez -> Context.t ->
+  Contract.t -> public_key_hash option ->
+  Operation.packed tzresult Lwt.t
+
+val revelation:
+  Context.t -> public_key -> Operation.packed tzresult Lwt.t
+
+val origination:
+  ?delegate:public_key_hash ->
+  ?script:Script.t ->
+  ?spendable:bool ->
+  ?delegatable:bool ->
+  ?preorigination: Contract.contract option ->
+  ?public_key:public_key ->
+  ?manager:public_key_hash ->
+  ?credit:Tez.tez ->
+  ?fee:Tez.tez ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  Context.t ->
+  Contract.contract ->
+  (Operation.packed * Contract.contract) tzresult Lwt.t
+
+val originated_contract:
+  Operation.packed -> Contract.contract
+
+val double_endorsement:
+  Context.t ->
+  Kind.endorsement Operation.t ->
+  Kind.endorsement Operation.t ->
+  Operation.packed tzresult Lwt.t
+
+val double_baking:
+  Context.t ->
+  Block_header.block_header ->
+  Block_header.block_header ->
+  Operation.packed tzresult Lwt.t
+
+val activation:
+  Context.t ->
+  Signature.Public_key_hash.t -> Blinded_public_key_hash.activation_code ->
+  Operation.packed tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/proto_alpha.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/proto_alpha.ml
new file mode 100644
index 000000000..5bfe3f514
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/proto_alpha.ml
@@ -0,0 +1,39 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Name = struct let name = "alpha" end
+module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)()
+
+type alpha_error = Alpha_environment.Error_monad.error
+type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
+
+module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+module Block_services = struct
+  include Block_services
+  include Block_services.Make(Proto)(Proto)
+end
+include Proto
+
+module M = Alpha_environment.Lift(Main)
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/test.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/test.ml
new file mode 100644
index 000000000..63d256388
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/test.ml
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Wraps an alcotest so that it prints correcly errors from the Error_monad. *)
+let tztest name speed f =
+  Alcotest_lwt.test_case name speed begin fun _sw () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error err ->
+        Tezos_stdlib_unix.Logging_unix.close () >>= fun () ->
+        Format.eprintf "WWW %a@." pp_print_error err ;
+        Lwt.fail Alcotest.Test_error
+  end
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/test_tez.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/test_tez.ml
new file mode 100644
index 000000000..5d2aeb67a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/test_tez.ml
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Alpha_environment
+
+(* This module is mostly to wrap the errors from the protocol *)
+module Tez = struct
+  include Tez
+
+  let ( +? ) t1 t2 = (t1 +? t2) |> wrap_error
+  let ( -? ) t1 t2 = (t1 -? t2) |> wrap_error
+  let ( *? ) t1 t2 = (t1 *? t2) |> wrap_error
+  let ( /? ) t1 t2 = (t1 /? t2) |> wrap_error
+
+  let ( + ) t1 t2 =
+    match t1 +? t2 with
+    | Ok r -> r
+    | Error _ ->
+        Pervasives.failwith "adding tez"
+
+  let of_int x =
+    match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with
+    | None -> invalid_arg "tez_of_int"
+    | Some x -> x
+end
diff --git a/vendors/tezos-modded/src/lib_shell/bench/helpers/test_utils.ml b/vendors/tezos-modded/src/lib_shell/bench/helpers/test_utils.ml
new file mode 100644
index 000000000..e71947bc7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bench/helpers/test_utils.ml
@@ -0,0 +1,43 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* This file should not depend on any other file from tests. *)
+
+let (>>?=) x y = match x with
+  | Ok(a) -> y a
+  | Error(b) -> fail @@ List.hd b
+
+(** Like List.find but returns the index of the found element *)
+let findi p =
+  let rec aux p i = function
+    | [] -> raise Not_found
+    | x :: l -> if p x then (x,i) else aux p (i+1) l
+  in
+  aux p 0
+
+exception Pair_of_list
+let pair_of_list = function
+  | [a;b] -> a,b
+  | _ -> raise Pair_of_list
diff --git a/vendors/tezos-modded/src/lib_shell/block_directory.ml b/vendors/tezos-modded/src/lib_shell/block_directory.ml
new file mode 100644
index 000000000..c9b7a8db7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_directory.ml
@@ -0,0 +1,374 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 rec read_partial_context context path depth =
+  (* non tail-recursive *)
+  if depth = 0 then
+    Lwt.return Block_services.Cut
+  else
+    (* try to read as file *)
+    Context.get context path >>= function
+    | Some v ->
+        Lwt.return (Block_services.Key v)
+    | None ->
+        (* try to read as directory *)
+        Context.fold context path ~init:[] ~f: begin fun k acc ->
+          match k with
+          | `Key k | `Dir k ->
+              read_partial_context context k (depth-1) >>= fun v ->
+              let k = List.nth k ((List.length k)-1) in
+              Lwt.return ((k,v)::acc)
+        end >>= fun l ->
+        Lwt.return (Block_services.Dir (List.rev l))
+
+let build_raw_rpc_directory
+    (module Proto : Block_services.PROTO)
+    (module Next_proto : Registered_protocol.T) =
+
+  let dir : State.Block.t RPC_directory.t ref =
+    ref RPC_directory.empty in
+
+  let register0 s f =
+    dir :=
+      RPC_directory.register !dir (RPC_service.subst0 s)
+        (fun block p q -> f block p q) in
+  let register1 s f =
+    dir :=
+      RPC_directory.register !dir (RPC_service.subst1 s)
+        (fun (block, a) p q -> f block a p q) in
+  let register2 s f =
+    dir :=
+      RPC_directory.register !dir (RPC_service.subst2 s)
+        (fun ((block, a), b) p q -> f block a b p q) in
+
+  let module Block_services = Block_services.Make(Proto)(Next_proto) in
+  let module S = Block_services.S in
+
+  register0 S.hash begin fun block () () ->
+    return (State.Block.hash block)
+  end ;
+
+  register0 S.live_blocks begin fun block () () ->
+    Chain_traversal.live_blocks
+      block
+      (State.Block.max_operations_ttl block)
+    >>= fun (live_blocks, _) ->
+    return live_blocks
+  end ;
+
+  (* block header *)
+
+  register0 S.header begin fun block () () ->
+    let chain_id = State.Block.chain_id block in
+    let hash = State.Block.hash block in
+    let header = State.Block.header block in
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.block_header_data_encoding
+        header.protocol_data in
+    return { Block_services.hash ; chain_id ;
+             shell = header.shell ; protocol_data }
+  end ;
+  register0 S.raw_header begin fun block () () ->
+    let header = State.Block.header block in
+    return (Data_encoding.Binary.to_bytes_exn Block_header.encoding header)
+  end ;
+  register0 S.Header.shell_header begin fun block () () ->
+    return (State.Block.header block).shell
+  end ;
+  register0 S.Header.protocol_data begin fun block () () ->
+    let header = State.Block.header block in
+    return
+      (Data_encoding.Binary.of_bytes_exn
+         Proto.block_header_data_encoding
+         header.protocol_data)
+  end ;
+  register0 S.Header.raw_protocol_data begin fun block () () ->
+    let header = State.Block.header block in
+    return header.protocol_data
+  end ;
+
+  (* block metadata *)
+
+  let metadata block =
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.block_header_metadata_encoding
+        (State.Block.metadata block) in
+    State.Block.test_chain block >>= fun test_chain_status ->
+    return {
+      Block_services.protocol_data ;
+      test_chain_status ;
+      max_operations_ttl = State.Block.max_operations_ttl block ;
+      max_operation_data_length = Next_proto.max_operation_data_length ;
+      max_block_header_length = Next_proto.max_block_length ;
+      operation_list_quota =
+        List.map
+          (fun { Tezos_protocol_environment_shell.max_size; max_op } ->
+             { Tezos_shell_services.Block_services.max_size ; max_op } )
+          Next_proto.validation_passes ;
+    } in
+
+  register0 S.metadata begin fun block () () ->
+    metadata block
+  end ;
+
+  (* operations *)
+
+  let convert chain_id (op : Operation.t) metadata : Block_services.operation =
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.operation_data_encoding
+        op.proto in
+    let receipt =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.operation_receipt_encoding
+        metadata in
+    { Block_services.chain_id ;
+      hash = Operation.hash op ;
+      shell = op.shell ;
+      protocol_data ;
+      receipt ;
+    } in
+
+  let operations block =
+    State.Block.all_operations block >>= fun ops ->
+    State.Block.all_operations_metadata block >>= fun metadata ->
+    let chain_id = State.Block.chain_id block in
+    return (List.map2 (List.map2 (convert chain_id)) ops metadata) in
+
+  register0 S.Operations.operations begin fun block () () ->
+    operations block
+  end ;
+
+  register1 S.Operations.operations_in_pass begin fun block i () () ->
+    let chain_id = State.Block.chain_id block in
+    try
+      State.Block.operations block i >>= fun (ops, _path) ->
+      State.Block.operations_metadata block i >>= fun metadata ->
+      return (List.map2 (convert chain_id) ops metadata)
+    with _ -> Lwt.fail Not_found
+  end ;
+
+  register2 S.Operations.operation begin fun block i j () () ->
+    let chain_id = State.Block.chain_id block in
+    begin try
+        State.Block.operations block i >>= fun (ops, _path) ->
+        State.Block.operations_metadata block i >>= fun metadata ->
+        Lwt.return (List.nth ops j, List.nth metadata j)
+      with _ -> Lwt.fail Not_found end >>= fun (op, md) ->
+    return (convert chain_id op md)
+  end ;
+
+  (* operation_hashes *)
+
+  register0 S.Operation_hashes.operation_hashes begin fun block () () ->
+    State.Block.all_operation_hashes block >>= return
+  end ;
+
+  register1 S.Operation_hashes.operation_hashes_in_pass begin fun block i () () ->
+    State.Block.operation_hashes block i >>= fun (ops, _) ->
+    return ops
+  end ;
+
+  register2 S.Operation_hashes.operation_hash begin fun block i j () () ->
+    begin try
+        State.Block.operation_hashes block i >>= fun (ops, _) ->
+        Lwt.return (List.nth ops j)
+      with _ -> Lwt.fail Not_found end >>= fun op ->
+    return op
+  end ;
+
+  (* context *)
+
+  register1 S.Context.read begin fun block path q () ->
+    let depth = Option.unopt ~default:max_int q#depth in
+    fail_unless (depth >= 0)
+      (Tezos_shell_services.Block_services.Invalid_depth_arg depth) >>=? fun () ->
+    State.Block.context block >>= fun context ->
+    Context.mem context path >>= fun mem ->
+    Context.dir_mem context path >>= fun dir_mem ->
+    if not (mem || dir_mem) then
+      Lwt.fail Not_found
+    else
+      read_partial_context context path depth >>= fun dir ->
+      return dir
+  end ;
+
+  (* info *)
+
+  register0 S.info begin fun block () () ->
+    let chain_id = State.Block.chain_id block in
+    let hash = State.Block.hash block in
+    let header = State.Block.header block in
+    let shell = header.shell in
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.block_header_data_encoding
+        header.protocol_data in
+    metadata block >>=? fun metadata ->
+    operations block >>=? fun operations ->
+    return { Block_services.hash ; chain_id ;
+             header = { shell ; protocol_data } ;
+             metadata ; operations }
+  end ;
+
+  (* helpers *)
+
+  register0 S.Helpers.Forge.block_header begin fun _block () header ->
+    return (Data_encoding.Binary.to_bytes_exn Block_header.encoding header)
+  end ;
+
+  register0 S.Helpers.Preapply.block begin fun block q p ->
+    let timestamp =
+      match q#timestamp with
+      | None -> Time.now ()
+      | Some time -> time in
+    let protocol_data =
+      Data_encoding.Binary.to_bytes_exn
+        Next_proto.block_header_data_encoding
+        p.protocol_data in
+    let operations =
+      List.map
+        (List.map
+           (fun op ->
+              let proto =
+                Data_encoding.Binary.to_bytes_exn
+                  Next_proto.operation_data_encoding
+                  op.Next_proto.protocol_data in
+              { Operation.shell = op.shell ; proto }))
+        p.operations in
+    Prevalidation.preapply
+      ~predecessor:block
+      ~timestamp
+      ~protocol_data
+      operations
+  end ;
+
+  register0 S.Helpers.Preapply.operations begin fun block () ops ->
+    State.Block.context block >>= fun ctxt ->
+    let predecessor = State.Block.hash block in
+    let header = State.Block.shell_header block in
+    Next_proto.begin_construction
+      ~chain_id: (State.Block.chain_id block)
+      ~predecessor_context:ctxt
+      ~predecessor_timestamp:header.timestamp
+      ~predecessor_level:header.level
+      ~predecessor_fitness:header.fitness
+      ~predecessor
+      ~timestamp:(Time.now ()) () >>=? fun state ->
+    fold_left_s
+      (fun (state, acc) op ->
+         Next_proto.apply_operation state op >>=? fun (state, result) ->
+         return (state, (op.protocol_data, result) :: acc))
+      (state, []) ops >>=? fun (state, acc) ->
+    Next_proto.finalize_block state >>=? fun _ ->
+    return (List.rev acc)
+  end ;
+
+  register1 S.Helpers.complete begin fun block prefix () () ->
+    State.Block.context block >>= fun ctxt ->
+    Base58.complete prefix >>= fun l1 ->
+    Next_proto.complete_b58prefix ctxt prefix >>= fun l2 ->
+    return (l1 @ l2)
+  end ;
+
+  (* merge protocol rpcs... *)
+
+  RPC_directory.merge
+    !dir
+    (RPC_directory.map
+       (fun block ->
+          State.Block.context block >|= fun context ->
+          { Tezos_protocol_environment_shell.
+            block_hash = State.Block.hash block ;
+            block_header = State.Block.shell_header block ;
+            context })
+       Next_proto.rpc_services)
+
+let get_protocol hash =
+  match Registered_protocol.get hash with
+  | None -> raise Not_found
+  | Some protocol -> protocol
+
+let get_directory block =
+  State.Block.get_rpc_directory block >>= function
+  | Some dir -> Lwt.return dir
+  | None ->
+      State.Block.protocol_hash block >>= fun next_protocol_hash ->
+      let next_protocol = get_protocol next_protocol_hash in
+      State.Block.predecessor block >>= function
+      | None ->
+          Lwt.return (build_raw_rpc_directory
+                        (module Block_services.Fake_protocol)
+                        next_protocol)
+      | Some pred ->
+          State.Block.protocol_hash pred >>= fun protocol_hash ->
+          let (module Proto) = get_protocol protocol_hash in
+          State.Block.get_rpc_directory block >>= function
+          | Some dir -> Lwt.return dir
+          | None ->
+              let dir = build_raw_rpc_directory (module Proto) next_protocol in
+              State.Block.set_rpc_directory block dir >>= fun () ->
+              Lwt.return dir
+
+let get_block chain_state = function
+  | `Genesis ->
+      Chain.genesis chain_state
+  |  `Head n ->
+      Chain.head chain_state >>= fun head ->
+      if n < 0 then
+        Lwt.fail Not_found
+      else if n = 0 then
+        Lwt.return head
+      else
+        State.Block.read_exn chain_state ~pred:n (State.Block.hash head)
+  | `Hash (hash, n) ->
+      if n < 0 then
+        State.Block.read_exn chain_state hash >>= fun block ->
+        Chain.head chain_state >>= fun head ->
+        let head_level = State.Block.level head in
+        let block_level = State.Block.level block in
+        let target =
+          Int32.(to_int (sub head_level (sub block_level (of_int n)))) in
+        if target < 0 then
+          Lwt.fail Not_found
+        else
+          State.Block.read_exn chain_state ~pred:target (State.Block.hash head)
+      else
+        State.Block.read_exn chain_state ~pred:n hash
+  | `Level i ->
+      Chain.head chain_state >>= fun head ->
+      let target = Int32.(to_int (sub (State.Block.level head) i)) in
+      if target < 0 then
+        Lwt.fail Not_found
+      else
+        State.Block.read_exn chain_state ~pred:target (State.Block.hash head)
+
+let build_rpc_directory chain_state block =
+  get_block chain_state block >>= fun block ->
+  get_directory block >>= fun dir ->
+  Lwt.return (RPC_directory.map (fun _ -> Lwt.return block) dir)
+
diff --git a/vendors/tezos-modded/src/lib_shell/block_directory.mli b/vendors/tezos-modded/src/lib_shell/block_directory.mli
new file mode 100644
index 000000000..4097b1ac8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_directory.mli
@@ -0,0 +1,36 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 get_block: State.Chain.t -> Block_services.block -> State.Block.t Lwt.t
+
+val build_raw_rpc_directory:
+  (module Block_services.PROTO) ->
+  (module Registered_protocol.T) ->
+  State.Block.t RPC_directory.directory
+
+val build_rpc_directory:
+  State.Chain.t ->
+  Block_services.block ->
+  'a RPC_directory.t Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/block_validator.ml b/vendors/tezos-modded/src/lib_shell/block_validator.ml
new file mode 100644
index 000000000..9a2462e64
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_validator.ml
@@ -0,0 +1,268 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Block_validator_worker_state
+open Block_validator_errors
+
+type limits = {
+  protocol_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+
+type validator_kind = Block_validator_process.validator_kind =
+  | Internal of Context.index
+
+module Name = struct
+  type t = unit
+  let encoding = Data_encoding.empty
+  let base = [ "validator.block" ]
+  let pp _ () = ()
+end
+
+module Types = struct
+  include Worker_state
+  type state = {
+    protocol_validator: Protocol_validator.t ;
+    validation_process: Block_validator_process.t ;
+    limits : limits ;
+  }
+  type parameters = limits * Distributed_db.t * Block_validator_process.validator_kind
+  let view _state _parameters = ()
+end
+
+module Request = struct
+  include Request
+  type 'a t =
+    | Request_validation : {
+        chain_db: Distributed_db.chain_db ;
+        notify_new_block: State.Block.t -> unit ;
+        canceler: Lwt_canceler.t option ;
+        peer: P2p_peer.Id.t option ;
+        hash: Block_hash.t ;
+        header: Block_header.t ;
+        operations: Operation.t list list ;
+      } -> State.Block.t option tzresult t
+  let view
+    : type a. a t -> view
+    = fun (Request_validation { chain_db ; peer ; hash }) ->
+      let chain_id = chain_db |> Distributed_db.chain_state |> State.Chain.id in
+      { chain_id ; block = hash ; peer = peer }
+end
+
+module Worker = Worker.Make (Name) (Event) (Request) (Types)
+
+type t = Worker.infinite Worker.queue Worker.t
+
+let debug w =
+  Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
+
+let check_chain_liveness chain_db hash (header: Block_header.t) =
+  let chain_state = Distributed_db.chain_state chain_db in
+  match State.Chain.expiration chain_state with
+  | Some eol when Time.(eol <= header.shell.timestamp) ->
+      fail @@ invalid_block hash @@
+      Expired_chain { chain_id = State.Chain.id chain_state ;
+                      expiration = eol ;
+                      timestamp = header.shell.timestamp }
+  | None | Some _ -> return_unit
+
+let get_proto pred hash =
+  State.Block.context pred >>= fun pred_context ->
+  Context.get_protocol pred_context >>= fun pred_protocol_hash ->
+  match Registered_protocol.get pred_protocol_hash with
+  | None ->
+      fail (Unavailable_protocol { block = hash ;
+                                   protocol = pred_protocol_hash })
+  | Some p -> return p
+
+
+let on_request
+  : type r. t -> r Request.t -> r tzresult Lwt.t
+  = fun w
+    (Request.Request_validation
+       { chain_db ; notify_new_block ; canceler ;
+         peer ; hash ; header ; operations }) ->
+    let bv = Worker.state w in
+    let chain_state = Distributed_db.chain_state chain_db in
+    State.Block.read_opt chain_state hash >>= function
+    | Some block ->
+        debug w "previously validated block %a (after pipe)"
+          Block_hash.pp_short hash ;
+        Protocol_validator.prefetch_and_compile_protocols
+          bv.protocol_validator
+          ?peer ~timeout:bv.limits.protocol_timeout
+          block ;
+        return (Ok None)
+    | None ->
+        State.Block.read_invalid chain_state hash >>= function
+        | Some { errors } ->
+            return (Error errors)
+        | None ->
+            begin
+              debug w "validating block %a" Block_hash.pp_short hash ;
+              State.Block.read
+                chain_state header.shell.predecessor >>=? fun pred ->
+              (* TODO also protect with [Worker.canceler w]. *)
+              protect ?canceler begin fun () ->
+                Block_validator_process.apply_block
+                  bv.validation_process
+                  ~predecessor:pred
+                  header operations >>=? fun { validation_result ; block_metadata ;
+                                               ops_metadata ; context_hash } ->
+                let validation_store =
+                  ({ context_hash ;
+                     message = validation_result.message ;
+                     max_operations_ttl =  validation_result.max_operations_ttl ;
+                     last_allowed_fork_level = validation_result.last_allowed_fork_level} :
+                     State.Block.validation_store) in
+                Distributed_db.commit_block
+                  chain_db hash
+                  header block_metadata operations ops_metadata
+                  validation_store >>=? function
+                | None -> assert false (* should not happen *)
+                | Some block -> return block
+              end
+            end >>= function
+            | Ok block ->
+                Protocol_validator.prefetch_and_compile_protocols
+                  bv.protocol_validator
+                  ?peer ~timeout:bv.limits.protocol_timeout
+                  block ;
+                notify_new_block block ;
+                return (Ok (Some block))
+            | Error [ Canceled | Unavailable_protocol _ | System_error _ ] as err ->
+                (* FIXME: Canceled can escape. Canceled is not registered. BOOM! *)
+                return err
+            | Error errors ->
+                Worker.protect w begin fun () ->
+                  Distributed_db.commit_invalid_block
+                    chain_db hash header errors
+                end >>=? fun commited ->
+                assert commited ;
+                return (Error errors)
+
+let on_launch _ _ (limits, db, validation_kind) =
+  let protocol_validator = Protocol_validator.create db in
+  Block_validator_process.init validation_kind >>= fun validation_process ->
+  return { Types.protocol_validator ; validation_process ; limits }
+
+let on_error w r st errs =
+  Worker.record_event w (Validation_failure (r, st, errs)) ;
+  Lwt.return (Error errs)
+
+let on_completion
+  : type a. t -> a Request.t -> a -> Worker_types.request_status -> unit Lwt.t
+  = fun w (Request.Request_validation _ as r) v st ->
+    match v with
+    | Ok (Some _) ->
+        Worker.record_event w
+          (Event.Validation_success (Request.view r, st)) ;
+        Lwt.return_unit
+    | Ok None ->
+        Lwt.return_unit
+    | Error errs ->
+        Worker.record_event w
+          (Event.Validation_failure (Request.view r, st, errs)) ;
+        Lwt.return_unit
+
+let on_close w =
+  let bv = Worker.state w in
+  Block_validator_process.close bv.validation_process
+
+let table = Worker.create_table Queue
+
+let create limits db validation_process_kind =
+  let module Handlers = struct
+    type self = t
+    let on_launch = on_launch
+    let on_request = on_request
+    let on_close = on_close
+    let on_error = on_error
+    let on_completion = on_completion
+    let on_no_request _ = return_unit
+  end in
+  Worker.launch
+    table
+    limits.worker_limits
+    ()
+    (limits, db, validation_process_kind)
+    (module Handlers)
+
+let shutdown = Worker.shutdown
+
+let validate w
+    ?canceler ?peer ?(notify_new_block = fun _ -> ())
+    chain_db hash (header : Block_header.t) operations =
+  let bv = Worker.state w in
+  let chain_state = Distributed_db.chain_state chain_db in
+  State.Block.read_opt chain_state hash >>= function
+  | Some block ->
+      debug w "previously validated block %a (before pipe)"
+        Block_hash.pp_short hash ;
+      Protocol_validator.prefetch_and_compile_protocols
+        bv.protocol_validator
+        ?peer ~timeout:bv.limits.protocol_timeout
+        block ;
+      return_none
+  | None ->
+      map_p (map_p (fun op ->
+          let op_hash = Operation.hash op in
+          return op_hash))
+        operations >>=? fun hashes ->
+      let computed_hash =
+        Operation_list_list_hash.compute
+          (List.map Operation_list_hash.compute hashes) in
+      fail_when
+        (Operation_list_list_hash.compare
+           computed_hash header.shell.operations_hash <> 0)
+        (Inconsistent_operations_hash {
+            block = hash ;
+            expected = header.shell.operations_hash ;
+            found = computed_hash ;
+          }) >>=? fun () ->
+      check_chain_liveness chain_db hash header >>=? fun () ->
+      Worker.push_request_and_wait w
+        (Request_validation
+           { chain_db ; notify_new_block ; canceler ;
+             peer ; hash ; header ; operations }) >>=? fun result ->
+      Lwt.return result
+
+let fetch_and_compile_protocol w =
+  let bv = Worker.state w in
+  Protocol_validator.fetch_and_compile_protocol bv.protocol_validator
+
+let status = Worker.status
+
+let running_worker () =
+  match Worker.list table with
+  | (_, single) :: _ -> single
+  | [] -> raise Not_found
+
+let pending_requests t = Worker.pending_requests t
+
+let current_request t = Worker.current_request t
+
+let last_events = Worker.last_events
diff --git a/vendors/tezos-modded/src/lib_shell/block_validator.mli b/vendors/tezos-modded/src/lib_shell/block_validator.mli
new file mode 100644
index 000000000..88d231680
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_validator.mli
@@ -0,0 +1,63 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+type limits = {
+  protocol_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+
+type validator_kind =
+  | Internal of Context.index
+
+val create:
+  limits ->  Distributed_db.t -> validator_kind ->
+  t tzresult Lwt.t
+
+val validate:
+  t ->
+  ?canceler:Lwt_canceler.t ->
+  ?peer:P2p_peer.Id.t ->
+  ?notify_new_block:(State.Block.t -> unit) ->
+  Distributed_db.chain_db ->
+  Block_hash.t -> Block_header.t -> Operation.t list list ->
+  State.Block.t option tzresult Lwt.t
+
+val fetch_and_compile_protocol:
+  t ->
+  ?peer:P2p_peer.Id.t ->
+  ?timeout:float ->
+  Protocol_hash.t -> Registered_protocol.t tzresult Lwt.t
+
+val shutdown: t -> unit Lwt.t
+
+val running_worker: unit -> t
+val status: t -> Worker_types.worker_status
+
+val pending_requests : t -> (Time.t * Block_validator_worker_state.Request.view) list
+val current_request : t -> (Time.t * Time.t * Block_validator_worker_state.Request.view) option
+val last_events : t -> (Lwt_log_core.level * Block_validator_worker_state.Event.t list) list
diff --git a/vendors/tezos-modded/src/lib_shell/block_validator_process.ml b/vendors/tezos-modded/src/lib_shell/block_validator_process.ml
new file mode 100644
index 000000000..bfa93d331
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_validator_process.ml
@@ -0,0 +1,106 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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 get_context index hash =
+  Context.checkout index hash >>= function
+  | None -> fail (Block_validator_errors.Failed_to_checkout_context hash)
+  | Some ctx -> return ctx
+
+(** The standard block validation method *)
+module Seq_validator = struct
+
+  include Logging.Make (struct let name = "validation_process.sequential" end)
+
+  type validation_context = {
+    context_index : Context.index ;
+  }
+
+  type t = validation_context
+
+  let init context_index =
+    lwt_log_notice "Intialized" >>= fun () ->
+    Lwt.return { context_index }
+
+  let close _ =
+    lwt_log_notice "Shutting down ..." >>= fun () ->
+    Lwt.return_unit
+
+  let apply_block
+      validator_process
+      chain_id
+      ~max_operations_ttl
+      ~(predecessor_block_header : Block_header.t)
+      ~block_header
+      operations =
+    get_context validator_process.context_index
+      predecessor_block_header.shell.context >>=? fun predecessor_context ->
+    Block_validation.apply
+      chain_id
+      ~max_operations_ttl
+      ~predecessor_block_header
+      ~predecessor_context
+      ~block_header
+      operations
+
+end
+
+type validator_kind =
+  | Internal of Context.index
+
+type t =
+  | Sequential of Seq_validator.t
+
+let init = function
+  | Internal index ->
+      Seq_validator.init index >>= fun v ->
+      Lwt.return (Sequential v)
+
+let close = function
+  | Sequential vp -> Seq_validator.close vp
+
+let apply_block bvp ~predecessor block_header operations =
+  let chain_state = State.Block.chain_state predecessor in
+  let chain_id = State.Block.chain_id predecessor in
+  let predecessor_block_header = State.Block.header predecessor in
+  let max_operations_ttl = State.Block.max_operations_ttl predecessor in
+  let block_hash = Block_header.hash block_header in
+  begin
+    Chain.data chain_state >>= fun chain_data ->
+    if State.Block.equal chain_data.current_head predecessor then
+      Lwt.return (chain_data.live_blocks, chain_data.live_operations)
+    else
+      Chain_traversal.live_blocks
+        predecessor (State.Block.max_operations_ttl predecessor)
+  end >>= fun (live_blocks, live_operations) ->
+  Block_validation.check_liveness
+    ~live_operations ~live_blocks block_hash operations >>=? fun () ->
+  match bvp with
+  | Sequential vp ->
+      Seq_validator.apply_block vp
+        ~max_operations_ttl
+        chain_id ~predecessor_block_header
+        ~block_header operations
+
diff --git a/vendors/tezos-modded/src/lib_shell/block_validator_process.mli b/vendors/tezos-modded/src/lib_shell/block_validator_process.mli
new file mode 100644
index 000000000..dacb85125
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/block_validator_process.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type validator_kind =
+  | Internal of Context.index
+
+type t
+
+val init : validator_kind -> t Lwt.t
+val close : t -> unit Lwt.t
+
+val apply_block :
+  t ->
+  predecessor:State.Block.t ->
+  Block_header.t ->
+  Operation.t list list ->
+  Block_validation.result tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.ml b/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.ml
new file mode 100644
index 000000000..c5f0a18c1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.ml
@@ -0,0 +1,349 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make_semantic(struct let name = "node.validator.bootstrap_pipeline" end)
+
+let node_time_tag = Tag.def ~doc:"local time at this node" "node_time" Time.pp_hum
+let block_time_tag = Tag.def ~doc:"claimed creation time of block" "block_time" Time.pp_hum
+
+open Validation_errors
+
+type t = {
+  canceler: Lwt_canceler.t ;
+  block_header_timeout: float ;
+  block_operations_timeout: float ;
+  mutable headers_fetch_worker: unit Lwt.t ;
+  mutable operations_fetch_worker: unit Lwt.t ;
+  mutable validation_worker: unit Lwt.t ;
+  peer_id: P2p_peer.Id.t ;
+  chain_db: Distributed_db.chain_db ;
+  locator: Block_locator.t ;
+  block_validator: Block_validator.t ;
+  notify_new_block: State.Block.t -> unit ;
+  fetched_headers:
+    (Block_hash.t * Block_header.t) Lwt_pipe.t ;
+  fetched_blocks:
+    (Block_hash.t * Block_header.t * Operation.t list list tzresult Lwt.t) Lwt_pipe.t ;
+  (* HACK, a worker should be able to return the 'error'. *)
+  mutable errors: Error_monad.error list ;
+}
+
+let operations_index_tag = Tag.def ~doc:"Operations index" "operations_index" Format.pp_print_int
+
+let assert_acceptable_header pipeline
+    hash (header : Block_header.t) =
+  let chain_state = Distributed_db.chain_state pipeline.chain_db in
+  let time_now = Time.now () in
+  fail_unless
+    (Time.(add time_now 15L >= header.shell.timestamp))
+    (Future_block_header { block = hash; time = time_now;
+                           block_time = header.shell.timestamp }) >>=? fun () ->
+  State.Chain.checkpoint chain_state >>= fun (checkpoint_level, checkpoint) ->
+  fail_when
+    (Int32.equal header.shell.level checkpoint_level &&
+     not (Block_hash.equal checkpoint hash))
+    (Checkpoint_error (hash, Some pipeline.peer_id)) >>=? fun () ->
+  Chain.head chain_state >>= fun head ->
+  let checkpoint_reached = (State.Block.header head).shell.level >= checkpoint_level in
+  if checkpoint_reached then
+    (* If reached the checkpoint, every block before the checkpoint
+       must be part of the chain. *)
+    if header.shell.level <= checkpoint_level then
+      Chain.mem chain_state hash >>= fun in_chain ->
+      fail_unless in_chain
+        (Checkpoint_error (hash, Some pipeline.peer_id)) >>=? fun () ->
+      return_unit
+    else
+      return_unit
+  else
+    return_unit
+
+let fetch_step pipeline (step : Block_locator.step)  =
+  lwt_log_info Tag.DSL.(fun f ->
+      f "fetching step %a -> %a (%a) from peer %a."
+      -% t event "fetching_step_from_peer"
+      -% a Block_hash.Logging.tag step.block
+      -% a Block_hash.Logging.predecessor_tag step.predecessor
+      -% a (Tag.def ~doc:"" "" Block_locator.pp_step) step
+      -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+  let rec fetch_loop acc hash cpt =
+    Lwt_unix.yield () >>= fun () ->
+    if cpt < 0 then
+      lwt_log_info Tag.DSL.(fun f ->
+          f "invalid step from peer %a (too long)."
+          -% t event "step_too_long"
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      fail (Invalid_locator (pipeline.peer_id, pipeline.locator))
+    else if Block_hash.equal hash step.predecessor then
+      if step.strict_step && cpt <> 0 then
+        lwt_log_info Tag.DSL.(fun f ->
+            f "invalid step from peer %a (too short)."
+            -% t event "step_too_short"
+            -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+        fail (Invalid_locator (pipeline.peer_id, pipeline.locator))
+      else
+        return acc
+    else
+      lwt_debug Tag.DSL.(fun f ->
+          f "fetching block header %a from peer %a."
+          -% t event "fetching_block_header_from_peer"
+          -% a Block_hash.Logging.tag hash
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      protect ~canceler:pipeline.canceler begin fun () ->
+        Distributed_db.Block_header.fetch
+          ~timeout:pipeline.block_header_timeout
+          pipeline.chain_db ~peer:pipeline.peer_id
+          hash ()
+      end >>=? fun header ->
+      assert_acceptable_header pipeline hash header >>=? fun () ->
+      lwt_debug Tag.DSL.(fun f ->
+          f "fetched block header %a from peer %a."
+          -% t event "fetched_block_header_from_peer"
+          -% a Block_hash.Logging.tag hash
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      fetch_loop ((hash, header) :: acc) header.shell.predecessor (cpt - 1)
+  in
+  fetch_loop [] step.block step.step >>=? fun headers ->
+  iter_s
+    begin fun header ->
+      protect ~canceler:pipeline.canceler begin fun () ->
+        Lwt_pipe.push pipeline.fetched_headers header >>= return
+      end
+    end
+    headers >>=? fun () ->
+  return_unit
+
+let headers_fetch_worker_loop pipeline =
+  begin
+    let sender_id = Distributed_db.my_peer_id pipeline.chain_db in
+    (* sender and receiver are inverted here because they are from
+       the point of view of the node sending the locator *)
+    let seed = {Block_locator.sender_id=pipeline.peer_id; receiver_id=sender_id } in
+    let steps = Block_locator.to_steps seed pipeline.locator in
+    iter_s (fetch_step pipeline) steps >>=? fun () ->
+    return_unit
+  end >>= function
+  | Ok () ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "fetched all steps from peer %a."
+          -% t event "fetched_all_steps_from_peer"
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      Lwt_pipe.close pipeline.fetched_headers ;
+      Lwt.return_unit
+  | Error [Exn Lwt.Canceled | Canceled | Exn Lwt_pipe.Closed] ->
+      Lwt.return_unit
+  | Error [ Distributed_db.Block_header.Timeout bh ] ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "request for header %a from peer %a timed out."
+          -% t event "header_request_timeout"
+          -% a Block_hash.Logging.tag bh
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+  | Error [ Future_block_header { block; block_time; time } ] ->
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "Block locator %a from peer %a contains future blocks. \
+             local time: %a, block time: %a"
+          -% t event "locator_contains_future_blocks"
+          -% a Block_hash.Logging.tag block
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id
+          -% a node_time_tag time
+          -% a block_time_tag block_time) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+  | Error err ->
+      pipeline.errors <- pipeline.errors @ err ;
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[Unexpected error (headers fetch):@ %a@]"
+          -% t event "unexpected_error"
+          -% a errs_tag err) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+
+let rec operations_fetch_worker_loop pipeline =
+  begin
+    Lwt_unix.yield () >>= fun () ->
+    protect ~canceler:pipeline.canceler begin fun () ->
+      Lwt_pipe.pop pipeline.fetched_headers >>= return
+    end >>=? fun (hash, header) ->
+    lwt_log_info Tag.DSL.(fun f ->
+        f "fetching operations of block %a from peer %a."
+        -% t event "fetching_operations"
+        -% a Block_hash.Logging.tag hash
+        -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+    let operations =
+      map_p
+        (fun i ->
+           protect ~canceler:pipeline.canceler begin fun () ->
+             Distributed_db.Operations.fetch
+               ~timeout:pipeline.block_operations_timeout
+               pipeline.chain_db ~peer:pipeline.peer_id
+               (hash, i) header.shell.operations_hash
+           end)
+        (0 -- (header.shell.validation_passes - 1)) >>=? fun operations ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "fetched operations of block %a from peer %a."
+          -% t event "fetched_operations"
+          -% a Block_hash.Logging.tag hash
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      return operations in
+    protect ~canceler:pipeline.canceler begin fun () ->
+      Lwt_pipe.push pipeline.fetched_blocks
+        (hash, header, operations) >>= return
+    end
+  end >>= function
+  | Ok () ->
+      operations_fetch_worker_loop pipeline
+  | Error [Exn Lwt.Canceled | Canceled | Exn Lwt_pipe.Closed] ->
+      Lwt_pipe.close pipeline.fetched_blocks ;
+      Lwt.return_unit
+  | Error [ Distributed_db.Operations.Timeout (bh, n) ] ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "request for operations %a:%d from peer %a timed out."
+          -% t event "request_operations_timeout"
+          -% a Block_hash.Logging.tag bh
+          -% s operations_index_tag n
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+  | Error err ->
+      pipeline.errors <- pipeline.errors @ err ;
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[Unexpected error (operations fetch):@ %a@]"
+          -% t event "unexpected_error"
+          -% a errs_tag err) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+
+let rec validation_worker_loop pipeline =
+  begin
+    Lwt_unix.yield () >>= fun () ->
+    protect ~canceler:pipeline.canceler begin fun () ->
+      Lwt_pipe.pop pipeline.fetched_blocks >>= return
+    end >>=? fun (hash, header, operations) ->
+    lwt_log_info Tag.DSL.(fun f ->
+        f "requesting validation for block %a from peer %a."
+        -% t event "requesting_validation"
+        -% a Block_hash.Logging.tag hash
+        -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+    operations >>=? fun operations ->
+    protect ~canceler:pipeline.canceler begin fun () ->
+      Block_validator.validate
+        ~canceler:pipeline.canceler
+        ~notify_new_block:pipeline.notify_new_block
+        pipeline.block_validator
+        pipeline.chain_db hash header operations
+    end >>=? fun _block ->
+    lwt_log_info Tag.DSL.(fun f ->
+        f "validated block %a from peer %a."
+        -% t event "validated_block"
+        -% a Block_hash.Logging.tag hash
+        -% a P2p_peer.Id.Logging.tag pipeline.peer_id) >>= fun () ->
+    return_unit
+  end >>= function
+  | Ok () -> validation_worker_loop pipeline
+  | Error [Exn Lwt.Canceled | Canceled | Exn Lwt_pipe.Closed] ->
+      Lwt.return_unit
+  | Error ([ Block_validator_errors.Invalid_block _
+           | Block_validator_errors.Unavailable_protocol _
+           | Block_validator_errors.System_error _
+           | Timeout] as err ) ->
+      (* Propagate the error to the peer validator. *)
+      pipeline.errors <- pipeline.errors @ err ;
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+  | Error err ->
+      pipeline.errors <- pipeline.errors @ err ;
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[Unexpected error (validator):@ %a@]"
+          -% t event "unexpected_error"
+          -% a errs_tag err) >>= fun () ->
+      Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+      Lwt.return_unit
+
+let create
+    ?(notify_new_block = fun _ -> ())
+    ~block_header_timeout ~block_operations_timeout
+    block_validator peer_id chain_db locator =
+  let canceler = Lwt_canceler.create () in
+  let fetched_headers =
+    Lwt_pipe.create ~size:(1024, fun _ -> 1) () in
+  let fetched_blocks =
+    Lwt_pipe.create ~size:(128, fun _ -> 1) () in
+  let pipeline = {
+    canceler ;
+    block_header_timeout ; block_operations_timeout ;
+    headers_fetch_worker = Lwt.return_unit ;
+    operations_fetch_worker = Lwt.return_unit ;
+    validation_worker = Lwt.return_unit ;
+    notify_new_block ;
+    peer_id ; chain_db ; locator ;
+    block_validator ;
+    fetched_headers ; fetched_blocks ;
+    errors = [] ;
+  } in
+  Lwt_canceler.on_cancel pipeline.canceler begin fun () ->
+    Lwt_pipe.close fetched_blocks ;
+    Lwt_pipe.close fetched_headers ;
+    (* TODO proper cleanup of ressources... *)
+    Lwt.return_unit
+  end ;
+  let head, _ = (pipeline.locator : Block_locator.t :> _ * _) in
+  let hash = Block_header.hash head in
+  pipeline.headers_fetch_worker <-
+    Lwt_utils.worker
+      (Format.asprintf "bootstrap_pipeline-headers_fetch.%a.%a"
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
+      ~run:(fun () -> headers_fetch_worker_loop pipeline)
+      ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
+  pipeline.operations_fetch_worker <-
+    Lwt_utils.worker
+      (Format.asprintf "bootstrap_pipeline-operations_fetch.%a.%a"
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
+      ~run:(fun () -> operations_fetch_worker_loop pipeline)
+      ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
+  pipeline.validation_worker <-
+    Lwt_utils.worker
+      (Format.asprintf "bootstrap_pipeline-validation.%a.%a"
+         P2p_peer.Id.pp_short peer_id Block_hash.pp_short hash)
+      ~run:(fun () -> validation_worker_loop pipeline)
+      ~cancel:(fun () -> Lwt_canceler.cancel pipeline.canceler) ;
+  pipeline
+
+let wait_workers pipeline =
+  pipeline.headers_fetch_worker >>= fun () ->
+  pipeline.operations_fetch_worker >>= fun () ->
+  pipeline.validation_worker >>= fun () ->
+  Lwt.return_unit
+
+let wait pipeline =
+  wait_workers pipeline >>= fun () ->
+  match pipeline.errors with
+  | [] -> return_unit
+  | errors -> Lwt.return_error errors
+
+let cancel pipeline =
+  Lwt_canceler.cancel pipeline.canceler >>= fun () ->
+  wait_workers pipeline
diff --git a/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.mli b/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.mli
new file mode 100644
index 000000000..66fa54930
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/bootstrap_pipeline.mli
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+val create:
+  ?notify_new_block: (State.Block.t -> unit) ->
+  block_header_timeout:float ->
+  block_operations_timeout: float ->
+  Block_validator.t ->
+  P2p_peer.Id.t -> Distributed_db.chain_db ->
+  Block_locator.t -> t
+
+val wait: t -> unit tzresult Lwt.t
+
+val cancel: t -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/chain.ml b/vendors/tezos-modded/src/lib_shell/chain.ml
new file mode 100644
index 000000000..34ee9802b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain.ml
@@ -0,0 +1,138 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 State_logging
+
+let block_hash_tag = Tag.def ~doc:"Block hash" "block_hash" Block_hash.pp_short
+
+let mempool_encoding = Mempool.encoding
+
+let genesis chain_state =
+  let genesis = State.Chain.genesis chain_state in
+  State.Block.read_exn chain_state genesis.block
+
+let known_heads chain_state =
+  State.read_chain_data chain_state begin fun chain_store _data ->
+    Store.Chain_data.Known_heads.elements chain_store
+  end >>= fun hashes ->
+  Lwt_list.map_p (State.Block.read_exn chain_state) hashes
+
+let head chain_state =
+  State.read_chain_data chain_state begin fun _chain_store data ->
+    Lwt.return data.current_head
+  end
+
+let mem chain_state hash =
+  State.read_chain_data chain_state begin fun chain_store data ->
+    if Block_hash.equal (State.Block.hash data.current_head) hash then
+      Lwt.return_true
+    else
+      Store.Chain_data.In_main_branch.known (chain_store, hash)
+  end
+
+type data = State.chain_data = {
+  current_head: State.Block.t ;
+  current_mempool: Mempool.t ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+  test_chain: Chain_id.t option ;
+}
+
+let data chain_state =
+  State.read_chain_data chain_state begin fun _chain_store data ->
+    Lwt.return data
+  end
+
+let locator chain_state seed =
+  data chain_state >>= fun data ->
+  State.compute_locator chain_state data.current_head seed
+
+let locked_set_head chain_store data block =
+  let rec pop_blocks ancestor block =
+    let hash = State.Block.hash block in
+    if Block_hash.equal hash ancestor then
+      Lwt.return_unit
+    else
+      lwt_debug Tag.DSL.(fun f ->
+          f "pop_block %a"
+          -% t event "pop_block"
+          -% a block_hash_tag hash) >>= fun () ->
+      Store.Chain_data.In_main_branch.remove (chain_store, hash) >>= fun () ->
+      State.Block.predecessor block >>= function
+      | Some predecessor ->
+          pop_blocks ancestor predecessor
+      | None -> assert false (* Cannot pop the genesis... *)
+  in
+  let push_block pred_hash block =
+    let hash = State.Block.hash block in
+    lwt_debug Tag.DSL.(fun f ->
+        f "push_block %a"
+        -% t event "push_block"
+        -% a block_hash_tag hash) >>= fun () ->
+    Store.Chain_data.In_main_branch.store
+      (chain_store, pred_hash) hash >>= fun () ->
+    Lwt.return hash
+  in
+  Chain_traversal.new_blocks
+    ~from_block:data.current_head ~to_block:block >>= fun (ancestor, path) ->
+  let ancestor = State.Block.hash ancestor in
+  pop_blocks ancestor data.current_head >>= fun () ->
+  Lwt_list.fold_left_s push_block ancestor path >>= fun _ ->
+  Store.Chain_data.Current_head.store chain_store (State.Block.hash block) >>= fun () ->
+  (* TODO more optimized updated of live_{blocks/operations} when the
+     new head is a direct successor of the current head...
+     Make sure to do the live blocks computation in `init_head`
+     when this TODO is resolved. *)
+  Chain_traversal.live_blocks
+    block (State.Block.max_operations_ttl block) >>= fun (live_blocks,
+                                                          live_operations) ->
+  Lwt.return { current_head = block  ;
+               current_mempool = Mempool.empty ;
+               live_blocks ;
+               live_operations ;
+               test_chain = None ;
+             }
+
+let set_head chain_state block =
+  State.update_chain_data chain_state begin fun chain_store data ->
+    locked_set_head chain_store data block >>= fun new_chain_data ->
+    Lwt.return (Some new_chain_data,
+                data.current_head)
+  end
+
+let test_and_set_head chain_state ~old block =
+  State.update_chain_data chain_state begin fun chain_store data ->
+    if not (State.Block.equal data.current_head old) then
+      Lwt.return (None, false)
+    else
+      locked_set_head chain_store data block >>= fun new_chain_data ->
+      Lwt.return (Some new_chain_data, true)
+  end
+
+let init_head chain_state =
+  head chain_state >>= fun block ->
+  set_head chain_state block >>= fun _ ->
+  Lwt.return_unit
+
diff --git a/vendors/tezos-modded/src/lib_shell/chain.mli b/vendors/tezos-modded/src/lib_shell/chain.mli
new file mode 100644
index 000000000..8ea2705a2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain.mli
@@ -0,0 +1,66 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell Module - Manging the current head. *)
+
+(** The genesis block of the chain. On a test chain,
+    the test protocol has been promoted as "main" protocol. *)
+val genesis: State.Chain.t -> State.Block.t Lwt.t
+
+(** The current head of the chain. *)
+val head: State.Chain.t -> State.Block.t Lwt.t
+val locator: State.Chain.t -> Block_locator.seed -> Block_locator.t Lwt.t
+
+(** All the available chain data. *)
+type data = {
+  current_head: State.Block.t ;
+  current_mempool: Mempool.t ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+  test_chain: Chain_id.t option ;
+}
+
+(** Reading atomically all the chain data. *)
+val data: State.Chain.t -> data Lwt.t
+
+(** The current head and all the known (valid) alternate heads. *)
+val known_heads: State.Chain.t -> State.Block.t list Lwt.t
+
+(** Test whether a block belongs to the current mainchain. *)
+val mem: State.Chain.t -> Block_hash.t -> bool Lwt.t
+
+(** Record a block as the current head of the chain.
+    It returns the previous head. *)
+val set_head: State.Chain.t -> State.Block.t -> State.Block.t Lwt.t
+
+(** Atomically change the current head of the chain.
+    This returns [true] whenever the change succeeded, or [false]
+    when the current head os not equal to the [old] argument. *)
+val test_and_set_head:
+  State.Chain.t -> old:State.Block.t -> State.Block.t -> bool Lwt.t
+
+(** Restores the data about the current head at startup
+    (recomputes the sets of live blocks and operations). *)
+val init_head: State.Chain.t -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/chain_directory.ml b/vendors/tezos-modded/src/lib_shell/chain_directory.ml
new file mode 100644
index 000000000..153b41498
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_directory.ml
@@ -0,0 +1,173 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Chain_services
+
+let get_chain_id state = function
+  | `Main -> Lwt.return (State.Chain.main state)
+  | `Test -> begin
+      State.Chain.get_exn state (State.Chain.main state) >>= fun main_chain ->
+      State.Chain.test main_chain >>= function
+      | None -> Lwt.fail Not_found
+      | Some chain_id -> Lwt.return chain_id
+    end
+  | `Hash chain_id ->
+      Lwt.return chain_id
+
+let get_chain state chain =
+  get_chain_id state chain >>= fun chain_id ->
+  State.Chain.get_exn state chain_id
+
+let predecessors ignored length head =
+  let rec loop acc length block =
+    if length <= 0 then
+      Lwt.return (List.rev acc)
+    else
+      State.Block.predecessor block >>= function
+      | None ->
+          Lwt.return (List.rev acc)
+      | Some pred ->
+          if Block_hash.Set.mem (State.Block.hash block) ignored then
+            Lwt.return (List.rev acc)
+          else
+            loop (State.Block.hash pred :: acc) (length-1) pred
+  in
+  loop [State.Block.hash head] (length-1) head
+
+let list_blocks chain_state ?(length = 1) ?min_date heads =
+  begin
+    match heads with
+    | [] ->
+        Chain.known_heads chain_state >>= fun heads ->
+        let heads =
+          match min_date with
+          | None -> heads
+          | Some min_date ->
+              List.fold_left
+                (fun acc block ->
+                   let timestamp = State.Block.timestamp block in
+                   if Time.(min_date <= timestamp) then block :: acc
+                   else acc)
+                [] heads in
+        let sorted_heads =
+          List.sort
+            (fun b1 b2 ->
+               let f1 = State.Block.fitness b1 in
+               let f2 = State.Block.fitness b2 in
+               ~- (Fitness.compare f1 f2))
+            heads in
+        Lwt.return (List.map (fun b -> Some b) sorted_heads)
+    | _ :: _ as heads ->
+        Lwt_list.map_p (State.Block.read_opt chain_state) heads
+  end >>= fun requested_heads ->
+  Lwt_list.fold_left_s
+    (fun (ignored, acc) head ->
+       match head with
+       | None -> Lwt.return (ignored, [])
+       | Some block ->
+           predecessors ignored length block >>= fun predecessors ->
+           let ignored = List.fold_left (fun acc v -> Block_hash.Set.add v acc)
+               ignored predecessors in
+           Lwt.return (ignored, predecessors :: acc))
+    (Block_hash.Set.empty, [])
+    requested_heads >>= fun (_, blocks) ->
+  return (List.rev blocks)
+
+let rpc_directory =
+
+  let dir : State.Chain.t RPC_directory.t ref =
+    ref RPC_directory.empty in
+
+  let register0 s f =
+    dir :=
+      RPC_directory.register !dir (RPC_service.subst0 s)
+        (fun chain p q -> f chain p q) in
+  let register1 s f =
+    dir :=
+      RPC_directory.register !dir (RPC_service.subst1 s)
+        (fun (chain, a) p q -> f chain a p q) in
+
+  let register_dynamic_directory2 ?descr s f =
+    dir :=
+      RPC_directory.register_dynamic_directory
+        !dir ?descr (RPC_path.subst1 s)
+        (fun (chain, a) -> f chain a) in
+
+  register0 S.chain_id begin fun chain () () ->
+    return (State.Chain.id chain)
+  end ;
+
+  (* blocks *)
+
+  register0 S.Blocks.list begin fun chain q () ->
+    list_blocks chain ?length:q#length ?min_date:q#min_date q#heads
+  end ;
+
+  register_dynamic_directory2
+    Block_services.path
+    Block_directory.build_rpc_directory ;
+
+  (* invalid_blocks *)
+
+  register0 S.Invalid_blocks.list begin fun chain () () ->
+    let convert (hash, level, errors) = { hash ; level ; errors } in
+    State.Block.list_invalid chain >>= fun blocks ->
+    return (List.map convert blocks)
+  end ;
+
+  register1 S.Invalid_blocks.get begin fun chain hash () () ->
+    State.Block.read_invalid chain hash >>= function
+    | None -> Lwt.fail Not_found
+    | Some { level ; errors } -> return { hash ; level ; errors }
+  end ;
+
+  register1 S.Invalid_blocks.delete begin fun chain hash () () ->
+    State.Block.unmark_invalid chain hash
+  end ;
+
+  !dir
+
+let build_rpc_directory validator =
+
+  let distributed_db = Validator.distributed_db validator in
+  let state = Distributed_db.state distributed_db in
+
+  let dir = ref rpc_directory in
+
+  (* Mempool *)
+
+  let merge d = dir := RPC_directory.merge !dir d in
+  merge
+    (RPC_directory.map
+       (fun chain ->
+          match Validator.get validator (State.Chain.id chain) with
+          | Error _ -> Lwt.fail Not_found
+          | Ok chain_validator ->
+              Lwt.return (Chain_validator.prevalidator chain_validator))
+       Prevalidator.rpc_directory) ;
+
+  RPC_directory.prefix Chain_services.path @@
+  RPC_directory.map (fun ((), chain) -> get_chain state chain) !dir
diff --git a/vendors/tezos-modded/src/lib_shell/chain_directory.mli b/vendors/tezos-modded/src/lib_shell/chain_directory.mli
new file mode 100644
index 000000000..87ac2f5d3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_directory.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 get_chain_id: State.t -> Chain_services.chain -> Chain_id.t Lwt.t
+val get_chain: State.t -> Chain_services.chain -> State.Chain.t Lwt.t
+
+val rpc_directory: State.Chain.t RPC_directory.t
+
+val build_rpc_directory: Validator.t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/chain_traversal.ml b/vendors/tezos-modded/src/lib_shell/chain_traversal.ml
new file mode 100644
index 000000000..028070858
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_traversal.ml
@@ -0,0 +1,150 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 State
+
+let path (b1: Block.t) (b2: Block.t) =
+  if not (Chain_id.equal (Block.chain_id b1) (Block.chain_id b2)) then
+    invalid_arg "Chain_traversal.path" ;
+  let rec loop acc current =
+    if Block.equal b1 current then
+      Lwt.return_some acc
+    else
+      Block.predecessor current >>= function
+      | Some pred -> loop (current :: acc) pred
+      | None -> Lwt.return_none in
+  loop [] b2
+
+let common_ancestor (b1: Block.t) (b2: Block.t) =
+  if not ( Chain_id.equal (Block.chain_id b1) (Block.chain_id b2)) then
+    invalid_arg "Chain_traversal.path" ;
+  let rec loop (b1: Block.t) (b2: Block.t) =
+    if Block.equal b1 b2 then
+      Lwt.return b1
+    else if Time.(Block.timestamp b1 <= Block.timestamp b2) then
+      Block.predecessor b2 >>= function
+      | None -> assert false
+      | Some b2 -> loop b1 b2
+    else
+      Block.predecessor b1 >>= function
+      | None -> assert false
+      | Some b1 -> loop b1 b2 in
+  loop b1 b2
+
+let iter_predecessors ?max ?min_fitness ?min_date heads ~f =
+  let module Local = struct exception Exit end in
+  let compare b1 b2 =
+    match Fitness.compare (Block.fitness b1) (Block.fitness b2) with
+    | 0 -> begin
+        match Time.compare (Block.timestamp b1) (Block.timestamp b2) with
+        | 0 -> Block.compare b1 b2
+        | res -> res
+      end
+    | res -> res in
+  let pop, push =
+    (* Poor-man priority queue *)
+    let queue : Block.t list ref = ref [] in
+    let pop () =
+      match !queue with
+      | [] -> None
+      | b :: bs -> queue := bs ; Some b in
+    let push b =
+      let rec loop = function
+        | [] -> [b]
+        | b' :: bs' as bs ->
+            let cmp = compare b b' in
+            if cmp = 0 then
+              bs
+            else if cmp < 0 then
+              b' :: loop bs'
+            else
+              b :: bs in
+      queue := loop !queue in
+    pop, push in
+  let check_count =
+    match max with
+    | None -> (fun () -> ())
+    | Some max ->
+        let cpt = ref 0 in
+        fun () ->
+          if !cpt >= max then raise Local.Exit ;
+          incr cpt in
+  let check_fitness =
+    match min_fitness with
+    | None -> (fun _ -> true)
+    | Some min_fitness ->
+        (fun b -> Fitness.compare min_fitness (Block.fitness b) <= 0) in
+  let check_date =
+    match min_date with
+    | None -> (fun _ -> true)
+    | Some min_date ->
+        (fun b -> Time.(min_date <= Block.timestamp b)) in
+  let rec loop () =
+    match pop () with
+    | None -> Lwt.return_unit
+    | Some b ->
+        check_count () ;
+        f b >>= fun () ->
+        Block.predecessor b >>= function
+        | None -> loop ()
+        | Some p ->
+            if check_fitness p && check_date p then push p ;
+            loop () in
+  List.iter push heads ;
+  try loop () with Local.Exit -> Lwt.return_unit
+
+let iter_predecessors ?max ?min_fitness ?min_date heads ~f =
+  match heads with
+  | [] -> Lwt.return_unit
+  | b :: _ ->
+      let chain_id = Block.chain_id b in
+      if not (List.for_all (fun b -> Chain_id.equal chain_id (Block.chain_id b)) heads) then
+        invalid_arg "State.Helpers.iter_predecessors" ;
+      iter_predecessors ?max ?min_fitness ?min_date heads ~f
+
+let new_blocks ~from_block ~to_block =
+  common_ancestor from_block to_block >>= fun ancestor ->
+  path ancestor to_block >>= function
+  | None -> assert false
+  | Some path -> Lwt.return (ancestor, path)
+
+let live_blocks block n =
+  let rec loop bacc oacc chain_state block_head n =
+    Block.Header.all_operation_hashes chain_state block_head >>= fun hashes ->
+    let oacc =
+      List.fold_left
+        (List.fold_left
+           (fun oacc op -> Operation_hash.Set.add op oacc))
+        oacc hashes  in
+    let bacc = Block_hash.Set.add (Block.Header.hash block_head) bacc in
+    if n = 0 then Lwt.return (bacc, oacc)
+    else
+      Block.Header.predecessor chain_state block_head >>= function
+      | None -> Lwt.return (bacc, oacc)
+      | Some predecessor -> loop bacc oacc chain_state predecessor (pred n) in
+  loop
+    Block_hash.Set.empty Operation_hash.Set.empty
+    (Block.chain_state block) (Block.Header.of_block block)
+    n
diff --git a/vendors/tezos-modded/src/lib_shell/chain_traversal.mli b/vendors/tezos-modded/src/lib_shell/chain_traversal.mli
new file mode 100644
index 000000000..a89496361
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_traversal.mli
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell Module - Chain Traversal API *)
+
+open State
+
+val path: Block.t -> Block.t -> Block.t list option Lwt.t
+(** If [h1] is an ancestor of [h2] in the current [state],
+    then [path state h1 h2] returns the chain of block from
+    [h1] (excluded) to [h2] (included). Returns [None] otherwise. *)
+
+val common_ancestor: Block.t -> Block.t -> Block.t Lwt.t
+(** [common_ancestor state h1 h2] returns the first common ancestors
+    in the history of blocks [h1] and [h2]. *)
+
+val iter_predecessors:
+  ?max:int ->
+  ?min_fitness:Fitness.t ->
+  ?min_date:Time.t ->
+  Block.t list ->
+  f:(Block.t -> unit Lwt.t) ->
+  unit Lwt.t
+(** [iter_predecessors state blocks f] iter [f] on [blocks] and
+    their recursive predecessors. Blocks are visited with a
+    decreasing fitness (then decreasing timestamp). If the optional
+    argument [max] is provided, the iteration is stopped after [max]
+    visited block. If [min_fitness] id provided, blocks with a
+    fitness lower than [min_fitness] are ignored. If [min_date],
+    blocks with a fitness lower than [min_date] are ignored. *)
+
+val new_blocks:
+  from_block:Block.t -> to_block:Block.t ->
+  (Block.t * Block.t list) Lwt.t
+(** [new_blocks ~from_block ~to_block] returns a pair [(ancestor,
+    path)], where [ancestor] is the common ancestor of [from_block]
+    and [to_block] and where [path] is the chain from [ancestor]
+    (excluded) to [to_block] (included).  The function raises an
+    exception when the two provided blocks do not belong the the same
+    [chain].  *)
+
+val live_blocks:
+  Block.t -> int -> (Block_hash.Set.t * Operation_hash.Set.t) Lwt.t
+(** [live_blocks b n] return a pair [(blocks,operations)] where
+    [blocks] is the set of arity [n], that contains [b] and its [n-1]
+    predecessors. And where [operations] is the set of operations
+    included in those blocks.
+*)
diff --git a/vendors/tezos-modded/src/lib_shell/chain_validator.ml b/vendors/tezos-modded/src/lib_shell/chain_validator.ml
new file mode 100644
index 000000000..5cf4e6833
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_validator.ml
@@ -0,0 +1,574 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Chain_validator_worker_state
+
+module Log = Tezos_stdlib.Logging.Make(struct let name = "node.chain_validator" end)
+
+module Name = struct
+  type t = Chain_id.t
+  let encoding = Chain_id.encoding
+  let base = [ "validator.chain" ]
+  let pp = Chain_id.pp_short
+end
+
+module Request = struct
+  include Request
+  type _ t = Validated : State.Block.t -> Event.update t
+  let view (type a) (Validated block : a t) : view =
+    State.Block.hash block
+end
+
+type limits = {
+  bootstrap_threshold: int ;
+  worker_limits: Worker_types.limits
+}
+
+module Types = struct
+  include Worker_state
+
+  type parameters = {
+    parent: Name.t option ;
+    db: Distributed_db.t ;
+    chain_state: State.Chain.t ;
+    chain_db: Distributed_db.chain_db ;
+    block_validator: Block_validator.t ;
+    global_valid_block_input: State.Block.t Lwt_watcher.input ;
+
+    prevalidator_limits: Prevalidator.limits ;
+    peer_validator_limits: Peer_validator.limits ;
+    max_child_ttl: int option ;
+    limits: limits;
+  }
+
+  type state = {
+    parameters: parameters ;
+
+    mutable bootstrapped: bool ;
+    bootstrapped_waiter: unit Lwt.t ;
+    bootstrapped_wakener: unit Lwt.u ;
+    valid_block_input: State.Block.t Lwt_watcher.input ;
+    new_head_input: State.Block.t Lwt_watcher.input ;
+
+    mutable child:
+      (state * (unit -> unit Lwt.t (* shutdown *))) option ;
+    mutable prevalidator: Prevalidator.t option ;
+    active_peers: Peer_validator.t tzresult Lwt.t P2p_peer.Table.t ;
+    bootstrapped_peers: unit P2p_peer.Table.t ;
+  }
+
+  let view (state : state) _ : view =
+    let { bootstrapped ; active_peers ; bootstrapped_peers } = state in
+    { bootstrapped ;
+      active_peers =
+        P2p_peer.Table.fold (fun id _ l -> id :: l) active_peers [] ;
+      bootstrapped_peers =
+        P2p_peer.Table.fold (fun id _ l -> id :: l) bootstrapped_peers [] }
+end
+
+module Worker = Worker.Make (Name) (Event) (Request) (Types)
+
+open Types
+
+type t = Worker.infinite Worker.queue Worker.t
+
+let table = Worker.create_table Queue
+
+let shutdown w =
+  Worker.shutdown w
+
+let shutdown_child nv =
+  Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child
+
+let notify_new_block w block =
+  let nv = Worker.state w in
+  Option.iter nv.parameters.parent
+    ~f:(fun id -> try
+           let w = List.assoc id (Worker.list table) in
+           let nv = Worker.state w in
+           Lwt_watcher.notify nv.valid_block_input block
+         with Not_found -> ()) ;
+  Lwt_watcher.notify nv.valid_block_input block ;
+  Lwt_watcher.notify nv.parameters.global_valid_block_input block ;
+  Worker.push_request_now w (Validated block)
+
+let may_toggle_bootstrapped_chain w =
+  let nv = Worker.state w in
+  if not nv.bootstrapped &&
+     P2p_peer.Table.length nv.bootstrapped_peers >= nv.parameters.limits.bootstrap_threshold
+  then begin
+    Log.log_info "bootstrapped";
+    nv.bootstrapped <- true ;
+    Lwt.wakeup_later nv.bootstrapped_wakener () ;
+  end
+
+let with_activated_peer_validator w peer_id f =
+  let nv = Worker.state w in
+  begin
+    match P2p_peer.Table.find_opt nv.active_peers peer_id with
+    | Some pv -> pv
+    | None ->
+        let pv =
+          Peer_validator.create
+            ~notify_new_block:(notify_new_block w)
+            ~notify_bootstrapped: begin fun () ->
+              P2p_peer.Table.add nv.bootstrapped_peers peer_id () ;
+              may_toggle_bootstrapped_chain w
+            end
+            ~notify_termination: begin fun _pv ->
+              P2p_peer.Table.remove nv.active_peers peer_id ;
+              P2p_peer.Table.remove nv.bootstrapped_peers peer_id ;
+            end
+            nv.parameters.peer_validator_limits
+            nv.parameters.block_validator
+            nv.parameters.chain_db
+            peer_id in
+        P2p_peer.Table.add nv.active_peers peer_id pv ;
+        pv
+  end >>= function
+  | Error _ as e ->
+      P2p_peer.Table.remove nv.active_peers peer_id ;
+      Lwt.return e
+  | Ok pv ->
+      match Peer_validator.status pv with
+      | Worker_types.Running _ -> f pv
+      | Worker_types.Closing (_, _)
+      | Worker_types.Closed (_, _, _)
+      | Worker_types.Launching _ -> return_unit
+
+let may_update_checkpoint chain_state new_head =
+  State.Chain.checkpoint chain_state >>= fun (old_level, _old_block) ->
+  let new_level = State.Block.last_allowed_fork_level new_head in
+  if new_level <= old_level then
+    Lwt.return_unit
+  else
+    let head_level = State.Block.level new_head in
+    State.Block.predecessor_n new_head
+      (Int32.to_int (Int32.sub head_level new_level)) >>= function
+    | None -> Lwt.return_unit (* should not happen *)
+    | Some new_block ->
+        State.Chain.set_checkpoint chain_state (new_level, new_block)
+
+let may_switch_test_chain w spawn_child block =
+  let nv = Worker.state w in
+  let create_child genesis protocol expiration =
+    if State.Chain.allow_forked_chain nv.parameters.chain_state then begin
+      shutdown_child nv >>= fun () ->
+      begin
+        let chain_id = Chain_id.of_block_hash (State.Block.hash genesis) in
+        State.Chain.get
+          (State.Chain.global_state nv.parameters.chain_state) chain_id >>= function
+        | Ok chain_state -> return chain_state
+        | Error _ ->
+            State.fork_testchain
+              genesis protocol expiration >>=? fun chain_state ->
+            Chain.head chain_state >>= fun new_genesis_block ->
+            Lwt_watcher.notify nv.parameters.global_valid_block_input new_genesis_block ;
+            Lwt_watcher.notify nv.valid_block_input new_genesis_block ;
+            return chain_state
+      end >>=? fun chain_state ->
+      spawn_child
+        ~parent:(State.Chain.id chain_state)
+        nv.parameters.peer_validator_limits
+        nv.parameters.prevalidator_limits
+        nv.parameters.block_validator
+        nv.parameters.global_valid_block_input
+        nv.parameters.db chain_state
+        nv.parameters.limits (* TODO: different limits main/test ? *) >>=? fun child ->
+      nv.child <- Some child ;
+      return_unit
+    end else begin
+      (* Ignoring request... *)
+      return_unit
+    end in
+
+  let check_child genesis protocol expiration current_time =
+    let activated =
+      match nv.child with
+      | None -> false
+      | Some (child , _) ->
+          Block_hash.equal
+            (State.Chain.genesis child.parameters.chain_state).block
+            genesis in
+    State.Block.read nv.parameters.chain_state genesis >>=? fun genesis ->
+    begin
+      match nv.parameters.max_child_ttl with
+      | None -> Lwt.return expiration
+      | Some ttl ->
+          Lwt.return
+            (Time.min expiration
+               (Time.add (State.Block.timestamp genesis) (Int64.of_int ttl)))
+    end >>= fun local_expiration ->
+    let expired = Time.(local_expiration <= current_time) in
+    if expired && activated then
+      shutdown_child nv >>= return
+    else if not activated && not expired then
+      create_child genesis protocol expiration
+    else
+      return_unit in
+
+  begin
+    let block_header = State.Block.header block in
+    State.Block.test_chain block >>= function
+    | Not_running -> shutdown_child nv >>= return
+    | Running { genesis ; protocol ; expiration } ->
+        check_child genesis protocol expiration
+          block_header.shell.timestamp
+    | Forking { protocol ; expiration } ->
+        create_child block protocol expiration
+  end >>= function
+  | Ok () -> Lwt.return_unit
+  | Error err ->
+      Worker.record_event w (Could_not_switch_testchain err) ;
+      Lwt.return_unit
+
+let broadcast_head w ~previous block =
+  let nv = Worker.state w in
+  if not nv.bootstrapped then
+    Lwt.return_unit
+  else begin
+    begin
+      State.Block.predecessor block >>= function
+      | None -> Lwt.return_true
+      | Some predecessor ->
+          Lwt.return (State.Block.equal predecessor previous)
+    end >>= fun successor ->
+    if successor then begin
+      Distributed_db.Advertise.current_head
+        nv.parameters.chain_db block ;
+      Lwt.return_unit
+    end else begin
+      Distributed_db.Advertise.current_branch nv.parameters.chain_db
+    end
+  end
+
+let safe_get_protocol hash =
+  match Registered_protocol.get hash with
+  | None ->
+      (* FIXME. *)
+      (* This should not happen: it should be handled in the validator. *)
+      failwith "chain_validator: missing protocol '%a' for the current block."
+        Protocol_hash.pp_short hash
+  | Some protocol ->
+      return protocol
+
+let on_request (type a) w spawn_child (req : a Request.t) : a tzresult Lwt.t =
+  let Request.Validated block = req in
+  let nv = Worker.state w in
+  Chain.head nv.parameters.chain_state >>= fun head ->
+  let head_header = State.Block.header head
+  and head_hash = State.Block.hash head
+  and block_header = State.Block.header block
+  and block_hash = State.Block.hash block in
+  begin
+    match nv.prevalidator with
+    | None ->
+        Lwt.return head_header.shell.fitness
+    | Some pv ->
+        Prevalidator.fitness pv
+  end >>= fun context_fitness ->
+  let head_fitness = head_header.shell.fitness in
+  let new_fitness = block_header.shell.fitness in
+  let accepted_head =
+    if Fitness.(context_fitness = head_fitness) then
+      Fitness.(new_fitness > head_fitness)
+    else
+      Fitness.(new_fitness >= context_fitness) in
+  if not accepted_head then
+    return Event.Ignored_head
+  else begin
+    Chain.set_head nv.parameters.chain_state block >>= fun previous ->
+    may_update_checkpoint nv.parameters.chain_state block >>= fun () ->
+    broadcast_head w ~previous block >>= fun () ->
+    begin match nv.prevalidator with
+      | Some old_prevalidator ->
+          State.Block.protocol_hash block >>= fun new_protocol ->
+          let old_protocol = Prevalidator.protocol_hash old_prevalidator in
+          begin
+            if not (Protocol_hash.equal old_protocol new_protocol) then begin
+              safe_get_protocol new_protocol >>=? fun (module Proto) ->
+              let (limits, chain_db) = Prevalidator.parameters old_prevalidator in
+              (* TODO inject in the new prevalidator the operation
+                 from the previous one. *)
+              Prevalidator.create limits (module Proto) chain_db >>= function
+              | Error errs ->
+                  Log.lwt_log_error "@[Failed to reinstantiate prevalidator:@ %a@]"
+                    pp_print_error errs >>= fun () ->
+                  nv.prevalidator <- None ;
+                  Prevalidator.shutdown old_prevalidator >>= fun () ->
+                  return_unit
+              | Ok prevalidator ->
+                  nv.prevalidator <- Some prevalidator ;
+                  Prevalidator.shutdown old_prevalidator >>= fun () ->
+                  return_unit
+            end else begin
+              Prevalidator.flush old_prevalidator block_hash >>=? fun () ->
+              return_unit
+            end
+          end >>=? fun () ->
+          return_unit
+      | None -> return_unit
+    end >>=? fun () ->
+    may_switch_test_chain w spawn_child block >>= fun () ->
+    Lwt_watcher.notify nv.new_head_input block ;
+    if Block_hash.equal head_hash block_header.shell.predecessor then
+      return Event.Head_incrememt
+    else
+      return Event.Branch_switch
+  end
+
+let on_completion (type a) w  (req : a Request.t) (update : a) request_status =
+  let Request.Validated block = req in
+  let fitness = State.Block.fitness block in
+  let request = State.Block.hash block in
+  Worker.record_event w (Processed_block { request ; request_status ; update ; fitness }) ;
+  Lwt.return_unit
+
+let on_close w =
+  let nv = Worker.state w in
+  Distributed_db.deactivate nv.parameters.chain_db >>= fun () ->
+  begin
+    P2p_peer.Table.fold
+      (fun peer_id pv acc ->
+         acc >>= fun acc ->
+         pv >|= function
+         | Ok pv -> Peer_validator.shutdown pv :: acc
+         | Error _ ->
+             P2p_peer.Table.remove nv.active_peers peer_id ;
+             acc)
+      nv.active_peers (Lwt.return [])
+  end >>= fun pvs ->
+  Lwt.join
+    (begin match nv.prevalidator with
+       | Some prevalidator -> Prevalidator.shutdown prevalidator
+       | None -> Lwt.return_unit
+     end ::
+     Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child ::
+     pvs) >>= fun () ->
+  Lwt.return_unit
+
+let on_launch start_prevalidator w _ parameters =
+  Chain.init_head parameters.chain_state >>= fun () ->
+  (if start_prevalidator then
+     State.read_chain_data parameters.chain_state
+       (fun _ {State.current_head} -> Lwt.return current_head) >>= fun head ->
+     State.Block.protocol_hash head >>= fun head_hash ->
+     safe_get_protocol head_hash >>= function
+     | Ok (module Proto) -> begin
+         Prevalidator.create
+           parameters.prevalidator_limits
+           (module Proto)
+           parameters.chain_db >>= function
+         | Error err ->
+             Log.lwt_log_error "@[Failed to instantiate prevalidator:@ %a@]"
+               pp_print_error err >>= fun () ->
+             return_none
+         | Ok prevalidator ->
+             return_some prevalidator
+       end
+     | Error err ->
+         Log.lwt_log_error "@[Failed to instantiate prevalidator:@ %a@]"
+           pp_print_error err >>= fun () ->
+         return_none
+   else return_none) >>=? fun prevalidator ->
+  let valid_block_input = Lwt_watcher.create_input () in
+  let new_head_input = Lwt_watcher.create_input () in
+  let bootstrapped_waiter, bootstrapped_wakener = Lwt.wait () in
+  let nv =
+    { parameters ;
+      valid_block_input ;
+      new_head_input ;
+      bootstrapped_wakener ;
+      bootstrapped_waiter ;
+      bootstrapped = (parameters.limits.bootstrap_threshold <= 0) ;
+      active_peers =
+        P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *)
+      bootstrapped_peers =
+        P2p_peer.Table.create 50 ; (* TODO use `2 * max_connection` *)
+      child = None ;
+      prevalidator } in
+  if nv.bootstrapped then Lwt.wakeup_later bootstrapped_wakener () ;
+  Distributed_db.set_callback parameters.chain_db {
+    notify_branch = begin fun peer_id locator ->
+      Lwt.async begin fun () ->
+        with_activated_peer_validator w peer_id @@ fun pv ->
+        Peer_validator.notify_branch pv locator ;
+        return_unit
+      end
+    end ;
+    notify_head = begin fun peer_id block ops ->
+      Lwt.async begin fun () ->
+        with_activated_peer_validator w peer_id (fun pv ->
+            Peer_validator.notify_head pv block ;
+            return_unit) >>=? fun () ->
+        (* TODO notify prevalidator only if head is known ??? *)
+        match nv.prevalidator with
+        | Some prevalidator ->
+            Prevalidator.notify_operations prevalidator peer_id ops >>= fun () ->
+            return_unit
+        | None -> return_unit
+      end;
+    end ;
+    disconnection = begin fun peer_id ->
+      Lwt.async begin fun () ->
+        let nv = Worker.state w in
+        match P2p_peer.Table.find_opt nv.active_peers peer_id with
+        | None -> return_unit
+        | Some pv ->
+            pv >>= function
+            | Error _ as e ->
+                P2p_peer.Table.remove nv.active_peers peer_id ;
+                Lwt.return e
+            | Ok pv ->
+                Peer_validator.shutdown pv >>= fun () ->
+                return_unit
+      end
+    end ;
+  } ;
+  return nv
+
+let rec create
+    ?max_child_ttl ~start_prevalidator ?parent
+    peer_validator_limits prevalidator_limits block_validator
+    global_valid_block_input db chain_state limits =
+  let spawn_child ~parent pvl pl bl gvbi db n l =
+    create ~start_prevalidator ~parent pvl pl bl gvbi db n l >>=? fun w ->
+    return (Worker.state w, (fun () -> Worker.shutdown w))
+  in
+  let module Handlers = struct
+    type self = t
+    let on_launch = on_launch start_prevalidator
+    let on_request w = on_request w spawn_child
+    let on_close = on_close
+    let on_error _ _ _ errs = Lwt.return (Error errs)
+    let on_completion = on_completion
+    let on_no_request _ = return_unit
+  end in
+  let parameters =
+    { max_child_ttl ;
+      parent ;
+      peer_validator_limits ;
+      prevalidator_limits ;
+      block_validator ;
+      global_valid_block_input ;
+      db ;
+      chain_db = Distributed_db.activate db chain_state ;
+      chain_state ;
+      limits } in
+  Worker.launch table
+    prevalidator_limits.worker_limits
+    (State.Chain.id chain_state)
+    parameters
+    (module Handlers)
+
+(** Current block computation *)
+
+let create
+    ?max_child_ttl
+    ~start_prevalidator
+    peer_validator_limits prevalidator_limits
+    block_validator global_valid_block_input global_db state limits =
+  (* hide the optional ?parent *)
+  create
+    ?max_child_ttl
+    ~start_prevalidator
+    peer_validator_limits prevalidator_limits
+    block_validator global_valid_block_input global_db state limits
+
+let chain_id w =
+  let { parameters = { chain_state } } = Worker.state w in
+  State.Chain.id chain_state
+
+let chain_state w =
+  let { parameters = { chain_state } } = Worker.state w in
+  chain_state
+
+let prevalidator w =
+  let { prevalidator } = Worker.state w in
+  prevalidator
+
+let chain_db w =
+  let { parameters = { chain_db } } = Worker.state w in
+  chain_db
+
+let child w =
+  match (Worker.state w).child with
+  | None -> None
+  | Some ({ parameters = { chain_state } }, _) ->
+      try Some (List.assoc (State.Chain.id chain_state) (Worker.list table))
+      with Not_found -> None
+
+let assert_fitness_increases ?(force = false) w distant_header =
+  let pv = Worker.state w in
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  Chain.head chain_state >>= fun local_header ->
+  fail_when
+    (not force &&
+     Fitness.compare
+       distant_header.Block_header.shell.fitness
+       (State.Block.fitness local_header) <= 0)
+    (failure "Fitness too low")
+
+let assert_checkpoint w hash (header: Block_header.t) =
+  let pv = Worker.state w in
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  State.Chain.acceptable_block chain_state hash header >>= fun acceptable ->
+  fail_unless acceptable
+    (Validation_errors.Checkpoint_error (hash, None))
+
+let validate_block w ?force hash block operations =
+  let nv = Worker.state w in
+  assert (Block_hash.equal hash (Block_header.hash block)) ;
+  assert_fitness_increases ?force w block >>=? fun () ->
+  assert_checkpoint w hash block >>=? fun () ->
+  Block_validator.validate
+    ~canceler:(Worker.canceler w)
+    ~notify_new_block:(notify_new_block w)
+    nv.parameters.block_validator
+    nv.parameters.chain_db
+    hash block operations
+
+let bootstrapped w =
+  let { bootstrapped_waiter } = Worker.state w in
+  Lwt.protected bootstrapped_waiter
+
+let valid_block_watcher w =
+  let { valid_block_input } = Worker.state w in
+  Lwt_watcher.create_stream valid_block_input
+
+let new_head_watcher w =
+  let { new_head_input } = Worker.state w in
+  Lwt_watcher.create_stream new_head_input
+
+let status = Worker.status
+
+let running_workers () = Worker.list table
+
+let pending_requests t = Worker.pending_requests t
+
+let current_request t = Worker.current_request t
+
+let last_events = Worker.last_events
diff --git a/vendors/tezos-modded/src/lib_shell/chain_validator.mli b/vendors/tezos-modded/src/lib_shell/chain_validator.mli
new file mode 100644
index 000000000..a4c0be7e3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/chain_validator.mli
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+type limits = {
+  bootstrap_threshold: int ;
+  worker_limits: Worker_types.limits
+}
+
+val create:
+  ?max_child_ttl:int ->
+  start_prevalidator:bool ->
+  Peer_validator.limits ->
+  Prevalidator.limits ->
+  Block_validator.t ->
+  State.Block.t Lwt_watcher.input ->
+  Distributed_db.t ->
+  State.Chain.t ->
+  limits ->
+  t tzresult Lwt.t
+
+val bootstrapped: t -> unit Lwt.t
+
+val chain_id: t -> Chain_id.t
+val chain_state: t -> State.Chain.t
+val prevalidator: t -> Prevalidator.t option
+val chain_db: t -> Distributed_db.chain_db
+val child: t -> t option
+
+val validate_block:
+  t ->
+  ?force:bool ->
+  Block_hash.t -> Block_header.t -> Operation.t list list ->
+  State.Block.t option tzresult Lwt.t
+
+val shutdown: t -> unit Lwt.t
+
+val valid_block_watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
+val new_head_watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
+
+val running_workers: unit -> (Chain_id.t * t) list
+val status: t -> Worker_types.worker_status
+
+val pending_requests : t -> (Time.t * Chain_validator_worker_state.Request.view) list
+val current_request : t -> (Time.t * Time.t * Chain_validator_worker_state.Request.view) option
+val last_events : t -> (Lwt_log_core.level * Chain_validator_worker_state.Event.t list) list
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db.ml b/vendors/tezos-modded/src/lib_shell/distributed_db.ml
new file mode 100644
index 000000000..191cb75fc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db.ml
@@ -0,0 +1,1142 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Message = Distributed_db_message
+
+include Logging.Make(struct let name = "node.distributed_db" end)
+
+type p2p = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.net
+type connection = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.connection
+
+type 'a request_param = {
+  p2p : (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.t ;
+  data: 'a ;
+  active: unit -> P2p_peer.Set.t ;
+  send: P2p_peer.Id.t -> Message.t -> unit ;
+}
+
+module Make_raw
+    (Hash : sig
+       type t
+       val name : string
+       val encoding : t Data_encoding.t
+       val pp : Format.formatter -> t -> unit
+
+       module Logging : sig
+         val tag : t Tag.def
+       end
+     end)
+    (Disk_table :
+       Distributed_db_functors.DISK_TABLE with type key := Hash.t)
+    (Memory_table :
+       Distributed_db_functors.MEMORY_TABLE with type key := Hash.t)
+    (Request_message : sig
+       type param
+       val max_length : int
+       val initial_delay : float
+       val forge : param -> Hash.t list -> Message.t
+     end)
+    (Precheck : Distributed_db_functors.PRECHECK
+     with type key := Hash.t
+      and type value := Disk_table.value) = struct
+
+  module Request = struct
+    type param = Request_message.param request_param
+    let active { active } = active ()
+    let initial_delay  = Request_message.initial_delay
+
+    let rec send state gid keys =
+      let first_keys, keys = List.split_n Request_message.max_length keys in
+      let msg = (Request_message.forge state.data first_keys) in
+      state.send gid msg ;
+      let open Peer_metadata in
+      let (req : requests_kind) = match msg with
+        | Get_current_branch _ -> Branch
+        | Get_current_head _ -> Head
+        | Get_block_headers _ -> Block_header
+        | Get_operations _ -> Operations
+        | Get_protocols _ -> Protocols
+        | Get_operation_hashes_for_blocks _ -> Operation_hashes_for_block
+        | Get_operations_for_blocks _ -> Operations_for_block
+        | _ -> Other in
+      let meta = P2p.get_peer_metadata state.p2p gid in
+      Peer_metadata.incr meta @@ Scheduled_request req ;
+      if keys <> [] then send state gid keys
+  end
+
+  module Scheduler =
+    Distributed_db_functors.Make_request_scheduler
+      (Hash) (Memory_table) (Request)
+  module Table =
+    Distributed_db_functors.Make_table
+      (Hash) (Disk_table) (Memory_table) (Scheduler) (Precheck)
+
+  type t = {
+    scheduler: Scheduler.t ;
+    table: Table.t ;
+  }
+
+  let create ?global_input request_param param =
+    let scheduler = Scheduler.create request_param in
+    let table = Table.create ?global_input scheduler param in
+    { scheduler ; table }
+
+  let shutdown { scheduler } =
+    Scheduler.shutdown scheduler
+
+end
+
+module Fake_operation_storage = struct
+  type store = State.Chain.t
+  type value = Operation.t
+  let known _ _ = Lwt.return_false
+  let read _ _ = Lwt.return (Error_monad.error_exn Not_found)
+  let read_opt _ _ = Lwt.return_none
+  let read_exn _ _ = raise Not_found
+end
+
+module Raw_operation =
+  Make_raw
+    (Operation_hash)
+    (Fake_operation_storage)
+    (Operation_hash.Table)
+    (struct
+      type param = unit
+      let max_length = 10
+      let initial_delay = 0.5
+      let forge () keys = Message.Get_operations keys
+    end)
+    (struct
+      type param = unit
+      type notified_value = Operation.t
+      let precheck _ _ v = Some v
+    end)
+
+module Block_header_storage = struct
+  type store = State.Chain.t
+  type value = Block_header.t
+  let known = State.Block.known_valid
+  let read chain_state h =
+    State.Block.read chain_state h >>=? fun b ->
+    return (State.Block.header b)
+  let read_opt chain_state h =
+    State.Block.read_opt chain_state h >>= fun b ->
+    Lwt.return (Option.map ~f:State.Block.header b)
+  let read_exn chain_state h =
+    State.Block.read_exn chain_state h >>= fun b ->
+    Lwt.return (State.Block.header b)
+end
+
+module Raw_block_header =
+  Make_raw
+    (Block_hash)
+    (Block_header_storage)
+    (Block_hash.Table)
+    (struct
+      type param = unit
+      let max_length = 10
+      let initial_delay = 0.5
+      let forge () keys = Message.Get_block_headers keys
+    end)
+    (struct
+      type param = unit
+      type notified_value = Block_header.t
+      let precheck _ _ v = Some v
+    end)
+
+module Operation_hashes_storage = struct
+  type store = State.Chain.t
+  type value = Operation_hash.t list
+  let known chain_state (h, _) = State.Block.known_valid chain_state h
+  let read chain_state (h, i) =
+    State.Block.read chain_state h >>=? fun b ->
+    State.Block.operation_hashes b i >>= fun (ops, _) ->
+    return ops
+  let read_opt chain_state (h, i) =
+    State.Block.read_opt chain_state h >>= function
+    | None -> Lwt.return_none
+    | Some b ->
+        State.Block.operation_hashes b i >>= fun (ops, _) ->
+        Lwt.return_some ops
+  let read_exn chain_state (h, i) =
+    State.Block.read_exn chain_state h >>= fun b ->
+    State.Block.operation_hashes b i >>= fun (ops, _) ->
+    Lwt.return ops
+end
+
+module Operations_table =
+  Hashtbl.Make(struct
+    type t = Block_hash.t * int
+    let hash = Hashtbl.hash
+    let equal (b1, i1) (b2, i2) =
+      Block_hash.equal b1 b2 && i1 = i2
+  end)
+
+module Raw_operation_hashes = struct
+
+  include
+    Make_raw
+      (struct
+        type t = Block_hash.t * int
+        let name = "operation_hashes"
+        let pp ppf (h, n) = Format.fprintf ppf "%a:%d" Block_hash.pp h n
+        let encoding =
+          let open Data_encoding in
+          obj2 (req "block" Block_hash.encoding) (req "index" uint16)
+        module Logging = struct
+          let tag = Tag.def ~doc:"Operation hashes" "operation_hashes" pp
+        end
+      end)
+      (Operation_hashes_storage)
+      (Operations_table)
+      (struct
+        type param = unit
+        let max_length = 10
+        let initial_delay = 1.
+        let forge () keys =
+          Message.Get_operation_hashes_for_blocks keys
+      end)
+      (struct
+        type param = Operation_list_list_hash.t
+        type notified_value =
+          Operation_hash.t list * Operation_list_list_hash.path
+        let precheck (_block, expected_ofs) expected_hash (ops, path) =
+          let received_hash, received_ofs =
+            Operation_list_list_hash.check_path path
+              (Operation_list_hash.compute ops) in
+          if
+            received_ofs = expected_ofs &&
+            Operation_list_list_hash.compare expected_hash received_hash = 0
+          then
+            Some ops
+          else
+            None
+      end)
+
+  let inject_all table hash operations =
+    Lwt_list.mapi_p
+      (fun i ops -> Table.inject table (hash, i) ops)
+      operations >>= Lwt_list.for_all_s (fun x -> Lwt.return x)
+
+  let read_all table hash n =
+    map_p (fun i -> Table.read table (hash, i)) (0 -- (n-1))
+
+  let clear_all table hash n =
+    List.iter (fun i -> Table.clear_or_cancel table (hash, i)) (0 -- (n-1))
+
+end
+
+module Operations_storage = struct
+  type store = State.Chain.t
+  type value = Operation.t list
+  let known chain_state (h, _) = State.Block.known_valid chain_state h
+  let read chain_state (h, i) =
+    State.Block.read chain_state h >>=? fun b ->
+    State.Block.operations b i >>= fun (ops, _) ->
+    return ops
+  let read_opt chain_state (h, i) =
+    State.Block.read_opt chain_state h >>= function
+    | None -> Lwt.return_none
+    | Some b ->
+        State.Block.operations b i >>= fun (ops, _) ->
+        Lwt.return_some ops
+  let read_exn chain_state (h, i) =
+    State.Block.read_exn chain_state h >>= fun b ->
+    State.Block.operations b i >>= fun (ops, _) ->
+    Lwt.return ops
+end
+
+module Raw_operations = struct
+  include
+    Make_raw
+      (struct
+        type t = Block_hash.t * int
+        let name = "operations"
+        let pp ppf (h, n) = Format.fprintf ppf "%a:%d" Block_hash.pp h n
+        let encoding =
+          let open Data_encoding in
+          obj2 (req "block" Block_hash.encoding) (req "index" uint16)
+        module Logging = struct
+          let tag = Tag.def ~doc:"Operations" "operations" pp
+        end
+      end)
+      (Operations_storage)
+      (Operations_table)
+      (struct
+        type param = unit
+        let max_length = 10
+        let initial_delay = 1.
+        let forge () keys =
+          Message.Get_operations_for_blocks keys
+      end)
+      (struct
+        type param = Operation_list_list_hash.t
+        type notified_value = Operation.t list * Operation_list_list_hash.path
+        let precheck (_block, expected_ofs) expected_hash (ops, path) =
+          let received_hash, received_ofs =
+            Operation_list_list_hash.check_path path
+              (Operation_list_hash.compute
+                 (List.map Operation.hash ops)) in
+          if
+            received_ofs = expected_ofs &&
+            Operation_list_list_hash.compare expected_hash received_hash = 0
+          then
+            Some ops
+          else
+            None
+      end)
+
+  let inject_all table hash operations =
+    Lwt_list.mapi_p
+      (fun i ops -> Table.inject table (hash, i) ops)
+      operations >>= Lwt_list.for_all_s (fun x -> Lwt.return x)
+
+  let read_all table hash n =
+    map_p (fun i -> Table.read table (hash, i)) (0 -- (n-1))
+
+  let clear_all table hash n =
+    List.iter (fun i -> Table.clear_or_cancel table (hash, i)) (0 -- (n-1))
+
+end
+
+module Protocol_storage = struct
+  type store = State.t
+  type value = Protocol.t
+  let known = State.Protocol.known
+  let read = State.Protocol.read
+  let read_opt = State.Protocol.read_opt
+  let read_exn = State.Protocol.read_exn
+end
+
+module Raw_protocol =
+  Make_raw
+    (Protocol_hash)
+    (Protocol_storage)
+    (Protocol_hash.Table)
+    (struct
+      type param = unit
+      let initial_delay = 10.
+      let max_length = 10
+      let forge () keys = Message.Get_protocols keys
+    end)
+    (struct
+      type param = unit
+      type notified_value = Protocol.t
+      let precheck _ _ v = Some v
+    end)
+
+type callback = {
+  notify_branch:
+    P2p_peer.Id.t -> Block_locator.t -> unit ;
+  notify_head:
+    P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ;
+  disconnection: P2p_peer.Id.t -> unit ;
+}
+
+type db = {
+  p2p: p2p ;
+  p2p_readers: p2p_reader P2p_peer.Table.t ;
+  disk: State.t ;
+  active_chains: chain_db Chain_id.Table.t ;
+  protocol_db: Raw_protocol.t ;
+  block_input: (Block_hash.t * Block_header.t) Lwt_watcher.input ;
+  operation_input: (Operation_hash.t * Operation.t) Lwt_watcher.input ;
+}
+
+and chain_db = {
+  chain_state: State.Chain.t ;
+  global_db: db ;
+  operation_db: Raw_operation.t ;
+  block_header_db: Raw_block_header.t ;
+  operation_hashes_db: Raw_operation_hashes.t ;
+  operations_db: Raw_operations.t ;
+  mutable callback: callback ;
+  active_peers: P2p_peer.Set.t ref ;
+  active_connections: p2p_reader P2p_peer.Table.t ;
+}
+
+and p2p_reader = {
+  gid: P2p_peer.Id.t ;
+  conn: connection ;
+  peer_active_chains: chain_db Chain_id.Table.t ;
+  canceler: Lwt_canceler.t ;
+  mutable worker: unit Lwt.t ;
+}
+
+let noop_callback = {
+  notify_branch = begin fun _gid _locator -> () end ;
+  notify_head =  begin fun _gid _block _ops -> () end ;
+  disconnection = begin fun _gid -> () end ;
+}
+
+type t = db
+
+let state { disk } = disk
+let chain_state { chain_state } = chain_state
+let db { global_db } = global_db
+
+let my_peer_id chain_db = P2p.peer_id chain_db.global_db.p2p
+
+let get_peer_metadata chain_db = P2p.get_peer_metadata chain_db.global_db.p2p
+
+let read_block_header { disk } h =
+  State.read_block disk h >>= function
+  | Some b ->
+      Lwt.return_some (State.Block.chain_id b, State.Block.header b)
+  | None ->
+      Lwt.return_none
+
+let find_pending_block_header { peer_active_chains } h  =
+  Chain_id.Table.fold
+    (fun _chain_id chain_db acc ->
+       match acc with
+       | Some _ -> acc
+       | None when Raw_block_header.Table.pending
+             chain_db.block_header_db.table h ->
+           Some chain_db
+       | None -> None)
+    peer_active_chains
+    None
+
+let find_pending_operations { peer_active_chains } h i =
+  Chain_id.Table.fold
+    (fun _chain_id chain_db acc ->
+       match acc with
+       | Some _ -> acc
+       | None when Raw_operations.Table.pending
+             chain_db.operations_db.table (h, i) ->
+           Some chain_db
+       | None -> None)
+    peer_active_chains
+    None
+
+let find_pending_operation_hashes { peer_active_chains } h i =
+  Chain_id.Table.fold
+    (fun _chain_id chain_db acc ->
+       match acc with
+       | Some _ -> acc
+       | None when Raw_operation_hashes.Table.pending
+             chain_db.operation_hashes_db.table (h, i) ->
+           Some chain_db
+       | None -> None)
+    peer_active_chains
+    None
+
+let find_pending_operation { peer_active_chains } h =
+  Chain_id.Table.fold
+    (fun _chain_id chain_db acc ->
+       match acc with
+       | Some _ -> acc
+       | None when Raw_operation.Table.pending
+             chain_db.operation_db.table h ->
+           Some chain_db
+       | None -> None)
+    peer_active_chains
+    None
+
+let read_operation { active_chains } h =
+  Chain_id.Table.fold
+    (fun chain_id chain_db acc ->
+       acc >>= function
+       | Some _ -> acc
+       | None ->
+           Raw_operation.Table.read_opt
+             chain_db.operation_db.table h >>= function
+           | None -> Lwt.return_none
+           | Some bh -> Lwt.return_some (chain_id, bh))
+    active_chains
+    Lwt.return_none
+
+module P2p_reader = struct
+
+  let may_activate global_db state chain_id f =
+    match Chain_id.Table.find_opt state.peer_active_chains chain_id with
+    | Some chain_db ->
+        f chain_db
+    | None ->
+        match Chain_id.Table.find_opt global_db.active_chains chain_id with
+        | Some chain_db ->
+            chain_db.active_peers :=
+              P2p_peer.Set.add state.gid !(chain_db.active_peers) ;
+            P2p_peer.Table.add chain_db.active_connections
+              state.gid state ;
+            Chain_id.Table.add state.peer_active_chains chain_id chain_db ;
+            f chain_db
+        | None ->
+            let meta = P2p.get_peer_metadata global_db.p2p state.gid in
+            Peer_metadata.incr meta Unactivated_chain ;
+            Lwt.return_unit
+
+  let deactivate state chain_db =
+    chain_db.callback.disconnection state.gid ;
+    chain_db.active_peers :=
+      P2p_peer.Set.remove state.gid !(chain_db.active_peers) ;
+    P2p_peer.Table.remove chain_db.active_connections state.gid
+
+  (* check if the chain advertized by a peer is (still) active *)
+  let may_handle global_db state chain_id f =
+    match Chain_id.Table.find_opt state.peer_active_chains chain_id with
+    | None ->
+        let meta = P2p.get_peer_metadata global_db.p2p state.gid in
+        Peer_metadata.incr meta Inactive_chain ;
+        Lwt.return_unit
+    | Some chain_db ->
+        f chain_db
+
+  let may_handle_global global_db chain_id f =
+    match Chain_id.Table.find_opt global_db.active_chains chain_id with
+    | None ->
+        Lwt.return_unit
+    | Some chain_db ->
+        f chain_db
+
+  module Handle_msg_Logging =
+    Tezos_stdlib.Logging.Make_semantic(struct let name = "node.distributed_db.p2p_reader" end)
+
+  let handle_msg global_db state msg =
+
+    let open Message in
+    let open Handle_msg_Logging in
+    let meta = P2p.get_peer_metadata global_db.p2p state.gid in
+
+    lwt_debug Tag.DSL.(fun f ->
+        f "Read message from %a: %a"
+        -% t event "read_message"
+        -% a P2p_peer.Id.Logging.tag state.gid
+        -% a Message.Logging.tag msg) >>= fun () ->
+
+    match msg with
+    | Get_current_branch chain_id ->
+        Peer_metadata.incr meta @@ Received_request Branch;
+        may_handle_global global_db chain_id @@ fun chain_db ->
+        if not (Chain_id.Table.mem state.peer_active_chains chain_id) then
+          Peer_metadata.update_requests meta Branch @@
+          P2p.try_send global_db.p2p state.conn @@
+          Get_current_branch chain_id ;
+        let seed = {
+          Block_locator.receiver_id=state.gid;
+          sender_id=(my_peer_id chain_db) } in
+        (Chain.locator chain_db.chain_state seed) >>= fun locator ->
+        Peer_metadata.update_responses meta Branch @@
+        P2p.try_send global_db.p2p state.conn @@
+        Current_branch (chain_id, locator)  ;
+        Lwt.return_unit
+
+    | Current_branch (chain_id, locator) ->
+        may_activate global_db state chain_id @@ fun chain_db ->
+        let head, hist = (locator :> Block_header.t * Block_hash.t list) in
+        Lwt_list.exists_p
+          (State.Block.known_invalid chain_db.chain_state)
+          (Block_header.hash head :: hist) >>= fun known_invalid ->
+        if known_invalid then begin
+          P2p.disconnect global_db.p2p state.conn >>= fun () ->
+          P2p.greylist_peer global_db.p2p state.gid ;
+          Lwt.return_unit
+        end else if Time.(add (now ()) 15L < head.shell.timestamp) then begin
+          Peer_metadata.incr meta Future_block ;
+          lwt_log_notice Tag.DSL.(fun f ->
+              f "Received future block %a from peer %a."
+              -% t event "received_future_block"
+              -% a Block_hash.Logging.tag (Block_header.hash head)
+              -% a P2p_peer.Id.Logging.tag state.gid) >>= fun () ->
+          Lwt.return_unit
+        end else begin
+          chain_db.callback.notify_branch state.gid locator ;
+          (* TODO discriminate between received advertisements
+             and responses? *)
+          Peer_metadata.incr meta @@ Received_advertisement Branch ;
+          Lwt.return_unit
+        end
+
+    | Deactivate chain_id ->
+        may_handle global_db state chain_id @@ fun chain_db ->
+        deactivate state chain_db ;
+        Chain_id.Table.remove state.peer_active_chains chain_id ;
+        Lwt.return_unit
+
+    | Get_current_head chain_id ->
+        may_handle global_db state chain_id @@ fun chain_db ->
+        Peer_metadata.incr meta @@ Received_request Head ;
+        let { Connection_metadata.disable_mempool } =
+          P2p.connection_remote_metadata chain_db.global_db.p2p state.conn in
+        begin
+          if disable_mempool then
+            Chain.head chain_db.chain_state >>= fun head ->
+            Lwt.return (State.Block.header head, Mempool.empty)
+          else
+            State.Current_mempool.get chain_db.chain_state
+        end >>= fun (head, mempool) ->
+        (* TODO bound the sent mempool size *)
+        Peer_metadata.update_responses meta Head @@
+        P2p.try_send global_db.p2p state.conn @@
+        Current_head (chain_id, head, mempool) ;
+        Lwt.return_unit
+
+    | Current_head (chain_id, header, mempool) ->
+        may_handle global_db state chain_id @@ fun chain_db ->
+        let head = Block_header.hash header in
+        State.Block.known_invalid chain_db.chain_state head >>= fun known_invalid ->
+        let { Connection_metadata.disable_mempool } =
+          P2p.connection_local_metadata chain_db.global_db.p2p state.conn in
+        let known_invalid =
+          known_invalid ||
+          (disable_mempool && mempool <> Mempool.empty)
+          (* A non-empty mempool was received while mempool is desactivated,
+               so the message is ignored.
+               This should probably warrant a reduction of the sender's score. *)
+        in
+        if known_invalid then begin
+          P2p.disconnect global_db.p2p state.conn >>= fun () ->
+          P2p.greylist_peer global_db.p2p state.gid ;
+          Lwt.return_unit
+        end else if Time.(add (now ()) 15L < header.shell.timestamp) then begin
+          Peer_metadata.incr meta Future_block ;
+          lwt_log_notice Tag.DSL.(fun f ->
+              f "Received future block %a from peer %a."
+              -% t event "received_future_block"
+              -% a Block_hash.Logging.tag head
+              -% a P2p_peer.Id.Logging.tag state.gid) >>= fun () ->
+          Lwt.return_unit
+        end else begin
+          chain_db.callback.notify_head state.gid header mempool ;
+          (* TODO discriminate between received advertisements
+             and responses? *)
+          Peer_metadata.incr meta @@ Received_advertisement Head ;
+          Lwt.return_unit
+        end
+
+    | Get_block_headers hashes ->
+        Peer_metadata.incr meta @@ Received_request Block_header ;
+        Lwt_list.iter_p
+          (fun hash ->
+             read_block_header global_db hash >>= function
+             | None ->
+                 Peer_metadata.incr meta @@ Unadvertised Block ;
+                 Lwt.return_unit
+             | Some (_chain_id, header) ->
+                 Peer_metadata.update_responses meta Block_header @@
+                 P2p.try_send global_db.p2p state.conn @@
+                 Block_header header ;
+                 Lwt.return_unit)
+          hashes
+    | Block_header block -> begin
+        let hash = Block_header.hash block in
+        match find_pending_block_header state hash with
+        | None ->
+            Peer_metadata.incr meta Unexpected_response ;
+            Lwt.return_unit
+        | Some chain_db ->
+            Raw_block_header.Table.notify
+              chain_db.block_header_db.table state.gid hash block >>= fun () ->
+            Peer_metadata.incr meta @@ Received_response Block_header ;
+            Lwt.return_unit
+      end
+
+    | Get_operations hashes ->
+        Peer_metadata.incr meta @@ Received_request Operations ;
+        Lwt_list.iter_p
+          (fun hash ->
+             read_operation global_db hash >>= function
+             | None ->
+                 Peer_metadata.incr meta @@ Unadvertised Operations ;
+                 Lwt.return_unit
+             | Some (_chain_id, op) ->
+                 Peer_metadata.update_responses meta Operations @@
+                 P2p.try_send global_db.p2p state.conn @@
+                 Operation op ;
+                 Lwt.return_unit)
+          hashes
+
+    | Operation operation -> begin
+        let hash = Operation.hash operation in
+        match find_pending_operation state hash with
+        | None ->
+            Peer_metadata.incr meta Unexpected_response ;
+            Lwt.return_unit
+        | Some chain_db ->
+            Raw_operation.Table.notify
+              chain_db.operation_db.table state.gid hash operation >>= fun () ->
+            Peer_metadata.incr meta @@ Received_response Operations ;
+            Lwt.return_unit
+      end
+
+    | Get_protocols hashes ->
+        Peer_metadata.incr meta @@ Received_request Protocols ;
+        Lwt_list.iter_p
+          (fun hash ->
+             State.Protocol.read_opt global_db.disk hash >>= function
+             | None ->
+                 Peer_metadata.incr meta @@ Unadvertised Protocol ;
+                 Lwt.return_unit
+             | Some p ->
+                 Peer_metadata.update_responses meta Protocols @@
+                 P2p.try_send global_db.p2p state.conn @@
+                 Protocol p ;
+                 Lwt.return_unit)
+          hashes
+
+    | Protocol protocol ->
+        let hash = Protocol.hash protocol in
+        Raw_protocol.Table.notify
+          global_db.protocol_db.table state.gid hash protocol >>= fun () ->
+        Peer_metadata.incr meta @@ Received_response Protocols ;
+        Lwt.return_unit
+
+    | Get_operation_hashes_for_blocks blocks ->
+        Peer_metadata.incr meta @@
+        Received_request Operation_hashes_for_block ;
+        Lwt_list.iter_p
+          (fun (hash, ofs) ->
+             State.read_block global_db.disk hash >>= function
+             | None -> Lwt.return_unit
+             | Some block ->
+                 State.Block.operation_hashes
+                   block ofs >>= fun (hashes, path) ->
+                 Peer_metadata.update_responses meta
+                   Operation_hashes_for_block @@
+                 P2p.try_send global_db.p2p state.conn @@
+                 Operation_hashes_for_block (hash, ofs, hashes, path) ;
+                 Lwt.return_unit)
+          blocks
+
+    | Operation_hashes_for_block (block, ofs, ops, path) -> begin
+        match find_pending_operation_hashes state block ofs with
+        | None ->
+            Peer_metadata.incr meta Unexpected_response ;
+            Lwt.return_unit
+        | Some chain_db ->
+            Raw_operation_hashes.Table.notify
+              chain_db.operation_hashes_db.table state.gid
+              (block, ofs) (ops, path) >>= fun () ->
+            Peer_metadata.incr meta @@
+            Received_response Operation_hashes_for_block ;
+            Lwt.return_unit
+      end
+
+    | Get_operations_for_blocks blocks ->
+        Peer_metadata.incr meta @@
+        Received_request Operations_for_block ;
+        Lwt_list.iter_p
+          (fun (hash, ofs) ->
+             State.read_block global_db.disk hash >>= function
+             | None -> Lwt.return_unit
+             | Some block ->
+                 State.Block.operations
+                   block ofs >>= fun (ops, path) ->
+                 Peer_metadata.update_responses meta
+                   Operations_for_block @@
+                 P2p.try_send global_db.p2p state.conn @@
+                 Operations_for_block (hash, ofs, ops, path) ;
+                 Lwt.return_unit)
+          blocks
+
+    | Operations_for_block (block, ofs, ops, path) -> begin
+        match find_pending_operations state block ofs with
+        | None ->
+            Peer_metadata.incr meta Unexpected_response ;
+            Lwt.return_unit
+        | Some chain_db ->
+            Raw_operations.Table.notify
+              chain_db.operations_db.table state.gid
+              (block, ofs) (ops, path) >>= fun () ->
+            Peer_metadata.incr meta @@
+            Received_response Operations_for_block ;
+            Lwt.return_unit
+      end
+
+  let rec worker_loop global_db state =
+    protect ~canceler:state.canceler begin fun () ->
+      P2p.recv global_db.p2p state.conn
+    end >>= function
+    | Ok msg ->
+        handle_msg global_db state msg >>= fun () ->
+        worker_loop global_db state
+    | Error _ ->
+        Chain_id.Table.iter
+          (fun _ -> deactivate state)
+          state.peer_active_chains ;
+        P2p_peer.Table.remove global_db.p2p_readers state.gid ;
+        Lwt.return_unit
+
+  let run db gid conn =
+    let canceler = Lwt_canceler.create () in
+    let state = {
+      conn ; gid ; canceler ;
+      peer_active_chains = Chain_id.Table.create 17 ;
+      worker = Lwt.return_unit ;
+    } in
+    Chain_id.Table.iter (fun chain_id _chain_db ->
+        Lwt.async begin fun () ->
+          let meta = P2p.get_peer_metadata db.p2p gid in
+          Peer_metadata.incr meta (Sent_request Branch) ;
+          P2p.send db.p2p conn (Get_current_branch chain_id)
+        end)
+      db.active_chains ;
+    state.worker <-
+      Lwt_utils.worker
+        (Format.asprintf "db_network_reader.%a"
+           P2p_peer.Id.pp_short gid)
+        ~run:(fun () -> worker_loop db state)
+        ~cancel:(fun () -> Lwt_canceler.cancel canceler) ;
+    P2p_peer.Table.add db.p2p_readers gid state
+
+  let shutdown s =
+    Lwt_canceler.cancel s.canceler >>= fun () ->
+    s.worker
+
+end
+
+let active_peer_ids p2p () =
+  List.fold_left
+    (fun acc conn ->
+       let { P2p_connection.Info.peer_id } = P2p.connection_info p2p conn in
+       P2p_peer.Set.add peer_id acc)
+    P2p_peer.Set.empty
+    (P2p.connections p2p)
+
+let raw_try_send p2p peer_id msg =
+  match P2p.find_connection p2p peer_id with
+  | None -> ()
+  | Some conn -> ignore (P2p.try_send p2p conn msg : bool)
+
+
+let create disk p2p =
+  let global_request =
+    { p2p ;
+      data = () ;
+      active = active_peer_ids p2p ;
+      send = raw_try_send p2p ;
+    } in
+  let protocol_db = Raw_protocol.create global_request disk in
+  let active_chains = Chain_id.Table.create 17 in
+  let p2p_readers = P2p_peer.Table.create 17 in
+  let block_input = Lwt_watcher.create_input () in
+  let operation_input = Lwt_watcher.create_input () in
+  let db =
+    { p2p ; p2p_readers ; disk ;
+      active_chains ; protocol_db ;
+      block_input ; operation_input ;
+    } in
+  db
+
+let activate ({ p2p ; active_chains } as global_db) chain_state =
+  P2p.on_new_connection p2p (P2p_reader.run global_db) ;
+  P2p.iter_connections p2p (P2p_reader.run global_db) ;
+  P2p.activate p2p;
+  let chain_id = State.Chain.id chain_state in
+  match Chain_id.Table.find_opt active_chains chain_id with
+  | None ->
+      let active_peers = ref P2p_peer.Set.empty in
+      let p2p_request =
+        { p2p ;
+          data = () ;
+          active = (fun () -> !active_peers) ;
+          send = raw_try_send p2p ;
+        } in
+      let operation_db =
+        Raw_operation.create
+          ~global_input:global_db.operation_input p2p_request chain_state in
+      let block_header_db =
+        Raw_block_header.create
+          ~global_input:global_db.block_input p2p_request chain_state in
+      let operation_hashes_db =
+        Raw_operation_hashes.create p2p_request chain_state in
+      let operations_db =
+        Raw_operations.create p2p_request chain_state in
+      let chain = {
+        global_db ; operation_db ; block_header_db ;
+        operation_hashes_db ; operations_db ;
+        chain_state ; callback = noop_callback ; active_peers ;
+        active_connections = P2p_peer.Table.create 53 ;
+      } in
+      P2p.iter_connections p2p (fun _peer_id conn ->
+          Lwt.async begin fun () ->
+            P2p.send p2p conn (Get_current_branch chain_id)
+          end) ;
+      Chain_id.Table.add active_chains chain_id chain ;
+      chain
+  | Some chain ->
+      chain
+
+let set_callback chain_db callback =
+  chain_db.callback <- callback
+
+let deactivate chain_db =
+  let { active_chains ; p2p } = chain_db.global_db in
+  let chain_id = State.Chain.id chain_db.chain_state in
+  Chain_id.Table.remove active_chains chain_id ;
+  P2p_peer.Table.iter
+    (fun _peer_id reader ->
+       P2p_reader.deactivate reader chain_db  ;
+       Lwt.async begin fun () ->
+         P2p.send p2p reader.conn (Deactivate chain_id)
+       end)
+    chain_db.active_connections ;
+  Raw_operation.shutdown chain_db.operation_db >>= fun () ->
+  Raw_block_header.shutdown chain_db.block_header_db >>= fun () ->
+  Lwt.return_unit >>= fun () ->
+  Lwt.return_unit
+
+let get_chain { active_chains } chain_id =
+  Chain_id.Table.find_opt active_chains chain_id
+
+let greylist { global_db = { p2p } } peer_id =
+  Lwt.return (P2p.greylist_peer p2p peer_id)
+
+let disconnect { global_db = { p2p } } peer_id =
+  match P2p.find_connection p2p peer_id with
+  | None -> Lwt.return_unit
+  | Some conn -> P2p.disconnect p2p conn
+
+let shutdown { p2p_readers ; active_chains } =
+  P2p_peer.Table.fold
+    (fun _peer_id reader acc ->
+       P2p_reader.shutdown reader >>= fun () -> acc)
+    p2p_readers
+    Lwt.return_unit >>= fun () ->
+  Chain_id.Table.fold
+    (fun _ chain_db acc ->
+       Raw_operation.shutdown chain_db.operation_db >>= fun () ->
+       Raw_block_header.shutdown chain_db.block_header_db >>= fun () ->
+       acc)
+    active_chains
+    Lwt.return_unit >>= fun () ->
+  Lwt.return_unit
+
+let clear_block chain_db hash n =
+  Raw_operations.clear_all chain_db.operations_db.table hash n ;
+  Raw_operation_hashes.clear_all chain_db.operation_hashes_db.table hash n ;
+  Raw_block_header.Table.clear_or_cancel chain_db.block_header_db.table hash
+
+let commit_block chain_db hash
+    header header_data operations operations_data result =
+  assert (Block_hash.equal hash (Block_header.hash header)) ;
+  assert (List.length operations = header.shell.validation_passes) ;
+  State.Block.store chain_db.chain_state
+    header header_data operations operations_data result >>=? fun res ->
+  clear_block chain_db hash header.shell.validation_passes ;
+  return res
+
+let commit_invalid_block chain_db hash header errors =
+  assert (Block_hash.equal hash (Block_header.hash header)) ;
+  State.Block.store_invalid chain_db.chain_state header errors >>=? fun res ->
+  clear_block chain_db hash header.shell.validation_passes ;
+  return res
+
+let inject_operation chain_db h op =
+  assert (Operation_hash.equal h (Operation.hash op)) ;
+  Raw_operation.Table.inject chain_db.operation_db.table h op
+
+let commit_protocol db h p =
+  State.Protocol.store db.disk p >>= fun res ->
+  Raw_protocol.Table.clear_or_cancel db.protocol_db.table h ;
+  return (res <> None)
+
+let watch_block_header { block_input } =
+  Lwt_watcher.create_stream block_input
+let watch_operation { operation_input } =
+  Lwt_watcher.create_stream operation_input
+
+module Raw = struct
+  let encoding = P2p.Raw.encoding Message.cfg.encoding
+  let supported_versions = Message.cfg.versions
+end
+
+module Make
+    (Table : Distributed_db_functors.DISTRIBUTED_DB)
+    (Kind : sig
+       type t
+       val proj: t -> Table.t
+     end) = struct
+  type key = Table.key
+  type value = Table.value
+  let known t k = Table.known (Kind.proj t) k
+  type error += Missing_data = Table.Missing_data
+  type error += Canceled = Table.Canceled
+  type error += Timeout = Table.Timeout
+  let read t k = Table.read (Kind.proj t) k
+  let read_opt t k = Table.read_opt (Kind.proj t) k
+  let read_exn t k = Table.read_exn (Kind.proj t) k
+  let prefetch t ?peer ?timeout k p =
+    Table.prefetch (Kind.proj t) ?peer ?timeout k p
+  let fetch t ?peer ?timeout k p =
+    Table.fetch (Kind.proj t) ?peer ?timeout k p
+  let clear_or_cancel t k = Table.clear_or_cancel (Kind.proj t) k
+  let inject t k v = Table.inject (Kind.proj t) k v
+  let pending t k = Table.pending (Kind.proj t) k
+  let watch t = Table.watch (Kind.proj t)
+end
+
+module Block_header = struct
+  type t = Block_header.t
+  include (Make (Raw_block_header.Table) (struct
+             type t = chain_db
+             let proj chain = chain.block_header_db.table
+           end) : Distributed_db_functors.DISTRIBUTED_DB with type t := chain_db
+                                                          and type key := Block_hash.t
+                                                          and type value := Block_header.t
+                                                          and type param := unit)
+end
+
+module Operation_hashes =
+  Make (Raw_operation_hashes.Table) (struct
+    type t = chain_db
+    let proj chain = chain.operation_hashes_db.table
+  end)
+
+module Operations =
+  Make (Raw_operations.Table) (struct
+    type t = chain_db
+    let proj chain = chain.operations_db.table
+  end)
+
+module Operation = struct
+  include Operation
+  include (Make (Raw_operation.Table) (struct
+             type t = chain_db
+             let proj chain = chain.operation_db.table
+           end) : Distributed_db_functors.DISTRIBUTED_DB with type t := chain_db
+                                                          and type key := Operation_hash.t
+                                                          and type value := Operation.t
+                                                          and type param := unit)
+end
+
+module Protocol = struct
+  type t = Protocol.t
+  include (Make (Raw_protocol.Table) (struct
+             type t = db
+             let proj db = db.protocol_db.table
+           end) : Distributed_db_functors.DISTRIBUTED_DB with type t := db
+                                                          and type key := Protocol_hash.t
+                                                          and type value := Protocol.t
+                                                          and type param := unit)
+end
+
+
+let broadcast chain_db msg =
+  P2p_peer.Table.iter
+    (fun _peer_id state ->
+       ignore (P2p.try_send chain_db.global_db.p2p state.conn msg))
+    chain_db.active_connections
+
+let try_send chain_db peer_id msg =
+  match P2p_peer.Table.find_opt chain_db.active_connections peer_id with
+  | None -> ()
+  | Some conn ->
+      ignore (P2p.try_send chain_db.global_db.p2p conn.conn msg : bool)
+
+let send chain_db ?peer msg =
+  match peer with
+  | Some peer -> try_send chain_db peer msg
+  | None -> broadcast chain_db msg
+
+module Request = struct
+
+  let current_head chain_db ?peer () =
+    let chain_id = State.Chain.id chain_db.chain_state in
+    begin match peer with
+      |Some peer ->
+          let meta = P2p.get_peer_metadata chain_db.global_db.p2p peer in
+          Peer_metadata.incr meta (Sent_request Head)
+      |None -> ()
+    end ;
+    send chain_db ?peer @@ Get_current_head chain_id
+
+  let current_branch chain_db ?peer () =
+    let chain_id = State.Chain.id chain_db.chain_state in
+    begin match peer with
+      |Some peer ->
+          let meta = P2p.get_peer_metadata chain_db.global_db.p2p peer in
+          Peer_metadata.incr meta (Sent_request Head)
+      |None -> ()
+    end ;
+    send chain_db ?peer @@ Get_current_branch chain_id
+
+end
+
+module Advertise = struct
+
+  let current_head chain_db ?peer ?(mempool = Mempool.empty) head =
+    let chain_id = State.Chain.id chain_db.chain_state in
+    assert (Chain_id.equal chain_id (State.Block.chain_id head)) ;
+    begin match peer with
+      | Some peer ->
+          let meta = P2p.get_peer_metadata chain_db.global_db.p2p peer in
+          Peer_metadata.incr meta (Sent_advertisement Head)
+      | None -> ()
+    end ;
+    let msg_mempool =
+      Message.Current_head (chain_id, State.Block.header head, mempool) in
+    if mempool = Mempool.empty then
+      send chain_db ?peer msg_mempool
+    else
+      let msg_disable_mempool =
+        Message.Current_head (chain_id, State.Block.header head, Mempool.empty) in
+      let send_mempool state =
+        let { Connection_metadata.disable_mempool } =
+          P2p.connection_remote_metadata chain_db.global_db.p2p state.conn in
+        let msg = if disable_mempool then msg_disable_mempool else msg_mempool in
+        ignore @@ P2p.try_send chain_db.global_db.p2p state.conn msg
+      in
+      match peer with
+      | Some receiver_id ->
+          let state = P2p_peer.Table.find chain_db.active_connections receiver_id in
+          send_mempool state
+      | None ->
+          List.iter (fun (_receiver_id, state) -> send_mempool state)
+            (P2p_peer.Table.fold (fun k v acc -> (k,v)::acc) chain_db.active_connections [])
+
+  let current_branch ?peer chain_db =
+    let chain_id = State.Chain.id chain_db.chain_state in
+    let chain_state = chain_state chain_db in
+    let sender_id = my_peer_id chain_db in
+    begin match peer with
+      | Some peer ->
+          let meta = P2p.get_peer_metadata chain_db.global_db.p2p peer in
+          Peer_metadata.incr meta (Sent_advertisement Branch)
+      | None -> ()
+    end ;
+
+    match peer with
+    | Some receiver_id ->
+        let seed = {
+          Block_locator.receiver_id=receiver_id; sender_id } in
+        (Chain.locator chain_state seed) >>= fun locator ->
+        let msg = Message.Current_branch (chain_id, locator) in
+        try_send chain_db receiver_id msg;
+        Lwt.return_unit
+    | None ->
+        Lwt_list.iter_p
+          (fun (receiver_id,state) ->
+             let seed = {
+               Block_locator.receiver_id=receiver_id; sender_id } in
+             (Chain.locator chain_state seed) >>= fun locator ->
+             let msg = Message.Current_branch (chain_id, locator) in
+             ignore (P2p.try_send chain_db.global_db.p2p state.conn msg);
+             Lwt.return_unit
+          ) (P2p_peer.Table.fold (fun k v acc -> (k,v)::acc) chain_db.active_connections [])
+
+end
+
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db.mli b/vendors/tezos-modded/src/lib_shell/distributed_db.mli
new file mode 100644
index 000000000..cbf410689
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db.mli
@@ -0,0 +1,205 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - High-level API for the Gossip network and local storage. *)
+
+open Distributed_db_functors
+
+type t
+type db = t
+
+module Message = Distributed_db_message
+
+type p2p = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.net
+
+val create: State.t -> p2p -> t
+val state: db -> State.t
+val shutdown: t -> unit Lwt.t
+
+(** {1 Network database} *)
+
+(** An instance of the distributed DB for a given chain (mainchain,
+    current testchain, ...) *)
+type chain_db
+
+(** Activate a given chain. The node will notify its neighbours that
+    it now handles the given chain and that it expects notification
+    for new head or new operations. *)
+val activate: t -> State.Chain.t -> chain_db
+
+(** Look for the database of an active chain. *)
+val get_chain: t -> Chain_id.t -> chain_db option
+
+(** Deactivate a given chain. The node will notify its neighbours
+    that it does not care anymore about this chain. *)
+val deactivate: chain_db -> unit Lwt.t
+
+type callback = {
+  notify_branch: P2p_peer.Id.t -> Block_locator.t -> unit ;
+  notify_head: P2p_peer.Id.t -> Block_header.t -> Mempool.t -> unit ;
+  disconnection: P2p_peer.Id.t -> unit ;
+}
+
+(** Register all the possible callback from the distributed DB to the
+    validator. *)
+val set_callback: chain_db -> callback -> unit
+
+(** Kick a given peer. *)
+val disconnect: chain_db -> P2p_peer.Id.t -> unit Lwt.t
+
+(** Greylist a given peer. *)
+val greylist: chain_db -> P2p_peer.Id.t -> unit Lwt.t
+
+(** Various accessors. *)
+val chain_state: chain_db -> State.Chain.t
+val db: chain_db -> db
+
+(** Return the peer id of the node *)
+val my_peer_id: chain_db -> P2p_peer.Id.t
+
+val get_peer_metadata: chain_db -> P2p_peer.Id.t -> Peer_metadata.t
+
+(** {1 Sending messages} *)
+
+module Request : sig
+
+  (** Send to a given peer, or to all known active peers for the
+      chain, a friendly request "Hey, what's your current branch
+      ?". The expected answer is a `Block_locator.t.`. *)
+  val current_branch: chain_db -> ?peer:P2p_peer.Id.t -> unit -> unit
+
+  (** Send to a given peer, or to all known active peers for the
+      given chain, a friendly request "Hey, what's your current
+      branch ?". The expected answer is a `Block_locator.t.`. *)
+  val current_head: chain_db -> ?peer:P2p_peer.Id.t -> unit -> unit
+
+end
+
+module Advertise : sig
+
+  (** Notify a given peer, or all known active peers for the
+      chain, of a new head and possibly of new operations. *)
+  val current_head:
+    chain_db -> ?peer:P2p_peer.Id.t ->
+    ?mempool:Mempool.t -> State.Block.t -> unit
+
+  (** Notify a given peer, or all known active peers for the
+      chain, of a new head and its sparse history. *)
+  val current_branch:
+    ?peer:P2p_peer.Id.t -> chain_db -> unit Lwt.t
+
+end
+
+(** {2 Block index} *)
+
+(** Index of block headers. *)
+module Block_header : sig
+  type t = Block_header.t (* avoid shadowing. *)
+  include DISTRIBUTED_DB with type t := chain_db
+                          and type key := Block_hash.t
+                          and type value := Block_header.t
+                          and type param := unit
+end
+
+(** Lookup for block header in any active chains *)
+val read_block_header:
+  db -> Block_hash.t -> (Chain_id.t * Block_header.t) option Lwt.t
+
+(** Index of all the operations of a given block (per validation pass). *)
+module Operations :
+  DISTRIBUTED_DB with type t := chain_db
+                  and type key = Block_hash.t * int
+                  and type value = Operation.t list
+                  and type param := Operation_list_list_hash.t
+
+(** Index of all the hashes of operations of a given block (per
+    validation pass). *)
+module Operation_hashes :
+  DISTRIBUTED_DB with type t := chain_db
+                  and type key = Block_hash.t * int
+                  and type value = Operation_hash.t list
+                  and type param := Operation_list_list_hash.t
+
+(** Store on disk all the data associated to a valid block. *)
+val commit_block:
+  chain_db ->
+  Block_hash.t ->
+  Block_header.t -> MBytes.t ->
+  Operation.t list list -> MBytes.t list list ->
+  State.Block.validation_store ->
+  State.Block.t option tzresult Lwt.t
+
+(** Store on disk all the data associated to an invalid block. *)
+val commit_invalid_block:
+  chain_db ->
+  Block_hash.t -> Block_header.t -> Error_monad.error list ->
+  bool tzresult Lwt.t
+
+(** Monitor all the fetched block headers (for all activate chains). *)
+val watch_block_header:
+  t -> (Block_hash.t * Block_header.t) Lwt_stream.t * Lwt_watcher.stopper
+
+
+(** {2 Operations index} *)
+
+(** Index of operations (for the mempool). *)
+module Operation : sig
+  type t = Operation.t (* avoid shadowing. *)
+  include DISTRIBUTED_DB with type t := chain_db
+                          and type key := Operation_hash.t
+                          and type value := Operation.t
+                          and type param := unit
+end
+
+(** Inject a new operation in the local index (memory only). *)
+val inject_operation:
+  chain_db -> Operation_hash.t -> Operation.t -> bool Lwt.t
+
+(** Monitor all the fetched operations (for all activate chains). *)
+val watch_operation:
+  t -> (Operation_hash.t * Operation.t) Lwt_stream.t * Lwt_watcher.stopper
+
+(** {2 Protocol index} *)
+
+(** Index of protocol sources. *)
+module Protocol : sig
+  type t = Protocol.t (* avoid shadowing. *)
+  include DISTRIBUTED_DB with type t := db
+                          and type key := Protocol_hash.t
+                          and type value := Protocol.t
+                          and type param := unit
+end
+
+(** Store on disk protocol sources. *)
+val commit_protocol:
+  db -> Protocol_hash.t -> Protocol.t -> bool tzresult Lwt.t
+
+(**/**)
+
+module Raw : sig
+  val encoding: Message.t P2p.Raw.t Data_encoding.t
+  val supported_versions: P2p_version.t list
+end
+
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db_functors.ml b/vendors/tezos-modded/src/lib_shell/distributed_db_functors.ml
new file mode 100644
index 000000000..311abe678
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db_functors.ml
@@ -0,0 +1,603 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type DISTRIBUTED_DB = sig
+
+  type t
+  type key
+  type value
+  type param
+
+  val known: t -> key -> bool Lwt.t
+
+  type error += Missing_data of key
+  type error += Canceled of key
+  type error += Timeout of key
+
+  val read: t -> key -> value tzresult Lwt.t
+  val read_opt: t -> key -> value option Lwt.t
+  val read_exn: t -> key -> value Lwt.t
+
+  val prefetch:
+    t ->
+    ?peer:P2p_peer.Id.t ->
+    ?timeout:float ->
+    key -> param -> unit
+
+  val fetch:
+    t ->
+    ?peer:P2p_peer.Id.t ->
+    ?timeout:float ->
+    key -> param -> value tzresult Lwt.t
+
+  val clear_or_cancel: t -> key -> unit
+  val inject: t -> key -> value -> bool Lwt.t
+  val watch: t -> (key * value) Lwt_stream.t * Lwt_watcher.stopper
+
+  val pending: t -> key -> bool
+
+end
+
+module type DISK_TABLE = sig
+  type store
+  type key
+  type value
+  val known: store -> key -> bool Lwt.t
+  val read: store -> key -> value tzresult Lwt.t
+  val read_opt: store -> key -> value option Lwt.t
+  val read_exn: store -> key -> value Lwt.t
+end
+
+module type MEMORY_TABLE = sig
+  type 'a t
+  type key
+  val create: int -> 'a t
+  val find: 'a t -> key -> 'a
+  val find_opt: 'a t -> key -> 'a option
+  val add: 'a t -> key -> 'a -> unit
+  val replace: 'a t -> key -> 'a -> unit
+  val remove: 'a t -> key -> unit
+  val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+end
+
+module type SCHEDULER_EVENTS = sig
+  type t
+  type key
+  val request: t -> P2p_peer.Id.t option -> key -> unit
+  val notify: t -> P2p_peer.Id.t -> key -> unit
+  val notify_cancelation: t -> key -> unit
+  val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit
+  val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit
+  val notify_invalid: t -> P2p_peer.Id.t -> key -> unit
+end
+
+module type PRECHECK = sig
+  type key
+  type param
+  type notified_value
+  type value
+  val precheck: key -> param -> notified_value -> value option
+end
+
+module Make_table
+    (Hash : sig
+       type t
+       val name : string
+       val encoding : t Data_encoding.t
+       val pp : Format.formatter -> t -> unit
+     end)
+    (Disk_table : DISK_TABLE with type key := Hash.t)
+    (Memory_table : MEMORY_TABLE with type key := Hash.t)
+    (Scheduler : SCHEDULER_EVENTS with type key := Hash.t)
+    (Precheck : PRECHECK with type key := Hash.t
+                          and type value := Disk_table.value) : sig
+
+  include DISTRIBUTED_DB with type key = Hash.t
+                          and type value = Disk_table.value
+                          and type param = Precheck.param
+  val create:
+    ?global_input:(key * value) Lwt_watcher.input ->
+    Scheduler.t -> Disk_table.store -> t
+  val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t
+
+end = struct
+
+  type key = Hash.t
+  type value = Disk_table.value
+  type param = Precheck.param
+
+  type t = {
+    scheduler: Scheduler.t ;
+    disk: Disk_table.store ;
+    memory: status Memory_table.t ;
+    global_input: (key * value) Lwt_watcher.input option ;
+    input: (key * value) Lwt_watcher.input ;
+  }
+
+  and status =
+    | Pending of { waiter : value tzresult Lwt.t ;
+                   wakener : value tzresult Lwt.u ;
+                   mutable waiters : int ;
+                   param : param }
+    | Found of value
+
+  let known s k =
+    match Memory_table.find_opt s.memory k with
+    | None -> Disk_table.known s.disk k
+    | Some (Pending _) -> Lwt.return_false
+    | Some (Found _) -> Lwt.return_true
+
+  let read_opt s k =
+    match Memory_table.find_opt s.memory k with
+    | None -> Disk_table.read_opt s.disk k
+    | Some (Found v) -> Lwt.return_some v
+    | Some (Pending _) -> Lwt.return_none
+
+  let read_exn s k =
+    match Memory_table.find_opt s.memory k with
+    | None -> Disk_table.read_exn s.disk k
+    | Some (Found v) -> Lwt.return v
+    | Some (Pending _) -> Lwt.fail Not_found
+
+  type error += Missing_data of key
+  type error += Canceled of key
+  type error += Timeout of key
+
+  let () =
+    (* Missing data key *)
+    register_error_kind
+      `Permanent
+      ~id: ("distributed_db." ^ Hash.name ^ ".missing")
+      ~title: ("Missing " ^ Hash.name)
+      ~description: ("Some " ^ Hash.name ^ " is missing from the distributed db")
+      ~pp: (fun ppf key ->
+          Format.fprintf ppf "Missing %s %a" Hash.name Hash.pp key)
+      (Data_encoding.obj1 (Data_encoding.req "key" Hash.encoding))
+      (function Missing_data key -> Some key | _ -> None)
+      (fun key -> Missing_data key) ;
+    (* Canceled key *)
+    register_error_kind
+      `Permanent
+      ~title: ("Canceled fetch of a " ^ Hash.name)
+      ~description: ("The fetch of a " ^ Hash.name ^ " has been canceled")
+      ~id: ("distributed_db." ^ Hash.name ^ ".fetch_canceled")
+      ~pp: (fun ppf key ->
+          Format.fprintf ppf "Fetch of %s %a canceled" Hash.name Hash.pp key)
+      Data_encoding.(obj1 (req "key" Hash.encoding))
+      (function (Canceled key) -> Some key | _ -> None)
+      (fun key -> Canceled key) ;
+    (* Timeout key *)
+    register_error_kind
+      `Permanent
+      ~title: ("Timed out fetch of a " ^ Hash.name)
+      ~description: ("The fetch of a " ^ Hash.name ^ " has timed out")
+      ~id: ("distributed_db." ^ Hash.name ^ ".fetch_timeout")
+      ~pp: (fun ppf key ->
+          Format.fprintf ppf "Fetch of %s %a timed out" Hash.name Hash.pp key)
+      Data_encoding.(obj1 (req "key" Hash.encoding))
+      (function (Timeout key) -> Some key | _ -> None)
+      (fun key -> Timeout key)
+
+  let read s k =
+    match Memory_table.find_opt s.memory k with
+    | None ->
+        trace (Missing_data k) @@
+        Disk_table.read s.disk k
+    | Some (Found v) -> return v
+    | Some (Pending _) -> fail (Missing_data k)
+
+  let wrap s k ?timeout t =
+    let t = Lwt.protected t in
+    Lwt.on_cancel t begin fun () ->
+      match Memory_table.find_opt s.memory k with
+      | None -> ()
+      | Some (Found _) -> ()
+      | Some (Pending data) ->
+          data.waiters <- data.waiters - 1 ;
+          if data.waiters = 0 then begin
+            Memory_table.remove s.memory k ;
+            Scheduler.notify_cancelation s.scheduler k ;
+          end
+    end ;
+    match timeout with
+    | None -> t
+    | Some delay ->
+        let timeout =
+          Lwt_unix.sleep delay >>= fun () -> fail (Timeout k) in
+        Lwt.pick [ t ; timeout ]
+
+  let fetch s ?peer ?timeout k param =
+    match Memory_table.find_opt s.memory k with
+    | None -> begin
+        Disk_table.read_opt s.disk k >>= function
+        | Some v -> return v
+        | None ->
+            match Memory_table.find_opt s.memory k with
+            | None -> begin
+                let waiter, wakener = Lwt.wait () in
+                Memory_table.add s.memory k
+                  (Pending { waiter ; wakener ; waiters =  1 ; param }) ;
+                Scheduler.request s.scheduler peer k ;
+                wrap s k ?timeout waiter
+              end
+            | Some (Pending data) ->
+                Scheduler.request s.scheduler peer k ;
+                data.waiters <- data.waiters + 1 ;
+                wrap s k ?timeout data.waiter
+            | Some (Found v) -> return v
+      end
+    | Some (Pending data) ->
+        Scheduler.request s.scheduler peer k ;
+        data.waiters <- data.waiters + 1 ;
+        wrap s k ?timeout data.waiter
+    | Some (Found v) -> return v
+
+  let prefetch s ?peer ?timeout k param =
+    try ignore (fetch s ?peer ?timeout k param) with _ -> ()
+
+  let notify s p k v =
+    match Memory_table.find_opt s.memory k with
+    | None -> begin
+        Disk_table.known s.disk k >>= function
+        | true ->
+            Scheduler.notify_duplicate s.scheduler p k ;
+            Lwt.return_unit
+        | false ->
+            Scheduler.notify_unrequested s.scheduler p k ;
+            Lwt.return_unit
+      end
+    | Some (Pending { wakener = w ; param }) -> begin
+        match Precheck.precheck k param v with
+        | None ->
+            Scheduler.notify_invalid s.scheduler p k ;
+            Lwt.return_unit
+        | Some v ->
+            Scheduler.notify s.scheduler p k ;
+            Memory_table.replace s.memory k (Found v) ;
+            Lwt.wakeup_later w (Ok v) ;
+            Option.iter s.global_input
+              ~f:(fun input -> Lwt_watcher.notify input (k, v)) ;
+            Lwt_watcher.notify s.input (k, v) ;
+            Lwt.return_unit
+      end
+    | Some (Found _) ->
+        Scheduler.notify_duplicate s.scheduler p k ;
+        Lwt.return_unit
+
+  let inject s k v =
+    match Memory_table.find_opt s.memory k with
+    | None -> begin
+        Disk_table.known s.disk k >>= function
+        | true ->
+            Lwt.return_false
+        | false ->
+            Memory_table.add s.memory k (Found v) ;
+            Lwt.return_true
+      end
+    | Some (Pending _)
+    | Some (Found _) ->
+        Lwt.return_false
+
+  let clear_or_cancel s k =
+    match Memory_table.find_opt s.memory k with
+    | None -> ()
+    | Some (Pending { wakener = w ; _ }) ->
+        Scheduler.notify_cancelation s.scheduler k ;
+        Memory_table.remove s.memory k ;
+        Lwt.wakeup_later w (Error [Canceled k])
+    | Some (Found _) -> Memory_table.remove s.memory k
+
+  let watch s = Lwt_watcher.create_stream s.input
+
+  let create ?global_input scheduler disk =
+    let memory = Memory_table.create 17 in
+    let input = Lwt_watcher.create_input () in
+    { scheduler ; disk ; memory ; input ; global_input }
+
+  let pending s k =
+    match Memory_table.find_opt s.memory k with
+    | None -> false
+    | Some (Found _) -> false
+    | Some (Pending _) -> true
+
+end
+
+module type REQUEST = sig
+  type key
+  type param
+  val initial_delay : float
+  val active : param -> P2p_peer.Set.t
+  val send : param -> P2p_peer.Id.t -> key list -> unit
+end
+
+module Make_request_scheduler
+    (Hash : sig
+       type t
+       val name : string
+       val encoding : t Data_encoding.t
+       val pp : Format.formatter -> t -> unit
+
+       module Logging : sig
+         val tag : t Tag.def
+       end
+     end)
+    (Table : MEMORY_TABLE with type key := Hash.t)
+    (Request : REQUEST with type key := Hash.t) : sig
+
+  type t
+  val create: Request.param -> t
+  val shutdown: t -> unit Lwt.t
+  include SCHEDULER_EVENTS with type t := t and type key := Hash.t
+
+end = struct
+
+  include Logging.Make_semantic(struct let name = "node.distributed_db.scheduler." ^ Hash.name end)
+
+  type key = Hash.t
+
+  type t = {
+    param: Request.param ;
+    pending: status Table.t ;
+
+    queue: event Lwt_pipe.t ;
+    mutable events: event list Lwt.t ;
+
+    canceler: Lwt_canceler.t ;
+    mutable worker: unit Lwt.t ;
+  }
+
+  and status = {
+    peers: P2p_peer.Set.t ;
+    next_request: float ;
+    delay: float ;
+  }
+
+  and event =
+    | Request of P2p_peer.Id.t option * key
+    | Notify of P2p_peer.Id.t * key
+    | Notify_cancelation of key
+    | Notify_invalid of P2p_peer.Id.t * key
+    | Notify_duplicate of P2p_peer.Id.t * key
+    | Notify_unrequested of P2p_peer.Id.t * key
+
+  let request t p k =
+    assert (Lwt_pipe.push_now t.queue (Request (p, k)))
+  let notify t p k =
+    debug Tag.DSL.(fun f ->
+        f "push received %a from %a"
+        -% t event "push_received"
+        -% a Hash.Logging.tag k
+        -% a P2p_peer.Id.Logging.tag p);
+    assert (Lwt_pipe.push_now t.queue (Notify (p, k)))
+  let notify_cancelation t k =
+    debug Tag.DSL.(fun f ->
+        f "push cancelation %a"
+        -% t event "push_cancelation"
+        -% a Hash.Logging.tag k);
+    assert (Lwt_pipe.push_now t.queue (Notify_cancelation k))
+  let notify_invalid t p k =
+    debug Tag.DSL.(fun f ->
+        f "push received invalid %a from %a"
+        -% t event "push_received_invalid"
+        -% a Hash.Logging.tag k
+        -% a P2p_peer.Id.Logging.tag p);
+    assert (Lwt_pipe.push_now t.queue (Notify_invalid (p, k)))
+  let notify_duplicate t p k =
+    debug Tag.DSL.(fun f ->
+        f "push received duplicate %a from %a"
+        -% t event "push_received_duplicate"
+        -% a Hash.Logging.tag k
+        -% a P2p_peer.Id.Logging.tag p);
+    assert (Lwt_pipe.push_now t.queue (Notify_duplicate (p, k)))
+  let notify_unrequested t p k =
+    debug Tag.DSL.(fun f ->
+        f "push received unrequested %a from %a"
+        -% t event "push_received_unrequested"
+        -% a Hash.Logging.tag k
+        -% a P2p_peer.Id.Logging.tag p);
+    assert (Lwt_pipe.push_now t.queue (Notify_unrequested (p, k)))
+
+  let compute_timeout state =
+    let next =
+      Table.fold
+        (fun _ { next_request } acc ->
+           match acc with
+           | None -> Some next_request
+           | Some x -> Some (min x next_request))
+        state.pending None in
+    match next with
+    | None -> fst @@ Lwt.task ()
+    | Some next ->
+        let now = Unix.gettimeofday () in
+        let delay = next -. now in
+        if delay <= 0. then Lwt.return_unit else begin
+          (* lwt_debug "waiting at least %.2fs" delay >>= fun () -> *)
+          Lwt_unix.sleep delay
+        end
+
+
+  let process_event state now = function
+    | Request (peer, key) -> begin
+        lwt_debug Tag.DSL.(fun f ->
+            f "registering request %a from %a"
+            -% t event "registering_request"
+            -% a Hash.Logging.tag key
+            -% a P2p_peer.Id.Logging.tag_opt peer) >>= fun () ->
+        try
+          let data = Table.find state.pending key in
+          let peers =
+            match peer with
+            | None -> data.peers
+            | Some peer -> P2p_peer.Set.add peer data.peers in
+          Table.replace state.pending key {
+            delay = Request.initial_delay ;
+            next_request = min data.next_request (now +. Request.initial_delay) ;
+            peers ;
+          } ;
+          lwt_debug Tag.DSL.(fun f ->
+              f "registering request %a from %a -> replaced"
+              -% t event "registering_request_replaced"
+              -% a Hash.Logging.tag key
+              -% a P2p_peer.Id.Logging.tag_opt peer) >>= fun () ->
+          Lwt.return_unit
+        with Not_found ->
+          let peers =
+            match peer with
+            | None -> P2p_peer.Set.empty
+            | Some peer -> P2p_peer.Set.singleton peer in
+          Table.add state.pending key {
+            peers ;
+            next_request = now ;
+            delay = Request.initial_delay ;
+          } ;
+          lwt_debug Tag.DSL.(fun f ->
+              f "registering request %a from %a -> added"
+              -% t event "registering_request_added"
+              -% a Hash.Logging.tag key
+              -% a P2p_peer.Id.Logging.tag_opt peer) >>= fun () ->
+          Lwt.return_unit
+      end
+    | Notify (peer, key) ->
+        Table.remove state.pending key ;
+        lwt_debug Tag.DSL.(fun f ->
+            f "received %a from %a"
+            -% t event "received"
+            -% a Hash.Logging.tag key
+            -% a P2p_peer.Id.Logging.tag peer) >>= fun () ->
+        Lwt.return_unit
+    | Notify_cancelation key ->
+        Table.remove state.pending key ;
+        lwt_debug Tag.DSL.(fun f ->
+            f "canceled %a"
+            -% t event "canceled"
+            -% a Hash.Logging.tag key) >>= fun () ->
+        Lwt.return_unit
+    | Notify_invalid (peer, key) ->
+        lwt_debug Tag.DSL.(fun f ->
+            f "received invalid %a from %a"
+            -% t event "received_invalid"
+            -% a Hash.Logging.tag key
+            -% a P2p_peer.Id.Logging.tag peer) >>= fun () ->
+        (* TODO *)
+        Lwt.return_unit
+    | Notify_unrequested (peer, key) ->
+        lwt_debug Tag.DSL.(fun f ->
+            f "received unrequested %a from %a"
+            -% t event "received_unrequested"
+            -% a Hash.Logging.tag key
+            -% a P2p_peer.Id.Logging.tag peer) >>= fun () ->
+        (* TODO *)
+        Lwt.return_unit
+    | Notify_duplicate (peer, key) ->
+        lwt_debug Tag.DSL.(fun f ->
+            f "received duplicate %a from %a"
+            -% t event "received_duplicate"
+            -% a Hash.Logging.tag key
+            -% a P2p_peer.Id.Logging.tag peer) >>= fun () ->
+        (* TODO *)
+        Lwt.return_unit
+
+  let worker_loop state =
+    let shutdown = Lwt_canceler.cancelation state.canceler in
+    let rec loop state =
+      let timeout = compute_timeout state in
+      Lwt.choose
+        [ (state.events >|= fun _ -> ()) ; timeout ; shutdown ] >>= fun () ->
+      if Lwt.state shutdown <> Lwt.Sleep then
+        lwt_debug Tag.DSL.(fun f ->
+            f "terminating" -% t event "terminating") >>= fun () ->
+        Lwt.return_unit
+      else if Lwt.state state.events <> Lwt.Sleep then
+        let now = Unix.gettimeofday () in
+        state.events >>= fun events ->
+        state.events <- Lwt_pipe.pop_all state.queue ;
+        Lwt_list.iter_s (process_event state now) events >>= fun () ->
+        loop state
+      else
+        lwt_debug Tag.DSL.(fun f ->
+            f "timeout" -% t event "timeout") >>= fun () ->
+        let now = Unix.gettimeofday () in
+        let active_peers = Request.active state.param in
+        let requests =
+          Table.fold
+            (fun key { peers ; next_request ; delay } acc ->
+               if next_request > now +. 0.2 then
+                 acc
+               else
+                 let remaining_peers =
+                   P2p_peer.Set.inter peers active_peers in
+                 if P2p_peer.Set.is_empty remaining_peers &&
+                    not (P2p_peer.Set.is_empty peers) then
+                   ( Table.remove state.pending key ; acc )
+                 else
+                   let requested_peer =
+                     P2p_peer.Id.Set.random_elt
+                       (if P2p_peer.Set.is_empty remaining_peers
+                        then active_peers
+                        else remaining_peers) in
+                   let next = { peers = remaining_peers ;
+                                next_request = now +. delay ;
+                                delay = delay *. 1.5 } in
+                   Table.replace state.pending key next ;
+                   let requests =
+                     try key :: P2p_peer.Map.find requested_peer acc
+                     with Not_found -> [key] in
+                   P2p_peer.Map.add requested_peer requests acc)
+            state.pending P2p_peer.Map.empty in
+        P2p_peer.Map.iter (Request.send state.param) requests ;
+        P2p_peer.Map.fold begin fun peer request acc ->
+          acc >>= fun () ->
+          Lwt_list.iter_s (fun key ->
+              lwt_debug Tag.DSL.(fun f ->
+                  f "requested %a from %a"
+                  -% t event "requested"
+                  -% a Hash.Logging.tag key
+                  -% a P2p_peer.Id.Logging.tag peer))
+            request
+        end requests Lwt.return_unit >>= fun () ->
+        loop state
+    in
+    loop state
+
+  let create param =
+    let state = {
+      param ;
+      queue = Lwt_pipe.create () ;
+      pending = Table.create 17 ;
+      events = Lwt.return_nil ;
+      canceler = Lwt_canceler.create () ;
+      worker = Lwt.return_unit ;
+    } in
+    state.worker <-
+      Lwt_utils.worker "db_request_scheduler"
+        ~run:(fun () -> worker_loop state)
+        ~cancel:(fun () -> Lwt_canceler.cancel state.canceler) ;
+    state
+
+  let shutdown s =
+    Lwt_canceler.cancel s.canceler >>= fun () ->
+    s.worker
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db_functors.mli b/vendors/tezos-modded/src/lib_shell/distributed_db_functors.mli
new file mode 100644
index 000000000..a5a93e0bb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db_functors.mli
@@ -0,0 +1,206 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - High-level API for the Gossip network and local
+                  storage (helpers). *)
+
+(** {1 Indexes} *)
+
+(** Generic interface for a "distributed" index.
+
+    By "distributed", it means that this interface abstract the p2p
+    gossip layer and it is able to fetch missing data from known
+    peers in a "synchronous" interface.
+
+*)
+module type DISTRIBUTED_DB = sig
+
+  type t
+
+  (** The index key *)
+  type key
+
+  (** The indexed data *)
+  type value
+
+  (** An extra parameter for the network lookup, usually
+      used for prevalidating data. *)
+  type param
+
+  (** Is the value known locally? *)
+  val known: t -> key -> bool Lwt.t
+
+  type error += Missing_data of key
+  type error += Canceled of key
+  type error += Timeout of key
+
+  (** Return the value if it is known locally, otherwise fail with
+      the error [Missing_data]. *)
+  val read: t -> key -> value tzresult Lwt.t
+
+  (** Return the value if it is known locally, otherwise fail with
+      the value [None]. *)
+  val read_opt: t -> key -> value option Lwt.t
+
+  (** Return the value if it is known locally, otherwise fail with
+      the exception [Not_found]. *)
+  val read_exn: t -> key -> value Lwt.t
+
+  (** Same as `fetch` but the call is non-blocking: the data will be
+      stored in the local index when received. *)
+  val prefetch:
+    t ->
+    ?peer:P2p_peer.Id.t ->
+    ?timeout:float ->
+    key -> param -> unit
+
+  (** Return the value if it is known locally, or block until the data
+      is received from the network. By default, the data will be
+      requested to all the active peers in the network; if the [peer]
+      argument is provided, the data will only be requested to the
+      provided peer. By default, the resulting promise will block
+      forever if the data is never received. If [timeout] is provided
+      the promise will be resolved with the error [Timeout] after the
+      provided amount of seconds.
+
+      A internal scheduler is able to re-send the request with an
+      exponential back-off until the data is received. If the function
+      is called multiple time with the same key but with disctinct
+      peers, the internal scheduler randomly chooses the requested
+      peer (at each retry). *)
+  val fetch:
+    t ->
+    ?peer:P2p_peer.Id.t ->
+    ?timeout:float ->
+    key -> param -> value tzresult Lwt.t
+
+  (** Remove the data from the local index or cancel all pending
+      request. Any pending [fetch] promises are resolved with the
+      error [Canceled]. *)
+  val clear_or_cancel: t -> key -> unit
+
+  val inject: t -> key -> value -> bool Lwt.t
+
+  (** Monitor all the fetched data. A given data will appear only
+      once. *)
+  val watch: t -> (key * value) Lwt_stream.t * Lwt_watcher.stopper
+
+  val pending: t -> key -> bool
+
+end
+
+module type DISK_TABLE = sig
+  type store
+  type key
+  type value
+  val known: store -> key -> bool Lwt.t
+  val read: store -> key -> value tzresult Lwt.t
+  val read_opt: store -> key -> value option Lwt.t
+  val read_exn: store -> key -> value Lwt.t
+end
+
+module type MEMORY_TABLE = sig
+  (* A subtype of Hashtbl.S *)
+  type 'a t
+  type key
+  val create: int -> 'a t
+  val find: 'a t -> key -> 'a
+  val find_opt: 'a t -> key -> 'a option
+  val add: 'a t -> key -> 'a -> unit
+  val replace: 'a t -> key -> 'a -> unit
+  val remove: 'a t -> key -> unit
+  val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+end
+
+module type SCHEDULER_EVENTS = sig
+  type t
+  type key
+  val request: t -> P2p_peer.Id.t option -> key -> unit
+  val notify: t -> P2p_peer.Id.t -> key -> unit
+  val notify_cancelation: t -> key -> unit
+  val notify_unrequested: t -> P2p_peer.Id.t -> key -> unit
+  val notify_duplicate: t -> P2p_peer.Id.t -> key -> unit
+  val notify_invalid: t -> P2p_peer.Id.t -> key -> unit
+end
+
+module type PRECHECK = sig
+  type key
+  type param
+  type notified_value
+  type value
+  val precheck: key -> param -> notified_value -> value option
+end
+
+module Make_table
+    (Hash : sig
+       type t
+       val name : string
+       val encoding : t Data_encoding.t
+       val pp : Format.formatter -> t -> unit
+     end)
+    (Disk_table : DISK_TABLE with type key := Hash.t)
+    (Memory_table : MEMORY_TABLE with type key := Hash.t)
+    (Scheduler : SCHEDULER_EVENTS with type key := Hash.t)
+    (Precheck : PRECHECK with type key := Hash.t
+                          and type value := Disk_table.value) : sig
+
+  include DISTRIBUTED_DB with type key = Hash.t
+                          and type value = Disk_table.value
+                          and type param = Precheck.param
+  val create:
+    ?global_input:(key * value) Lwt_watcher.input ->
+    Scheduler.t -> Disk_table.store -> t
+  val notify: t -> P2p_peer.Id.t -> key -> Precheck.notified_value -> unit Lwt.t
+
+end
+
+module type REQUEST = sig
+  type key
+  type param
+  val initial_delay : float
+  val active : param -> P2p_peer.Set.t
+  val send : param -> P2p_peer.Id.t -> key list -> unit
+end
+
+module Make_request_scheduler
+    (Hash : sig
+       type t
+       val name : string
+       val encoding : t Data_encoding.t
+       val pp : Format.formatter -> t -> unit
+
+       module Logging : sig
+         val tag : t Tag.def
+       end
+     end)
+    (Table : MEMORY_TABLE with type key := Hash.t)
+    (Request : REQUEST with type key := Hash.t) : sig
+
+  type t
+  val create: Request.param -> t
+  val shutdown: t -> unit Lwt.t
+  include SCHEDULER_EVENTS with type t := t and type key := Hash.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db_message.ml b/vendors/tezos-modded/src/lib_shell/distributed_db_message.ml
new file mode 100644
index 000000000..eda5cc9d6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db_message.ml
@@ -0,0 +1,324 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Bounded_encoding = struct
+
+  open Data_encoding
+
+  let block_header_max_size = ref (Some (8 * 1024 * 1024)) (* FIXME: arbitrary *)
+  let block_header_cache =
+    ref (Block_header.bounded_encoding ?max_size:!block_header_max_size ())
+  let block_locator_cache =
+    ref (Block_locator.bounded_encoding
+           ?max_header_size:!block_header_max_size ())
+
+  let update_block_header_encoding () =
+    block_header_cache :=
+      Block_header.bounded_encoding ?max_size:!block_header_max_size () ;
+    block_locator_cache :=
+      Block_locator.bounded_encoding ?max_header_size:!block_header_max_size ()
+
+  let set_block_header_max_size max =
+    block_header_max_size := max ;
+    update_block_header_encoding ()
+  let block_header = delayed (fun () -> !block_header_cache)
+  let block_locator = delayed (fun () -> !block_locator_cache)
+
+  (* FIXME: all constants below are arbitrary high bounds until we
+     have the mechanism to update them properly *)
+  let operation_max_size = ref (Some (128 * 1024)) (* FIXME: arbitrary *)
+  let operation_list_max_size = ref (Some (1024 * 1024)) (* FIXME: arbitrary *)
+  let operation_list_max_length = ref None (* FIXME: arbitrary *)
+  let operation_max_pass = ref (Some 8) (* FIXME: arbitrary *)
+
+  let operation_cache =
+    ref (Operation.bounded_encoding ?max_size:!operation_max_size ())
+  let operation_list_cache =
+    ref (Operation.bounded_list_encoding
+           ?max_length:!operation_list_max_length
+           ?max_size:!operation_list_max_size
+           ?max_operation_size:!operation_max_size
+           ?max_pass:!operation_max_pass ())
+  let operation_hash_list_cache =
+    ref (Operation.bounded_hash_list_encoding
+           ?max_length:!operation_list_max_length
+           ?max_pass:!operation_max_pass ())
+
+  let update_operation_list_encoding () =
+    operation_list_cache :=
+      Operation.bounded_list_encoding
+        ?max_length:!operation_list_max_length
+        ?max_size:!operation_list_max_size
+        ?max_operation_size:!operation_max_size
+        ?max_pass:!operation_max_pass
+        ()
+  let update_operation_hash_list_encoding () =
+    operation_list_cache :=
+      Operation.bounded_list_encoding
+        ?max_length:!operation_list_max_length
+        ?max_pass:!operation_max_pass
+        ()
+  let update_operation_encoding () =
+    operation_cache :=
+      Operation.bounded_encoding ?max_size:!operation_max_size ()
+
+  let set_operation_max_size max =
+    operation_max_size := max ;
+    update_operation_encoding () ;
+    update_operation_list_encoding ()
+  let set_operation_list_max_size max =
+    operation_list_max_size := max ;
+    update_operation_list_encoding ()
+  let set_operation_list_max_length max =
+    operation_list_max_length := max ;
+    update_operation_list_encoding () ;
+    update_operation_hash_list_encoding ()
+  let set_operation_max_pass max =
+    operation_max_pass := max ;
+    update_operation_list_encoding () ;
+    update_operation_hash_list_encoding ()
+
+  let operation = delayed (fun () -> !operation_cache)
+  let operation_list = delayed (fun () -> !operation_list_cache)
+  let operation_hash_list = delayed (fun () -> !operation_hash_list_cache)
+
+  let protocol_max_size = ref (Some (2 * 1024 * 1024)) (* FIXME: arbitrary *)
+  let protocol_cache =
+    ref (Protocol.bounded_encoding ?max_size:!protocol_max_size ())
+  let update_protocol_encoding () =
+    protocol_cache :=
+      Protocol.bounded_encoding ?max_size:!protocol_max_size ()
+  let set_protocol_max_size max =
+    protocol_max_size := max
+  let protocol = delayed (fun () -> !protocol_cache)
+
+  let mempool_max_operations = ref None
+  let mempool_cache =
+    ref (Mempool.bounded_encoding ?max_operations:!mempool_max_operations ())
+  let update_mempool_encoding () =
+    mempool_cache :=
+      Mempool.bounded_encoding ?max_operations:!mempool_max_operations ()
+  let set_mempool_max_operations max =
+    mempool_max_operations := max
+  let mempool = delayed (fun () -> !mempool_cache)
+
+end
+
+type t =
+
+  | Get_current_branch of Chain_id.t
+  | Current_branch of Chain_id.t * Block_locator.t
+  | Deactivate of Chain_id.t
+
+  | Get_current_head of Chain_id.t
+  | Current_head of Chain_id.t * Block_header.t * Mempool.t
+
+  | Get_block_headers of Block_hash.t list
+  | Block_header of Block_header.t
+
+  | Get_operations of Operation_hash.t list
+  | Operation of Operation.t
+
+  | Get_protocols of Protocol_hash.t list
+  | Protocol of Protocol.t
+
+  | Get_operation_hashes_for_blocks of (Block_hash.t * int) list
+  | Operation_hashes_for_block of
+      Block_hash.t * int *
+      Operation_hash.t list * Operation_list_list_hash.path
+
+  | Get_operations_for_blocks of (Block_hash.t * int) list
+  | Operations_for_block of
+      Block_hash.t * int *
+      Operation.t list * Operation_list_list_hash.path
+
+let encoding =
+  let open Data_encoding in
+  let case ?max_length ~tag ~title encoding unwrap wrap =
+    P2p.Encoding { tag ; title ; encoding ; wrap ; unwrap ; max_length } in
+  [
+    case ~tag:0x10
+      ~title:"Get_current_branch"
+      (obj1
+         (req "get_current_branch" Chain_id.encoding))
+      (function
+        | Get_current_branch chain_id -> Some chain_id
+        | _ -> None)
+      (fun chain_id -> Get_current_branch chain_id) ;
+
+    case ~tag:0x11
+      ~title:"Current_branch"
+      (obj2
+         (req "chain_id" Chain_id.encoding)
+         (req "current_branch" Bounded_encoding.block_locator))
+      (function
+        | Current_branch (chain_id, locator) -> Some (chain_id, locator)
+        | _ -> None)
+      (fun (chain_id, locator) -> Current_branch (chain_id, locator)) ;
+
+    case ~tag:0x12
+      ~title:"Deactivate"
+      (obj1
+         (req "deactivate" Chain_id.encoding))
+      (function
+        | Deactivate chain_id -> Some chain_id
+        | _ -> None)
+      (fun chain_id -> Deactivate chain_id) ;
+
+    case ~tag:0x13
+      ~title:"Get_current_head"
+      (obj1
+         (req "get_current_head" Chain_id.encoding))
+      (function
+        | Get_current_head chain_id -> Some chain_id
+        | _ -> None)
+      (fun chain_id -> Get_current_head chain_id) ;
+
+    case ~tag:0x14
+      ~title:"Current_head"
+      (obj3
+         (req "chain_id" Chain_id.encoding)
+         (req "current_block_header" (dynamic_size Bounded_encoding.block_header))
+         (req "current_mempool" Bounded_encoding.mempool))
+      (function
+        | Current_head (chain_id, bh, mempool) -> Some (chain_id, bh, mempool)
+        | _ -> None)
+      (fun (chain_id, bh, mempool) -> Current_head (chain_id, bh, mempool)) ;
+
+    case ~tag:0x20
+      ~title:"Get_block_headers"
+      (obj1 (req "get_block_headers" (list ~max_length:10 Block_hash.encoding)))
+      (function
+        | Get_block_headers bhs -> Some bhs
+        | _ -> None)
+      (fun bhs -> Get_block_headers bhs) ;
+
+    case ~tag:0x21
+      ~title:"Block_header"
+      (obj1 (req "block_header" Bounded_encoding.block_header))
+      (function
+        | Block_header bh -> Some bh
+        | _ -> None)
+      (fun bh -> Block_header bh) ;
+
+    case ~tag:0x30
+      ~title:"Get_operations"
+      (obj1 (req "get_operations" (list ~max_length:10 Operation_hash.encoding)))
+      (function
+        | Get_operations bhs -> Some bhs
+        | _ -> None)
+      (fun bhs -> Get_operations bhs) ;
+
+    case ~tag:0x31
+      ~title:"Operation"
+      (obj1 (req "operation" Bounded_encoding.operation))
+      (function Operation o -> Some o | _ -> None)
+      (fun o -> Operation o);
+
+    case ~tag:0x40
+      ~title:"Get_protocols"
+      (obj1
+         (req "get_protocols" (list ~max_length:10 Protocol_hash.encoding)))
+      (function
+        | Get_protocols protos -> Some protos
+        | _ -> None)
+      (fun protos -> Get_protocols protos);
+
+    case ~tag:0x41
+      ~title:"Protocol"
+      (obj1 (req "protocol" Bounded_encoding.protocol))
+      (function Protocol proto -> Some proto  | _ -> None)
+      (fun proto -> Protocol proto);
+
+    case ~tag:0x50
+      ~title:"Get_operation_hashes_for_blocks"
+      (obj1 (req "get_operation_hashes_for_blocks"
+               (list ~max_length:10 (tup2 Block_hash.encoding int8))))
+      (function
+        | Get_operation_hashes_for_blocks keys -> Some keys
+        | _ -> None)
+      (fun keys -> Get_operation_hashes_for_blocks keys);
+
+    case ~tag:0x51
+      ~title:"Operation_hashes_for_blocks"
+      (merge_objs
+         (obj1
+            (req "operation_hashes_for_block"
+               (obj2
+                  (req "hash" Block_hash.encoding)
+                  (req "validation_pass" int8))))
+         Bounded_encoding.operation_hash_list)
+      (function Operation_hashes_for_block (block, ofs, ops, path) ->
+         Some ((block, ofs), (path, ops)) | _ -> None)
+      (fun ((block, ofs), (path, ops)) ->
+         Operation_hashes_for_block (block, ofs, ops, path)) ;
+
+    case ~tag:0x60
+      ~title:"Get_operations_for_blocks"
+      (obj1 (req "get_operations_for_blocks"
+               (list ~max_length:10
+                  (obj2
+                     (req "hash" Block_hash.encoding)
+                     (req "validation_pass" int8)))))
+      (function
+        | Get_operations_for_blocks keys -> Some keys
+        | _ -> None)
+      (fun keys -> Get_operations_for_blocks keys);
+
+    case ~tag:0x61
+      ~title:"Operations_for_blocks"
+      (merge_objs
+         (obj1
+            (req "operations_for_block"
+               (obj2
+                  (req "hash" Block_hash.encoding)
+                  (req "validation_pass" int8))))
+         Bounded_encoding.operation_list)
+      (function Operations_for_block (block, ofs, ops, path) ->
+         Some ((block, ofs), (path, ops)) | _ -> None)
+      (fun ((block, ofs), (path, ops)) ->
+         Operations_for_block (block, ofs, ops, path)) ;
+
+  ]
+
+let versions =
+  let open P2p_version in
+  [ { name = "TEZOS_2018-06-30T16:07:32Z" ;
+      major = 0 ;
+      minor = 0 ;
+    }
+  ]
+
+let cfg : _ P2p.message_config = { encoding ; versions }
+
+let raw_encoding = P2p.Raw.encoding encoding
+
+let pp_json ppf msg =
+  Data_encoding.Json.pp ppf
+    (Data_encoding.Json.construct raw_encoding (Message msg))
+
+module Logging = struct
+  let tag = Tag.def ~doc:"Message" "message" pp_json
+end
diff --git a/vendors/tezos-modded/src/lib_shell/distributed_db_message.mli b/vendors/tezos-modded/src/lib_shell/distributed_db_message.mli
new file mode 100644
index 000000000..a0aa68673
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/distributed_db_message.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - Network message for the gossip P2P protocol. *)
+
+type t =
+
+  | Get_current_branch of Chain_id.t
+  | Current_branch of Chain_id.t * Block_locator.t
+  | Deactivate of Chain_id.t
+
+  | Get_current_head of Chain_id.t
+  | Current_head of Chain_id.t * Block_header.t * Mempool.t
+
+  | Get_block_headers of Block_hash.t list
+  | Block_header of Block_header.t
+
+  | Get_operations of Operation_hash.t list
+  | Operation of Operation.t
+
+  | Get_protocols of Protocol_hash.t list
+  | Protocol of Protocol.t
+
+  | Get_operation_hashes_for_blocks of (Block_hash.t * int) list
+  | Operation_hashes_for_block of
+      Block_hash.t * int *
+      Operation_hash.t list * Operation_list_list_hash.path
+
+  | Get_operations_for_blocks of (Block_hash.t * int) list
+  | Operations_for_block of
+      Block_hash.t * int *
+      Operation.t list * Operation_list_list_hash.path
+
+val cfg : t P2p.message_config
+
+val pp_json : Format.formatter -> t -> unit
+
+module Bounded_encoding : sig
+  val set_block_header_max_size: int option -> unit
+  val set_operation_max_size: int option -> unit
+  val set_operation_list_max_size: int option -> unit
+  val set_operation_list_max_length: int option -> unit
+  val set_operation_max_pass: int option -> unit
+  val set_protocol_max_size: int option -> unit
+  val set_mempool_max_operations: int option -> unit
+end
+
+module Logging : sig
+  val tag : t Tag.def
+end
diff --git a/vendors/tezos-modded/src/lib_shell/dune b/vendors/tezos-modded/src/lib_shell/dune
new file mode 100644
index 000000000..0e5e18d92
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/dune
@@ -0,0 +1,24 @@
+(library
+ (name tezos_shell)
+ (public_name tezos-shell)
+ (libraries tezos-base
+            tezos-storage
+            tezos-rpc-http
+            tezos-p2p
+            tezos-shell-services
+            tezos-protocol-updater
+	    tezos-validation)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_storage
+                   -open Tezos_rpc_http
+                   -open Tezos_p2p
+                   -open Tezos_shell_services
+                   -open Tezos_protocol_updater
+		   -open Tezos_validation)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_shell/injection_directory.ml b/vendors/tezos-modded/src/lib_shell/injection_directory.ml
new file mode 100644
index 000000000..d60973580
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/injection_directory.ml
@@ -0,0 +1,100 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 read_chain_id validator chain =
+  let distributed_db = Validator.distributed_db validator in
+  let state = Distributed_db.state distributed_db in
+  begin
+    match chain with
+    | None -> Lwt.return_none
+    | Some chain ->
+        Chain_directory.get_chain_id state chain >>= Lwt.return_some
+  end
+
+let inject_block validator ?force ?chain bytes operations =
+  read_chain_id validator chain >>= fun chain_id ->
+  Validator.validate_block
+    validator ?force ?chain_id bytes operations >>=? fun (hash, block) ->
+  return (hash, (block >>=? fun _ -> return_unit))
+
+let inject_operation validator ?chain bytes =
+  read_chain_id validator chain >>= fun chain_id ->
+  let t =
+    match Data_encoding.Binary.of_bytes Operation.encoding bytes with
+    | None -> failwith "Can't parse the operation"
+    | Some op ->
+        Validator.inject_operation validator ?chain_id op in
+  let hash = Operation_hash.hash_bytes [bytes] in
+  Lwt.return (hash, t)
+
+let inject_protocol state ?force:_ proto =
+  let proto_bytes =
+    Data_encoding.Binary.to_bytes_exn Protocol.encoding proto in
+  let hash = Protocol_hash.hash_bytes [proto_bytes] in
+  let validation =
+    Updater.compile hash proto >>= function
+    | false ->
+        failwith
+          "Compilation failed (%a)"
+          Protocol_hash.pp_short hash
+    | true ->
+        State.Protocol.store state proto >>= function
+        | None ->
+            failwith
+              "Previously registered protocol (%a)"
+              Protocol_hash.pp_short hash
+        | Some _ -> return_unit
+  in
+  Lwt.return (hash, validation)
+
+let build_rpc_directory validator =
+
+  let distributed_db = Validator.distributed_db validator in
+  let state = Distributed_db.state distributed_db in
+
+  let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
+  let register0 s f =
+    dir := RPC_directory.register !dir s (fun () p q -> f p q) in
+
+  register0 Injection_services.S.block begin fun q (raw, operations) ->
+    inject_block validator
+      ?chain:q#chain ~force:q#force raw operations >>=? fun (hash, wait) ->
+    (if q#async then return_unit else wait) >>=? fun () ->
+    return hash
+  end ;
+
+  register0 Injection_services.S.operation begin fun q contents ->
+    inject_operation validator ?chain:q#chain contents >>= fun (hash, wait) ->
+    (if q#async then return_unit else wait) >>=? fun () ->
+    return hash
+  end ;
+
+  register0 Injection_services.S.protocol begin fun q protocol ->
+    inject_protocol state ~force:q#force protocol >>= fun (hash, wait) ->
+    (if q#async then return_unit else wait) >>=? fun () ->
+    return hash
+  end ;
+
+  !dir
diff --git a/vendors/tezos-modded/src/lib_shell/injection_directory.mli b/vendors/tezos-modded/src/lib_shell/injection_directory.mli
new file mode 100644
index 000000000..149f27ec5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/injection_directory.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 build_rpc_directory: Validator.t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.ml b/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.ml
new file mode 100644
index 000000000..9f7c32000
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.ml
@@ -0,0 +1,418 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Validating batches of operations with some peer-based
+ * compartimentatilsation. *)
+
+type limits = {
+  max_promises_per_request : int ;
+  worker_limits : Worker_types.limits ;
+}
+
+module type T = sig
+  module Mempool_worker: Mempool_worker.T
+
+  type t
+  type input = Operation_hash.t list
+
+  val create: limits -> P2p_peer.Id.t -> Mempool_worker.t -> t tzresult Lwt.t
+  val shutdown: t -> input Lwt.t
+
+  val validate: t -> input -> unit tzresult Lwt.t
+
+end
+
+
+module type STATIC = sig
+  val max_pending_requests : int
+end
+
+module Make (Static: STATIC) (Mempool_worker: Mempool_worker.T)
+  : T with module Mempool_worker = Mempool_worker
+= struct
+
+  (* 0. Prelude: set up base modules and types *)
+  (* See interface file for info if needed. *)
+
+  module Proto = Mempool_worker.Proto
+  module Mempool_worker = Mempool_worker
+
+  type input = Operation_hash.t list
+  type result =
+    | Cannot_download of error list
+    | Cannot_parse of error list
+    | Cannot_validate of error list
+    | Mempool_result of Mempool_worker.result
+  type output = result Operation_hash.Map.t
+
+  let pp_input ppf input =
+    Format.fprintf ppf
+      "@[<v 0>%a@]"
+      (Format.pp_print_list Operation_hash.pp)
+      input
+  let result_encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Cannot download"
+          (obj1 (req "download_errors" (list Error_monad.error_encoding)))
+          (function Cannot_download errs -> Some errs | _ -> None)
+          (fun errs -> Cannot_download errs) ;
+        case (Tag 1)
+          ~title:"Cannot parse"
+          (obj1 (req "parse_errors" (list Error_monad.error_encoding)))
+          (function Cannot_parse errs -> Some errs | _ -> None)
+          (fun errs -> Cannot_parse errs) ;
+        case (Tag 2)
+          ~title:"Cannot validate"
+          (obj1 (req "validation_errors" (list Error_monad.error_encoding)))
+          (function Cannot_validate errs -> Some errs | _ -> None)
+          (fun errs -> Cannot_validate errs) ;
+        case (Tag 3)
+          ~title:"Validation result"
+          (obj1 (req "validation_result" Mempool_worker.result_encoding))
+          (function Mempool_result result -> Some result | _ -> None)
+          (fun result -> Mempool_result result) ]
+
+  module Log = Tezos_stdlib.Logging.Make(struct
+      let name = "node.mempool.peer_worker"
+    end)
+
+
+  (* 1. Core: the carefully scheduled work performed by the worker *)
+
+  module Work : sig
+    val process_batch: Mempool_worker.t -> int -> input -> output Lwt.t
+  end = struct
+    type t = {
+      pool: unit Lwt_pool.t;
+      received: Operation_hash.t Queue.t;
+      downloading: (Operation_hash.t * Operation.t tzresult Lwt.t) Queue.t;
+      applying: (Mempool_worker.operation * Mempool_worker.result tzresult Lwt.t) Queue.t;
+      mutable results: result Operation_hash.Map.t
+    }
+
+    (* Primitives *)
+
+    let is_empty t =
+      Queue.is_empty t.received &&
+      Queue.is_empty t.downloading &&
+      Queue.is_empty t.applying
+
+    let has_resolved t = match Lwt.state t with
+      | Lwt.Return _ | Lwt.Fail _ -> true
+      | Lwt.Sleep -> false
+
+    let head_is_resolved q =
+      (not (Queue.is_empty q)) && has_resolved (snd (Queue.peek q))
+
+    let select t =
+      (* A `select`-like function to wait on any of the pipeline's buffers'
+       * heads to resolve *)
+      assert (not (Queue.is_empty t.downloading && Queue.is_empty t.applying));
+      let first_task_or_never q =
+        if Queue.is_empty q then
+          Lwt_utils.never_ending ()
+        else
+          snd (Queue.peek q) >>= fun _ -> Lwt.return_unit
+      in
+      Lwt.choose (
+        (first_task_or_never t.downloading) ::
+        (first_task_or_never t.applying) ::
+        []
+      )
+
+    let record_result pipeline op_hash result =
+      pipeline.results <- Operation_hash.Map.add op_hash result pipeline.results
+
+    let q_of_list l =
+      let q = Queue.create () in
+      List.iter (fun x -> Queue.add x q) l;
+      q
+
+    let create pool_size op_hashes =
+      {
+        pool = Lwt_pool.create pool_size Lwt.return;
+        received = q_of_list op_hashes;
+        downloading = Queue.create ();
+        applying = Queue.create ();
+        results = Operation_hash.Map.empty;
+      }
+
+    let cancel pipeline =
+      let cancel_snd (_, p) = Lwt.cancel p in
+      Queue.iter cancel_snd pipeline.downloading;
+      Queue.iter cancel_snd pipeline.applying
+
+
+    (* Exported interactions *)
+
+    let step mempool_worker pipeline =
+      (* Going through each buffer one by one. *)
+      (* op_hash: Opertation_hash.t
+       * op: Operation.t
+       * mop: Mempool_worker.operation *)
+
+      if head_is_resolved pipeline.applying then begin
+        let (op, p) = Queue.pop pipeline.applying in
+        p >>= function
+        | Error errs ->
+            record_result pipeline op.hash (Cannot_validate errs);
+            Lwt.return_unit
+        | Ok mempool_result ->
+            record_result pipeline op.hash (Mempool_result mempool_result);
+            Lwt.return_unit
+      end
+
+      else if head_is_resolved pipeline.downloading then begin
+        let (op_hash, p) = Queue.pop pipeline.downloading in
+        p >>= function
+        | Error errs ->
+            record_result pipeline op_hash (Cannot_download errs);
+            Lwt.return_unit
+        | Ok op ->
+            match Mempool_worker.parse op with
+            | Error errs ->
+                record_result pipeline op_hash (Cannot_parse errs);
+                Lwt.return_unit
+            | Ok mop ->
+                let p =
+                  Lwt_pool.use pipeline.pool (fun () ->
+                      Mempool_worker.validate mempool_worker mop) in
+                Queue.push (mop, p) pipeline.applying;
+                Lwt.return_unit
+      end
+
+      else if (not (Queue.is_empty pipeline.received)) then begin
+        let op_hash = Queue.pop pipeline.received in
+        (* TODO[?] should we specify the current peer for fetching? *)
+        let chain_db = Mempool_worker.chain_db mempool_worker in
+        let p =
+          Lwt_pool.use pipeline.pool (fun () ->
+              Distributed_db.Operation.fetch chain_db op_hash ()) in
+        Queue.push (op_hash, p) pipeline.downloading;
+        Lwt.return_unit
+      end
+
+      else
+        (* There are some pending operations, we need to wait on them *)
+        select pipeline >>= fun () ->
+        Lwt.return_unit
+
+    let process_batch mempool_worker pool_size input =
+      let pipeline = create pool_size input in
+      let rec loop () =
+        if is_empty pipeline then
+          Lwt.return pipeline.results
+        else
+          step mempool_worker pipeline >>= fun () ->
+          loop ()
+      in
+      let work = loop () in
+      Lwt.on_cancel work (fun () -> cancel pipeline);
+      work
+
+  end
+
+
+  (* 2. Boilerplate: the set up for the worker architecture *)
+
+  module Name = struct
+    type t = P2p_peer.Id.t
+    let encoding = P2p_peer.Id.encoding
+    let base =
+      let proto_hash =
+        let _: string = Format.flush_str_formatter () in
+        Format.fprintf Format.str_formatter "%a" Protocol_hash.pp Proto.hash;
+        Format.flush_str_formatter () in
+      [ "node"; "mempool"; "peer_worker"; proto_hash ]
+    let pp = P2p_peer.Id.pp
+  end
+
+  module Request = struct
+    type 'a t = Batch : input -> output t
+    type view = input
+    let view
+      : type a. a t -> view
+      = fun (Batch os) -> os
+    let encoding =
+      let open Data_encoding in
+      list Operation_hash.encoding
+    let pp ppf = function
+      |[] -> Format.fprintf ppf "@[<v 2>Request:@, Empty List of Operations@]"
+      |os ->
+          Format.fprintf ppf
+            "@[<v 2>Request:@,%a@]"
+            (Format.pp_print_list Operation_hash.pp)
+            os
+  end
+
+  module Event = struct
+    type t =
+      | Start of input
+      | End_ok of (Request.view * Worker_types.request_status * output)
+      | End_error of (Request.view * Worker_types.request_status * error list)
+
+    let level req =
+      match req with
+      | Start _ -> Logging.Info
+      | End_ok _ -> Logging.Info
+      | End_error _ -> Logging.Error
+
+    let encoding =
+      let open Data_encoding in
+      union
+        [ case (Tag 0)
+            ~title:"Start"
+            (obj1 (req "input" (list Operation_hash.encoding)))
+            (function Start input -> Some input | _ -> None)
+            (fun input -> Start input) ;
+          case (Tag 1)
+            ~title:"End_ok"
+            (obj3
+               (req "request" Request.encoding)
+               (req "status" Worker_types.request_status_encoding)
+               (req "output" (Operation_hash.Map.encoding result_encoding)))
+            (function End_ok (view, status, result) -> Some (view, status, result) | _ -> None)
+            (fun (view, status, result) -> End_ok (view, status, result)) ;
+          case (Tag 2)
+            ~title:"End_error"
+            (obj3
+               (req "failed_request" Request.encoding)
+               (req "status" Worker_types.request_status_encoding)
+               (req "error" RPC_error.encoding))
+            (function End_error (view, status, errs) -> Some (view, status, errs) | _ -> None)
+            (fun (view, status, errs) -> End_error (view, status, errs)) ]
+
+    let pp ppf = function
+      | Start input ->
+          Format.fprintf ppf
+            "@[<v 0>Starting: %a@]"
+            pp_input
+            input
+      | End_ok (view, _, _) ->
+          Format.fprintf ppf
+            "@[<v 0>Finished: %a@]"
+            Request.pp view
+      | End_error (view, _, errs) ->
+          Format.fprintf ppf
+            "@[<v 0>Errors: %a, Operations: %a@]"
+            (Format.pp_print_list Error_monad.pp) errs
+            Request.pp view
+  end
+
+  module Types = struct
+    type parameters = Mempool_worker.t * int
+    type state = { mempool_worker: Mempool_worker.t ; pool_size: int }
+    type view = unit
+    let view _ _ = ()
+    let encoding = Data_encoding.unit
+    let pp _ _ = ()
+  end
+
+  module Worker = Worker.Make (Name) (Event) (Request) (Types)
+  type t = Worker.bounded Worker.queue Worker.t
+  let table =
+    let open Worker in
+    create_table (Bounded { size = Static.max_pending_requests })
+
+
+  (* 3. Workers' work: setting workers' callbacks to perform core work *)
+
+  module Handlers = struct
+
+    type self = t
+
+    let on_launch _ _ (mempool_worker, pool_size) =
+      return Types.{ mempool_worker; pool_size }
+
+    let on_request : type a. self -> a Request.t -> a tzresult Lwt.t
+      = fun t (Request.Batch os) ->
+        let st = Worker.state t in
+        Worker.record_event t (Event.Start os) ;
+        Work.process_batch st.mempool_worker st.pool_size os >>= fun r ->
+        return r
+
+    let on_no_request _ = return_unit
+
+    let on_close _ = Lwt.return_unit
+
+    let on_error t view st errs =
+      Worker.record_event t (Event.End_error (view, st, errs)) ;
+      Lwt.return (Error errs)
+
+    let on_completion
+      : type a. self -> a Request.t -> a -> Worker_types.request_status -> unit Lwt.t
+      = fun t req output st ->
+        match req with
+        | Request.Batch _ ->
+            Worker.record_event t (Event.End_ok (Request.view req, st, output)) ;
+            Lwt.return_unit
+
+  end
+
+
+  (* 4. Public interface: exporting a thin wrapper around workers and work. *)
+  (* See interface file for documentation *)
+
+  let validate t os =
+    Worker.push_request_and_wait t (Request.Batch os)
+    >>=? fun (_: output) -> return_unit
+
+  let create limits peer_id mempool_worker =
+    Worker.launch
+      table
+      limits.worker_limits
+      peer_id
+      (mempool_worker, limits.max_promises_per_request)
+      (module Handlers)
+
+  let shutdown w =
+    let recycled = Operation_hash.Set.empty in
+    let recycled =
+      List.fold_left
+        (fun recycled (_, input) ->
+           List.fold_left
+             (fun recycled op_h -> Operation_hash.Set.add op_h recycled)
+             recycled
+             input)
+        recycled
+        (Worker.pending_requests w)
+    in
+    let recycled =
+      match Worker.current_request w with
+      | Some (_, _, input) ->
+          List.fold_left
+            (fun recycled op_h -> Operation_hash.Set.add op_h recycled)
+            recycled
+            input
+      | None -> recycled
+    in
+    let input = Operation_hash.Set.elements recycled in
+    Worker.shutdown w >>= fun () ->
+    Lwt.return input
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.mli b/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.mli
new file mode 100644
index 000000000..7eb63cdb5
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/mempool_peer_worker.mli
@@ -0,0 +1,73 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Distributing validation work between different workers, one for each peer. *)
+
+type limits = {
+  max_promises_per_request : int ;
+  worker_limits : Worker_types.limits ;
+}
+
+module type T = sig
+  module Mempool_worker: Mempool_worker.T
+
+  (** The type of a peer worker. Each peer worker should be used for treating
+      all the operations from a given peer. *)
+  type t
+
+  (** Types for calls into this module *)
+
+  (** [input] are the batches of operations that are given to a peer worker to
+      validate. These hashes are gossiped on the network, and the mempool checks
+      their validity before gossiping them furhter. *)
+  type input = Operation_hash.t list
+
+  (** [create limits peer_id mempool_worker] creates a peer worker meant
+      to be used for validating batches of operations sent by the peer
+      [peer_id]. The validation of each operations is delegated to the
+      associated [mempool_worker]. *)
+  val create: limits -> P2p_peer.Id.t -> Mempool_worker.t -> t tzresult Lwt.t
+
+  (** [shutdown t] closes the peer worker [t]. It returns a list of operation
+      hashes that can be recycled when a new worker is created for the same peer.
+  *)
+  val shutdown: t -> input Lwt.t
+
+  (** [validate worker input] validates the batch of operations [input]. The
+      work is performed by [worker] and the underlying validation of each
+      operation is performed by the [mempool_worker] that was used to [create]
+      [worker]. *)
+  val validate: t -> input -> unit tzresult Lwt.t
+
+end
+
+
+module type STATIC = sig
+  val max_pending_requests : int
+end
+
+module Make (Static: STATIC) (Mempool_worker: Mempool_worker.T)
+  : T with module Mempool_worker = Mempool_worker
diff --git a/vendors/tezos-modded/src/lib_shell/mempool_worker.ml b/vendors/tezos-modded/src/lib_shell/mempool_worker.ml
new file mode 100644
index 000000000..20711cbdc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/mempool_worker.ml
@@ -0,0 +1,649 @@
+(*****************************************************************************)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type limits = {
+  worker_limits : Worker_types.limits ;
+}
+
+module type T = sig
+
+  module Proto: Registered_protocol.T
+
+  type t
+
+  type operation = private {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+
+  type result =
+    | Applied of Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Not_in_branch
+  val result_encoding : result Data_encoding.t
+
+  (** Creates/tear-down a new mempool validator context. *)
+  val create : limits -> Distributed_db.chain_db -> t tzresult Lwt.t
+  val shutdown : t -> unit Lwt.t
+
+  (** parse a new operation and add it to the mempool context *)
+  val parse : Operation.t -> operation tzresult
+
+  (** validate a new operation and add it to the mempool context *)
+  val validate : t -> operation -> result tzresult Lwt.t
+
+  val chain_db : t -> Distributed_db.chain_db
+
+  val rpc_directory : t RPC_directory.t
+
+end
+
+module type STATIC = sig
+  val max_size_parsed_cache: int
+end
+
+module Make(Static: STATIC)(Proto: Registered_protocol.T)
+  : T with module Proto = Proto
+= struct
+
+  module Proto = Proto
+
+  (* used for rpc *)
+  module Proto_services = Block_services.Make(Proto)(Proto)
+
+  type operation = {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+
+  type result =
+    | Applied of Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Not_in_branch
+
+  let result_encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Applied"
+          (obj1 (req "receipt" Proto.operation_receipt_encoding))
+          (function Applied receipt -> Some receipt | _ -> None)
+          (fun receipt -> Applied receipt) ;
+        case (Tag 1)
+          ~title:"Branch Delayed"
+          (obj1 (req "error" (list Error_monad.error_encoding)))
+          (function Branch_delayed error -> Some error | _ -> None)
+          (fun error -> Branch_delayed error) ;
+        case (Tag 2)
+          ~title:"Branch Refused"
+          (obj1 (req "error" (list Error_monad.error_encoding)))
+          (function Branch_refused error -> Some error | _ -> None)
+          (fun error -> Branch_refused error) ;
+        case (Tag 3)
+          ~title:"Refused"
+          (obj1 (req "error" (list Error_monad.error_encoding)))
+          (function Refused error -> Some error | _ -> None)
+          (fun error -> Refused error) ;
+        case (Tag 4)
+          ~title:"Duplicate"
+          empty
+          (function Duplicate -> Some () | _ -> None)
+          (fun () -> Duplicate) ;
+        case (Tag 5)
+          ~title:"Not_in_branch"
+          empty
+          (function Not_in_branch -> Some () | _ -> None)
+          (fun () -> Not_in_branch) ;
+      ]
+
+  let pp_result ppf = function
+    | Applied _ -> Format.pp_print_string ppf "applied"
+    | Branch_delayed _ -> Format.pp_print_string ppf "branch delayed"
+    | Branch_refused _ -> Format.pp_print_string ppf "branch refused"
+    | Refused _ -> Format.pp_print_string ppf "refused"
+    | Duplicate -> Format.pp_print_string ppf "duplicate"
+    | Not_in_branch -> Format.pp_print_string ppf "not in branch"
+
+  let operation_encoding =
+    let open Data_encoding in
+    conv
+      (fun { hash ; raw ; protocol_data } ->
+         ( hash, raw, protocol_data ))
+      (fun ( hash, raw, protocol_data ) -> { hash ; raw ; protocol_data })
+      (obj3
+         (req "hash" Operation_hash.encoding)
+         (req "raw" Operation.encoding)
+         (req "protocol_data" Proto.operation_data_encoding)
+      )
+
+  module Log = Tezos_stdlib.Logging.Make(struct
+      let name = "node.mempool_validator"
+    end)
+
+  module Name = struct
+    type t = Chain_id.t
+    let encoding = Chain_id.encoding
+    let base =
+      let proto_hash =
+        let _: string = Format.flush_str_formatter () in
+        Format.fprintf Format.str_formatter "%a" Protocol_hash.pp Proto.hash;
+        Format.flush_str_formatter () in
+      [ "node"; "mempool"; "worker"; proto_hash ]
+    let pp = Chain_id.pp_short
+  end
+
+  module Request = struct
+
+    type 'a t = Validate : operation -> result t [@@ocaml.unboxed]
+
+    type view = View : _ t -> view
+
+    let view req = View req
+
+    let encoding =
+      let open Data_encoding in
+      conv
+        (fun (View (Validate op)) -> op)
+        (fun op -> View (Validate op))
+        operation_encoding
+
+    let pp ppf (View (Validate { hash })) =
+      Format.fprintf ppf "Validating new operation %a" Operation_hash.pp hash
+  end
+
+  module Event = struct
+    type t =
+      | Request of (Request.view * Worker_types.request_status * error list option)
+      | Debug of string
+
+    let level req =
+      match req with
+      | Debug _ -> Logging.Debug
+      | Request _ -> Logging.Info
+
+    let encoding =
+      let open Data_encoding in
+      union
+        [ case (Tag 0)
+            ~title:"Debug"
+            (obj1 (req "message" string))
+            (function Debug msg -> Some msg | _ -> None)
+            (fun msg -> Debug msg) ;
+          case (Tag 1)
+            ~title:"Request"
+            (obj2
+               (req "request" Request.encoding)
+               (req "status" Worker_types.request_status_encoding))
+            (function Request (req, t, None) -> Some (req, t) | _ -> None)
+            (fun (req, t) -> Request (req, t, None)) ;
+          case (Tag 2)
+            ~title:"Failed request"
+            (obj3
+               (req "error" RPC_error.encoding)
+               (req "failed_request" Request.encoding)
+               (req "status" Worker_types.request_status_encoding))
+            (function Request (req, t, Some errs) -> Some (errs, req, t) | _ -> None)
+            (fun (errs, req, t) -> Request (req, t, Some errs)) ]
+
+    let pp ppf = function
+      | Debug msg -> Format.fprintf ppf "%s" msg
+      | Request (view, { pushed ; treated ; completed }, None)  ->
+          Format.fprintf ppf
+            "@[<v 0>%a@,Pushed: %a, Treated: %a, Completed: %a@]"
+            Request.pp view
+            Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+      | Request (view, { pushed ; treated ; completed }, Some errors)  ->
+          Format.fprintf ppf
+            "@[<v 0>%a@,Pushed: %a, Treated: %a, Failed: %a@,Errors: %a@]"
+            Request.pp view
+            Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+            (Format.pp_print_list Error_monad.pp) errors
+  end
+
+  (* parsed operations' cache. used for memoization *)
+  module ParsedCache = struct
+
+    type t = {
+      table: operation tzresult Operation_hash.Table.t ;
+      ring: Operation_hash.t Ring.t ;
+    }
+
+    let create () : t = {
+      table = Operation_hash.Table.create Static.max_size_parsed_cache ;
+      ring = Ring.create Static.max_size_parsed_cache ;
+    }
+
+    let add t raw_op parsed_op =
+      let hash = Operation.hash raw_op in
+      Option.iter
+        ~f:(Operation_hash.Table.remove t.table)
+        (Ring.add_and_return_erased t.ring hash);
+      Operation_hash.Table.replace t.table hash parsed_op
+
+    let find_opt t raw_op =
+      let hash = Operation.hash raw_op in
+      Operation_hash.Table.find_opt t.table hash
+
+    let find_hash_opt t hash =
+      Operation_hash.Table.find_opt t.table hash
+
+    let rem t hash =
+      (* NOTE: hashes are not removed from the ring. As a result, the cache size
+       * bound can be lowered. This is a non-issue because it's only a cache. *)
+      Operation_hash.Table.remove t.table hash
+
+  end
+
+  (* validated operations' cache. used for memoization *)
+  module ValidatedCache = struct
+
+    type t = (result * Operation.t) Operation_hash.Table.t
+
+    let encoding =
+      let open Data_encoding in
+      Operation_hash.Table.encoding (
+        tup2
+          result_encoding
+          Operation.encoding
+      )
+
+    let pp break ppf table =
+      let open Format in
+      Operation_hash.Table.iter
+        (fun h (r, _) ->
+           fprintf ppf "Operation %a: %a"
+             Operation_hash.pp_short h
+             pp_result r;
+           break ppf
+        )
+        table
+
+    let create () = Operation_hash.Table.create 1000
+
+    let add t parsed_op result =
+      Operation_hash.Table.replace t parsed_op.hash result
+
+    let find_opt t parsed_op =
+      Operation_hash.Table.find_opt t parsed_op.hash
+
+    let iter f t =
+      Operation_hash.Table.iter f t
+
+    let to_mempool t =
+      let empty = {
+        Proto_services.Mempool.applied = [] ;
+        refused = Operation_hash.Map.empty ;
+        branch_refused = Operation_hash.Map.empty ;
+        branch_delayed = Operation_hash.Map.empty ;
+        unprocessed = Operation_hash.Map.empty ;
+      } in
+      let map_op op =
+        let protocol_data =
+          Data_encoding.Binary.of_bytes_exn
+            Proto.operation_data_encoding
+            op.Operation.proto in
+        { Proto.shell = op.shell ; protocol_data } in
+      Operation_hash.Table.fold
+        (fun hash (result,raw_op) acc ->
+           let proto_op = map_op raw_op in
+           match result with
+           | Applied _ -> {
+               acc with
+               Proto_services.Mempool.applied =
+                 (hash, proto_op)::acc.Proto_services.Mempool.applied
+             }
+           | Branch_refused err -> {
+               acc with
+               Proto_services.Mempool.branch_refused =
+                 Operation_hash.Map.add
+                   hash
+                   (proto_op,err)
+                   acc.Proto_services.Mempool.branch_refused
+             }
+           | Branch_delayed err -> {
+               acc with
+               Proto_services.Mempool.branch_delayed =
+                 Operation_hash.Map.add
+                   hash
+                   (proto_op,err)
+                   acc.Proto_services.Mempool.branch_delayed
+             }
+           | Refused err -> {
+               acc with
+               Proto_services.Mempool.refused =
+                 Operation_hash.Map.add
+                   hash
+                   (proto_op,err)
+                   acc.Proto_services.Mempool.refused
+             }
+           | _ -> acc
+        ) t empty
+
+    let clear t = Operation_hash.Table.clear t
+
+  end
+
+  module Types = struct
+
+    type parameters = {
+      limits : limits ;
+      chain_db : Distributed_db.chain_db ;
+      validation_state : Proto.validation_state ;
+    }
+
+    (* internal worker state *)
+    type state =
+      {
+        (* state of the validator. this is updated at each apply_operation *)
+        mutable validation_state : Proto.validation_state ;
+
+        cache : ValidatedCache.t ;
+
+        (* live blocks and operations, initialized at worker launch *)
+        live_blocks : Block_hash.Set.t ;
+        live_operations : Operation_hash.Set.t ;
+
+        operation_stream: (
+          result *
+          Operation.shell_header *
+          Proto.operation_data
+        ) Lwt_watcher.input;
+
+        parameters : parameters ;
+      }
+
+    type view = { cache : ValidatedCache.t }
+
+    let view (state : state) _ : view = { cache = state.cache }
+
+    let encoding =
+      let open Data_encoding in
+      conv
+        (fun { cache } -> cache)
+        (fun cache -> { cache })
+        ValidatedCache.encoding
+
+    let pp ppf { cache } =
+      ValidatedCache.pp
+        (fun ppf ->
+           Format.pp_print_string ppf ";";
+           Format.pp_print_space ppf ())
+        ppf
+        cache
+
+  end
+
+  module Worker = Worker.Make (Name) (Event) (Request) (Types)
+
+  open Types
+
+  type t = Worker.infinite Worker.queue Worker.t
+
+  let parsed_cache = ParsedCache.create ()
+
+  let debug w =
+    Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
+
+  let shutdown w =
+    Worker.shutdown w
+
+  (*** prevalidation ****)
+  open Validation_errors
+
+  let create ?protocol_data ~predecessor ~timestamp () =
+    let { Block_header.shell =
+            { fitness = predecessor_fitness ;
+              timestamp = predecessor_timestamp ;
+              level = predecessor_level } } =
+      State.Block.header predecessor in
+    State.Block.context predecessor >>= fun predecessor_context ->
+    let predecessor_hash = State.Block.hash predecessor in
+    Context.reset_test_chain
+      predecessor_context predecessor_hash
+      timestamp >>= fun predecessor_context ->
+    Context.reset_test_chain
+      predecessor_context predecessor_hash
+      timestamp >>= fun predecessor_context ->
+    begin
+      match protocol_data with
+      | None -> return_none
+      | Some protocol_data ->
+          match
+            Data_encoding.Binary.of_bytes
+              Proto.block_header_data_encoding
+              protocol_data
+          with
+          | None -> failwith "Invalid block header"
+          | Some protocol_data -> return_some protocol_data
+    end >>=? fun protocol_data ->
+    Proto.begin_construction
+      ~chain_id: (State.Block.chain_id predecessor)
+      ~predecessor_context
+      ~predecessor_timestamp
+      ~predecessor_fitness
+      ~predecessor_level
+      ~predecessor:predecessor_hash
+      ~timestamp
+      ?protocol_data
+      ()
+
+  let apply_operation state op =
+    if Operation_hash.Set.mem op.hash state.live_operations then
+      Lwt.return (None, Duplicate)
+    else if not (Block_hash.Set.mem op.raw.Operation.shell.branch state.live_blocks) then
+      Lwt.return (None,Not_in_branch)
+    else
+      Proto.apply_operation state.validation_state
+        { shell = op.raw.shell ; protocol_data = op.protocol_data } >|= function
+      | Ok (validation_state, receipt) ->
+          (Some validation_state, Applied receipt)
+      | Error errors ->
+          (None,
+           match classify_errors errors with
+           | `Branch -> Branch_refused errors
+           | `Permanent -> Refused errors
+           | `Temporary -> Branch_delayed errors)
+
+  (*** end prevalidation ***)
+
+  let parse_helper raw_op =
+    let hash = Operation.hash raw_op in
+    let size = Data_encoding.Binary.length Operation.encoding raw_op in
+    if size > Proto.max_operation_data_length then
+      error (Oversized_operation
+               { size ; max = Proto.max_operation_data_length })
+    else
+      match Data_encoding.Binary.of_bytes
+              Proto.operation_data_encoding
+              raw_op.Operation.proto with
+      | None -> error Parse_error
+      | Some protocol_data ->
+          ok { hash ; raw = raw_op ; protocol_data }
+
+  (* this function update the internal state of the worker *)
+  let validate_helper w parsed_op =
+    let state = Worker.state w in
+    apply_operation state parsed_op >>= fun (validation_state, result) ->
+    begin
+      match validation_state with
+      | Some validation_state -> state.validation_state <- validation_state
+      | None -> ()
+    end ;
+    Lwt.return result
+
+  let notify_helper w result { Operation.shell ; proto } =
+    let state = Worker.state w in
+    (* this function is called by on_validate where we take care of the error *)
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.operation_data_encoding
+        proto in
+    Lwt_watcher.notify state.operation_stream (result, shell, protocol_data)
+
+  (* memoization is done only at on_* level *)
+  let on_validate w parsed_op =
+    let state = Worker.state w in
+    match ValidatedCache.find_opt state.cache parsed_op with
+    | None | Some ((Branch_delayed _),_) ->
+        validate_helper w parsed_op >>= fun result ->
+        ValidatedCache.add state.cache parsed_op (result, parsed_op.raw);
+        (* operations are notified only the first time *)
+        notify_helper w result parsed_op.raw ;
+        Lwt.return result
+    | Some (result,_) -> Lwt.return result
+
+  (* worker's handlers *)
+  let on_request :
+    type r. t -> r Request.t -> r tzresult Lwt.t = fun w request ->
+    match request with
+    | Request.Validate parsed_op -> on_validate w parsed_op >>= return
+
+  let on_launch (_ : t) (_ : Name.t) ( { chain_db ; validation_state } as parameters ) =
+    let chain_state = Distributed_db.chain_state chain_db in
+    Chain.data chain_state >>= fun {
+      current_mempool = _mempool ;
+      live_blocks ; live_operations } ->
+    (* remove all operations that are already included *)
+    Operation_hash.Set.iter (fun hash ->
+        ParsedCache.rem parsed_cache hash
+      ) live_operations;
+    return {
+      validation_state ;
+      cache = ValidatedCache.create () ;
+      live_blocks ;
+      live_operations ;
+      operation_stream = Lwt_watcher.create_input ();
+      parameters
+    }
+
+  let on_close w =
+    let state = Worker.state w in
+    Lwt_watcher.shutdown_input state.operation_stream;
+    ValidatedCache.iter (fun hash _ ->
+        Distributed_db.Operation.clear_or_cancel
+          state.parameters.chain_db hash)
+      state.cache ;
+    ValidatedCache.clear state.cache;
+    Lwt.return_unit
+
+  let on_error w r st errs =
+    Worker.record_event w (Event.Request (r, st, Some errs)) ;
+    Lwt.return (Error errs)
+
+  let on_completion w r _ st =
+    Worker.record_event w (Event.Request (Request.view r, st, None)) ;
+    Lwt.return_unit
+
+  let table = Worker.create_table Queue
+
+  let create limits chain_db  =
+    let chain_state = Distributed_db.chain_state chain_db in
+    let chain_id = State.Chain.id chain_state in
+    let module Handlers = struct
+      type self = t
+      let on_launch = on_launch
+      let on_close = on_close
+      let on_error = on_error
+      let on_completion = on_completion
+      let on_no_request _ = return_unit
+      let on_request = on_request
+    end in
+    Chain.data chain_state >>= fun { current_head = predecessor } ->
+    let timestamp = Time.now () in
+    create ~predecessor ~timestamp () >>=? fun validation_state ->
+    Worker.launch
+      table
+      limits.worker_limits
+      chain_id
+      { limits ; chain_db ; validation_state }
+      (module Handlers)
+
+  (* Exporting functions *)
+
+  let validate t parsed_op =
+    Worker.push_request_and_wait t (Request.Validate parsed_op)
+
+  (* atomic parse + memoization *)
+  let parse raw_op =
+    begin match ParsedCache.find_opt parsed_cache raw_op with
+      | None ->
+          let parsed_op = parse_helper raw_op in
+          ParsedCache.add parsed_cache raw_op parsed_op;
+          parsed_op
+      | Some parsed_op -> parsed_op
+    end
+
+  let chain_db t =
+    let state = Worker.state t in
+    state.parameters.chain_db
+
+  let pending_rpc_directory : t RPC_directory.t =
+    RPC_directory.gen_register
+      RPC_directory.empty
+      (Proto_services.S.Mempool.pending_operations RPC_path.open_root)
+      (fun w () () ->
+         let state = Worker.state w in
+         RPC_answer.return (ValidatedCache.to_mempool state.cache)
+      )
+
+  let monitor_rpc_directory : t RPC_directory.t =
+    RPC_directory.gen_register
+      RPC_directory.empty
+      (Proto_services.S.Mempool.monitor_operations RPC_path.open_root)
+      (fun w params () ->
+         let state = Worker.state w in
+         let filter_result = function
+           | Applied _ -> params#applied
+           | Refused _ -> params#branch_refused
+           | Branch_refused _ -> params#refused
+           | Branch_delayed _ -> params#branch_delayed
+           | _ -> false in
+
+         let op_stream, stopper = Lwt_watcher.create_stream state.operation_stream in
+         let shutdown () = Lwt_watcher.shutdown stopper in
+         let next () =
+           Lwt_stream.get op_stream >>= function
+           | Some (kind, shell, protocol_data) when filter_result kind ->
+               Lwt.return_some [ { Proto.shell ; protocol_data } ]
+           | _ -> Lwt.return_none in
+         RPC_answer.return_stream { next ; shutdown }
+      )
+
+  (* /mempool/<chain_id>/pending
+     /mempool/<chain_id>/monitor *)
+  let rpc_directory =
+    RPC_directory.merge
+      pending_rpc_directory
+      monitor_rpc_directory
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/mempool_worker.mli b/vendors/tezos-modded/src/lib_shell/mempool_worker.mli
new file mode 100644
index 000000000..61fc1e96b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/mempool_worker.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type limits = {
+  worker_limits : Worker_types.limits ;
+}
+
+module type T = sig
+
+  module Proto: Registered_protocol.T
+
+  type t
+
+  type operation = private {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+
+  type result =
+    | Applied of Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Not_in_branch
+  val result_encoding : result Data_encoding.t
+
+  (** Creates/tear-down a new mempool validator context. *)
+  val create : limits -> Distributed_db.chain_db -> t tzresult Lwt.t
+  val shutdown : t -> unit Lwt.t
+
+  (** parse a new operation *)
+  val parse : Operation.t -> operation tzresult
+
+  (** validate a new operation and add it to the mempool context *)
+  val validate : t -> operation -> result tzresult Lwt.t
+
+  val chain_db : t -> Distributed_db.chain_db
+
+  val rpc_directory : t RPC_directory.t
+
+end
+
+module type STATIC = sig
+  val max_size_parsed_cache: int
+end
+
+module Make (Static : STATIC) (Proto : Registered_protocol.T) : T with module Proto = Proto
diff --git a/vendors/tezos-modded/src/lib_shell/monitor_directory.ml b/vendors/tezos-modded/src/lib_shell/monitor_directory.ml
new file mode 100644
index 000000000..d5bb392b1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/monitor_directory.ml
@@ -0,0 +1,154 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 build_rpc_directory validator mainchain_validator =
+
+  let distributed_db = Validator.distributed_db validator in
+  let state = Distributed_db.state distributed_db in
+
+  let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
+  let gen_register0 s f =
+    dir := RPC_directory.gen_register !dir s (fun () p q -> f p q) in
+  let gen_register1 s f =
+    dir := RPC_directory.gen_register !dir s (fun ((), a) p q -> f a p q) in
+
+  gen_register0 Monitor_services.S.bootstrapped begin fun () () ->
+    let block_stream, stopper =
+      Chain_validator.new_head_watcher mainchain_validator in
+    let first_run = ref true in
+    let next () =
+      if !first_run then begin
+        first_run := false ;
+        let chain_state = Chain_validator.chain_state mainchain_validator in
+        Chain.head chain_state >>= fun head ->
+        let head_hash = State.Block.hash head in
+        let head_header = State.Block.header head in
+        Lwt.return_some (head_hash, head_header.shell.timestamp)
+      end else begin
+        Lwt.pick [
+          ( Lwt_stream.get block_stream >|=
+            Option.map ~f:(fun b ->
+                (State.Block.hash b, (State.Block.header b).shell.timestamp)) ) ;
+          (Chain_validator.bootstrapped mainchain_validator >|= fun () -> None) ;
+        ]
+      end in
+    let shutdown () = Lwt_watcher.shutdown stopper in
+    RPC_answer.return_stream { next ; shutdown }
+  end ;
+
+  gen_register0 Monitor_services.S.valid_blocks begin fun q () ->
+    let block_stream, stopper = State.watcher state in
+    let shutdown () = Lwt_watcher.shutdown stopper in
+    let in_chains block =
+      Lwt_list.map_p (Chain_directory.get_chain_id state) q#chains >>= function
+      | [] -> Lwt.return_true
+      | chains ->
+          let chain_id = State.Block.chain_id block in
+          Lwt.return (List.exists (Chain_id.equal chain_id) chains) in
+    let in_protocols block =
+      match q#protocols with
+      | [] -> Lwt.return_true
+      | protocols ->
+          State.Block.predecessor block >>= function
+          | None -> Lwt.return_false (* won't happen *)
+          | Some pred ->
+              State.Block.context pred >>= fun context ->
+              Context.get_protocol context >>= fun protocol ->
+              Lwt.return (List.exists (Protocol_hash.equal protocol) protocols) in
+    let in_next_protocols block =
+      match q#next_protocols with
+      | [] -> Lwt.return_true
+      | protocols ->
+          State.Block.context block >>= fun context ->
+          Context.get_protocol context >>= fun next_protocol ->
+          Lwt.return (List.exists (Protocol_hash.equal next_protocol) protocols) in
+    let stream =
+      Lwt_stream.filter_map_s
+        (fun block ->
+           in_chains block >>= fun in_chains ->
+           in_next_protocols block >>= fun in_next_protocols ->
+           in_protocols block >>= fun in_protocols ->
+           if in_chains && in_protocols && in_next_protocols then
+             Lwt.return_some
+               ((State.Block.chain_id block, State.Block.hash block),
+                State.Block.header block)
+           else
+             Lwt.return_none)
+        block_stream in
+    let next () = Lwt_stream.get stream in
+    RPC_answer.return_stream { next ; shutdown }
+  end ;
+
+  gen_register1 Monitor_services.S.heads begin fun chain q () ->
+    (* TODO: when `chain = `Test`, should we reset then stream when
+       the `testnet` change, or dias we currently do ?? *)
+    Chain_directory.get_chain state chain >>= fun chain ->
+    match Validator.get validator (State.Chain.id chain) with
+    | Error _ -> Lwt.fail Not_found
+    | Ok chain_validator ->
+        let block_stream, stopper = Chain_validator.new_head_watcher chain_validator in
+        Chain.head chain >>= fun head ->
+        let shutdown () = Lwt_watcher.shutdown stopper in
+        let in_next_protocols block =
+          match q#next_protocols with
+          | [] -> Lwt.return_true
+          | protocols ->
+              State.Block.context block >>= fun context ->
+              Context.get_protocol context >>= fun next_protocol ->
+              Lwt.return (List.exists (Protocol_hash.equal next_protocol) protocols) in
+        let stream =
+          Lwt_stream.filter_map_s
+            (fun block ->
+               in_next_protocols block >>= fun in_next_protocols ->
+               if in_next_protocols then
+                 Lwt.return_some (State.Block.hash block, State.Block.header block)
+               else
+                 Lwt.return_none)
+            block_stream in
+        in_next_protocols head >>= fun first_block_is_among_next_protocols ->
+        let first_call =
+          (* Skip the first block if this is false *)
+          ref first_block_is_among_next_protocols in
+        let next () =
+          if !first_call then begin
+            first_call := false ; Lwt.return_some (State.Block.hash head, State.Block.header head)
+          end else
+            Lwt_stream.get stream in
+        RPC_answer.return_stream { next ; shutdown }
+  end ;
+
+  gen_register0 Monitor_services.S.protocols begin fun () () ->
+    let stream, stopper = State.Protocol.watcher state in
+    let shutdown () = Lwt_watcher.shutdown stopper in
+    let next () = Lwt_stream.get stream in
+    RPC_answer.return_stream { next ; shutdown }
+  end ;
+
+  gen_register0 Monitor_services.S.commit_hash begin fun () () ->
+    RPC_answer.return Tezos_base.Current_git_info.commit_hash
+  end ;
+
+  !dir
diff --git a/vendors/tezos-modded/src/lib_shell/monitor_directory.mli b/vendors/tezos-modded/src/lib_shell/monitor_directory.mli
new file mode 100644
index 000000000..bf904f5f9
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/monitor_directory.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 build_rpc_directory:
+  Validator.t -> Chain_validator.t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/node.ml b/vendors/tezos-modded/src/lib_shell/node.ml
new file mode 100644
index 000000000..a60222cc4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/node.ml
@@ -0,0 +1,243 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+open Worker_logging
+
+type t = {
+  state: State.t ;
+  distributed_db: Distributed_db.t ;
+  validator: Validator.t ;
+  mainchain_validator: Chain_validator.t ;
+  p2p: Distributed_db.p2p ; (* For P2P RPCs *)
+  shutdown: unit -> unit Lwt.t ;
+}
+
+
+let peer_metadata_cfg : _ P2p.peer_meta_config = {
+  peer_meta_encoding = Peer_metadata.encoding ;
+  peer_meta_initial = Peer_metadata.empty ;
+  score = Peer_metadata.score ;
+}
+
+let connection_metadata_cfg cfg : _ P2p.conn_meta_config = {
+  conn_meta_encoding = Connection_metadata.encoding ;
+  private_node = (fun { private_node } -> private_node) ;
+  conn_meta_value = fun _ -> cfg;
+}
+
+let init_connection_metadata opt =
+  let open Connection_metadata in
+  match opt with
+  | None ->
+      { disable_mempool = false ;
+        private_node = false }
+  | Some c ->
+      { disable_mempool = c.P2p.disable_mempool ;
+        private_node = c.P2p.private_mode }
+
+let init_p2p ?(sandboxed = false) p2p_params =
+  match p2p_params with
+  | None ->
+      let c_meta = init_connection_metadata None in
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "P2P layer is disabled" -% t event "p2p_disabled") >>= fun () ->
+      return (P2p.faked_network peer_metadata_cfg c_meta)
+  | Some (config, limits) ->
+      let c_meta = init_connection_metadata (Some config) in
+      let conn_metadata_cfg = connection_metadata_cfg c_meta in
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "bootstrapping chain..." -% t event "bootstrapping_chain") >>= fun () ->
+      let message_cfg =
+        if sandboxed then
+          { Distributed_db_message.cfg with
+            versions =
+              List.map
+                (fun v -> { v with P2p_version.name =
+                                     "SANDBOXED_" ^ v.P2p_version.name })
+                Distributed_db_message.cfg.versions }
+        else
+          Distributed_db_message.cfg in
+      P2p.create
+        ~config ~limits
+        peer_metadata_cfg
+        conn_metadata_cfg
+        message_cfg >>=? fun p2p ->
+      Lwt.async (fun () -> P2p.maintain p2p) ;
+      return p2p
+
+type config = {
+  genesis: State.Chain.genesis ;
+  store_root: string ;
+  context_root: string ;
+  patch_context: (Context.t -> Context.t Lwt.t) option ;
+  p2p: (P2p.config * P2p.limits) option ;
+  test_chain_max_tll: int option ;
+  checkpoint: (Int32.t * Block_hash.t) option ;
+}
+
+and peer_validator_limits = Peer_validator.limits = {
+  new_head_request_timeout: float ;
+  block_header_timeout: float ;
+  block_operations_timeout: float ;
+  protocol_timeout: float ;
+  worker_limits: Worker_types.limits
+}
+
+and prevalidator_limits = Prevalidator.limits = {
+  max_refused_operations: int ;
+  operation_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+
+and block_validator_limits = Block_validator.limits = {
+  protocol_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+
+and chain_validator_limits = Chain_validator.limits = {
+  bootstrap_threshold: int ;
+  worker_limits : Worker_types.limits ;
+}
+
+let default_block_validator_limits = {
+  protocol_timeout = 120. ;
+  worker_limits = {
+    backlog_size = 1000 ;
+    backlog_level = Logging.Debug ;
+    zombie_lifetime = 3600. ;
+    zombie_memory = 1800. ;
+  }
+}
+let default_prevalidator_limits = {
+  operation_timeout = 10. ;
+  max_refused_operations = 1000 ;
+  worker_limits = {
+    backlog_size = 1000 ;
+    backlog_level = Logging.Info ;
+    zombie_lifetime = 600. ;
+    zombie_memory = 120. ;
+  }
+}
+let default_peer_validator_limits = {
+  block_header_timeout = 60. ;
+  block_operations_timeout = 60. ;
+  protocol_timeout = 120. ;
+  new_head_request_timeout = 90. ;
+  worker_limits = {
+    backlog_size = 1000 ;
+    backlog_level = Logging.Info ;
+    zombie_lifetime = 600. ;
+    zombie_memory = 120. ;
+  }
+}
+let default_chain_validator_limits = {
+  bootstrap_threshold = 4 ;
+  worker_limits = {
+    backlog_size = 1000 ;
+    backlog_level = Logging.Info ;
+    zombie_lifetime = 600. ;
+    zombie_memory = 120. ;
+  }
+}
+
+let may_update_checkpoint chain_state checkpoint =
+  match checkpoint with
+  | None ->
+      Lwt.return_unit
+  | Some checkpoint ->
+      State.best_known_head_for_checkpoint
+        chain_state checkpoint >>= fun new_head ->
+      Chain.set_head chain_state new_head >>= fun _old_head ->
+      State.Chain.set_checkpoint chain_state checkpoint
+
+let create
+    ?(sandboxed = false)
+    { genesis ; store_root ; context_root ;
+      patch_context ; p2p = p2p_params ;
+      test_chain_max_tll = max_child_ttl ;
+      checkpoint }
+    peer_validator_limits
+    block_validator_limits
+    prevalidator_limits
+    chain_validator_limits =
+  let start_prevalidator =
+    match p2p_params with
+    | Some (config, _limits) -> not config.P2p.disable_mempool
+    | None -> true in
+  init_p2p ~sandboxed p2p_params >>=? fun p2p ->
+  State.init
+    ~store_root ~context_root ?patch_context
+    genesis >>=? fun (state, mainchain_state, context_index) ->
+  may_update_checkpoint mainchain_state checkpoint >>= fun () ->
+  let distributed_db = Distributed_db.create state p2p in
+  Validator.create state distributed_db
+    peer_validator_limits
+    block_validator_limits
+    (Block_validator.Internal context_index)
+    prevalidator_limits
+    chain_validator_limits
+  >>=? fun validator ->
+  Validator.activate validator
+    ?max_child_ttl ~start_prevalidator mainchain_state >>=? fun mainchain_validator ->
+  let shutdown () =
+    P2p.shutdown p2p >>= fun () ->
+    Distributed_db.shutdown distributed_db >>= fun () ->
+    Validator.shutdown validator >>= fun () ->
+    State.close state >>= fun () ->
+    Lwt.return_unit
+  in
+  return {
+    state ;
+    distributed_db ;
+    validator ;
+    mainchain_validator ;
+    p2p ;
+    shutdown ;
+  }
+
+let shutdown node = node.shutdown ()
+
+let build_rpc_directory node =
+  let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
+  let merge d = dir := RPC_directory.merge !dir d in
+  let register0 s f =
+    dir := RPC_directory.register !dir s (fun () p q -> f p q) in
+
+  merge (Protocol_directory.build_rpc_directory node.state) ;
+  merge (Monitor_directory.build_rpc_directory
+           node.validator node.mainchain_validator) ;
+  merge (Injection_directory.build_rpc_directory node.validator) ;
+  merge (Chain_directory.build_rpc_directory node.validator) ;
+  merge (P2p.build_rpc_directory node.p2p) ;
+  merge (Worker_directory.build_rpc_directory node.state) ;
+
+  register0 RPC_service.error_service begin fun () () ->
+    return (Data_encoding.Json.schema Error_monad.error_encoding)
+  end ;
+
+  RPC_directory.register_describe_directory_service
+    !dir RPC_service.description_service
diff --git a/vendors/tezos-modded/src/lib_shell/node.mli b/vendors/tezos-modded/src/lib_shell/node.mli
new file mode 100644
index 000000000..ce167e61d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/node.mli
@@ -0,0 +1,75 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+type config = {
+  genesis: State.Chain.genesis ;
+  store_root: string ;
+  context_root: string ;
+  patch_context: (Context.t -> Context.t Lwt.t) option ;
+  p2p: (P2p.config * P2p.limits) option ;
+  test_chain_max_tll: int option ;
+  checkpoint: (Int32.t * Block_hash.t) option ;
+}
+
+and peer_validator_limits = {
+  new_head_request_timeout: float ;
+  block_header_timeout: float ;
+  block_operations_timeout: float ;
+  protocol_timeout: float ;
+  worker_limits: Worker_types.limits
+}
+and prevalidator_limits = {
+  max_refused_operations: int ;
+  operation_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+and block_validator_limits = {
+  protocol_timeout: float ;
+  worker_limits : Worker_types.limits ;
+}
+and chain_validator_limits = {
+  bootstrap_threshold: int ;
+  worker_limits : Worker_types.limits ;
+}
+
+val default_peer_validator_limits: peer_validator_limits
+val default_prevalidator_limits: prevalidator_limits
+val default_block_validator_limits: block_validator_limits
+val default_chain_validator_limits: chain_validator_limits
+
+val create:
+  ?sandboxed:bool ->
+  config ->
+  peer_validator_limits ->
+  block_validator_limits ->
+  prevalidator_limits ->
+  chain_validator_limits ->
+  t tzresult Lwt.t
+
+val shutdown: t -> unit Lwt.t
+
+val build_rpc_directory: t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/peer_validator.ml b/vendors/tezos-modded/src/lib_shell/peer_validator.ml
new file mode 100644
index 000000000..c194aec78
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/peer_validator.ml
@@ -0,0 +1,433 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* FIXME ignore/postpone fetching/validating of block in the future... *)
+
+open Peer_validator_worker_state
+
+module Name = struct
+  type t = Chain_id.t * P2p_peer.Id.t
+  let encoding =
+    Data_encoding.tup2 Chain_id.encoding P2p_peer.Id.encoding
+  let base = [ "validator.peer" ]
+  let pp ppf (chain, peer) =
+    Format.fprintf ppf "%a:%a"
+      Chain_id.pp_short chain P2p_peer.Id.pp_short peer
+end
+
+module Request = struct
+  include Request
+
+  type _ t =
+    | New_head : Block_hash.t * Block_header.t -> unit t
+    | New_branch : Block_hash.t * Block_locator.t * Block_locator.seed -> unit t
+
+  let view (type a) (req : a t) : view = match req with
+    | New_head (hash, _) ->
+        New_head hash
+    | New_branch (hash, locator, seed) ->
+        (* the seed is associated to each locator
+           w.r.t. the peer_id of the sender *)
+        New_branch (hash, Block_locator.estimated_length seed locator)
+end
+
+type limits = {
+  new_head_request_timeout: float ;
+  block_header_timeout: float ;
+  block_operations_timeout: float ;
+  protocol_timeout: float ;
+  worker_limits: Worker_types.limits
+}
+
+module Types = struct
+  include Worker_state
+
+  type parameters = {
+    chain_db: Distributed_db.chain_db ;
+    block_validator: Block_validator.t ;
+    (* callback to chain_validator *)
+    notify_new_block: State.Block.t -> unit ;
+    notify_bootstrapped: unit -> unit ;
+    notify_termination: unit -> unit ;
+    limits: limits;
+  }
+
+  type state = {
+    peer_id: P2p_peer.Id.t ;
+    parameters : parameters ;
+    mutable bootstrapped: bool ;
+    mutable last_validated_head: Block_header.t ;
+    mutable last_advertised_head: Block_header.t ;
+  }
+
+  let view (state : state) _ : view =
+    let { bootstrapped ; last_validated_head ; last_advertised_head } = state in
+    { bootstrapped ;
+      last_validated_head = Block_header.hash last_validated_head ;
+      last_advertised_head = Block_header.hash last_advertised_head }
+
+end
+
+module Worker = Worker.Make (Name) (Event) (Request) (Types)
+
+open Types
+
+type t = Worker.dropbox Worker.t
+
+let debug w =
+  Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
+
+let set_bootstrapped pv =
+  if not pv.bootstrapped then begin
+    pv.bootstrapped <- true ;
+    pv.parameters.notify_bootstrapped () ;
+  end
+
+let bootstrap_new_branch w _ancestor _head unknown_prefix =
+  let pv = Worker.state w in
+  let sender_id = Distributed_db.my_peer_id pv.parameters.chain_db in
+  (* sender and receiver are inverted here because they are from
+     the point of view of the node sending the locator *)
+  let seed = {Block_locator.sender_id=pv.peer_id; receiver_id = sender_id } in
+  let len = Block_locator.estimated_length seed unknown_prefix in
+  debug w
+    "validating new branch from peer %a (approx. %d blocks)"
+    P2p_peer.Id.pp_short pv.peer_id len ;
+  let pipeline =
+    Bootstrap_pipeline.create
+      ~notify_new_block:pv.parameters.notify_new_block
+      ~block_header_timeout:pv.parameters.limits.block_header_timeout
+      ~block_operations_timeout:pv.parameters.limits.block_operations_timeout
+      pv.parameters.block_validator
+      pv.peer_id pv.parameters.chain_db unknown_prefix in
+  Worker.protect w
+    ~on_error:begin fun error ->
+      (* if the peer_validator is killed, let's cancel the pipeline *)
+      Bootstrap_pipeline.cancel pipeline >>= fun () ->
+      Lwt.return_error error
+    end
+    begin fun () ->
+      Bootstrap_pipeline.wait pipeline
+    end >>=? fun () ->
+  set_bootstrapped pv ;
+  debug w
+    "done validating new branch from peer %a."
+    P2p_peer.Id.pp_short pv.peer_id ;
+  return_unit
+
+let validate_new_head w hash (header : Block_header.t) =
+  let pv = Worker.state w in
+  debug w
+    "fetching operations for new head %a from peer %a"
+    Block_hash.pp_short hash
+    P2p_peer.Id.pp_short pv.peer_id ;
+  map_p
+    (fun i ->
+       Worker.protect w begin fun () ->
+         Distributed_db.Operations.fetch
+           ~timeout:pv.parameters.limits.block_operations_timeout
+           pv.parameters.chain_db ~peer:pv.peer_id
+           (hash, i) header.shell.operations_hash
+       end)
+    (0 -- (header.shell.validation_passes - 1)) >>=? fun operations ->
+  debug w
+    "requesting validation for new head %a from peer %a"
+    Block_hash.pp_short hash
+    P2p_peer.Id.pp_short pv.peer_id ;
+  Block_validator.validate
+    ~notify_new_block:pv.parameters.notify_new_block
+    pv.parameters.block_validator pv.parameters.chain_db
+    hash header operations >>=? fun _block ->
+  debug w
+    "end of validation for new head %a from peer %a"
+    Block_hash.pp_short hash
+    P2p_peer.Id.pp_short pv.peer_id ;
+  set_bootstrapped pv ;
+  let meta = Distributed_db.get_peer_metadata pv.parameters.chain_db pv.peer_id in
+  Peer_metadata.incr meta Valid_blocks;
+  return_unit
+
+let only_if_fitness_increases w distant_header cont =
+  let pv = Worker.state w in
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  Chain.head chain_state >>= fun local_header ->
+  if Fitness.compare
+      distant_header.Block_header.shell.fitness
+      (State.Block.fitness local_header) <= 0 then begin
+    set_bootstrapped pv ;
+    debug w
+      "ignoring head %a with non increasing fitness from peer: %a."
+      Block_hash.pp_short (Block_header.hash distant_header)
+      P2p_peer.Id.pp_short pv.peer_id ;
+    (* Don't download a branch that cannot beat the current head. *)
+    let meta = Distributed_db.get_peer_metadata pv.parameters.chain_db pv.peer_id in
+    Peer_metadata.incr meta Old_heads;
+    return_unit
+  end else cont ()
+
+let assert_acceptable_head w hash (header: Block_header.t) =
+  let pv = Worker.state w in
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  State.Chain.acceptable_block chain_state hash header >>= fun acceptable ->
+  fail_unless acceptable
+    (Validation_errors.Checkpoint_error (hash, Some pv.peer_id))
+
+let may_validate_new_head w hash (header : Block_header.t) =
+  let pv = Worker.state w in
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  State.Block.known_valid chain_state hash >>= fun valid_block ->
+  State.Block.known_invalid chain_state hash >>= fun invalid_block ->
+  State.Block.known_valid chain_state
+    header.shell.predecessor >>= fun valid_predecessor ->
+  State.Block.known_invalid chain_state
+    header.shell.predecessor >>= fun invalid_predecessor ->
+  if valid_block then begin
+    debug w
+      "ignoring previously validated block %a from peer %a"
+      Block_hash.pp_short hash
+      P2p_peer.Id.pp_short pv.peer_id ;
+    set_bootstrapped pv ;
+    pv.last_validated_head <- header ;
+    return_unit
+  end else if invalid_block then begin
+    debug w
+      "ignoring known invalid block %a from peer %a"
+      Block_hash.pp_short hash
+      P2p_peer.Id.pp_short pv.peer_id ;
+    fail Validation_errors.Known_invalid
+  end else if invalid_predecessor then begin
+    debug w
+      "ignoring known invalid block %a from peer %a"
+      Block_hash.pp_short hash
+      P2p_peer.Id.pp_short pv.peer_id ;
+    Distributed_db.commit_invalid_block pv.parameters.chain_db
+      hash header [Validation_errors.Known_invalid] >>=? fun _ ->
+    fail Validation_errors.Known_invalid
+  end else if not valid_predecessor then begin
+    debug w
+      "missing predecessor for new head %a from peer %a"
+      Block_hash.pp_short hash
+      P2p_peer.Id.pp_short pv.peer_id ;
+    Distributed_db.Request.current_branch
+      pv.parameters.chain_db ~peer:pv.peer_id () ;
+    return_unit
+  end else begin
+    only_if_fitness_increases w header @@ fun () ->
+    assert_acceptable_head w hash header >>=? fun () ->
+    validate_new_head w hash header
+  end
+
+let may_validate_new_branch w distant_hash locator =
+  let pv = Worker.state w in
+  let distant_header, _ = (locator : Block_locator.t :> Block_header.t * _) in
+  only_if_fitness_increases w distant_header @@ fun () ->
+  assert_acceptable_head w
+    (Block_header.hash distant_header) distant_header >>=? fun () ->
+  let chain_state = Distributed_db.chain_state pv.parameters.chain_db in
+  State.Block.known_ancestor chain_state locator >>= function
+  | None ->
+      debug w
+        "ignoring branch %a without common ancestor from peer: %a."
+        Block_hash.pp_short distant_hash
+        P2p_peer.Id.pp_short pv.peer_id ;
+      fail Validation_errors.Unknown_ancestor
+  | Some (ancestor, unknown_prefix) ->
+      bootstrap_new_branch w ancestor distant_header unknown_prefix
+
+let on_no_request w =
+  let pv = Worker.state w in
+  debug w "no new head from peer %a for %g seconds."
+    P2p_peer.Id.pp_short pv.peer_id
+    pv.parameters.limits.new_head_request_timeout ;
+  Distributed_db.Request.current_head pv.parameters.chain_db ~peer:pv.peer_id () ;
+  return_unit
+
+let on_request (type a) w (req : a Request.t) : a tzresult Lwt.t =
+  let pv = Worker.state w in
+  match req with
+  | Request.New_head (hash, header) ->
+      debug w
+        "processing new head %a from peer %a."
+        Block_hash.pp_short hash
+        P2p_peer.Id.pp_short pv.peer_id ;
+      may_validate_new_head w hash header
+  | Request.New_branch (hash, locator, _seed) ->
+      (* TODO penalize empty locator... ?? *)
+      debug w "processing new branch %a from peer %a."
+        Block_hash.pp_short hash
+        P2p_peer.Id.pp_short pv.peer_id ;
+      may_validate_new_branch w hash locator
+
+let on_completion w r _ st =
+  Worker.record_event w (Event.Request (Request.view r, st, None )) ;
+  Lwt.return_unit
+
+let on_error w r st errs =
+  let pv = Worker.state w in
+  match errs with
+    ((( Validation_errors.Unknown_ancestor
+      | Validation_errors.Invalid_locator _
+      | Block_validator_errors.Invalid_block _ ) :: _) as errors ) ->
+      Distributed_db.greylist pv.parameters.chain_db pv.peer_id >>= fun () ->
+      debug w
+        "Terminating the validation worker for peer %a (kickban)."
+        P2p_peer.Id.pp_short pv.peer_id ;
+      debug w "%a" Error_monad.pp_print_error errors ;
+      Worker.trigger_shutdown w ;
+      Worker.record_event w (Event.Request (r, st, Some errs)) ;
+      Lwt.return (Error errs)
+  | [Block_validator_errors.System_error _ ] as errs ->
+      Worker.record_event w (Event.Request (r, st, Some errs)) ;
+      return_unit
+  | [Block_validator_errors.Unavailable_protocol { protocol } ] -> begin
+      Block_validator.fetch_and_compile_protocol
+        pv.parameters.block_validator
+        ~peer:pv.peer_id
+        ~timeout:pv.parameters.limits.protocol_timeout
+        protocol >>= function
+      | Ok _ ->
+          Distributed_db.Request.current_head
+            pv.parameters.chain_db ~peer:pv.peer_id () ;
+          return_unit
+      | Error _ ->
+          (* TODO: punish *)
+          debug w
+            "Terminating the validation worker for peer %a \
+             (missing protocol %a)."
+            P2p_peer.Id.pp_short pv.peer_id
+            Protocol_hash.pp_short protocol ;
+          Worker.record_event w (Event.Request (r, st, Some errs)) ;
+          Lwt.return (Error errs)
+    end
+  | _ ->
+      Worker.record_event w (Event.Request (r, st, Some errs)) ;
+      Lwt.return (Error errs)
+
+let on_close w =
+  let pv = Worker.state w in
+  Distributed_db.disconnect pv.parameters.chain_db pv.peer_id >>= fun () ->
+  pv.parameters.notify_termination () ;
+  Lwt.return_unit
+
+let on_launch _ name parameters =
+  let chain_state = Distributed_db.chain_state parameters.chain_db in
+  State.Block.read_exn chain_state
+    (State.Chain.genesis chain_state).block >>= fun genesis ->
+  let rec pv = {
+    peer_id = snd name ;
+    parameters = { parameters with notify_new_block } ;
+    bootstrapped = false ;
+    last_validated_head = State.Block.header genesis ;
+    last_advertised_head = State.Block.header genesis ;
+  }
+  and notify_new_block block =
+    pv.last_validated_head <- State.Block.header block ;
+    parameters.notify_new_block block in
+  return pv
+
+let table =
+  let merge w (Worker.Any_request neu) old =
+    let pv = Worker.state w in
+    match neu with
+    | Request.New_branch (_, locator, _) ->
+        let header, _ = (locator : Block_locator.t :> _ * _) in
+        pv.last_advertised_head <- header ;
+        Some (Worker.Any_request neu)
+    | Request.New_head (_, header) ->
+        pv.last_advertised_head <- header ;
+        (* TODO penalize decreasing fitness *)
+        match old with
+        | Some (Worker.Any_request (Request.New_branch _) as old) ->
+            Some old (* ignore *)
+        | Some (Worker.Any_request (Request.New_head _)) ->
+            Some (Any_request neu)
+        | None ->
+            Some (Any_request neu) in
+  Worker.create_table (Dropbox { merge })
+
+let create
+    ?(notify_new_block = fun _ -> ())
+    ?(notify_bootstrapped = fun () -> ())
+    ?(notify_termination = fun _ -> ())
+    limits block_validator chain_db peer_id =
+  let name = (State.Chain.id (Distributed_db.chain_state chain_db), peer_id) in
+  let parameters = {
+    chain_db ;
+    notify_termination ;
+    block_validator ;
+    notify_new_block ;
+    notify_bootstrapped ;
+    limits ;
+  } in
+  let module Handlers = struct
+    type self = t
+    let on_launch = on_launch
+    let on_request = on_request
+    let on_close = on_close
+    let on_error = on_error
+    let on_completion = on_completion
+    let on_no_request _ = return_unit
+  end in
+  Worker.launch table ~timeout: limits.new_head_request_timeout limits.worker_limits
+    name parameters
+    (module Handlers)
+
+let notify_branch w locator =
+  let header, _ = (locator : Block_locator.t :> _ * _) in
+  let hash = Block_header.hash header in
+  let pv = Worker.state w in
+  let sender_id = Distributed_db.my_peer_id pv.parameters.chain_db in
+  (* sender and receiver are inverted here because they are from
+     the point of view of the node sending the locator *)
+  let seed = {Block_locator.sender_id=pv.peer_id; receiver_id=sender_id } in
+  Worker.drop_request w (New_branch (hash, locator, seed))
+
+let notify_head w header =
+  let hash = Block_header.hash header in
+  Worker.drop_request w (New_head (hash, header))
+
+let shutdown w =
+  Worker.shutdown w
+
+let peer_id w =
+  let pv = Worker.state w in
+  pv.peer_id
+
+let bootstrapped w =
+  let pv = Worker.state w in
+  pv.bootstrapped
+
+let current_head w =
+  let pv = Worker.state w in
+  pv.last_validated_head
+
+let status = Worker.status
+
+let running_workers () = Worker.list table
+
+let current_request t = Worker.current_request t
+
+let last_events = Worker.last_events
diff --git a/vendors/tezos-modded/src/lib_shell/peer_validator.mli b/vendors/tezos-modded/src/lib_shell/peer_validator.mli
new file mode 100644
index 000000000..416a3a6bb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/peer_validator.mli
@@ -0,0 +1,57 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+type limits = {
+  new_head_request_timeout: float ;
+  block_header_timeout: float ;
+  block_operations_timeout: float ;
+  protocol_timeout: float ;
+  worker_limits: Worker_types.limits
+}
+
+val peer_id: t -> P2p_peer.Id.t
+val bootstrapped: t -> bool
+val current_head: t -> Block_header.t
+
+val create:
+  ?notify_new_block: (State.Block.t -> unit) ->
+  ?notify_bootstrapped: (unit -> unit) ->
+  ?notify_termination: (unit -> unit) ->
+  limits ->
+  Block_validator.t ->
+  Distributed_db.chain_db -> P2p_peer.Id.t -> t tzresult Lwt.t
+val shutdown: t -> unit Lwt.t
+
+val notify_branch: t -> Block_locator.t -> unit
+val notify_head: t -> Block_header.t -> unit
+
+val running_workers: unit -> ((Chain_id.t * P2p_peer.Id.t) * t) list
+val status: t -> Worker_types.worker_status
+
+val current_request : t -> (Time.t * Time.t * Peer_validator_worker_state.Request.view) option
+val last_events : t -> (Lwt_log_core.level * Peer_validator_worker_state.Event.t list) list
diff --git a/vendors/tezos-modded/src/lib_shell/prevalidation.ml b/vendors/tezos-modded/src/lib_shell/prevalidation.ml
new file mode 100644
index 000000000..8de7d1505
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/prevalidation.ml
@@ -0,0 +1,310 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Validation_errors
+
+module type T = sig
+
+  module Proto: Registered_protocol.T
+
+  type t
+
+  type operation = private {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+  val compare: operation -> operation -> int
+
+  val parse: Operation.t -> operation tzresult
+
+  (** Creates a new prevalidation context w.r.t. the protocol associate to the
+      predecessor block . When ?protocol_data is passed to this function, it will
+      be used to create the new block *)
+  val create :
+    ?protocol_data: MBytes.t ->
+    predecessor: State.Block.t ->
+    timestamp: Time.t ->
+    unit -> t tzresult Lwt.t
+
+  type result =
+    | Applied of t * Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Outdated
+
+  val apply_operation: t -> operation -> result Lwt.t
+
+  type status = {
+    applied_operations : (operation * Proto.operation_receipt) list ;
+    block_result : Tezos_protocol_environment_shell.validation_result ;
+    block_metadata : Proto.block_header_metadata ;
+  }
+
+  val status: t -> status tzresult Lwt.t
+
+end
+
+module Make(Proto : Registered_protocol.T) : T with module Proto = Proto = struct
+
+  module Proto = Proto
+
+  type operation = {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+
+
+  type t =
+    { state : Proto.validation_state ;
+      applied : (operation * Proto.operation_receipt) list ;
+      live_blocks : Block_hash.Set.t ;
+      live_operations : Operation_hash.Set.t ;
+    }
+
+  type result =
+    | Applied of t * Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Outdated
+
+  let parse (raw : Operation.t) =
+    let hash = Operation.hash raw in
+    let size = Data_encoding.Binary.length Operation.encoding raw in
+    if size > Proto.max_operation_data_length then
+      error
+        (Oversized_operation
+           { size ; max = Proto.max_operation_data_length })
+    else
+      match Data_encoding.Binary.of_bytes
+              Proto.operation_data_encoding
+              raw.Operation.proto with
+      | None -> error Parse_error
+      | Some protocol_data ->
+          ok { hash ; raw ; protocol_data }
+
+  let compare op1 op2 =
+    Proto.compare_operations
+      { shell = op1.raw.shell ; protocol_data = op1.protocol_data }
+      { shell = op2.raw.shell ; protocol_data = op2.protocol_data }
+
+  let create ?protocol_data ~predecessor ~timestamp () =
+    let { Block_header.shell =
+            { fitness = predecessor_fitness ;
+              timestamp = predecessor_timestamp ;
+              level = predecessor_level } } =
+      State.Block.header predecessor in
+    State.Block.context predecessor >>= fun predecessor_context ->
+    let predecessor_hash = State.Block.hash predecessor in
+    Chain_traversal.live_blocks
+      predecessor
+      (State.Block.max_operations_ttl predecessor)
+    >>= fun (live_blocks, live_operations) ->
+    Context.reset_test_chain
+      predecessor_context predecessor_hash
+      timestamp >>= fun predecessor_context ->
+
+    Context.reset_test_chain
+      predecessor_context predecessor_hash
+      timestamp >>= fun predecessor_context ->
+    begin
+      match protocol_data with
+      | None -> return_none
+      | Some protocol_data ->
+          match
+            Data_encoding.Binary.of_bytes
+              Proto.block_header_data_encoding
+              protocol_data
+          with
+          | None -> failwith "Invalid block header"
+          | Some protocol_data -> return_some protocol_data
+    end >>=? fun protocol_data ->
+    Proto.begin_construction
+      ~chain_id: (State.Block.chain_id predecessor)
+      ~predecessor_context
+      ~predecessor_timestamp
+      ~predecessor_fitness
+      ~predecessor_level
+      ~predecessor: predecessor_hash
+      ~timestamp
+      ?protocol_data
+      ()
+    >>=? fun state ->
+    (* FIXME arbitrary value, to be customisable *)
+    return {
+      state ;
+      applied = [] ;
+      live_blocks ;
+      live_operations ;
+    }
+
+  let apply_operation pv op =
+    if Operation_hash.Set.mem op.hash pv.live_operations then
+      Lwt.return Outdated
+    else
+      Proto.apply_operation pv.state
+        { shell = op.raw.shell ; protocol_data = op.protocol_data } >|= function
+      | Ok (state, receipt) ->
+          let pv =
+            { state ;
+              applied = (op, receipt) :: pv.applied ;
+              live_blocks = pv.live_blocks ;
+              live_operations = Operation_hash.Set.add op.hash pv.live_operations ;
+            } in
+          Applied (pv, receipt)
+      | Error errors ->
+          match classify_errors errors with
+          | `Branch -> Branch_refused errors
+          | `Permanent -> Refused errors
+          | `Temporary -> Branch_delayed errors
+
+  type status = {
+    applied_operations : (operation * Proto.operation_receipt) list ;
+    block_result : Tezos_protocol_environment_shell.validation_result ;
+    block_metadata : Proto.block_header_metadata ;
+  }
+
+  let status pv =
+    Proto.finalize_block pv.state >>=? fun (block_result, block_metadata) ->
+    return {
+      block_metadata ;
+      block_result ;
+      applied_operations = pv.applied ;
+    }
+
+end
+
+let preapply ~predecessor ~timestamp ~protocol_data operations =
+  State.Block.context predecessor >>= fun predecessor_context ->
+  Context.get_protocol predecessor_context >>= fun protocol ->
+  begin
+    match Registered_protocol.get protocol with
+    | None ->
+        (* FIXME. *)
+        (* This should not happen: it should be handled in the validator. *)
+        failwith "Prevalidation: missing protocol '%a' for the current block."
+          Protocol_hash.pp_short protocol
+    | Some protocol ->
+        return protocol
+  end >>=? fun (module Proto) ->
+  let module Prevalidation = Make(Proto) in
+  let apply_operation_with_preapply_result preapp t op =
+    let open Preapply_result in
+    Prevalidation.apply_operation t op >>= function
+    | Applied (t, _) ->
+        let applied = (op.hash, op.raw) :: preapp.applied in
+        Lwt.return ({ preapp with applied }, t)
+    | Branch_delayed errors ->
+        let branch_delayed =
+          Operation_hash.Map.add
+            op.hash
+            (op.raw, errors)
+            preapp.branch_delayed in
+        Lwt.return ({ preapp with branch_delayed }, t)
+    | Branch_refused errors ->
+        let branch_refused =
+          Operation_hash.Map.add
+            op.hash
+            (op.raw, errors)
+            preapp.branch_refused in
+        Lwt.return ({ preapp with branch_refused }, t)
+    | Refused errors ->
+        let refused =
+          Operation_hash.Map.add
+            op.hash
+            (op.raw, errors)
+            preapp.refused in
+        Lwt.return ({ preapp with refused }, t)
+    | Duplicate | Outdated -> Lwt.return (preapp, t) in
+  Prevalidation.create
+    ~protocol_data ~predecessor ~timestamp () >>=? fun validation_state ->
+  Lwt_list.fold_left_s
+    (fun (acc_validation_result, acc_validation_state) operations ->
+       Lwt_list.fold_left_s
+         (fun (acc_validation_result, acc_validation_state) op ->
+            match Prevalidation.parse op with
+            | Error _ ->
+                (* FIXME *)
+                Lwt.return (acc_validation_result, acc_validation_state)
+            | Ok op ->
+                apply_operation_with_preapply_result
+                  acc_validation_result acc_validation_state op)
+         (Preapply_result.empty, acc_validation_state)
+         operations
+       >>= fun (new_validation_result, new_validation_state) ->
+       (* Applied operations are reverted ; revert to the initial ordering *)
+       let new_validation_result =
+         { new_validation_result with applied = List.rev new_validation_result.applied } in
+       Lwt.return (acc_validation_result @ [new_validation_result], new_validation_state)
+    ) ([], validation_state) operations
+  >>= fun (validation_result_list, validation_state) ->
+  let operations_hash =
+    Operation_list_list_hash.compute
+      (List.map (fun r ->
+           Operation_list_hash.compute
+             (List.map fst r.Preapply_result.applied)
+         ) validation_result_list)
+  in
+  Prevalidation.status validation_state >>=? fun { block_result ; _ } ->
+  let pred_shell_header = State.Block.shell_header predecessor in
+  let level = Int32.succ pred_shell_header.level in
+  Block_validation.may_patch_protocol
+    ~level block_result >>=? fun { fitness ; context ; message } ->
+  State.Block.protocol_hash predecessor >>= fun pred_protocol ->
+  Context.get_protocol context >>= fun protocol ->
+  let proto_level =
+    if Protocol_hash.equal protocol pred_protocol then
+      pred_shell_header.proto_level
+    else
+      ((pred_shell_header.proto_level + 1) mod 256) in
+  let shell_header : Block_header.shell_header = {
+    level ;
+    proto_level ;
+    predecessor = State.Block.hash predecessor ;
+    timestamp ;
+    validation_passes = List.length validation_result_list ;
+    operations_hash ;
+    fitness ;
+    context = Context_hash.zero ; (* place holder *)
+  } in
+  begin
+    if Protocol_hash.equal protocol pred_protocol then
+      return (context, message)
+    else
+      match Registered_protocol.get protocol with
+      | None ->
+          fail (Block_validator_errors.Unavailable_protocol
+                  { block = State.Block.hash predecessor ; protocol })
+      | Some (module NewProto) ->
+          NewProto.init context shell_header >>=? fun { context ; message ; _ } ->
+          return (context, message)
+  end >>=? fun (context, message) ->
+  Context.hash ?message ~time:timestamp context >>= fun context ->
+  return ({ shell_header with context }, validation_result_list)
diff --git a/vendors/tezos-modded/src/lib_shell/prevalidation.mli b/vendors/tezos-modded/src/lib_shell/prevalidation.mli
new file mode 100644
index 000000000..d429aa818
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/prevalidation.mli
@@ -0,0 +1,83 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** A newly received block is validated by replaying locally the block
+    creation, applying each operation and its finalization to ensure their
+    consistency. This module is stateless and creates and manupulates the
+    prevalidation_state. *)
+
+module type T = sig
+
+  module Proto: Registered_protocol.T
+
+  type t
+
+  type operation = private {
+    hash: Operation_hash.t ;
+    raw: Operation.t ;
+    protocol_data: Proto.operation_data ;
+  }
+  val compare: operation -> operation -> int
+
+  val parse: Operation.t -> operation tzresult
+
+  (** Creates a new prevalidation context w.r.t. the protocol associate to the
+      predecessor block . When ?protocol_data is passed to this function, it will
+      be used to create the new block *)
+  val create :
+    ?protocol_data: MBytes.t ->
+    predecessor: State.Block.t ->
+    timestamp: Time.t ->
+    unit -> t tzresult Lwt.t
+
+  type result =
+    | Applied of t * Proto.operation_receipt
+    | Branch_delayed of error list
+    | Branch_refused of error list
+    | Refused of error list
+    | Duplicate
+    | Outdated
+
+  val apply_operation: t -> operation -> result Lwt.t
+
+  type status = {
+    applied_operations : (operation * Proto.operation_receipt) list ;
+    block_result : Tezos_protocol_environment_shell.validation_result ;
+    block_metadata : Proto.block_header_metadata ;
+  }
+
+  val status: t -> status tzresult Lwt.t
+
+end
+
+module Make(Proto : Registered_protocol.T) : T with module Proto = Proto
+
+(** Pre-apply creates a new block and returns it. *)
+val preapply :
+  predecessor:State.Block.t ->
+  timestamp:Time.t ->
+  protocol_data:MBytes.t ->
+  Operation.t list list ->
+  (Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/prevalidator.ml b/vendors/tezos-modded/src/lib_shell/prevalidator.ml
new file mode 100644
index 000000000..d3467a0aa
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/prevalidator.ml
@@ -0,0 +1,892 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Prevalidator_worker_state
+
+type limits = {
+  max_refused_operations : int ;
+  operation_timeout : float ;
+  worker_limits : Worker_types.limits ;
+}
+
+type name_t = (Chain_id.t * Protocol_hash.t)
+
+module type T = sig
+
+  module Proto: Registered_protocol.T
+  val name: name_t
+  val parameters: limits *  Distributed_db.chain_db
+  module Prevalidation: Prevalidation.T with module Proto = Proto
+  type types_state = {
+    chain_db : Distributed_db.chain_db ;
+    limits : limits ;
+    mutable predecessor : State.Block.t ;
+    mutable timestamp : Time.t ;
+    mutable live_blocks : Block_hash.Set.t ;
+    mutable live_operations : Operation_hash.Set.t ;
+    refused : Operation_hash.t Ring.t ;
+    mutable refusals : (Operation.t * error list) Operation_hash.Map.t ;
+    branch_refused : Operation_hash.t Ring.t ;
+    mutable branch_refusals : (Operation.t * error list) Operation_hash.Map.t;
+    branch_delayed : Operation_hash.t Ring.t ;
+    mutable branch_delays : (Operation.t * error list) Operation_hash.Map.t;
+    mutable fetching : Operation_hash.Set.t ;
+    mutable pending : Operation.t Operation_hash.Map.t ;
+    mutable mempool : Mempool.t ;
+    mutable in_mempool : Operation_hash.Set.t ;
+    mutable applied : (Operation_hash.t * Operation.t) list;
+    mutable applied_count : int ;
+    mutable validation_state : Prevalidation.t tzresult ;
+    mutable operation_stream :
+      ([ `Applied | `Refused | `Branch_refused | `Branch_delayed ] *
+       Operation.shell_header *
+       Proto.operation_data
+      ) Lwt_watcher.input;
+    mutable advertisement : [ `Pending of Mempool.t | `None ] ;
+    mutable rpc_directory : types_state RPC_directory.t lazy_t ;
+  }
+  module Name: Worker.NAME with type t = name_t
+  module Types: Worker.TYPES with type state = types_state
+  module Worker: Worker.T
+    with type Event.t = Event.t
+     and type 'a Request.t = 'a Request.t
+     and type Request.view = Request.view
+     and type Types.state = types_state
+  type worker = Worker.infinite Worker.queue Worker.t
+  val list_pendings:
+    ?maintain_chain_db:Distributed_db.chain_db ->
+    from_block:State.Block.t ->
+    to_block:State.Block.t ->
+    Operation.t Operation_hash.Map.t ->
+    (Operation.t Operation_hash.Map.t * Block_hash.Set.t * Operation_hash.Set.t) Lwt.t
+  val validation_result: types_state -> error Preapply_result.t
+
+  val fitness: unit -> Fitness.t Lwt.t
+  val initialization_errors: unit tzresult Lwt.t
+  val worker: worker Lazy.t
+
+end
+
+module type ARG = sig
+  val limits: limits
+  val chain_db: Distributed_db.chain_db
+  val chain_id: Chain_id.t
+end
+
+type t = (module T)
+
+module Make(Proto: Registered_protocol.T)(Arg: ARG): T = struct
+  module Proto = Proto
+  let name = (Arg.chain_id, Proto.hash)
+  let parameters = (Arg.limits, Arg.chain_db)
+  module Prevalidation = Prevalidation.Make(Proto)
+  type types_state = {
+    chain_db : Distributed_db.chain_db ;
+    limits : limits ;
+    mutable predecessor : State.Block.t ;
+    mutable timestamp : Time.t ;
+    mutable live_blocks : Block_hash.Set.t ; (* just a cache *)
+    mutable live_operations : Operation_hash.Set.t ; (* just a cache *)
+    refused : Operation_hash.t Ring.t ;
+    mutable refusals : (Operation.t * error list) Operation_hash.Map.t ;
+    branch_refused : Operation_hash.t Ring.t ;
+    mutable branch_refusals : (Operation.t * error list) Operation_hash.Map.t;
+    branch_delayed : Operation_hash.t Ring.t ;
+    mutable branch_delays : (Operation.t * error list) Operation_hash.Map.t;
+    mutable fetching : Operation_hash.Set.t ;
+    mutable pending : Operation.t Operation_hash.Map.t ;
+    mutable mempool : Mempool.t ;
+    mutable in_mempool : Operation_hash.Set.t ;
+    mutable applied : (Operation_hash.t * Operation.t) list;
+    mutable applied_count : int ;
+    mutable validation_state : Prevalidation.t tzresult ;
+    mutable operation_stream :
+      ([ `Applied | `Refused | `Branch_refused | `Branch_delayed ] *
+       Operation.shell_header *
+       Proto.operation_data
+      ) Lwt_watcher.input;
+    mutable advertisement : [ `Pending of Mempool.t | `None ] ;
+    mutable rpc_directory : types_state RPC_directory.t lazy_t ;
+  }
+
+  module Name = struct
+    type t = name_t
+    let encoding =
+      Data_encoding.tup2
+        Chain_id.encoding
+        Protocol_hash.encoding
+    let chain_id_string =
+      let _: string = Format.flush_str_formatter () in
+      Chain_id.pp_short Format.str_formatter Arg.chain_id;
+      Format.flush_str_formatter ()
+    let proto_hash_string =
+      let _: string = Format.flush_str_formatter () in
+      Protocol_hash.pp_short Format.str_formatter Proto.hash;
+      Format.flush_str_formatter ()
+    let base = [ "prevalidator" ; chain_id_string ; proto_hash_string  ]
+    let pp fmt (chain_id, proto_hash) =
+      Chain_id.pp_short fmt chain_id;
+      Format.pp_print_string fmt ".";
+      Protocol_hash.pp_short fmt proto_hash
+  end
+
+  module Types = struct
+    (* Invariants:
+       - an operation is in only one of these sets (map domains):
+         pv.refusals pv.pending pv.fetching pv.live_operations pv.in_mempool
+       - pv.in_mempool is the domain of all fields of pv.prevalidation_result
+       - pv.prevalidation_result.refused = Ø, refused ops are in pv.refused
+       - the 'applied' operations in pv.validation_result are in reverse order. *)
+    type state = types_state
+    type parameters = limits * Distributed_db.chain_db
+
+    include Worker_state
+
+    let view (state : state) _ : view =
+      let domain map =
+        Operation_hash.Map.fold
+          (fun elt _ acc -> Operation_hash.Set.add elt acc)
+          map Operation_hash.Set.empty in
+      { head = State.Block.hash state.predecessor ;
+        timestamp = state.timestamp ;
+        fetching = state.fetching ;
+        pending = domain state.pending ;
+        applied =
+          List.rev
+            (List.map (fun (h, _) -> h)
+               state.applied) ;
+        delayed =
+          Operation_hash.Set.union
+            (domain state.branch_delays)
+            (domain state.branch_refusals) }
+
+  end
+
+  module Worker: Worker.T
+    with type Name.t = Name.t
+     and type Event.t = Event.t
+     and type 'a Request.t = 'a Request.t
+     and type Request.view = Request.view
+     and type Types.state = Types.state
+     and type Types.parameters = Types.parameters
+    = Worker.Make (Name) (Prevalidator_worker_state.Event)
+      (Prevalidator_worker_state.Request) (Types)
+
+  (** Centralised operation stream for the RPCs *)
+  let notify_operation { operation_stream } result  { Operation.shell ; proto } =
+    let protocol_data =
+      Data_encoding.Binary.of_bytes_exn
+        Proto.operation_data_encoding
+        proto in
+    Lwt_watcher.notify operation_stream (result, shell, protocol_data)
+
+  open Types
+
+  type worker = Worker.infinite Worker.queue Worker.t
+
+  let debug w =
+    Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
+
+  let list_pendings ?maintain_chain_db  ~from_block ~to_block old_mempool =
+    let rec pop_blocks ancestor block mempool =
+      let hash = State.Block.hash block in
+      if Block_hash.equal hash ancestor then
+        Lwt.return mempool
+      else
+        State.Block.all_operations block >>= fun operations ->
+        Lwt_list.fold_left_s
+          (Lwt_list.fold_left_s (fun mempool op ->
+               let h = Operation.hash op in
+               Lwt_utils.may maintain_chain_db
+                 ~f:begin fun chain_db ->
+                   Distributed_db.inject_operation chain_db h op >>= fun _ ->
+                   Lwt.return_unit
+                 end >>= fun () ->
+               Lwt.return (Operation_hash.Map.add h op mempool)))
+          mempool operations >>= fun mempool ->
+        State.Block.predecessor block >>= function
+        | None -> assert false
+        | Some predecessor -> pop_blocks ancestor predecessor mempool
+    in
+    let push_block mempool block =
+      State.Block.all_operation_hashes block >|= fun operations ->
+      Option.iter maintain_chain_db
+        ~f:(fun chain_db ->
+            List.iter
+              (List.iter (Distributed_db.Operation.clear_or_cancel chain_db))
+              operations) ;
+      List.fold_left
+        (List.fold_left (fun mempool h -> Operation_hash.Map.remove h mempool))
+        mempool operations
+    in
+    Chain_traversal.new_blocks ~from_block ~to_block >>= fun (ancestor, path) ->
+    pop_blocks
+      (State.Block.hash ancestor)
+      from_block old_mempool >>= fun mempool ->
+    Lwt_list.fold_left_s push_block mempool path >>= fun new_mempool ->
+    Chain_traversal.live_blocks
+      to_block
+      (State.Block.max_operations_ttl to_block)
+    >>= fun (live_blocks, live_operations) ->
+    let new_mempool, outdated =
+      Operation_hash.Map.partition
+        (fun _oph op ->
+           Block_hash.Set.mem op.Operation.shell.branch live_blocks)
+        new_mempool in
+    Option.iter maintain_chain_db
+      ~f:(fun chain_db ->
+          Operation_hash.Map.iter
+            (fun oph _op -> Distributed_db.Operation.clear_or_cancel chain_db oph)
+            outdated) ;
+    Lwt.return (new_mempool, live_blocks, live_operations)
+
+  let already_handled pv oph =
+    Operation_hash.Map.mem oph pv.refusals
+    || Operation_hash.Map.mem oph pv.pending
+    || Operation_hash.Set.mem oph pv.fetching
+    || Operation_hash.Set.mem oph pv.live_operations
+    || Operation_hash.Set.mem oph pv.in_mempool
+
+  let validation_result (state : types_state) =
+    { Preapply_result.applied = List.rev state.applied ;
+      branch_delayed = state.branch_delays ;
+      branch_refused = state.branch_refusals ;
+      refused = Operation_hash.Map.empty }
+
+  let mempool_of_prevalidation_result (r : error Preapply_result.t) : Mempool.t =
+    { Mempool.known_valid = List.map fst r.applied ;
+      pending =
+        Operation_hash.Map.fold
+          (fun k _ s -> Operation_hash.Set.add k s)
+          r.branch_delayed @@
+        Operation_hash.Map.fold
+          (fun k _ s -> Operation_hash.Set.add k s)
+          r.branch_refused @@
+        Operation_hash.Set.empty }
+
+  let merge_validation_results ~old ~neu =
+    let open Preapply_result in
+    let merge _key a b =
+      match a, b with
+      | None, None -> None
+      | Some x, None -> Some x
+      | _, Some y -> Some y in
+    let filter_out s m =
+      List.fold_right (fun (h, _op) -> Operation_hash.Map.remove h) s m in
+    { applied = List.rev_append neu.applied old.applied ;
+      refused = Operation_hash.Map.empty ;
+      branch_refused =
+        Operation_hash.Map.merge merge
+          (* filtering should not be required if the protocol is sound *)
+          (filter_out neu.applied old.branch_refused)
+          neu.branch_refused ;
+      branch_delayed =
+        Operation_hash.Map.merge merge
+          (filter_out neu.applied old.branch_delayed)
+          neu.branch_delayed }
+
+  let advertise (w : worker) pv mempool =
+    match pv.advertisement with
+    | `Pending { Mempool.known_valid ; pending } ->
+        pv.advertisement <-
+          `Pending
+            { known_valid = known_valid @ mempool.Mempool.known_valid ;
+              pending = Operation_hash.Set.union pending mempool.pending }
+    | `None ->
+        pv.advertisement <- `Pending mempool ;
+        Lwt.async (fun () ->
+            Lwt_unix.sleep 0.01 >>= fun () ->
+            Worker.push_request_now w Advertise ;
+            Lwt.return_unit)
+
+  let is_endorsement ( op : Prevalidation.operation ) =
+    Proto.acceptable_passes {
+      shell = op.raw.shell ;
+      protocol_data = op.protocol_data } = [0]
+
+  let is_endorsement_raw op =
+    match Prevalidation.parse op with
+    |Ok op -> is_endorsement op
+    |Error _ -> false
+
+  let handle_unprocessed w pv =
+    begin match pv.validation_state with
+      | Error err ->
+          Operation_hash.Map.iter
+            (fun h op ->
+               Option.iter (Ring.add_and_return_erased pv.branch_delayed h)
+                 ~f:(fun e ->
+                     pv.branch_delays <- Operation_hash.Map.remove e pv.branch_delays ;
+                     pv.in_mempool <- Operation_hash.Set.remove e pv.in_mempool) ;
+               pv.in_mempool <-
+                 Operation_hash.Set.add h pv.in_mempool ;
+               pv.branch_delays <-
+                 Operation_hash.Map.add h (op, err) pv.branch_delays)
+            pv.pending ;
+          pv.pending <-
+            Operation_hash.Map.empty ;
+          Lwt.return_unit
+      | Ok state ->
+          match Operation_hash.Map.cardinal pv.pending with
+          | 0 -> Lwt.return_unit
+          | n ->
+              debug w "processing %d operations" n ;
+              let operations = List.map snd (Operation_hash.Map.bindings pv.pending) in
+              Lwt_list.fold_left_s (fun (acc_validation_state, acc_mempool) op ->
+                  let refused hash raw errors =
+                    notify_operation pv `Refused raw ;
+                    let new_mempool = Mempool.{ acc_mempool with pending = Operation_hash.Set.add hash acc_mempool.pending } in
+                    Option.iter (Ring.add_and_return_erased pv.refused hash)
+                      ~f:(fun e -> pv.refusals <- Operation_hash.Map.remove e pv.refusals) ;
+                    pv.refusals <- Operation_hash.Map.add hash (raw, errors) pv.refusals ;
+                    Distributed_db.Operation.clear_or_cancel pv.chain_db hash ;
+                    Lwt.return (acc_validation_state, new_mempool) in
+                  match Prevalidation.parse op with
+                  | Error errors ->
+                      refused (Operation.hash op) op errors
+                  | Ok op ->
+                      Prevalidation.apply_operation state op >>= function
+                      | Applied (new_acc_validation_state, _) ->
+                          if pv.applied_count <= 2000
+                          (* this test is a quick fix while we wait for the new mempool *)
+                          || is_endorsement op then begin
+                            notify_operation pv `Applied op.raw ;
+                            let new_mempool = Mempool.{ acc_mempool with known_valid = op.hash :: acc_mempool.known_valid } in
+                            pv.applied <- (op.hash, op.raw) :: pv.applied ;
+                            pv.in_mempool <- Operation_hash.Set.add op.hash pv.in_mempool ;
+                            Lwt.return (new_acc_validation_state, new_mempool)
+                          end else
+                            Lwt.return (acc_validation_state, acc_mempool)
+                      | Branch_delayed errors ->
+                          notify_operation pv `Branch_delayed op.raw ;
+                          let new_mempool = Mempool.{ acc_mempool with pending = Operation_hash.Set.add op.hash acc_mempool.pending } in
+                          Option.iter (Ring.add_and_return_erased pv.branch_delayed op.hash)
+                            ~f:(fun e ->
+                                pv.branch_delays <- Operation_hash.Map.remove e pv.branch_delays ;
+                                pv.in_mempool <- Operation_hash.Set.remove e pv.in_mempool) ;
+                          pv.in_mempool <- Operation_hash.Set.add op.hash pv.in_mempool ;
+                          pv.branch_delays <- Operation_hash.Map.add op.hash (op.raw, errors) pv.branch_delays ;
+                          Lwt.return (acc_validation_state, new_mempool)
+                      | Branch_refused errors ->
+                          notify_operation pv `Branch_refused op.raw ;
+                          let new_mempool = Mempool.{ acc_mempool with pending = Operation_hash.Set.add op.hash acc_mempool.pending } in
+                          Option.iter (Ring.add_and_return_erased pv.branch_refused op.hash)
+                            ~f:(fun e ->
+                                pv.branch_refusals <- Operation_hash.Map.remove e pv.branch_refusals ;
+                                pv.in_mempool <- Operation_hash.Set.remove e pv.in_mempool) ;
+                          pv.in_mempool <- Operation_hash.Set.add op.hash pv.in_mempool ;
+                          pv.branch_refusals <- Operation_hash.Map.add op.hash (op.raw, errors) pv.branch_refusals ;
+                          Lwt.return (acc_validation_state, new_mempool)
+                      | Refused errors ->
+                          refused op.hash op.raw errors
+                      | Duplicate | Outdated -> Lwt.return (acc_validation_state, acc_mempool))
+                (state, Mempool.empty)
+                operations >>= fun (state, advertised_mempool) ->
+              pv.validation_state <- Ok state ;
+              pv.pending <- Operation_hash.Map.empty ;
+              advertise w pv
+                { advertised_mempool with known_valid = List.rev advertised_mempool.known_valid } ;
+              Lwt.return_unit
+    end >>= fun () ->
+    pv.mempool <-
+      { Mempool.known_valid =
+          List.rev_map fst pv.applied ;
+        pending =
+          Operation_hash.Map.fold
+            (fun k (op,_) s ->
+               if is_endorsement_raw op then
+                 Operation_hash.Set.add k s
+               else s)
+            pv.branch_delays @@
+          Operation_hash.Map.fold
+            (fun k (op,_) s ->
+               if is_endorsement_raw op then
+                 Operation_hash.Set.add k s
+               else s)
+            pv.branch_refusals @@
+          Operation_hash.Set.empty
+      } ;
+    State.Current_mempool.set (Distributed_db.chain_state pv.chain_db)
+      ~head:(State.Block.hash pv.predecessor) pv.mempool >>= fun () ->
+    Lwt.return_unit
+
+  let fetch_operation w pv ?peer oph =
+    debug w
+      "fetching operation %a"
+      Operation_hash.pp_short oph ;
+    Distributed_db.Operation.fetch
+      ~timeout:pv.limits.operation_timeout
+      pv.chain_db ?peer oph () >>= function
+    | Ok op ->
+        Worker.push_request_now w (Arrived (oph, op)) ;
+        Lwt.return_unit
+    | Error [ Distributed_db.Operation.Canceled _ ] ->
+        debug w
+          "operation %a included before being prevalidated"
+          Operation_hash.pp_short oph ;
+        Lwt.return_unit
+    | Error _ -> (* should not happen *)
+        Lwt.return_unit
+
+  let rpc_directory = lazy (
+    let dir : state RPC_directory.t ref = ref RPC_directory.empty in
+
+    let module Proto_services = Block_services.Make(Proto)(Proto) in
+
+    dir := RPC_directory.register !dir
+        (Proto_services.S.Mempool.pending_operations RPC_path.open_root)
+        (fun pv () () ->
+           let map_op op =
+             let protocol_data =
+               Data_encoding.Binary.of_bytes_exn
+                 Proto.operation_data_encoding
+                 op.Operation.proto in
+             { Proto.shell = op.shell ; protocol_data } in
+           let map_op_error (op, error) = (map_op op, error) in
+           return {
+             Proto_services.Mempool.applied =
+               List.map
+                 (fun (hash, op) -> (hash, map_op op))
+                 (List.rev pv.applied) ;
+             refused =
+               Operation_hash.Map.map map_op_error pv.refusals ;
+             branch_refused =
+               Operation_hash.Map.map map_op_error pv.branch_refusals ;
+             branch_delayed =
+               Operation_hash.Map.map map_op_error pv.branch_delays ;
+             unprocessed =
+               Operation_hash.Map.map map_op pv.pending ;
+           }) ;
+
+    dir := RPC_directory.register !dir
+        (Proto_services.S.Mempool.request_operations RPC_path.open_root)
+        (fun pv () () ->
+           Distributed_db.Request.current_head pv.chain_db () ;
+           return_unit
+        ) ;
+
+    dir := RPC_directory.gen_register !dir
+        (Proto_services.S.Mempool.monitor_operations RPC_path.open_root)
+        begin fun { applied ; refusals = refused ; branch_refusals = branch_refused ; branch_delays = branch_delayed ; operation_stream } params () ->
+          let op_stream, stopper = Lwt_watcher.create_stream operation_stream in
+          (* Convert ops *)
+          let map_op op =
+            let protocol_data =
+              Data_encoding.Binary.of_bytes_exn
+                Proto.operation_data_encoding
+                op.Operation.proto in
+            Proto.{ shell = op.shell ; protocol_data } in
+          let fold_op _k (op, _error) acc = map_op op :: acc in
+          (* First call : retrieve the current set of op from the mempool *)
+          let applied = if params#applied then List.map map_op (List.map snd applied) else [] in
+          let refused = if params#refused then
+              Operation_hash.Map.fold fold_op refused [] else [] in
+          let branch_refused = if params#branch_refused then
+              Operation_hash.Map.fold fold_op branch_refused [] else [] in
+          let branch_delayed = if params#branch_delayed then
+              Operation_hash.Map.fold fold_op branch_delayed [] else [] in
+          let current_mempool = List.concat [ applied ; refused ; branch_refused ; branch_delayed ] in
+          let current_mempool = ref (Some current_mempool) in
+          let filter_result = function
+            | `Applied -> params#applied
+            | `Refused -> params#refused
+            | `Branch_refused -> params#branch_refused
+            | `Branch_delayed -> params#branch_delayed
+          in
+          let rec next () =
+            match !current_mempool with
+            | Some mempool -> begin
+                current_mempool := None ;
+                Lwt.return_some mempool
+              end
+            | None -> begin
+                Lwt_stream.get op_stream >>= function
+                | Some (kind, shell, protocol_data) when filter_result kind ->
+                    (* NOTE: Should the protocol change, a new Prevalidation
+                     * context would be created. Thus, we use the same Proto. *)
+                    let bytes = Data_encoding.Binary.to_bytes_exn
+                        Proto.operation_data_encoding
+                        protocol_data in
+                    let protocol_data = Data_encoding.Binary.of_bytes_exn
+                        Proto.operation_data_encoding
+                        bytes in
+                    Lwt.return_some [ { Proto.shell ; protocol_data } ]
+                | Some _ -> next ()
+                | None -> Lwt.return_none
+              end
+          in
+          let shutdown () = Lwt_watcher.shutdown stopper in
+          RPC_answer.return_stream { next ; shutdown }
+        end ;
+
+    !dir
+  )
+
+  module Handlers = struct
+
+    type self = worker
+
+    let on_operation_arrived (pv : state) oph op =
+      pv.fetching <- Operation_hash.Set.remove oph pv.fetching ;
+      if not (Block_hash.Set.mem op.Operation.shell.branch pv.live_blocks) then begin
+        Distributed_db.Operation.clear_or_cancel pv.chain_db oph
+        (* TODO: put in a specific delayed map ? *)
+      end else if not (already_handled pv oph) (* prevent double inclusion on flush *) then begin
+        pv.pending <- Operation_hash.Map.add oph op pv.pending
+      end
+
+    let on_inject pv op =
+      let oph = Operation.hash op in
+      if already_handled pv oph then
+        return_unit (* FIXME : is this an error ? *)
+      else
+        Lwt.return pv.validation_state >>=? fun validation_state ->
+        Lwt.return (Prevalidation.parse op) >>=? fun parsed_op ->
+        Prevalidation.apply_operation validation_state parsed_op >>= function
+        | Applied (_, _result) ->
+            Distributed_db.inject_operation pv.chain_db oph op >>= fun (_ : bool) ->
+            pv.pending <- Operation_hash.Map.add parsed_op.hash op pv.pending ;
+            return_unit
+        | _ ->
+            failwith "Error while applying operation %a" Operation_hash.pp oph
+
+    let on_notify w pv peer mempool =
+      let all_ophs =
+        List.fold_left
+          (fun s oph -> Operation_hash.Set.add oph s)
+          mempool.Mempool.pending mempool.known_valid in
+      let to_fetch =
+        Operation_hash.Set.filter
+          (fun oph -> not (already_handled pv oph))
+          all_ophs in
+      pv.fetching <-
+        Operation_hash.Set.union
+          to_fetch
+          pv.fetching ;
+      Operation_hash.Set.iter
+        (fun oph -> Lwt.ignore_result (fetch_operation w pv ~peer oph))
+        to_fetch
+
+    let on_flush w pv predecessor =
+      Lwt_watcher.shutdown_input pv.operation_stream;
+      list_pendings
+        ~maintain_chain_db:pv.chain_db
+        ~from_block:pv.predecessor ~to_block:predecessor
+        (Preapply_result.operations (validation_result pv))
+      >>= fun (pending, new_live_blocks, new_live_operations) ->
+      let timestamp = Time.now () in
+      Prevalidation.create ~predecessor ~timestamp () >>= fun validation_state ->
+      debug w "%d operations were not washed by the flush"
+        (Operation_hash.Map.cardinal pending) ;
+      pv.predecessor <- predecessor ;
+      pv.live_blocks <- new_live_blocks ;
+      pv.live_operations <- new_live_operations ;
+      pv.timestamp <- timestamp ;
+      pv.mempool <- { known_valid = [] ; pending = Operation_hash.Set.empty };
+      pv.pending <- pending ;
+      pv.in_mempool <- Operation_hash.Set.empty ;
+      Ring.clear pv.branch_delayed ;
+      pv.branch_delays <- Operation_hash.Map.empty ;
+      Ring.clear pv.branch_refused ;
+      pv.branch_refusals <- Operation_hash.Map.empty ;
+      pv.applied <- [] ;
+      pv.applied_count <- 0 ;
+      pv.validation_state <- validation_state ;
+      pv.operation_stream <- Lwt_watcher.create_input () ;
+      return_unit
+
+    let on_advertise pv =
+      match pv.advertisement with
+      | `None -> () (* should not happen *)
+      | `Pending mempool ->
+          pv.advertisement <- `None ;
+          Distributed_db.Advertise.current_head pv.chain_db ~mempool pv.predecessor
+
+    let on_request
+      : type r. worker -> r Request.t -> r tzresult Lwt.t
+      = fun w request ->
+        let pv = Worker.state w in
+        begin match request with
+          | Request.Flush hash ->
+              on_advertise pv ;
+              (* TODO: rebase the advertisement instead *)
+              let chain_state = Distributed_db.chain_state pv.chain_db in
+              State.Block.read chain_state hash >>=? fun block ->
+              on_flush w pv block >>=? fun () ->
+              return (() : r)
+          | Request.Notify (peer, mempool) ->
+              on_notify w pv peer mempool ;
+              return_unit
+          | Request.Inject op ->
+              on_inject pv op
+          | Request.Arrived (oph, op) ->
+              on_operation_arrived pv oph op ;
+              return_unit
+          | Request.Advertise ->
+              on_advertise pv ;
+              return_unit
+        end >>=? fun r ->
+        handle_unprocessed w pv >>= fun () ->
+        return r
+
+    let on_close w =
+      let pv = Worker.state w in
+      Operation_hash.Set.iter
+        (Distributed_db.Operation.clear_or_cancel pv.chain_db)
+        pv.fetching ;
+      Lwt.return_unit
+
+    let on_launch w _ (limits, chain_db) =
+      let chain_state = Distributed_db.chain_state chain_db in
+      Chain.data chain_state >>= fun
+        { current_head = predecessor ; current_mempool = mempool ;
+          live_blocks ; live_operations } ->
+      let timestamp = Time.now () in
+      Prevalidation.create ~predecessor ~timestamp () >>= fun validation_state ->
+      let fetching =
+        List.fold_left
+          (fun s h -> Operation_hash.Set.add h s)
+          Operation_hash.Set.empty mempool.known_valid in
+      let pv =
+        { limits ; chain_db ;
+          predecessor ; timestamp ; live_blocks ; live_operations ;
+          mempool = { known_valid = [] ; pending = Operation_hash.Set.empty };
+          refused = Ring.create limits.max_refused_operations ;
+          refusals = Operation_hash.Map.empty ;
+          fetching ;
+          pending = Operation_hash.Map.empty ;
+          in_mempool = Operation_hash.Set.empty ;
+          applied = [] ;
+          applied_count = 0 ;
+          branch_refused = Ring.create limits.max_refused_operations ;
+          branch_refusals = Operation_hash.Map.empty ;
+          branch_delayed = Ring.create limits.max_refused_operations ;
+          branch_delays = Operation_hash.Map.empty ;
+          validation_state ;
+          operation_stream = Lwt_watcher.create_input () ;
+          advertisement = `None ;
+          rpc_directory = rpc_directory ;
+        } in
+      List.iter
+        (fun oph -> Lwt.ignore_result (fetch_operation w pv oph))
+        mempool.known_valid ;
+      return pv
+
+    let on_error w r st errs =
+      Worker.record_event w (Event.Request (r, st, Some errs)) ;
+      match r with
+      | Request.(View (Inject _)) -> return_unit
+      | _ -> Lwt.return (Error errs)
+
+    let on_completion w r _ st =
+      Worker.record_event w (Event.Request (Request.view r, st, None)) ;
+      Lwt.return_unit
+
+    let on_no_request _ = return_unit
+
+  end
+
+  let table = Worker.create_table Queue
+
+  (* NOTE: we register a single worker for each instantiation of this Make
+   * functor (and thus a single worker for the single instantiaion of Worker).
+   * Whislt this is somewhat abusing the intended purpose of worker, it is part
+   * of a transition plan to a one-worker-per-peer architecture. *)
+  let worker_promise =
+    Worker.launch table Arg.limits.worker_limits
+      name
+      (Arg.limits, Arg.chain_db)
+      (module Handlers)
+
+  let initialization_errors =
+    worker_promise >>=? fun _ -> return_unit
+
+  let worker = lazy begin
+    match Lwt.state worker_promise with
+    | Lwt.Return (Ok worker) -> worker
+    | Lwt.Return (Error _) | Lwt.Fail _ | Lwt.Sleep -> assert false
+  end
+
+  let fitness () =
+    let w = Lazy.force worker in
+    let pv = Worker.state w in
+    begin
+      Lwt.return pv.validation_state >>=? fun state ->
+      Prevalidation.status state >>=? fun status ->
+      return status.block_result.fitness
+    end >>= function
+    | Ok fitness -> Lwt.return fitness
+    | Error _ ->
+        Lwt.return (State.Block.fitness pv.predecessor)
+
+end
+
+module ChainProto_registry =
+  Registry.Make(struct
+    type v = t
+    type t = (Chain_id.t * Protocol_hash.t)
+    let compare (c1, p1) (c2, p2) =
+      let pc = Protocol_hash.compare p1 p2 in
+      if pc = 0 then
+        Chain_id.compare c1 c2
+      else
+        pc
+  end)
+
+
+let create limits (module Proto: Registered_protocol.T) chain_db =
+  let chain_state = Distributed_db.chain_state chain_db in
+  let chain_id = State.Chain.id chain_state in
+  match ChainProto_registry.query (chain_id, Proto.hash) with
+  | None ->
+      let module Prevalidator =
+        Make(Proto)(struct
+          let limits = limits
+          let chain_db = chain_db
+          let chain_id = chain_id
+        end) in
+      (* Checking initialization errors before giving a reference to dnagerous
+       * `worker` value to caller. *)
+      Prevalidator.initialization_errors >>=? fun () ->
+      ChainProto_registry.register Prevalidator.name (module Prevalidator: T);
+      return (module Prevalidator: T)
+  | Some p ->
+      return p
+
+let shutdown (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  ChainProto_registry.remove Prevalidator.name;
+  Prevalidator.Worker.shutdown w
+
+let flush (t:t) head =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.push_request_and_wait w (Request.Flush head)
+
+let notify_operations (t:t) peer mempool =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.push_request w (Request.Notify (peer, mempool))
+
+let operations (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  let pv = Prevalidator.Worker.state w in
+  ({ (Prevalidator.validation_result pv) with applied = List.rev pv.applied },
+   pv.pending)
+
+let pending ?block (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  let pv = Prevalidator.Worker.state w in
+  let ops = Preapply_result.operations (Prevalidator.validation_result pv) in
+  match block with
+  | Some to_block ->
+      Prevalidator.list_pendings
+        ~from_block:pv.predecessor ~to_block ops >>= fun (pending, _, _) ->
+      Lwt.return pending
+  | None -> Lwt.return ops
+
+let timestamp (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  let pv = Prevalidator.Worker.state w in
+  pv.timestamp
+
+let fitness (t:t) =
+  let module Prevalidator: T = (val t) in
+  Prevalidator.fitness ()
+
+let inject_operation (t:t) op =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.push_request_and_wait w (Inject op)
+
+let status (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.status w
+
+let running_workers () =
+  ChainProto_registry.fold
+    (fun (id, proto) t acc -> (id, proto, t) :: acc)
+    []
+
+let pending_requests (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.pending_requests w
+
+let current_request (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.current_request w
+
+let last_events (t:t) =
+  let module Prevalidator: T = (val t) in
+  let w = Lazy.force Prevalidator.worker in
+  Prevalidator.Worker.last_events w
+
+let protocol_hash (t:t) =
+  let module Prevalidator: T = (val t) in
+  Prevalidator.Proto.hash
+
+let parameters (t:t) =
+  let module Prevalidator: T = (val t) in
+  Prevalidator.parameters
+
+let empty_rpc_directory : unit RPC_directory.t =
+  RPC_directory.register
+    RPC_directory.empty
+    (Block_services.Empty.S.Mempool.pending_operations RPC_path.open_root)
+    (fun _pv () () ->
+       return {
+         Block_services.Empty.Mempool.applied = [] ;
+         refused = Operation_hash.Map.empty ;
+         branch_refused = Operation_hash.Map.empty ;
+         branch_delayed = Operation_hash.Map.empty ;
+         unprocessed = Operation_hash.Map.empty ;
+       })
+
+
+let rpc_directory  : t option RPC_directory.t =
+  RPC_directory.register_dynamic_directory
+    RPC_directory.empty
+    (Block_services.mempool_path RPC_path.open_root)
+    (function
+      | None ->
+          Lwt.return (RPC_directory.map (fun _ -> Lwt.return_unit) empty_rpc_directory)
+      | Some t ->
+          let module Prevalidator: T = (val t: T) in
+          Prevalidator.initialization_errors >>= function
+          | Error _ ->
+              Lwt.return (RPC_directory.map (fun _ -> Lwt.return_unit) empty_rpc_directory)
+          | Ok () ->
+              let w = Lazy.force Prevalidator.worker in
+              let pv = Prevalidator.Worker.state w in
+              let pv_rpc_dir = Lazy.force pv.rpc_directory in
+              Lwt.return (RPC_directory.map (fun _ -> Lwt.return pv) pv_rpc_dir))
diff --git a/vendors/tezos-modded/src/lib_shell/prevalidator.mli b/vendors/tezos-modded/src/lib_shell/prevalidator.mli
new file mode 100644
index 000000000..e6050486a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/prevalidator.mli
@@ -0,0 +1,111 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - Prevalidation of pending operations (a.k.a Mempool) *)
+
+(** The prevalidator is in charge of the "mempool" (a.k.a. the
+    set of known not-invalid-for-sure operations that are not yet
+    included in the blockchain).
+
+    The prevalidator also maintains a sorted subset of the mempool that
+    might correspond to a valid block on top of the current head. The
+    "in-progress" context produced by the application of those
+    operations is called the (pre)validation context.
+
+    Before including an operation into the mempool, the prevalidation
+    worker tries to append the operation the prevalidation context. If
+    the operation is (strongly) refused, it will not be added into the
+    mempool and then it will be ignored by the node and never
+    broadcast. If the operation is only "branch_refused" or
+    "branch_delayed", the operation won't be appended in the
+    prevalidation context, but still broadcast.
+
+*)
+
+
+
+(** An (abstract) prevalidator context. Separate prevalidator contexts should be
+ * used for separate chains (e.g., mainchain vs testchain). *)
+type t
+
+type limits = {
+  max_refused_operations : int ;
+  operation_timeout : float ;
+  worker_limits : Worker_types.limits ;
+}
+
+(** Creates/tear-down a new prevalidator context. *)
+val create:
+  limits ->
+  (module Registered_protocol.T) ->
+  Distributed_db.chain_db ->
+  t tzresult Lwt.t
+val shutdown: t -> unit Lwt.t
+
+(** Notify the prevalidator that the identified peer has sent a bunch of
+ * operations relevant to the specified context. *)
+val notify_operations: t -> P2p_peer.Id.t -> Mempool.t -> unit Lwt.t
+
+(** Notify the prevalidator worker of a new injected operation. *)
+val inject_operation: t -> Operation.t -> unit tzresult Lwt.t
+
+(** Notify the prevalidator that a new head has been selected. *)
+val flush: t -> Block_hash.t -> unit tzresult Lwt.t
+
+(** Returns the timestamp of the prevalidator worker, that is the timestamp of the last
+    reset of the prevalidation context *)
+val timestamp: t -> Time.t
+
+(** Returns the fitness of the current prevalidation context *)
+val fitness: t -> Fitness.t Lwt.t
+
+(** Returns the list of valid operations known to this prevalidation worker *)
+val operations: t -> (error Preapply_result.t * Operation.t Operation_hash.Map.t)
+
+(** Returns the list of pending operations known to this prevalidation worker *)
+val pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t Lwt.t
+
+(** Returns the list of prevalidation contexts running and their associated chain *)
+val running_workers: unit -> (Chain_id.t * Protocol_hash.t * t) list
+
+(** Two functions that are useful for managing the prevalidator's transition
+ * from one protocol to the next. *)
+
+(** Returns the hash of the protocol the prevalidator was instantiated with *)
+val protocol_hash: t -> Protocol_hash.t
+
+(** Returns the parameters the prevalidator was created with. *)
+val parameters: t -> limits * Distributed_db.chain_db
+
+(** Worker status and events *)
+
+(* None indicates the there are no workers for the current protocol. *)
+val status: t -> Worker_types.worker_status
+val pending_requests : t -> (Time.t * Prevalidator_worker_state.Request.view) list
+val current_request : t -> (Time.t * Time.t * Prevalidator_worker_state.Request.view) option
+val last_events : t -> (Lwt_log_core.level * Prevalidator_worker_state.Event.t list) list
+
+val rpc_directory : t option RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/protocol_directory.ml b/vendors/tezos-modded/src/lib_shell/protocol_directory.ml
new file mode 100644
index 000000000..646a5629d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/protocol_directory.ml
@@ -0,0 +1,48 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 build_rpc_directory state =
+
+  let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
+  let gen_register0 s f =
+    dir := RPC_directory.gen_register !dir s (fun () p q -> f p q) in
+  let register1 s f =
+    dir := RPC_directory.register !dir s (fun ((), a) p q -> f a p q) in
+
+  gen_register0 Protocol_services.S.list begin fun () () ->
+    State.Protocol.list state >>= fun set ->
+    let protocols =
+      Protocol_hash.Set.elements set @
+      Registered_protocol.list_embedded () in
+    RPC_answer.return protocols
+  end ;
+
+  register1 Protocol_services.S.contents begin fun hash () () ->
+    match Registered_protocol.get_embedded_sources hash with
+    | Some p -> return p
+    | None -> State.Protocol.read state hash
+  end ;
+
+  !dir
diff --git a/vendors/tezos-modded/src/lib_shell/protocol_directory.mli b/vendors/tezos-modded/src/lib_shell/protocol_directory.mli
new file mode 100644
index 000000000..50beb2798
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/protocol_directory.mli
@@ -0,0 +1,27 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 build_rpc_directory:
+  State.t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/protocol_validator.ml b/vendors/tezos-modded/src/lib_shell/protocol_validator.ml
new file mode 100644
index 000000000..7b0e59949
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/protocol_validator.ml
@@ -0,0 +1,173 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Validation_errors
+
+include Logging.Make_semantic(struct let name = "node.validator.block" end)
+
+type 'a request =
+  | Request_validation: {
+      hash: Protocol_hash.t ;
+      protocol: Protocol.t ;
+    } -> Registered_protocol.t tzresult request
+
+type message = Message: 'a request * 'a Lwt.u option -> message
+
+type t = {
+  db: Distributed_db.t ;
+  mutable worker: unit Lwt.t ;
+  messages: message Lwt_pipe.t ;
+  canceler: Lwt_canceler.t ;
+}
+
+(** Block validation *)
+
+let rec worker_loop bv =
+  begin
+    protect ~canceler:bv.canceler begin fun () ->
+      Lwt_pipe.pop bv.messages >>= return
+    end >>=? function Message (request, wakener) ->
+    match request with
+    | Request_validation { hash ; protocol } ->
+        Updater.compile hash protocol >>= fun valid ->
+        begin
+          if valid then
+            Distributed_db.commit_protocol bv.db hash protocol
+          else
+            (* no need to tag 'invalid' protocol on disk,
+               the economic protocol prevents us from
+               being spammed with protocol validation. *)
+            return_true
+        end >>=? fun _ ->
+        match wakener with
+        | None ->
+            return_unit
+        | Some wakener ->
+            if valid then
+              match Registered_protocol.get hash with
+              | Some protocol ->
+                  Lwt.wakeup_later wakener (Ok protocol)
+              | None ->
+                  Lwt.wakeup_later wakener
+                    (Error
+                       [Invalid_protocol { hash ;
+                                           error = Dynlinking_failed }])
+            else
+              Lwt.wakeup_later wakener
+                (Error
+                   [Invalid_protocol { hash ;
+                                       error = Compilation_failed }]) ;
+            return_unit
+  end >>= function
+  | Ok () ->
+      worker_loop bv
+  | Error [Canceled | Exn Lwt_pipe.Closed] ->
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "terminating" -% t event "terminating") >>= fun () ->
+      Lwt.return_unit
+  | Error err ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[Unexpected error (worker):@ %a@]"
+          -% t event "unexpected_error"
+          -% a errs_tag err) >>= fun () ->
+      Lwt_canceler.cancel bv.canceler >>= fun () ->
+      Lwt.return_unit
+
+let create db =
+  let canceler = Lwt_canceler.create () in
+  let messages = Lwt_pipe.create () in
+  let bv = {
+    canceler ; messages ; db ;
+    worker = Lwt.return_unit } in
+  Lwt_canceler.on_cancel bv.canceler begin fun () ->
+    Lwt_pipe.close bv.messages ;
+    Lwt.return_unit
+  end ;
+  bv.worker <-
+    Lwt_utils.worker "block_validator"
+      ~run:(fun () -> worker_loop bv)
+      ~cancel:(fun () -> Lwt_canceler.cancel bv.canceler) ;
+  bv
+
+let shutdown { canceler ; worker } =
+  Lwt_canceler.cancel canceler >>= fun () ->
+  worker
+
+let validate { messages } hash protocol =
+  match Registered_protocol.get hash with
+  | Some protocol ->
+      lwt_debug Tag.DSL.(fun f ->
+          f "previously validated protocol %a (before pipe)"
+          -% t event "previously_validated_protocol"
+          -% a Protocol_hash.Logging.tag hash) >>= fun () ->
+      return protocol
+  | None ->
+      let res, wakener = Lwt.task () in
+      lwt_debug Tag.DSL.(fun f ->
+          f "pushing validation request for protocol %a"
+          -% t event "pushing_validation_request"
+          -% a Protocol_hash.Logging.tag hash) >>= fun () ->
+      Lwt_pipe.push messages
+        (Message (Request_validation { hash ; protocol },
+                  Some wakener)) >>= fun () ->
+      res
+
+let fetch_and_compile_protocol pv ?peer ?timeout hash =
+  match Registered_protocol.get hash with
+  | Some proto -> return proto
+  | None ->
+      begin
+        Distributed_db.Protocol.read_opt pv.db hash >>= function
+        | Some protocol -> return protocol
+        | None ->
+            lwt_log_notice Tag.DSL.(fun f ->
+                f "Fetching protocol %a%a"
+                -% t event "fetching_protocol"
+                -% a Protocol_hash.Logging.tag hash
+                -% a P2p_peer.Id.Logging.tag_source peer) >>= fun () ->
+            Distributed_db.Protocol.fetch pv.db ?peer ?timeout hash ()
+      end >>=? fun protocol ->
+      validate pv hash protocol >>=? fun proto ->
+      return proto
+
+let fetch_and_compile_protocols pv ?peer ?timeout (block: State.Block.t) =
+  State.Block.context block >>= fun context ->
+  let protocol =
+    Context.get_protocol context >>= fun protocol_hash ->
+    fetch_and_compile_protocol pv ?peer ?timeout protocol_hash >>=? fun _ ->
+    return_unit
+  and test_protocol =
+    Context.get_test_chain context >>= function
+    | Not_running -> return_unit
+    | Forking { protocol }
+    | Running { protocol } ->
+        fetch_and_compile_protocol pv ?peer ?timeout protocol  >>=? fun _ ->
+        return_unit in
+  protocol >>=? fun () ->
+  test_protocol >>=? fun () ->
+  return_unit
+
+let prefetch_and_compile_protocols pv ?peer ?timeout block =
+  try ignore (fetch_and_compile_protocols pv ?peer ?timeout block) with _ -> ()
diff --git a/vendors/tezos-modded/src/lib_shell/protocol_validator.mli b/vendors/tezos-modded/src/lib_shell/protocol_validator.mli
new file mode 100644
index 000000000..b1503a391
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/protocol_validator.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+val create: Distributed_db.t -> t
+
+val validate:
+  t ->
+  Protocol_hash.t -> Protocol.t ->
+  Registered_protocol.t tzresult Lwt.t
+
+val shutdown: t -> unit Lwt.t
+
+val fetch_and_compile_protocol:
+  t ->
+  ?peer:P2p_peer.Id.t ->
+  ?timeout:float ->
+  Protocol_hash.t -> Registered_protocol.t tzresult Lwt.t
+
+val fetch_and_compile_protocols:
+  t ->
+  ?peer:P2p_peer.Id.t ->
+  ?timeout:float ->
+  State.Block.t -> unit tzresult Lwt.t
+
+val prefetch_and_compile_protocols:
+  t ->
+  ?peer:P2p_peer.Id.t ->
+  ?timeout:float ->
+  State.Block.t -> unit
+
diff --git a/vendors/tezos-modded/src/lib_shell/state.ml b/vendors/tezos-modded/src/lib_shell/state.ml
new file mode 100644
index 000000000..7f3b9d696
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/state.ml
@@ -0,0 +1,1308 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 State_logging
+open Validation_errors
+
+module Shared = struct
+  type 'a t = {
+    data: 'a ;
+    lock: Lwt_mutex.t ;
+  }
+  let create data = { data ; lock = Lwt_mutex.create () }
+  let use { data ; lock } f =
+    Lwt_mutex.with_lock lock (fun () -> f data)
+end
+
+type global_state = {
+  global_data: global_data Shared.t ;
+  protocol_store: Store.Protocol.store Shared.t ;
+  main_chain: Chain_id.t ;
+  protocol_watcher: Protocol_hash.t Lwt_watcher.input ;
+  block_watcher: block Lwt_watcher.input ;
+}
+
+and global_data = {
+  chains: chain_state Chain_id.Table.t ;
+  global_store: Store.t ;
+  context_index: Context.index ;
+}
+
+and chain_state = {
+  (* never take the lock on 'block_store' when holding
+     the lock on 'chain_data'. *)
+  global_state: global_state ;
+  chain_id: Chain_id.t ;
+  genesis: genesis ;
+  faked_genesis_hash: Block_hash.t ;
+  expiration: Time.t option ;
+  allow_forked_chain: bool ;
+  block_store: Store.Block.store Shared.t ;
+  context_index: Context.index Shared.t ;
+  block_watcher: block Lwt_watcher.input ;
+  chain_data: chain_data_state Shared.t ;
+  block_rpc_directories:
+    block RPC_directory.t Protocol_hash.Map.t Protocol_hash.Table.t  ;
+}
+
+and genesis = {
+  time: Time.t ;
+  block: Block_hash.t ;
+  protocol: Protocol_hash.t ;
+}
+
+and chain_data_state = {
+  mutable data: chain_data ;
+  mutable checkpoint: Int32.t * Block_hash.t ;
+  chain_data_store: Store.Chain_data.store ;
+}
+
+and chain_data = {
+  current_head: block ;
+  current_mempool: Mempool.t ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+  test_chain: Chain_id.t option ;
+}
+
+and block = {
+  chain_state: chain_state ;
+  hash: Block_hash.t ;
+  contents: Store.Block.contents ;
+  header: Block_header.t ;
+}
+
+and hashed_header = {
+  header: Block_header.t ;
+  hash: Block_hash.t ;
+}
+
+let read_chain_data { chain_data } f =
+  Shared.use chain_data begin fun state ->
+    f state.chain_data_store state.data
+  end
+
+let update_chain_data { chain_id ; context_index ; chain_data } f =
+  Shared.use chain_data begin fun state ->
+    f state.chain_data_store state.data >>= fun (data, res) ->
+    Lwt_utils.may data
+      ~f:begin fun data ->
+        state.data <- data ;
+        Shared.use context_index begin fun context_index ->
+          Context.set_head context_index chain_id
+            data.current_head.contents.context
+        end >>= fun () ->
+        Lwt.return_unit
+      end >>= fun () ->
+    Lwt.return res
+  end
+
+(** The number of predecessors stored per block.
+    This value chosen to compute efficiently block locators that
+    can cover a chain of 2 months, at 1 block/min, which is ~86K
+    blocks at the cost in space of ~72MB.
+    |locator| = log2(|chain|/10) -1
+*)
+let stored_predecessors_size = 12
+
+(**
+   Takes a block and populates its predecessors store, under the
+   assumption that all its predecessors have their store already
+   populated. The precedecessors are distributed along the chain, up
+   to the genesis, at a distance from [b] that grows exponentially.
+   The store tabulates a function [p] from distances to block_ids such
+   that if [p(b,d)=b'] then [b'] is at distance 2^d from [b].
+   Example of how previous predecessors are used:
+   p(n,0) = n-1
+   p(n,1) = n-2  = p(n-1,0)
+   p(n,2) = n-4  = p(n-2,1)
+   p(n,3) = n-8  = p(n-4,2)
+   p(n,4) = n-16 = p(n-8,3)
+*)
+let store_predecessors (store: Store.Block.store) (b: Block_hash.t) : unit Lwt.t =
+  let rec loop pred dist =
+    if dist = stored_predecessors_size
+    then Lwt.return_unit
+    else
+      Store.Block.Predecessors.read_opt (store, pred) (dist-1) >>= function
+      | None -> Lwt.return_unit (* we reached genesis *)
+      | Some p ->
+          Store.Block.Predecessors.store (store, b) dist p >>= fun () ->
+          loop p (dist+1)
+  in
+  (* the first predecessor is fetched from the header *)
+  Store.Block.Header.read_exn (store, b) >>= fun header ->
+  let pred = header.shell.predecessor in
+  if Block_hash.equal b pred then
+    Lwt.return_unit  (* genesis *)
+  else
+    Store.Block.Predecessors.store (store,b) 0 pred >>= fun () ->
+    loop pred 1
+
+(**
+   [predecessor s b d] returns the hash of the node at distance [d] from [b].
+   Returns [None] if [d] is greater than the distance of [b] from genesis or
+   if [b] is genesis.
+   Works in O(log|chain|) if the chain is shorter than 2^[stored_predecessors_size]
+   and in O(|chain|) after that.
+   @raise Invalid_argument "State.predecessors: negative distance"
+*)
+let predecessor_n (store: Store.Block.store) (block_hash: Block_hash.t) (distance: int)
+  : Block_hash.t option Lwt.t =
+  (* helper functions *)
+  (* computes power of 2 w/o floats *)
+  let power_of_2 n =
+    if n < 0 then invalid_arg "negative argument" else
+      let rec loop cnt res =
+        if cnt<1 then res
+        else loop (cnt-1) (res*2)
+      in
+      loop n 1
+  in
+  (* computes the closest power of two smaller than a given
+     a number and the rest w/o floats *)
+  let closest_power_two_and_rest n =
+    if n < 0 then invalid_arg "negative argument" else
+      let rec loop cnt n rest =
+        if n<=1
+        then (cnt,rest)
+        else loop (cnt+1) (n/2) (rest + (power_of_2 cnt) * (n mod 2))
+      in
+      loop 0 n 0
+  in
+
+  (* actual predecessor function *)
+  if distance < 0 then
+    invalid_arg ("State.predecessor: distance <= 0"^(string_of_int distance))
+  else if distance = 0 then
+    Lwt.return_some block_hash
+  else
+    let rec loop block_hash distance =
+      if distance = 1
+      then Store.Block.Predecessors.read_opt (store, block_hash) 0
+      else
+        let (power,rest) = closest_power_two_and_rest distance in
+        let (power,rest) =
+          if power < stored_predecessors_size then (power,rest)
+          else
+            let power = stored_predecessors_size-1 in
+            let rest = distance - (power_of_2 power) in
+            (power,rest)
+        in
+        Store.Block.Predecessors.read_opt (store, block_hash) power >>= function
+        | None -> Lwt.return_none (* reached genesis *)
+        | Some pred ->
+            if rest = 0
+            then Lwt.return_some pred (* landed on the requested predecessor *)
+            else loop pred rest       (* need to jump further back *)
+    in
+    loop block_hash distance
+
+let compute_locator_from_hash (chain : chain_state) ?(size = 200) head_hash seed =
+  Shared.use chain.block_store begin fun block_store ->
+    Store.Block.Header.read_exn (block_store, head_hash) >>= fun header ->
+    Block_locator.compute ~predecessor:(predecessor_n block_store)
+      ~genesis:chain.genesis.block head_hash header seed ~size
+  end
+
+let compute_locator chain ?size head seed =
+  compute_locator_from_hash chain ?size head.hash seed
+
+type t = global_state
+
+module Locked_block = struct
+
+  let store_genesis store genesis context =
+    let shell : Block_header.shell_header = {
+      level = 0l ;
+      proto_level = 0 ;
+      predecessor = genesis.block ; (* genesis' predecessor is genesis *)
+      timestamp = genesis.time ;
+      fitness = [] ;
+      validation_passes = 0 ;
+      operations_hash = Operation_list_list_hash.empty ;
+      context ;
+    } in
+    let header : Block_header.t = { shell ; protocol_data = MBytes.create 0 } in
+    Store.Block.Header.store  (store, genesis.block) header >>= fun () ->
+    Store.Block.Contents.store (store, genesis.block)
+      { Store.Block.message = Some "Genesis" ;
+        max_operations_ttl = 0 ; context ;
+        metadata = MBytes.create 0 ;
+        last_allowed_fork_level = 0l ;
+      } >>= fun () ->
+    Lwt.return header
+
+  (* Will that block is compatible with the current checkpoint. *)
+  let acceptable chain_data hash (header : Block_header.t) =
+    let level, block = chain_data.checkpoint in
+    if level < header.shell.level then
+      (* the predecessor is assumed compatible. *)
+      Lwt.return_true
+    else if level = header.shell.level then
+      Lwt.return (Block_hash.equal hash block)
+    else (* header.shell.level < level *)
+      (* valid only if the current head is lower than the checkpoint. *)
+      let head_level =
+        chain_data.data.current_head.header.shell.level in
+      Lwt.return (head_level < level)
+
+  (* Is a block still valid for a given checkpoint ? *)
+  let is_valid_for_checkpoint
+      block_store hash (header : Block_header.t) (level, block) =
+    if Compare.Int32.(header.shell.level < level) then
+      Lwt.return_true
+    else
+      predecessor_n block_store hash
+        (Int32.to_int @@
+         Int32.sub header.shell.level level) >>= function
+      | None -> assert false
+      | Some pred ->
+          if Block_hash.equal pred block then
+            Lwt.return_true
+          else
+            Lwt.return_false
+
+end
+
+(* Find the branches that are still valid with a given checkpoint, i.e.
+   heads with lower level, or branches that goes through the checkpoint. *)
+let locked_valid_heads_for_checkpoint block_store data checkpoint =
+  Store.Chain_data.Known_heads.read_all
+    data.chain_data_store >>= fun heads ->
+  Block_hash.Set.fold
+    (fun head acc ->
+       let valid_header =
+         Store.Block.Header.read_exn
+           (block_store, head) >>= fun header ->
+         Locked_block.is_valid_for_checkpoint
+           block_store head header checkpoint >>= fun valid ->
+         Lwt.return (valid, header) in
+       acc >>= fun (valid_heads, invalid_heads) ->
+       valid_header >>= fun (valid, header) ->
+       if valid then
+         Lwt.return ((head, header) :: valid_heads, invalid_heads)
+       else
+         Lwt.return (valid_heads, (head, header) :: invalid_heads))
+    heads
+    (Lwt.return ([], []))
+
+(* Tag as invalid all blocks in `heads` and their predecessors whose
+   level strictly higher to 'level'. *)
+let tag_invalid_heads block_store chain_store heads level =
+  let rec tag_invalid_head (hash, header) =
+    if header.Block_header.shell.level <= level then
+      Store.Chain_data.Known_heads.store chain_store hash >>= fun () ->
+      Lwt.return_some (hash, header)
+    else
+      let errors = [ Validation_errors.Checkpoint_error (hash, None) ] in
+      Store.Block.Invalid_block.store block_store hash
+        { level = header.shell.level ; errors } >>= fun () ->
+      Store.Block.Contents.remove (block_store, hash) >>= fun () ->
+      Store.Block.Operation_hashes.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Operation_path.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Operations.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Predecessors.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Header.read_opt
+        (block_store, header.shell.predecessor) >>= function
+      | None ->
+          Lwt.return_none
+      | Some header ->
+          tag_invalid_head (Block_header.hash header, header) in
+  Lwt_list.iter_p
+    (fun (hash, _header) ->
+       Store.Chain_data.Known_heads.remove chain_store hash)
+    heads >>= fun () ->
+  Lwt_list.filter_map_s tag_invalid_head heads
+
+(* Remove all blocks that are not in the chain. *)
+let cut_alternate_heads block_store chain_store heads =
+  let rec cut_alternate_head hash header =
+    Store.Chain_data.In_main_branch.known (chain_store, hash) >>= fun in_chain ->
+    if in_chain then
+      Lwt.return_unit
+    else
+      Store.Block.Contents.remove (block_store, hash) >>= fun () ->
+      Store.Block.Operation_hashes.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Operation_path.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Operations.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Predecessors.remove_all (block_store, hash) >>= fun () ->
+      Store.Block.Header.read_opt
+        (block_store, header.Block_header.shell.predecessor) >>= function
+      | None ->
+          Lwt.return_unit
+      | Some header ->
+          cut_alternate_head (Block_header.hash header) header in
+  Lwt_list.iter_p
+    (fun (hash, header) ->
+       Store.Chain_data.Known_heads.remove chain_store hash >>= fun () ->
+       cut_alternate_head hash header)
+    heads
+
+module Chain = struct
+
+  type nonrec genesis = genesis = {
+    time: Time.t ;
+    block: Block_hash.t ;
+    protocol: Protocol_hash.t ;
+  }
+  let genesis_encoding =
+    let open Data_encoding in
+    conv
+      (fun { time ; block ; protocol } -> (time, block, protocol))
+      (fun (time, block, protocol) -> { time ; block ; protocol })
+      (obj3
+         (req "timestamp" Time.encoding)
+         (req "block" Block_hash.encoding)
+         (req "protocol" Protocol_hash.encoding))
+
+  type t = chain_state
+  type chain_state = t
+
+  let main { main_chain } = main_chain
+  let test chain_state =
+    read_chain_data chain_state begin fun _ chain_data ->
+      Lwt.return chain_data.test_chain
+    end
+
+  let allocate
+      ~genesis ~faked_genesis_hash ~expiration ~allow_forked_chain
+      ~current_head ~checkpoint
+      global_state context_index chain_data_store block_store =
+    Store.Block.Contents.read_exn
+      (block_store, current_head) >>= fun current_block ->
+    Store.Block.Header.read_exn
+      (block_store, current_head) >>= fun current_block_head ->
+    let rec chain_data = {
+      data = {
+        current_head = {
+          chain_state ;
+          hash = current_head ;
+          contents = current_block ;
+          header = current_block_head ;
+        } ;
+        current_mempool = Mempool.empty ;
+        live_blocks = Block_hash.Set.singleton genesis.block ;
+        live_operations = Operation_hash.Set.empty ;
+        test_chain = None ;
+      } ;
+      checkpoint ;
+      chain_data_store ;
+    }
+    and chain_state = {
+      global_state ;
+      chain_id = Chain_id.of_block_hash genesis.block ;
+      chain_data = { Shared.data = chain_data ; lock = Lwt_mutex.create () } ;
+      genesis ; faked_genesis_hash ;
+      expiration ;
+      allow_forked_chain ;
+      block_store = Shared.create block_store ;
+      context_index = Shared.create context_index ;
+      block_watcher = Lwt_watcher.create_input () ;
+      block_rpc_directories = Protocol_hash.Table.create 7 ;
+    } in
+    Lwt.return chain_state
+
+  let locked_create
+      global_state data ?expiration ?(allow_forked_chain = false)
+      chain_id genesis commit =
+    let chain_store = Store.Chain.get data.global_store chain_id in
+    let block_store = Store.Block.get chain_store
+    and chain_data_store = Store.Chain_data.get chain_store in
+    let checkpoint = 0l, genesis.block in
+    Store.Chain.Genesis_hash.store chain_store genesis.block >>= fun () ->
+    Store.Chain.Genesis_time.store chain_store genesis.time >>= fun () ->
+    Store.Chain.Genesis_protocol.store chain_store genesis.protocol >>= fun () ->
+    Store.Chain_data.Current_head.store chain_data_store genesis.block >>= fun () ->
+    Store.Chain_data.Known_heads.store chain_data_store genesis.block >>= fun () ->
+    Store.Chain_data.Checkpoint.store chain_data_store checkpoint >>= fun () ->
+    begin
+      match expiration with
+      | None -> Lwt.return_unit
+      | Some time -> Store.Chain.Expiration.store chain_store time
+    end >>= fun () ->
+    begin
+      if allow_forked_chain then
+        Store.Chain.Allow_forked_chain.store data.global_store chain_id
+      else
+        Lwt.return_unit
+    end >>= fun () ->
+    Locked_block.store_genesis
+      block_store genesis commit >>= fun genesis_header ->
+    allocate
+      ~genesis
+      ~faked_genesis_hash:(Block_header.hash genesis_header)
+      ~current_head:genesis.block
+      ~expiration
+      ~allow_forked_chain
+      ~checkpoint
+      global_state
+      data.context_index
+      chain_data_store
+      block_store
+
+  let create state ?allow_forked_chain genesis  =
+    let chain_id = Chain_id.of_block_hash genesis.block in
+    Shared.use state.global_data begin fun data ->
+      if Chain_id.Table.mem data.chains chain_id then
+        Pervasives.failwith "State.Chain.create"
+      else
+        Context.commit_genesis
+          data.context_index
+          ~chain_id
+          ~time:genesis.time
+          ~protocol:genesis.protocol >>= fun commit ->
+        locked_create
+          state data ?allow_forked_chain chain_id genesis commit >>= fun chain ->
+        Chain_id.Table.add data.chains chain_id chain ;
+        Lwt.return chain
+    end
+
+  let locked_read global_state data id =
+    let chain_store = Store.Chain.get data.global_store id in
+    let block_store = Store.Block.get chain_store
+    and chain_data_store = Store.Chain_data.get chain_store in
+    Store.Chain.Genesis_hash.read chain_store >>=? fun genesis_hash ->
+    Store.Chain.Genesis_time.read chain_store >>=? fun time ->
+    Store.Chain.Genesis_protocol.read chain_store >>=? fun protocol ->
+    Store.Chain.Expiration.read_opt chain_store >>= fun expiration ->
+    Store.Chain.Allow_forked_chain.known
+      data.global_store id >>= fun allow_forked_chain ->
+    Store.Block.Header.read (block_store, genesis_hash) >>=? fun genesis_header ->
+    let genesis = { time ; protocol ; block = genesis_hash } in
+    Store.Chain_data.Current_head.read chain_data_store >>=? fun current_head ->
+    Store.Chain_data.Checkpoint.read chain_data_store >>=? fun checkpoint ->
+    try
+      allocate
+        ~genesis
+        ~faked_genesis_hash:(Block_header.hash genesis_header)
+        ~current_head
+        ~expiration
+        ~allow_forked_chain
+        ~checkpoint
+        global_state
+        data.context_index
+        chain_data_store
+        block_store >>= return
+    with Not_found ->
+      fail Bad_data_dir
+
+  let locked_read_all global_state data =
+    Store.Chain.list data.global_store >>= fun ids ->
+    iter_p
+      (fun id ->
+         locked_read global_state data id >>=? fun chain ->
+         Chain_id.Table.add data.chains id chain ;
+         return_unit)
+      ids
+
+  let read_all state =
+    Shared.use state.global_data begin fun data ->
+      locked_read_all state data
+    end
+
+  let get_exn state id =
+    Shared.use state.global_data begin fun data ->
+      Lwt.return (Chain_id.Table.find data.chains id)
+    end
+
+  let get state id =
+    Lwt.catch
+      (fun () -> get_exn state id >>= return)
+      (function
+        | Not_found -> fail (Unknown_chain id)
+        | exn -> Lwt.fail exn)
+
+  let all state =
+    Shared.use state.global_data begin fun { chains } ->
+      Lwt.return @@
+      Chain_id.Table.fold (fun _ chain acc -> chain :: acc) chains []
+    end
+
+  let id { chain_id } = chain_id
+  let genesis { genesis } = genesis
+  let faked_genesis_hash { faked_genesis_hash } = faked_genesis_hash
+  let expiration { expiration } = expiration
+  let allow_forked_chain { allow_forked_chain } = allow_forked_chain
+  let global_state { global_state } = global_state
+  let checkpoint chain_state =
+    Shared.use chain_state.chain_data begin fun { checkpoint } ->
+      Lwt.return checkpoint
+    end
+
+  let set_checkpoint chain_state ((level, _block) as checkpoint) =
+    Shared.use chain_state.block_store begin fun store ->
+      Shared.use chain_state.chain_data begin fun data ->
+        let head_header =
+          data.data.current_head.header in
+        let head_hash = data.data.current_head.hash in
+        Locked_block.is_valid_for_checkpoint
+          store head_hash head_header checkpoint >>= fun valid ->
+        assert valid ;
+        (* Remove outdated invalid blocks. *)
+        Store.Block.Invalid_block.iter store ~f: begin fun hash iblock ->
+          if iblock.level <= level then
+            Store.Block.Invalid_block.remove store hash
+          else
+            Lwt.return_unit
+        end >>= fun () ->
+        (* Remove outdated heads and tag invalid branches. *)
+        begin
+          locked_valid_heads_for_checkpoint
+            store data checkpoint >>= fun (valid_heads, invalid_heads) ->
+          tag_invalid_heads store data.chain_data_store
+            invalid_heads level >>= fun outdated_invalid_heads ->
+          if head_header.shell.level < level then
+            Lwt.return_unit
+          else
+            let outdated_valid_heads =
+              List.filter
+                (fun (hash, { Block_header.shell } ) ->
+                   shell.level <= level &&
+                   not (Block_hash.equal hash head_hash))
+                valid_heads in
+            cut_alternate_heads store data.chain_data_store
+              outdated_valid_heads >>= fun () ->
+            cut_alternate_heads store data.chain_data_store
+              outdated_invalid_heads
+        end >>= fun () ->
+        (* Store the new checkpoint. *)
+        Store.Chain_data.Checkpoint.store
+          data.chain_data_store checkpoint >>= fun () ->
+        data.checkpoint <- checkpoint ;
+        (* TODO 'git fsck' in the context. *)
+        Lwt.return_unit
+      end
+    end
+
+  let acceptable_block chain_state hash (header : Block_header.t) =
+    Shared.use chain_state.chain_data begin fun chain_data ->
+      Locked_block.acceptable chain_data hash header
+    end
+
+  let destroy state chain =
+    lwt_debug Tag.DSL.(fun f ->
+        f "destroy %a"
+        -% t event "destroy"
+        -% a chain_id (id chain)) >>= fun () ->
+    Shared.use state.global_data begin fun { global_store ; chains } ->
+      Chain_id.Table.remove chains (id chain) ;
+      Store.Chain.destroy global_store (id chain) >>= fun () ->
+      Lwt.return_unit
+    end
+
+end
+
+module Block = struct
+
+  type t = block = {
+    chain_state: Chain.t ;
+    hash: Block_hash.t ;
+    contents: Store.Block.contents ;
+    header: Block_header.t ;
+  }
+  type block = t
+
+  type validation_store = {
+    context_hash: Context_hash.t;
+    message: string option;
+    max_operations_ttl: int;
+    last_allowed_fork_level: Int32.t;
+  }
+
+  module Header = struct
+
+    type t = hashed_header = {
+      header: Block_header.t ;
+      hash: Block_hash.t ;
+    }
+    type block_header = t
+
+    let compare b1 b2 = Block_hash.compare b1.hash b2.hash
+    let equal b1 b2 = Block_hash.equal b1.hash b2.hash
+
+    let hash { hash } = hash
+    let header { header } = header
+    let shell_header { header = { Block_header.shell } } = shell
+    let timestamp b = (shell_header b).timestamp
+    let fitness b = (shell_header b).fitness
+    let level b = (shell_header b).level
+    let validation_passes b = (shell_header b).validation_passes
+
+    let known chain_state hash =
+      Shared.use chain_state.block_store begin fun store ->
+        Store.Block.Header.known (store, hash)
+      end
+
+    let read chain_state ?(pred = 0) hash =
+      Shared.use chain_state.block_store begin fun store ->
+        begin
+          if pred = 0 then
+            return hash
+          else
+            predecessor_n store hash pred >>= function
+            | None -> return chain_state.genesis.block
+            | Some hash -> return hash
+        end >>=? fun hash ->
+        Store.Block.Header.read (store, hash) >>=? fun header ->
+        return { header ; hash }
+      end
+    let read_opt chain_state ?pred hash =
+      read chain_state ?pred hash >>= function
+      | Error _ -> Lwt.return_none
+      | Ok v -> Lwt.return_some v
+    let read_exn chain_state ?(pred = 0) hash =
+      Shared.use chain_state.block_store begin fun store ->
+        begin
+          if pred = 0 then
+            Lwt.return hash
+          else
+            predecessor_n store hash pred >>= function
+            | None -> Lwt.return chain_state.genesis.block
+            | Some hash -> Lwt.return hash
+        end >>= fun hash ->
+        Store.Block.Header.read_exn (store, hash) >>= fun header ->
+        Lwt.return { header ; hash }
+      end
+
+    let of_block ( { hash ; header } : block ) : t = { hash ; header }
+    let to_block chain_state ( { hash ; header } : t ) : block option Lwt.t =
+      Shared.use chain_state.block_store begin fun store ->
+        Store.Block.Contents.read_opt (store, hash) >>= function
+        | Some contents -> Lwt.return_some { chain_state ; hash ; contents ; header }
+        | None -> Lwt.return_none
+      end
+
+    let all_operation_hashes chain_state { hash ; header } =
+      Shared.use chain_state.block_store begin fun store ->
+        Lwt_list.map_p
+          (Store.Block.Operation_hashes.read_exn (store, hash))
+          (0 -- (header.Block_header.shell.validation_passes - 1))
+      end
+
+    let predecessor chain_state { hash ; header } =
+      if Block_hash.equal hash header.Block_header.shell.predecessor then
+        Lwt.return_none           (* we are at genesis *)
+      else
+        read_exn chain_state header.Block_header.shell.predecessor >>= fun block ->
+        Lwt.return_some block
+
+    let predecessor_n chain_state hash n =
+      Shared.use chain_state.block_store begin fun block_store ->
+        predecessor_n block_store hash n
+      end
+  end
+
+  let compare b1 b2 = Block_hash.compare b1.hash b2.hash
+  let equal b1 b2 = Block_hash.equal b1.hash b2.hash
+
+  let hash { hash } = hash
+  let header { header } = header
+  let metadata { contents = { metadata } } = metadata
+  let chain_state { chain_state } = chain_state
+  let chain_id { chain_state = { chain_id } } = chain_id
+  let shell_header { header = { shell } } = shell
+  let timestamp b = (shell_header b).timestamp
+  let fitness b = (shell_header b).fitness
+  let level b = (shell_header b).level
+  let proto_level b = (shell_header b).proto_level
+  let validation_passes b = (shell_header b).validation_passes
+  let message { contents = { message } } = message
+  let max_operations_ttl { contents = { max_operations_ttl } } =
+    max_operations_ttl
+  let last_allowed_fork_level { contents = { last_allowed_fork_level } } =
+    last_allowed_fork_level
+
+  let is_genesis b = Block_hash.equal b.hash b.chain_state.genesis.block
+
+  let known_valid chain_state hash =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Contents.known (store, hash)
+    end
+  let known_invalid chain_state hash =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Invalid_block.known store hash
+    end
+  let read_invalid chain_state hash =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Invalid_block.read_opt store hash
+    end
+  let list_invalid chain_state =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Invalid_block.fold store ~init:[]
+        ~f:(fun hash { level ; errors } acc ->
+            Lwt.return ((hash, level, errors) :: acc))
+    end
+  let unmark_invalid chain_state block =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Invalid_block.known store block >>= fun mem ->
+      if mem
+      then Store.Block.Invalid_block.remove store block >>= return
+      else fail (Block_not_invalid block)
+    end
+
+  let is_valid_for_checkpoint block checkpoint =
+    let chain_state = block.chain_state in
+    Shared.use chain_state.block_store begin fun store ->
+      Locked_block.is_valid_for_checkpoint
+        store block.hash block.header checkpoint
+    end
+
+  let known chain_state hash =
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Contents.known (store, hash) >>= fun known ->
+      if known then
+        Lwt.return_true
+      else
+        Store.Block.Invalid_block.known store hash
+    end
+
+  let read chain_state ?(pred = 0) hash =
+    Shared.use chain_state.block_store begin fun store ->
+      begin
+        if pred = 0 then
+          return hash
+        else
+          predecessor_n store hash pred >>= function
+          | None -> return chain_state.genesis.block
+          | Some hash -> return hash
+      end >>=? fun hash ->
+      Store.Block.Contents.read (store, hash) >>=? fun contents ->
+      Store.Block.Header.read (store, hash) >>=? fun header ->
+      return { chain_state ; hash ; contents ; header }
+    end
+  let read_opt chain_state ?pred hash =
+    read chain_state ?pred hash >>= function
+    | Error _ -> Lwt.return_none
+    | Ok v -> Lwt.return_some v
+  let read_exn chain_state ?(pred = 0) hash =
+    Shared.use chain_state.block_store begin fun store ->
+      begin
+        if pred = 0 then
+          Lwt.return hash
+        else
+          predecessor_n store hash pred >>= function
+          | None -> Lwt.return chain_state.genesis.block
+          | Some hash -> Lwt.return hash
+      end >>= fun hash ->
+      Store.Block.Contents.read_exn (store, hash) >>= fun contents ->
+      Store.Block.Header.read_exn (store, hash) >>= fun header ->
+      Lwt.return { chain_state ; hash ; contents ; header }
+    end
+
+  (* Quick accessor to be optimized ?? *)
+  let read_predecessor chain_state hash =
+    Header.read chain_state hash >>=? fun { Header.header } ->
+    return header.shell.predecessor
+  let read_predecessor_opt chain_state hash =
+    read_predecessor chain_state hash >>= function
+    | Error _ -> Lwt.return_none
+    | Ok v -> Lwt.return_some v
+  let read_predecessor_exn chain_state hash =
+    Header.read_exn chain_state hash >>= fun { Header.header } ->
+    Lwt.return header.shell.predecessor
+
+  let predecessor { chain_state ; header ; hash } =
+    if Block_hash.equal hash header.shell.predecessor then
+      Lwt.return_none           (* we are at genesis *)
+    else
+      read_exn chain_state header.shell.predecessor >>= fun block ->
+      Lwt.return_some block
+
+  let predecessor_n b n =
+    Shared.use b.chain_state.block_store begin fun block_store ->
+      predecessor_n block_store b.hash n
+    end
+
+  let store
+      ?(dont_enforce_context_hash = false)
+      chain_state block_header block_header_metadata
+      operations operations_metadata
+      { context_hash ; message ; max_operations_ttl ; last_allowed_fork_level } =
+    let bytes = Block_header.to_bytes block_header in
+    let hash = Block_header.hash_raw bytes in
+    fail_unless
+      (block_header.shell.validation_passes = List.length operations)
+      (failure "State.Block.store: invalid operations length") >>=? fun () ->
+    fail_unless
+      (block_header.shell.validation_passes = List.length operations_metadata)
+      (failure "State.Block.store: invalid operations_data length") >>=? fun () ->
+    fail_unless
+      (List.for_all2
+         (fun l1 l2 -> List.length l1 = List.length l2)
+         operations operations_metadata)
+      (failure "State.Block.store: inconsistent operations and operations_data") >>=? fun () ->
+    (* let's the validator check the consistency... of fitness, level, ... *)
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
+      fail_when known_invalid (failure "Known invalid") >>=? fun () ->
+      Store.Block.Contents.known (store, hash) >>= fun known ->
+      if known then
+        return_none
+      else begin
+        (* safety check: never ever commit a block that is not compatible
+           with the current checkpoint.  *)
+        begin
+          let predecessor = block_header.shell.predecessor in
+          Store.Block.Contents.known
+            (store, predecessor) >>= fun valid_predecessor ->
+          if not valid_predecessor then
+            Lwt.return_false
+          else
+            Shared.use chain_state.chain_data begin fun chain_data ->
+              Locked_block.acceptable chain_data hash block_header
+            end
+        end >>= fun acceptable_block ->
+        fail_unless
+          acceptable_block
+          (Checkpoint_error (hash, None)) >>=? fun () ->
+        let commit = context_hash in
+        Context.exists chain_state.context_index.data commit
+        >>= fun exists ->
+        fail_unless exists
+          (failure "State.Block.store: context hash not found in context")
+        >>=? fun _ ->
+        fail_unless
+          (dont_enforce_context_hash
+           || Context_hash.equal block_header.shell.context commit)
+          (Inconsistent_hash (commit, block_header.shell.context)) >>=? fun () ->
+        let header =
+          if dont_enforce_context_hash then
+            { block_header
+              with shell = { block_header.shell with context = commit } }
+          else
+            block_header
+        in
+        let contents = {
+          Store.Block.message ;
+          max_operations_ttl ;
+          last_allowed_fork_level ;
+          context = commit ;
+          metadata = block_header_metadata ;
+        } in
+        Store.Block.Header.store (store, hash) header >>= fun () ->
+        Store.Block.Contents.store (store, hash) contents >>= fun () ->
+        let hashes = List.map (List.map Operation.hash) operations in
+        let list_hashes = List.map Operation_list_hash.compute hashes in
+        Lwt_list.iteri_p
+          (fun i hashes ->
+             let path = Operation_list_list_hash.compute_path list_hashes i in
+             Store.Block.Operation_hashes.store
+               (store, hash) i hashes >>= fun () ->
+             Store.Block.Operation_path.store (store, hash) i path)
+          hashes >>= fun () ->
+        Lwt_list.iteri_p
+          (fun i ops ->
+             Store.Block.Operations.store (store, hash) i ops)
+          operations >>= fun () ->
+        Lwt_list.iteri_p
+          (fun i ops ->
+             Store.Block.Operations_metadata.store (store, hash) i ops)
+          operations_metadata >>= fun () ->
+        (* Store predecessors *)
+        store_predecessors store hash >>= fun () ->
+        (* Update the chain state. *)
+        Shared.use chain_state.chain_data begin fun chain_data ->
+          let store = chain_data.chain_data_store in
+          let predecessor = block_header.shell.predecessor in
+          Store.Chain_data.Known_heads.remove store predecessor >>= fun () ->
+          Store.Chain_data.Known_heads.store store hash
+        end >>= fun () ->
+        let block = { chain_state ; hash ; contents ; header } in
+        Lwt_watcher.notify chain_state.block_watcher block ;
+        Lwt_watcher.notify chain_state.global_state.block_watcher block ;
+        return_some block
+      end
+    end
+
+  let store_invalid chain_state block_header errors =
+    let bytes = Block_header.to_bytes block_header in
+    let hash = Block_header.hash_raw bytes in
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Contents.known (store, hash) >>= fun known_valid ->
+      fail_when known_valid (failure "Known valid") >>=? fun () ->
+      Store.Block.Invalid_block.known store hash >>= fun known_invalid ->
+      if known_invalid then
+        return_false
+      else
+        Store.Block.Invalid_block.store store hash
+          { level = block_header.shell.level ; errors } >>= fun () ->
+        return_true
+    end
+
+  let watcher (state : chain_state) =
+    Lwt_watcher.create_stream state.block_watcher
+
+  let operation_hashes { chain_state ; hash ; header } i =
+    if i < 0 || header.shell.validation_passes <= i then
+      invalid_arg "State.Block.operations" ;
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Operation_hashes.read_exn (store, hash) i >>= fun hashes ->
+      Store.Block.Operation_path.read_exn (store, hash) i >>= fun path ->
+      Lwt.return (hashes, path)
+    end
+
+  let all_operation_hashes { chain_state ; hash ; header } =
+    Shared.use chain_state.block_store begin fun store ->
+      Lwt_list.map_p
+        (Store.Block.Operation_hashes.read_exn (store, hash))
+        (0 -- (header.shell.validation_passes - 1))
+    end
+
+  let operations { chain_state ; hash ; header } i =
+    if i < 0 || header.shell.validation_passes <= i then
+      invalid_arg "State.Block.operations" ;
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Operation_path.read_exn (store, hash) i >>= fun path ->
+      Store.Block.Operations.read_exn (store, hash) i >>= fun ops ->
+      Lwt.return (ops, path)
+    end
+
+  let operations_metadata { chain_state ; hash ; header } i =
+    if i < 0 || header.shell.validation_passes <= i then
+      invalid_arg "State.Block.operations_metadata" ;
+    Shared.use chain_state.block_store begin fun store ->
+      Store.Block.Operations_metadata.read_exn (store, hash) i >>= fun ops ->
+      Lwt.return ops
+    end
+
+  let all_operations { chain_state ; hash ; header } =
+    Shared.use chain_state.block_store begin fun store ->
+      Lwt_list.map_p
+        (fun i -> Store.Block.Operations.read_exn (store, hash) i)
+        (0 -- (header.shell.validation_passes - 1))
+    end
+
+  let all_operations_metadata { chain_state ; hash ; header } =
+    Shared.use chain_state.block_store begin fun store ->
+      Lwt_list.map_p
+        (fun i -> Store.Block.Operations_metadata.read_exn (store, hash) i)
+        (0 -- (header.shell.validation_passes - 1))
+    end
+
+  let context { chain_state ; hash } =
+    Shared.use chain_state.block_store begin fun block_store ->
+      Store.Block.Contents.read_exn (block_store, hash)
+    end >>= fun { context = commit } ->
+    Shared.use chain_state.context_index begin fun context_index ->
+      Context.checkout_exn context_index commit
+    end
+
+  let protocol_hash block =
+    context block >>= fun context ->
+    Context.get_protocol context
+
+  let test_chain block =
+    context block >>= fun context ->
+    Context.get_test_chain context
+
+  let block_validity chain_state block : Block_locator.validity Lwt.t =
+    known chain_state block >>= function
+    | false ->
+        if Block_hash.equal block (Chain.faked_genesis_hash chain_state) then
+          Lwt.return Block_locator.Known_valid
+        else
+          Lwt.return Block_locator.Unknown
+    | true ->
+        known_invalid chain_state block >>= function
+        | true ->
+            Lwt.return Block_locator.Known_invalid
+        | false ->
+            Lwt.return Block_locator.Known_valid
+
+  let known_ancestor chain_state locator =
+    Block_locator.unknown_prefix
+      ~is_known:(block_validity chain_state) locator >>= function
+    | None -> Lwt.return_none
+    | Some (tail, locator) ->
+        if Block_hash.equal tail (Chain.faked_genesis_hash chain_state) then
+          read_exn
+            chain_state (Chain.genesis chain_state).block >>= fun genesis ->
+          Lwt.return_some (genesis, locator)
+        else
+          read_exn chain_state tail >>= fun block ->
+          Lwt.return_some (block, locator)
+
+  let get_rpc_directory ({ chain_state ; _ } as block) =
+    read_opt chain_state block.header.shell.predecessor >>= function
+    | None -> Lwt.return_none (* genesis *)
+    | Some pred ->
+        protocol_hash pred >>= fun protocol ->
+        match
+          Protocol_hash.Table.find_opt
+            chain_state.block_rpc_directories protocol
+        with
+        | None -> Lwt.return_none
+        | Some map ->
+            protocol_hash block >>= fun next_protocol ->
+            Lwt.return (Protocol_hash.Map.find_opt next_protocol map)
+
+  let set_rpc_directory ({ chain_state ; _ } as block) dir =
+    read_exn chain_state block.header.shell.predecessor >>= fun pred ->
+    protocol_hash block >>= fun next_protocol ->
+    protocol_hash pred >>= fun protocol ->
+    let map =
+      Option.unopt ~default:Protocol_hash.Map.empty
+        (Protocol_hash.Table.find_opt chain_state.block_rpc_directories protocol)
+    in
+    Protocol_hash.Table.replace
+      chain_state.block_rpc_directories protocol
+      (Protocol_hash.Map.add next_protocol dir map) ;
+    Lwt.return_unit
+
+end
+
+let watcher (state : global_state) =
+  Lwt_watcher.create_stream state.block_watcher
+
+let read_block { global_data } ?pred hash =
+  Shared.use global_data begin fun { chains } ->
+    Chain_id.Table.fold
+      (fun _chain_id chain_state acc ->
+         acc >>= function
+         | Some _ -> acc
+         | None ->
+             Block.read_opt chain_state ?pred hash >>= function
+             | None -> acc
+             | Some block -> Lwt.return_some block)
+      chains
+      Lwt.return_none
+  end
+
+let read_block_exn t ?pred hash =
+  read_block t ?pred hash >>= function
+  | None -> Lwt.fail Not_found
+  | Some b -> Lwt.return b
+
+let fork_testchain block protocol expiration =
+  Shared.use block.chain_state.global_state.global_data begin fun data ->
+    Block.context block >>= fun context ->
+    Context.set_test_chain context Not_running >>= fun context ->
+    Context.set_protocol context protocol >>= fun context ->
+    Context.commit_test_chain_genesis
+      data.context_index block.hash block.header.shell.timestamp
+      context >>=? fun (chain_id, genesis, commit) ->
+    let genesis = {
+      block = genesis ;
+      time = Time.add block.header.shell.timestamp 1L ;
+      protocol ;
+    } in
+    Chain.locked_create block.chain_state.global_state data
+      chain_id ~expiration genesis commit >>= fun chain ->
+    update_chain_data block.chain_state begin fun _ chain_data ->
+      Lwt.return (Some { chain_data with test_chain = Some chain.chain_id }, ())
+    end >>= fun () ->
+    return chain
+  end
+
+let best_known_head_for_checkpoint chain_state (level, _ as checkpoint) =
+  Shared.use chain_state.block_store begin fun store ->
+    Shared.use chain_state.chain_data begin fun data ->
+      let head_hash = data.data.current_head.hash in
+      let head_header = data.data.current_head.header in
+      Locked_block.is_valid_for_checkpoint
+        store head_hash head_header checkpoint >>= fun valid ->
+      if valid then
+        Lwt.return data.data.current_head
+      else
+        let find_valid_predecessor hash =
+          Store.Block.Header.read_exn
+            (store, hash) >>= fun header ->
+          if Compare.Int32.(header.shell.level < level) then
+            Store.Block.Contents.read_exn
+              (store, hash) >>= fun contents ->
+            Lwt.return { hash ; contents ; chain_state ; header }
+          else
+            predecessor_n store hash
+              (1 + (Int32.to_int @@
+                    Int32.sub header.shell.level level)) >>= function
+            | None -> assert false
+            | Some pred ->
+                Store.Block.Contents.read_exn
+                  (store, pred) >>= fun pred_contents ->
+                Store.Block.Header.read_exn
+                  (store, pred) >>= fun pred_header ->
+                Lwt.return { hash = pred ; contents = pred_contents ;
+                             chain_state ; header = pred_header } in
+        Store.Chain_data.Known_heads.read_all
+          data.chain_data_store >>= fun heads ->
+        Store.Block.Contents.read_exn
+          (store, chain_state.genesis.block) >>= fun genesis_contents ->
+        Store.Block.Header.read_exn
+          (store, chain_state.genesis.block) >>= fun genesis_header ->
+        let genesis =
+          { hash = chain_state.genesis.block ;
+            contents = genesis_contents ;
+            chain_state ; header = genesis_header } in
+        Block_hash.Set.fold
+          (fun head best ->
+             let valid_predecessor = find_valid_predecessor head in
+             best >>= fun best ->
+             valid_predecessor >>= fun pred ->
+             if Fitness.(pred.header.shell.fitness >
+                         best.header.shell.fitness) then
+               Lwt.return pred
+             else
+               Lwt.return best)
+          heads
+          (Lwt.return genesis)
+    end
+  end
+
+module Protocol = struct
+
+  include Protocol
+
+  let known global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.known store hash
+    end
+
+  let read global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.read store hash
+    end
+  let read_opt global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.read_opt store hash
+    end
+  let read_exn global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.read_exn store hash
+    end
+
+  let read_raw global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.RawContents.read (store, hash)
+    end
+  let read_raw_opt global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.RawContents.read_opt (store, hash)
+    end
+  let read_raw_exn global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.RawContents.read_exn (store, hash)
+    end
+
+  let store global_state p =
+    let bytes = Protocol.to_bytes p in
+    let hash = Protocol.hash_raw bytes in
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.known store hash >>= fun known ->
+      if known then
+        Lwt.return_none
+      else
+        Store.Protocol.RawContents.store (store, hash) bytes >>= fun () ->
+        Lwt_watcher.notify global_state.protocol_watcher hash ;
+        Lwt.return_some hash
+    end
+
+  let remove global_state hash =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.known store hash >>= fun known ->
+      if known then
+        Lwt.return_false
+      else
+        Store.Protocol.Contents.remove store hash >>= fun () ->
+        Lwt.return_true
+    end
+
+  let list global_state =
+    Shared.use global_state.protocol_store begin fun store ->
+      Store.Protocol.Contents.fold_keys store
+        ~init:Protocol_hash.Set.empty
+        ~f:(fun x acc -> Lwt.return (Protocol_hash.Set.add x acc))
+    end
+
+  let watcher (state : global_state) =
+    Lwt_watcher.create_stream state.protocol_watcher
+
+end
+
+module Current_mempool = struct
+
+  let set chain_state ~head mempool =
+    update_chain_data chain_state begin fun _chain_data_store data ->
+      if Block_hash.equal head (Block.hash data.current_head) then
+        Lwt.return (Some { data with current_mempool = mempool }, ())
+      else
+        Lwt.return (None, ())
+    end
+
+  let get chain_state =
+    read_chain_data chain_state begin fun _chain_data_store data ->
+      Lwt.return (Block.header data.current_head, data.current_mempool)
+    end
+
+end
+
+let may_create_chain state chain genesis =
+  Chain.get state chain >>= function
+  | Ok chain -> Lwt.return chain
+  | Error _ ->
+      Chain.create
+        ~allow_forked_chain:true
+        state genesis
+
+let read
+    global_store
+    context_index
+    main_chain =
+  let global_data = {
+    chains = Chain_id.Table.create 17 ;
+    global_store ;
+    context_index ;
+  } in
+  let state = {
+    global_data = Shared.create global_data ;
+    protocol_store = Shared.create @@ Store.Protocol.get global_store ;
+    main_chain ;
+    protocol_watcher = Lwt_watcher.create_input () ;
+    block_watcher = Lwt_watcher.create_input () ;
+  } in
+  Chain.read_all state >>=? fun () ->
+  return state
+
+let init
+    ?patch_context
+    ?(store_mapsize=40_960_000_000L)
+    ?(context_mapsize=409_600_000_000L)
+    ~store_root
+    ~context_root
+    genesis =
+  Store.init ~mapsize:store_mapsize store_root >>=? fun global_store ->
+  Context.init
+    ~mapsize:context_mapsize ?patch_context
+    context_root >>= fun context_index ->
+  let main_chain = Chain_id.of_block_hash genesis.Chain.block in
+  read global_store context_index main_chain >>=? fun state ->
+  may_create_chain state main_chain genesis >>= fun main_chain_state ->
+  return (state, main_chain_state, context_index)
+
+let close { global_data } =
+  Shared.use global_data begin fun { global_store } ->
+    Store.close global_store ;
+    Lwt.return_unit
+  end
diff --git a/vendors/tezos-modded/src/lib_shell/state.mli b/vendors/tezos-modded/src/lib_shell/state.mli
new file mode 100644
index 000000000..95b90a1cd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/state.mli
@@ -0,0 +1,331 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - Abstraction over all the disk storage.
+
+    It encapsulates access to:
+
+    - the index of validation contexts; and
+    - the persistent state of the node:
+      - the blockchain and its alternate heads ;
+      - the pool of pending operations of a chain. *)
+
+type t
+type global_state = t
+
+(** {2 Network} ************************************************************)
+
+(** Data specific to a given chain (e.g the main chain or the current
+    test chain).  *)
+module Chain : sig
+
+  type t
+  type chain_state = t
+
+  (** The chain starts from a genesis block associated to a seed protocol *)
+  type genesis = {
+    time: Time.t ;
+    block: Block_hash.t ;
+    protocol: Protocol_hash.t ;
+  }
+  val genesis_encoding: genesis Data_encoding.t
+
+  (** Initialize a chain for a given [genesis]. By default,
+      the chain does accept forking test chain. When
+      [~allow_forked_chain:true] is provided, test chain are allowed. *)
+  val create:
+    global_state ->
+    ?allow_forked_chain:bool ->
+    genesis -> chain_state Lwt.t
+
+  (** Look up for a chain by the hash of its genesis block. *)
+  val get: global_state -> Chain_id.t -> chain_state tzresult Lwt.t
+  val get_exn: global_state -> Chain_id.t -> chain_state Lwt.t
+
+  val main: global_state -> Chain_id.t
+  val test: chain_state -> Chain_id.t option Lwt.t
+
+  (** Returns all the known chains. *)
+  val all: global_state -> chain_state list Lwt.t
+
+  (** Destroy a chain: this completly removes from the local storage all
+      the data associated to the chain (this includes blocks and
+      operations). *)
+  val destroy: global_state -> chain_state -> unit Lwt.t
+
+  (** Various accessors. *)
+  val id: chain_state -> Chain_id.t
+  val genesis: chain_state -> genesis
+  val global_state: chain_state -> global_state
+
+  (** Hash of the faked block header of the genesis block. *)
+  val faked_genesis_hash: chain_state -> Block_hash.t
+
+  (** Return the expiration timestamp of a test chain. *)
+  val expiration: chain_state -> Time.t option
+  val allow_forked_chain: chain_state -> bool
+
+  val checkpoint: chain_state -> (Int32.t * Block_hash.t) Lwt.t
+
+  (** Update the current checkpoint. The current head should be
+      consistent (i.e. it should either have a lower level or pass
+      through the checkpoint). In the process all the blocks from
+      invalid alternate heads are removed from the disk, either
+      completely (when `level <= checkpoint`) or still tagged as
+      invalid (when `level > checkpoint`). *)
+  val set_checkpoint:
+    chain_state ->
+    Int32.t * Block_hash.t ->
+    unit Lwt.t
+
+  (** Check that a block is compatible with the current checkpoint.
+      This function assumes that the predecessor is known valid. *)
+  val acceptable_block:
+    chain_state ->
+    Block_hash.t -> Block_header.t ->
+    bool Lwt.t
+
+end
+
+(** {2 Block header manipulation} ******************************************)
+
+
+(** {2 Block database} *****************************************************)
+
+module Block : sig
+
+  type t
+  type block = t
+
+  type validation_store = {
+    context_hash: Context_hash.t ;
+    message: string option ;
+    max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
+  }
+
+  val known: Chain.t -> Block_hash.t -> bool Lwt.t
+  val known_valid: Chain.t -> Block_hash.t -> bool Lwt.t
+  val known_invalid: Chain.t -> Block_hash.t -> bool Lwt.t
+  val read_invalid: Chain.t -> Block_hash.t -> Store.Block.invalid_block option Lwt.t
+  val list_invalid: Chain.t -> (Block_hash.t * int32 * error list) list Lwt.t
+  val unmark_invalid: Chain.t -> Block_hash.t -> unit tzresult Lwt.t
+
+  val read: Chain.t -> ?pred:int -> Block_hash.t -> block tzresult Lwt.t
+  val read_opt: Chain.t -> ?pred:int -> Block_hash.t -> block option Lwt.t
+  val read_exn: Chain.t -> ?pred:int -> Block_hash.t -> block Lwt.t
+
+  val store:
+    ?dont_enforce_context_hash:bool ->
+    Chain.t ->
+    Block_header.t -> MBytes.t ->
+    Operation.t list list -> MBytes.t list list ->
+    validation_store ->
+    block option tzresult Lwt.t
+
+  val store_invalid:
+    Chain.t ->
+    Block_header.t ->
+    error list ->
+    bool tzresult Lwt.t
+
+  module Header : sig
+    type t
+    type block_header = t
+
+    val known: Chain.t -> Block_hash.t -> bool Lwt.t
+
+    val read: Chain.t -> ?pred:int -> Block_hash.t -> block_header tzresult Lwt.t
+    val read_opt: Chain.t -> ?pred:int -> Block_hash.t -> block_header option Lwt.t
+    val read_exn: Chain.t -> ?pred:int -> Block_hash.t -> block_header Lwt.t
+    val of_block: block -> block_header
+    val to_block: Chain.t -> block_header -> block option Lwt.t
+
+    val compare: t -> t -> int
+    val equal: t -> t -> bool
+
+    val hash: t -> Block_hash.t
+    val header: t -> Block_header.t
+    val shell_header: t -> Block_header.shell_header
+    val timestamp: t -> Time.t
+    val fitness: t -> Fitness.t
+    val validation_passes: t -> int
+    val level: t -> Int32.t
+
+    val all_operation_hashes: Chain.t -> block_header -> Operation_hash.t list list Lwt.t
+
+    val predecessor : Chain.t -> block_header -> block_header option Lwt.t
+    val predecessor_n : Chain.t -> Block_hash.t -> int -> Block_hash.t option Lwt.t
+
+  end
+
+
+  val compare: t -> t -> int
+  val equal: t -> t -> bool
+
+  val hash: t -> Block_hash.t
+  val header: t -> Block_header.t
+  val shell_header: t -> Block_header.shell_header
+  val timestamp: t -> Time.t
+  val fitness: t -> Fitness.t
+  val validation_passes: t -> int
+  val chain_id: t -> Chain_id.t
+  val chain_state: t -> Chain.t
+  val level: t -> Int32.t
+  val message: t -> string option
+  val max_operations_ttl: t -> int
+  val metadata: t -> MBytes.t
+  val last_allowed_fork_level: t -> Int32.t
+
+  val is_genesis: t -> bool
+  val predecessor: t -> block option Lwt.t
+  val predecessor_n: t -> int -> Block_hash.t option Lwt.t
+
+  val is_valid_for_checkpoint: t -> (Int32.t * Block_hash.t) -> bool Lwt.t
+
+  val context: t -> Context.t Lwt.t
+  val protocol_hash: t -> Protocol_hash.t Lwt.t
+  val test_chain: t -> Test_chain_status.t Lwt.t
+
+  val operation_hashes:
+    t -> int ->
+    (Operation_hash.t list * Operation_list_list_hash.path) Lwt.t
+  val all_operation_hashes: t -> Operation_hash.t list list Lwt.t
+
+  val operations:
+    t -> int -> (Operation.t list * Operation_list_list_hash.path) Lwt.t
+  val all_operations: t -> Operation.t list list Lwt.t
+
+  val operations_metadata:
+    t -> int -> MBytes.t list Lwt.t
+  val all_operations_metadata: t -> MBytes.t list list Lwt.t
+
+  val watcher: Chain.t -> block Lwt_stream.t * Lwt_watcher.stopper
+
+  val known_ancestor:
+    Chain.t -> Block_locator.t -> (block * Block_locator.t) option Lwt.t
+  (** [known_ancestor chain_state locator] computes the first block of
+      [locator] that is known to be a valid block. It also computes the
+      'prefix' of [locator] with end at the first valid block.  The
+      function returns [None] when no block in the locator are known or
+      if the first known block is invalid. *)
+
+  val get_rpc_directory: block -> block RPC_directory.t option Lwt.t
+  val set_rpc_directory: block -> block RPC_directory.t -> unit Lwt.t
+
+end
+
+val read_block:
+  global_state -> ?pred:int -> Block_hash.t -> Block.t option Lwt.t
+
+val read_block_exn:
+  global_state -> ?pred:int -> Block_hash.t -> Block.t Lwt.t
+
+val watcher: t -> Block.t Lwt_stream.t * Lwt_watcher.stopper
+
+(** Computes the block with the best fitness amongst the known blocks
+    which are compatible with the given checkpoint. *)
+val best_known_head_for_checkpoint:
+  Chain.t ->
+  Int32.t * Block_hash.t ->
+  Block.t Lwt.t
+
+val compute_locator: Chain.t -> ?size:int -> Block.t -> Block_locator.seed -> Block_locator.t Lwt.t
+
+val fork_testchain:
+  Block.t -> Protocol_hash.t -> Time.t -> Chain.t tzresult Lwt.t
+
+type chain_data = {
+  current_head: Block.t ;
+  current_mempool: Mempool.t ;
+  live_blocks: Block_hash.Set.t ;
+  live_operations: Operation_hash.Set.t ;
+  test_chain: Chain_id.t option ;
+}
+
+val read_chain_data:
+  Chain.t ->
+  (Store.Chain_data.store -> chain_data -> 'a Lwt.t) ->
+  'a Lwt.t
+
+val update_chain_data:
+  Chain.t ->
+  (Store.Chain_data.store -> chain_data -> (chain_data option * 'a) Lwt.t) ->
+  'a Lwt.t
+
+(** {2 Protocol database} ***************************************************)
+
+module Protocol : sig
+
+  include (module type of (struct include Protocol end))
+
+  (** Is a value stored in the local database ? *)
+  val known: global_state -> Protocol_hash.t -> bool Lwt.t
+
+  (** Read a value in the local database. *)
+  val read: global_state -> Protocol_hash.t -> Protocol.t tzresult Lwt.t
+  val read_opt: global_state -> Protocol_hash.t -> Protocol.t option Lwt.t
+  val read_exn: global_state -> Protocol_hash.t -> Protocol.t Lwt.t
+
+  (** Read a value in the local database (without parsing). *)
+  val read_raw: global_state -> Protocol_hash.t -> MBytes.t tzresult Lwt.t
+  val read_raw_opt: global_state -> Protocol_hash.t -> MBytes.t option Lwt.t
+  val read_raw_exn: global_state -> Protocol_hash.t -> MBytes.t Lwt.t
+
+  val store: global_state -> Protocol.t -> Protocol_hash.t option Lwt.t
+
+  (** Remove a value from the local database. *)
+  val remove: global_state -> Protocol_hash.t -> bool Lwt.t
+
+  val list: global_state -> Protocol_hash.Set.t Lwt.t
+
+  val watcher: global_state -> Protocol_hash.t Lwt_stream.t * Lwt_watcher.stopper
+
+end
+
+module Current_mempool : sig
+
+  val get: Chain.t -> (Block_header.t * Mempool.t) Lwt.t
+  (** The current mempool. *)
+
+  val set: Chain.t -> head:Block_hash.t -> Mempool.t -> unit Lwt.t
+  (** Set the current mempool. It is ignored if the current head is
+      not the provided one. *)
+
+end
+
+(** Read the internal state of the node and initialize
+    the databases. *)
+val init:
+  ?patch_context:(Context.t -> Context.t Lwt.t) ->
+  ?store_mapsize:int64 ->
+  ?context_mapsize:int64 ->
+  store_root:string ->
+  context_root:string ->
+  Chain.genesis ->
+  (global_state * Chain.t * Context.index) tzresult Lwt.t
+
+val close:
+  global_state -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell/store.ml b/vendors/tezos-modded/src/lib_shell/store.ml
new file mode 100644
index 000000000..943c9a16e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/store.ml
@@ -0,0 +1,305 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Raw_store.t
+type global_store = t
+
+(**************************************************************************
+ * Net store under "chain/"
+ **************************************************************************)
+
+module Chain = struct
+
+  type store = global_store * Chain_id.t
+  let get s id = (s, id)
+
+  module Indexed_store =
+    Store_helpers.Make_indexed_substore
+      (Store_helpers.Make_substore(Raw_store)(struct let name = ["chain"] end))
+      (Chain_id)
+
+  let destroy = Indexed_store.remove_all
+  let list t =
+    Indexed_store.fold_indexes t ~init:[]
+      ~f:(fun h acc -> Lwt.return (h :: acc))
+
+  module Genesis_hash =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["genesis" ; "hash"] end)
+      (Store_helpers.Make_value(Block_hash))
+
+  module Genesis_time =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["genesis" ; "time"] end)
+      (Store_helpers.Make_value(Time))
+
+  module Genesis_protocol =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["genesis" ; "protocol"] end)
+      (Store_helpers.Make_value(Protocol_hash))
+
+  module Genesis_test_protocol =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["genesis" ; "test_protocol"] end)
+      (Store_helpers.Make_value(Protocol_hash))
+
+  module Expiration =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["expiration"] end)
+      (Store_helpers.Make_value(Time))
+
+  module Allow_forked_chain =
+    Indexed_store.Make_set (struct let name = ["allow_forked_chain"] end)
+
+end
+
+(**************************************************************************
+ * Block_header store under "chain/<id>/blocks/"
+ **************************************************************************)
+
+module Block = struct
+
+  type store = Chain.store
+  let get x = x
+
+  module Indexed_store =
+    Store_helpers.Make_indexed_substore
+      (Store_helpers.Make_substore
+         (Chain.Indexed_store.Store)
+         (struct let name = ["blocks"] end))
+      (Block_hash)
+
+  type contents = {
+    message: string option ;
+    max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
+    context: Context_hash.t ;
+    metadata: MBytes.t ;
+  }
+
+  module Header =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["header"] end)
+      (Store_helpers.Make_value(Block_header))
+
+  module Contents =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["contents"] end)
+      (Store_helpers.Make_value(struct
+         type t = contents
+         let encoding =
+           let open Data_encoding in
+           conv
+             (fun { message ; max_operations_ttl ;
+                    last_allowed_fork_level ;
+                    context ; metadata } ->
+               (message, max_operations_ttl, last_allowed_fork_level,
+                context, metadata ))
+             (fun (message, max_operations_ttl, last_allowed_fork_level,
+                   context, metadata ) ->
+               { message ; max_operations_ttl ;
+                 last_allowed_fork_level ;
+                 context ; metadata })
+             (obj5
+                (opt "message" string)
+                (req "max_operations_ttl" uint16)
+                (req "last_allowed_fork_level" int32)
+                (req "context" Context_hash.encoding)
+                (req "metadata" bytes))
+       end))
+
+  module Operations_index =
+    Store_helpers.Make_indexed_substore
+      (Store_helpers.Make_substore
+         (Indexed_store.Store)
+         (struct let name = ["operations"] end))
+      (Store_helpers.Integer_index)
+
+  module Operation_hashes =
+    Operations_index.Make_map
+      (struct let name = ["hashes"] end)
+      (Store_helpers.Make_value(struct
+         type t = Operation_hash.t list
+         let encoding = Data_encoding.list Operation_hash.encoding
+       end))
+
+  module Operation_path =
+    Operations_index.Make_map
+      (struct let name = ["path"] end)
+      (Store_helpers.Make_value(struct
+         type t = Operation_list_list_hash.path
+         let encoding = Operation_list_list_hash.path_encoding
+       end))
+
+  module Operations =
+    Operations_index.Make_map
+      (struct let name = ["contents"] end)
+      (Store_helpers.Make_value(struct
+         type t = Operation.t list
+         let encoding = Data_encoding.(list (dynamic_size Operation.encoding))
+       end))
+
+  module Operations_metadata =
+    Operations_index.Make_map
+      (struct let name = ["metadata"] end)
+      (Store_helpers.Make_value(struct
+         type t = MBytes.t list
+         let encoding = Data_encoding.(list bytes)
+       end))
+
+  type invalid_block = {
+    level: int32 ;
+    errors: Error_monad.error list ;
+  }
+
+  module Invalid_block =
+    Store_helpers.Make_map
+      (Store_helpers.Make_substore
+         (Chain.Indexed_store.Store)
+         (struct let name = ["invalid_blocks"] end))
+      (Block_hash)
+      (Store_helpers.Make_value(struct
+         type t = invalid_block
+         let encoding =
+           let open Data_encoding in
+           conv
+             (fun { level ; errors } -> (level, errors))
+             (fun (level, errors) -> { level ; errors })
+             (tup2 int32 (list Error_monad.error_encoding))
+       end))
+
+  let register s =
+    Base58.register_resolver Block_hash.b58check_encoding begin fun str ->
+      let pstr = Block_hash.prefix_path str in
+      Chain.Indexed_store.fold_indexes s ~init:[]
+        ~f:begin fun chain acc ->
+          Indexed_store.resolve_index (s, chain) pstr >>= fun l ->
+          Lwt.return (List.rev_append l acc)
+        end
+    end
+
+  module Predecessors =
+    Store_helpers.Make_map
+      (Store_helpers.Make_substore
+         (Indexed_store.Store)
+         (struct let name = ["predecessors"] end))
+      (Store_helpers.Integer_index)
+      (Store_helpers.Make_value(Block_hash))
+
+end
+
+
+(**************************************************************************
+ * Blockchain data
+ **************************************************************************)
+
+module Chain_data = struct
+
+  type store = Chain.store
+  let get s = s
+
+  module Known_heads =
+    Store_helpers.Make_buffered_set
+      (Store_helpers.Make_substore
+         (Chain.Indexed_store.Store)
+         (struct let name = ["known_heads"] end))
+      (Block_hash)
+      (Block_hash.Set)
+
+  module Current_head =
+    Store_helpers.Make_single_store
+      (Chain.Indexed_store.Store)
+      (struct let name = ["current_head"] end)
+      (Store_helpers.Make_value(Block_hash))
+
+  module In_main_branch =
+    Store_helpers.Make_single_store
+      (Block.Indexed_store.Store)
+      (struct let name = ["in_chain"] end)
+      (Store_helpers.Make_value(Block_hash)) (* successor *)
+
+  module Checkpoint =
+    Store_helpers.Make_single_store
+      (Chain.Indexed_store.Store)
+      (struct let name = ["checkpoint"] end)
+      (Store_helpers.Make_value(struct
+         type t = Int32.t * Block_hash.t
+         let encoding =
+           let open Data_encoding in
+           tup2 int32 Block_hash.encoding
+       end))
+
+end
+
+
+(**************************************************************************
+ * Protocol store under "protocols/"
+ **************************************************************************)
+
+module Protocol = struct
+
+  type store = global_store
+  let get x = x
+
+  module Indexed_store =
+    Store_helpers.Make_indexed_substore
+      (Store_helpers.Make_substore
+         (Raw_store)
+         (struct let name = ["protocols"] end))
+      (Protocol_hash)
+
+  module Contents =
+    Indexed_store.Make_map
+      (struct let name = ["contents"] end)
+      (Store_helpers.Make_value(Protocol))
+
+  module RawContents =
+    Store_helpers.Make_single_store
+      (Indexed_store.Store)
+      (struct let name = ["contents"] end)
+      (Store_helpers.Raw_value)
+
+  let register s =
+    Base58.register_resolver Protocol_hash.b58check_encoding begin fun str ->
+      let pstr = Protocol_hash.prefix_path str in
+      Indexed_store.resolve_index s pstr
+    end
+
+end
+
+let init ?mapsize dir =
+  Raw_store.init ?mapsize dir >>=? fun s ->
+  Block.register s ;
+  Protocol.register s ;
+  return s
+
+let close = Raw_store.close
diff --git a/vendors/tezos-modded/src/lib_shell/store.mli b/vendors/tezos-modded/src/lib_shell/store.mli
new file mode 100644
index 000000000..317b1098e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/store.mli
@@ -0,0 +1,183 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Store_sigs
+
+type t
+type global_store = t
+
+(** [init ~mapsize path] returns an initialized store at [path] of
+    maximum capacity [mapsize] bytes. *)
+val init: ?mapsize:int64 -> string -> t tzresult Lwt.t
+val close : t -> unit
+
+
+(** {2 Chain store} **********************************************************)
+
+module Chain : sig
+
+  val list: global_store -> Chain_id.t list Lwt.t
+  val destroy: global_store -> Chain_id.t -> unit Lwt.t
+
+  type store
+  val get: global_store -> Chain_id.t -> store
+
+  module Genesis_hash : SINGLE_STORE
+    with type t := store
+     and type value := Block_hash.t
+
+  module Genesis_time : SINGLE_STORE
+    with type t := store
+     and type value := Time.t
+
+  module Genesis_protocol : SINGLE_STORE
+    with type t := store
+     and type value := Protocol_hash.t
+
+  module Genesis_test_protocol : SINGLE_STORE
+    with type t := store
+     and type value := Protocol_hash.t
+
+  module Expiration : SINGLE_STORE
+    with type t := store
+     and type value := Time.t
+
+  module Allow_forked_chain : SET_STORE
+    with type t := t
+     and type elt := Chain_id.t
+
+end
+
+
+(** {2 Mutable chain data} *******************************************************)
+
+module Chain_data : sig
+
+  type store
+  val get: Chain.store -> store
+
+  module Current_head : SINGLE_STORE
+    with type t := store
+     and type value := Block_hash.t
+
+  module Known_heads : BUFFERED_SET_STORE
+    with type t := store
+     and type elt := Block_hash.t
+     and module Set := Block_hash.Set
+
+  module In_main_branch : SINGLE_STORE
+    with type t = store * Block_hash.t
+     and type value := Block_hash.t (* successor *)
+
+  module Checkpoint : SINGLE_STORE
+    with type t := store
+     and type value := Int32.t * Block_hash.t
+
+end
+
+
+(** {2 Block header store} **************************************************)
+
+module Block : sig
+
+  type store
+  val get: Chain.store -> store
+
+  type contents = {
+    message: string option ;
+    max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
+    context: Context_hash.t ;
+    metadata: MBytes.t ;
+  }
+
+  module Header : SINGLE_STORE
+    with type t = store * Block_hash.t
+     and type value := Block_header.t
+
+  module Contents : SINGLE_STORE
+    with type t = store * Block_hash.t
+     and type value := contents
+
+  module Operation_hashes : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = Operation_hash.t list
+
+  module Operation_path : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = Operation_list_list_hash.path
+
+  module Operations : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = Operation.t list
+
+  module Operations_metadata : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = MBytes.t list
+
+  type invalid_block = {
+    level: int32 ;
+    errors: Error_monad.error list ;
+  }
+
+  module Invalid_block : MAP_STORE
+    with type t = store
+     and type key = Block_hash.t
+     and type value = invalid_block
+
+  (**
+     Block predecessors under
+     [/blocks/<block_id>/predecessors/<distance>/<block_id>].
+     Used to compute block predecessors in [lib_node_shell/state.ml].
+  *)
+  module Predecessors : MAP_STORE
+    with type t = store * Block_hash.t
+     and type key = int
+     and type value = Block_hash.t
+
+end
+
+
+(** {2 Protocol store} ******************************************************)
+
+module Protocol : sig
+
+  type store
+  val get: global_store -> store
+
+  module Contents : MAP_STORE
+    with type t := store
+     and type key := Protocol_hash.t
+     and type value := Protocol.t
+
+  module RawContents : SINGLE_STORE
+    with type t = store * Protocol_hash.t
+     and type value := MBytes.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/test/assert.ml b/vendors/tezos-modded/src/lib_shell/test/assert.ml
new file mode 100644
index 000000000..738048003
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/assert.ml
@@ -0,0 +1,128 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fail expected given msg =
+  Format.kasprintf Pervasives.failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+
+let fail_msg ?(expected="") ?(given="") fmt =
+  Format.kasprintf (fail expected given) fmt
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (prn x) (prn y) msg
+
+let equal_operation ?msg op1 op2 =
+  let eq op1 op2 =
+    match op1, op2 with
+    | None, None -> true
+    | Some op1, Some op2 ->
+        Operation.equal op1 op2
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some op -> Operation_hash.to_b58check (Operation.hash op) in
+  equal ?msg ~prn ~eq op1 op2
+
+let equal_block ?msg st1 st2 =
+  let eq st1 st2 =
+    match st1, st2 with
+    | None, None -> true
+    | Some st1, Some st2 -> Block_header.equal st1 st2
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some st -> Block_hash.to_b58check (Block_header.hash st) in
+  equal ?msg ~prn ~eq st1 st2
+
+let make_equal_list eq prn ?(msg="") x y =
+  let rec iter i x y =
+    match x, y with
+    | hd_x :: tl_x, hd_y :: tl_y ->
+        if eq hd_x hd_y then
+          iter (succ i) tl_x tl_y
+        else
+          fail_msg ~expected:(prn hd_x) ~given:(prn hd_y)
+            "%s (at index %d)" msg i
+    | _ :: _, [] | [], _ :: _ ->
+        fail_msg ~expected:"" ~given:""
+          "%s (lists of different sizes %d %d)" msg
+          (List.length x) (List.length y)
+    | [], [] ->
+        () in
+  iter 0 x y
+
+let equal_string_list ?msg l1 l2 =
+  make_equal_list ?msg (=) (fun x -> x) l1 l2
+
+let equal_string_list_list ?msg l1 l2 =
+  let pr_persist l =
+    let res =
+      String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
+    Printf.sprintf "[%s]" res in
+  make_equal_list ?msg (=) pr_persist l1 l2
+
+let equal_block_set ?msg set1 set2 =
+  let b1 = Block_hash.Set.elements set1
+  and b2 = Block_hash.Set.elements set2 in
+  make_equal_list ?msg
+    (fun h1 h2 -> Block_hash.equal h1 h2)
+    Block_hash.to_string
+    b1 b2
+
+let equal_block_map ?msg ~eq map1 map2 =
+  let b1 = Block_hash.Map.bindings map1
+  and b2 = Block_hash.Map.bindings map2 in
+  make_equal_list ?msg
+    (fun (h1, b1) (h2, b2) -> Block_hash.equal h1 h2 && eq b1 b2)
+    (fun (h1, _) -> Block_hash.to_string h1)
+    b1 b2
+
+let equal_block_hash_list ?msg l1 l2 =
+  let pr_block_hash = Block_hash.to_short_b58check in
+  make_equal_list ?msg Block_hash.equal pr_block_hash l1 l2
+
+let is_false ?(msg="") x =
+  if x then fail "false" "true" msg
+
+let is_true ?(msg="") x =
+  if not x then fail "true" "false" msg
+
+let equal_checkpoint ?msg cp1 cp2 =
+  let eq cp1 cp2 =
+    match cp1, cp2 with
+    | None, None -> true
+    | Some (x, bh1), Some (y, bh2) ->
+        Int32.equal x y &&
+        (Block_hash.equal bh1 bh2)
+    | _ -> false in
+  let prn = function
+    | None -> "none"
+    | Some (_x, bh) ->
+        (*let s = Printf.sprintf "%s" x in*)
+        Block_hash.to_b58check bh
+  in
+  equal ?msg ~prn ~eq cp1 cp2
diff --git a/vendors/tezos-modded/src/lib_shell/test/dune b/vendors/tezos-modded/src/lib_shell/test/dune
new file mode 100644
index 000000000..84cad004c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/dune
@@ -0,0 +1,46 @@
+(executables
+ (names test
+        test_locator)
+ (libraries tezos-base
+            tezos-storage
+            tezos-protocol-updater
+            tezos-shell
+            tezos-shell-services
+            tezos-embedded-protocol-demo
+            tezos-stdlib-unix
+            alcotest-lwt)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_storage
+                   -open Tezos_protocol_updater
+                   -open Tezos_shell
+                   -open Tezos_shell_services
+                   -open Tezos_stdlib_unix)))
+
+(alias
+ (name buildtest)
+ (deps test.exe
+       test_locator.exe))
+
+(alias
+ (name runtest_shell)
+ (action (run %{exe:test.exe})))
+
+(alias
+ (name runtest_locator)
+ (action (run %{exe:test_locator.exe} --no-bench)))
+
+(alias
+ (name runbench_locator)
+ (action (run %{exe:test_locator.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_shell)
+       (alias runtest_locator)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_shell/test/test.ml b/vendors/tezos-modded/src/lib_shell/test/test.ml
new file mode 100644
index 000000000..97f06177d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test.ml
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Alcotest.run "tezos-state" [
+    "store", Test_store.tests ;
+    "state", Test_state.tests ;
+    "store checkpoint", Test_store_checkpoint.tests;
+    "state checkpoint", Test_state_checkpoint.tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_locator.ml b/vendors/tezos-modded/src/lib_shell/test/test_locator.ml
new file mode 100644
index 000000000..810276c00
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_locator.ml
@@ -0,0 +1,367 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 (//) = Filename.concat
+
+(** Basic blocks *)
+
+let genesis_hash =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+let genesis_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let genesis_time = Time.of_seconds 0L
+
+let state_genesis_block =
+  {
+    State.Chain.time = genesis_time ;
+    State.Chain.block= genesis_hash ;
+    State.Chain.protocol = genesis_protocol
+  }
+
+let chain_id = Chain_id.of_block_hash genesis_hash
+
+module Proto = (val Registered_protocol.get_exn genesis_protocol)
+
+let incr_timestamp timestamp =
+  Time.add timestamp (Int64.add 1L (Random.int64 10L))
+
+let incr_fitness fitness =
+  let new_fitness =
+    match fitness with
+    | [ fitness ] ->
+        Pervasives.(
+          Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
+          |> Option.unopt ~default:0L
+          |> Int64.succ
+          |> Data_encoding.Binary.to_bytes_exn Data_encoding.int64
+        )
+    | _ -> Data_encoding.Binary.to_bytes_exn Data_encoding.int64 1L
+  in
+  [ new_fitness ]
+
+
+(* returns a new state with a single block, genesis *)
+let init_chain base_dir : State.Chain.t Lwt.t =
+  let store_root = base_dir // "store" in
+  let context_root = base_dir // "context" in
+  State.init
+    ~store_root ~context_root state_genesis_block >>= function
+  | Error _ -> Pervasives.failwith "read err"
+  | Ok (_state, chain, _index) ->
+      Lwt.return chain
+
+
+let block_header
+    ?(context = Context_hash.zero)
+    (pred : State.Block.t) : Block_header.t =
+  let pred_header = State.Block.shell_header pred in
+  let timestamp = incr_timestamp pred_header.timestamp in
+  let fitness = incr_fitness pred_header.fitness in
+  {
+    Block_header.shell =
+      {
+        level = Int32.add Int32.one (State.Block.level pred);
+        proto_level = 0;
+        predecessor = State.Block.hash pred;
+        timestamp = timestamp;
+        validation_passes = 0;
+        operations_hash = Operation_list_list_hash.empty;
+        fitness = fitness ;
+        context ;
+      } ;
+    Block_header.protocol_data = MBytes.of_string "" ;
+  }
+
+let zero = MBytes.create 0
+
+(* adds n blocks on top of an initialized chain *)
+let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
+  State.Block.read_exn chain genesis_hash >>= fun genesis ->
+  State.Block.context genesis >>= fun empty_context ->
+  let header = State.Block.header genesis in
+  let timestamp = State.Block.timestamp genesis in
+  Context.hash ~time:timestamp empty_context
+  >>= fun empty_context_hash ->
+  Context.commit
+    ~time:header.shell.timestamp empty_context >>= fun context ->
+  let header = { header with shell = { header.shell with context } } in
+  let empty_result = {
+    State.Block.
+    context_hash = empty_context_hash ;
+    message = None ;
+    max_operations_ttl = 0 ;
+    last_allowed_fork_level = 0l ;
+  } in
+  let rec loop lvl pred =
+    if lvl >= n then
+      return pred
+    else
+      let header =
+        { header with
+          shell = { header.shell with predecessor = pred ;
+                                      level = Int32.of_int lvl } } in
+      State.Block.store chain header zero [] [] empty_result >>=? fun _ ->
+      loop (lvl+1) (Block_header.hash header)
+  in
+  loop 1 genesis_hash >>= function
+  | Ok b -> Lwt.return b
+  | Error err ->
+      Error_monad.pp_print_error Format.err_formatter err ;
+      assert false
+
+
+
+
+(* helper functions ------------------------------------- *)
+
+(* wall clock time of a unit function *)
+let time1 (f: unit -> 'a) : 'a * float =
+  let t = Unix.gettimeofday () in
+  let res = f () in
+  let wall_clock = Unix.gettimeofday () -. t in
+  (res,wall_clock)
+
+(* returns result from first run and average time of [runs] runs *)
+let time ?(runs=1) f =
+  if runs < 1 then invalid_arg "time negative arg" else
+    let rec loop cnt sum =
+      if cnt = (runs)
+      then sum
+      else
+        let (_,t) = time1 f in
+        loop (cnt+1) (sum+.t)
+    in
+    let (res,t) = time1 f in
+    let sum = loop 1 t in
+    (res, sum /. (float runs))
+
+let rec repeat f n =
+  if n<0 then invalid_arg "repeat: negative arg" else
+  if n=0 then ()
+  else let _ = f () in repeat f (n-1)
+
+(* ----------------------------------------------------- *)
+
+let print_block b =
+  Printf.printf "%6i %s\n"
+    (Int32.to_int (State.Block.level b))
+    (Block_hash.to_b58check (State.Block.hash b))
+
+let print_block_h chain bh =
+  State.Block.read_exn chain bh >|= fun b ->
+  print_block b
+
+
+(* returns the predecessor at distance one, reading the header *)
+let linear_predecessor chain (bh: Block_hash.t) : Block_hash.t option Lwt.t =
+  State.Block.read_exn chain bh >>= fun b ->
+  State.Block.predecessor b >|= function
+  | None -> None
+  | Some pred -> Some (State.Block.hash pred)
+
+let print_chain chain bh =
+  let rec loop bh cnt =
+    let _ = print_block_h chain bh in
+    linear_predecessor chain bh >>= function
+    | Some pred -> loop pred (cnt+1)
+    | None -> Lwt.return_unit
+  in
+  loop bh 0
+
+
+(* returns the predecessors at ditance n, traversing all n intermediate blocks *)
+let linear_predecessor_n (chain:State.Chain.t) (bh:Block_hash.t) (distance:int)
+  : Block_hash.t option Lwt.t =
+  (* let _ = Printf.printf "LP: %4i " distance; print_block_h chain bh in *)
+  if distance < 1 then invalid_arg "distance<1" else
+    let rec loop bh distance =
+      if distance = 0
+      then Lwt.return_some bh   (* reached distance *)
+      else
+        linear_predecessor chain bh >>= function
+        | None -> Lwt.return_none
+        | Some pred ->
+            loop pred (distance-1)
+    in
+    loop bh distance
+
+
+
+(* Tests that the linear predecessor defined above and the
+   exponential predecessor implemented in State.predecessor_n
+   return the same block and it is the block at the distance
+   requested *)
+let test_pred (base_dir:string) : unit tzresult Lwt.t =
+  let size_chain = 1000 in
+  init_chain base_dir >>= fun chain ->
+  make_empty_chain chain size_chain >>= fun head ->
+
+  let test_once distance =
+    linear_predecessor_n chain head distance >>= fun lin_res ->
+    State.Block.read_exn chain head >>= fun head_block ->
+    State.Block.predecessor_n head_block distance >>= fun exp_res ->
+    match lin_res,exp_res with
+    | None, None ->
+        Lwt.return_unit
+    | None,Some _ | Some _,None ->
+        Assert.fail_msg "mismatch between exponential and linear predecessor_n"
+    | Some lin_res, Some exp_res ->
+        (* check that the two results are the same *)
+        (assert (lin_res = exp_res));
+        State.Block.read_exn chain lin_res >>= fun pred ->
+        let level_pred = Int32.to_int (State.Block.level pred) in
+        State.Block.read_exn chain head >>= fun head ->
+        let level_start = Int32.to_int (State.Block.level head) in
+        (* check distance using the level *)
+        assert (level_start - distance = level_pred);
+        Lwt.return_unit
+  in
+  let _ = Random.self_init () in
+  let range = size_chain+(size_chain/10) in
+  let repeats = 100 in
+  return (repeat (fun () -> test_once (1 + Random.int range)) repeats)
+
+let seed =
+  let receiver_id = P2p_peer.Id.of_string_exn (String.make P2p_peer.Id.size 'r') in
+  let sender_id = P2p_peer.Id.of_string_exn (String.make P2p_peer.Id.size 's') in
+  {Block_locator.receiver_id=receiver_id ; sender_id }
+
+(* compute locator using the linear predecessor *)
+let compute_linear_locator (chain:State.Chain.t) ~size block =
+  let genesis = State.Chain.genesis chain in
+  let block_hash = State.Block.hash block in
+  let header = State.Block.header block in
+  Block_locator.compute ~predecessor:(linear_predecessor_n chain)
+    ~genesis:genesis.block block_hash header ~size seed
+
+
+(* given the size of a chain, returns the size required for a locator
+   to reach genesis *)
+let compute_size_locator size_chain =
+  let repeats = 10. in
+  int_of_float ((log ((float size_chain) /. repeats)) /. (log 2.) -. 1.) * 10
+
+(* given the size of a locator, returns the size of the chain that it
+   can cover back to genesis *)
+let compute_size_chain size_locator =
+  let repeats = 10. in
+  int_of_float (repeats *. (2. ** (float (size_locator + 1))))
+
+
+(* test if the linear and exponential locator are the same and outputs
+   their timing.
+   Run the test with:
+   $ dune build @runbench_locator
+   Copy the output to a file timing.dat and plot it with:
+   $ test_locator_plot.sh timing.dat
+*)
+(*
+   chain 1 year   518k   covered by locator 150
+   chain 2 months 86k    covered by locator 120
+*)
+let test_locator base_dir =
+  let size_chain = 80000 in
+  (* timing locators with average over [runs] times *)
+  let runs = 10 in
+  let _ = Printf.printf "#runs %i\n" runs in
+  (* limit after which exp should go linear *)
+  let exp_limit = compute_size_chain 120 in
+  let _ = Printf.printf "#exp_limit %i\n" exp_limit in
+  (* size after which locator always reaches genesis *)
+  let locator_limit = compute_size_locator size_chain in
+  let _ = Printf.printf "#locator_limit %i\n" locator_limit in
+
+  init_chain base_dir >>= fun chain ->
+  time1 (fun () ->
+      make_empty_chain chain size_chain) |>
+  fun (res, t_chain) ->
+  let _ = Printf.printf
+      "#size_chain %i built in %f sec\n#      size      exp       lins\n"
+      size_chain t_chain in
+  res >>= fun head ->
+
+  let check_locator size : unit tzresult Lwt.t =
+    State.Block.read chain head >>=? fun block ->
+    time ~runs:runs (fun () ->
+        State.compute_locator chain ~size:size block seed) |>
+    fun (l_exp,t_exp) ->
+    time ~runs:runs (fun () ->
+        compute_linear_locator chain ~size:size block) |>
+    fun (l_lin,t_lin) ->
+    l_exp >>= fun l_exp ->
+    l_lin >>= fun l_lin ->
+    let _, l_exp = (l_exp : Block_locator.t :> _ * _) in
+    let _, l_lin = (l_lin : Block_locator.t :> _ * _) in
+    let _ = Printf.printf "%10i %f %f\n" size t_exp t_lin in
+    List.iter2
+      (fun hn ho ->
+         if not (Block_hash.equal hn ho)
+         then
+           Assert.fail_msg "Invalid locator %i" size)
+      l_exp l_lin;
+    return_unit
+  in
+  let stop = locator_limit + 20 in
+  let rec loop size =
+    if size < stop then (
+      check_locator size >>=? fun _ ->
+      loop (size+5)
+    )
+    else return_unit
+  in
+  loop 1
+
+let wrap n f =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    Lwt_utils_unix.with_tempdir "tezos_test_" begin fun dir ->
+      f dir >>= function
+      | Ok () -> Lwt.return_unit
+      | Error error ->
+          Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+    end
+  end
+
+let tests =
+  [ wrap "test pred" test_pred ]
+
+let bench = [ wrap "test locator" test_locator ]
+
+let tests =
+  try
+    if Sys.argv.(1) = "--no-bench" then
+      tests
+    else
+      tests @ bench
+  with _ -> tests @ bench
+
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-shell" [
+    "locator", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_locator_plot.sh b/vendors/tezos-modded/src/lib_shell/test/test_locator_plot.sh
new file mode 100755
index 000000000..0b6162ec6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_locator_plot.sh
@@ -0,0 +1,23 @@
+#!/bin/bash
+
+# plots the output of 'dune build @runtest_locator'
+
+set -e
+
+size_chain=$(grep 'size_chain' $1 | awk '{print $2}')
+exp_limit=$(grep 'exp_limit' $1 | awk '{print $2}')
+locator_limit=$(grep 'locator_limit' $1 | awk '{print $2}')
+runs=$(grep 'runs' $1 | awk '{print $2}')
+
+echo "\
+input=\"${1}\";
+set terminal svg;
+#set terminal dumb;
+set key top left;
+#set logscale y;
+set title '# stored predecessors 12, runs ${runs}, size chain ${size_chain}, exp limit ${exp_limit}, locator limit ${locator_limit}'
+set xlabel 'size locator';
+set ylabel 'time (seconds)';
+plot input using 1:2 ls 1 title 'exponential', \
+     input using 1:3 ls 2 title 'linear'
+" | gnuplot > ${1}.svg
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_state.ml b/vendors/tezos-modded/src/lib_shell/test/test_state.ml
new file mode 100644
index 000000000..6f67e2565
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_state.ml
@@ -0,0 +1,444 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 (//) = Filename.concat
+
+(** Basic blocks *)
+
+let genesis_block =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+let genesis_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let genesis_time =
+  Time.of_seconds 0L
+
+module Proto = (val Registered_protocol.get_exn genesis_protocol)
+
+let genesis : State.Chain.genesis = {
+  time = genesis_time ;
+  block = genesis_block ;
+  protocol = genesis_protocol ;
+}
+
+let chain_id = Chain_id.of_block_hash genesis_block
+
+let incr_fitness fitness =
+  let new_fitness =
+    match fitness with
+    | [ fitness ] ->
+        Pervasives.(
+          Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
+          |> Option.unopt ~default:0L
+          |> Int64.succ
+          |> Data_encoding.Binary.to_bytes_exn Data_encoding.int64
+        )
+    | _ -> Data_encoding.Binary.to_bytes_exn Data_encoding.int64 1L
+  in
+  [ new_fitness ]
+
+let incr_timestamp timestamp =
+  Time.add timestamp (Int64.add 1L (Random.int64 10L))
+
+let operation op =
+  let op : Operation.t = {
+    shell = { branch = genesis_block } ;
+    proto = MBytes.of_string op ;
+  } in
+  Operation.hash op,
+  op,
+  Data_encoding.Binary.to_bytes Operation.encoding op
+
+
+let block _state ?(context = Context_hash.zero) ?(operations = []) (pred: State.Block.t) name
+  : Block_header.t =
+  let operations_hash =
+    Operation_list_list_hash.compute
+      [Operation_list_hash.compute operations] in
+  let pred_header = State.Block.shell_header pred in
+  let fitness = incr_fitness pred_header.fitness in
+  let timestamp = incr_timestamp pred_header.timestamp in
+  { shell = { level = Int32.succ pred_header.level ;
+              proto_level = pred_header.proto_level ;
+              predecessor = State.Block.hash pred ;
+              validation_passes = 1 ;
+              timestamp ; operations_hash ; fitness ;
+              context } ;
+    protocol_data = MBytes.of_string name ;
+  }
+
+let parsed_block ({ shell ; protocol_data } : Block_header.t) =
+  let protocol_data =
+    Data_encoding.Binary.of_bytes_exn
+      Proto.block_header_data_encoding
+      protocol_data in
+  ({ shell ; protocol_data } : Proto.block_header)
+
+let zero = MBytes.create 0
+
+let build_valid_chain state vtbl pred names =
+  Lwt_list.fold_left_s
+    (fun pred name ->
+       State.Block.context pred >>= fun predecessor_context ->
+       let rec attempt context =
+         begin
+           let oph, op, _bytes = operation name in
+           let block = block ?context state ~operations:[oph] pred name in
+           let hash = Block_header.hash block in
+           let pred_header = State.Block.header pred in
+           begin
+             Proto.begin_application
+               ~chain_id: Chain_id.zero
+               ~predecessor_context
+               ~predecessor_timestamp: pred_header.shell.timestamp
+               ~predecessor_fitness: pred_header.shell.fitness
+               (parsed_block block) >>=? fun vstate ->
+             (* no operations *)
+             Proto.finalize_block vstate
+           end >>=? fun (ctxt, _metadata) ->
+           Context.commit ~time:block.shell.timestamp ctxt.context
+           >>= fun context_hash ->
+           State.Block.store state
+             block zero [[op]] [[zero]]
+             ({context_hash;
+               message = ctxt.message;
+               max_operations_ttl = ctxt.max_operations_ttl;
+               last_allowed_fork_level = ctxt.last_allowed_fork_level} :
+                State.Block.validation_store) >>=? fun _vblock ->
+           State.Block.read state hash >>=? fun vblock ->
+           Hashtbl.add vtbl name vblock ;
+           return vblock
+         end >>= function
+         | Ok v -> Lwt.return v
+         | Error [ Validation_errors.Inconsistent_hash (got, _) ] ->
+             (* Kind of a hack, but at least it tests idempotence to some extent. *)
+             attempt (Some got)
+         | Error err ->
+             Error_monad.pp_print_error Format.err_formatter err ;
+             assert false in
+       attempt None)
+    pred
+    names >>= fun _ ->
+  Lwt.return_unit
+
+let build_example_tree chain =
+  let vtbl = Hashtbl.create 23 in
+  Chain.genesis chain >>= fun genesis ->
+  Hashtbl.add vtbl "Genesis" genesis ;
+  let c = [ "A1" ; "A2" ; "A3" ; "A4" ; "A5" ; "A6" ; "A7" ; "A8" ] in
+  build_valid_chain chain vtbl genesis c >>= fun () ->
+  let a3 = Hashtbl.find vtbl "A3" in
+  let c = [ "B1" ; "B2" ; "B3" ; "B4" ; "B5" ; "B6" ; "B7" ; "B8" ] in
+  build_valid_chain chain vtbl a3 c >>= fun () ->
+  Lwt.return vtbl
+
+type state = {
+  vblock: (string, State.Block.t) Hashtbl.t ;
+  state: State.t ;
+  chain: State.Chain.t ;
+}
+
+let vblock s = Hashtbl.find s.vblock
+
+exception Found of string
+
+let vblocks s =
+  Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.vblock []
+  |> List.sort Pervasives.compare
+
+let wrap_state_init f base_dir =
+  begin
+    let store_root = base_dir // "store" in
+    let context_root = base_dir // "context" in
+    State.init
+      ~store_mapsize:4_096_000_000L
+      ~context_mapsize:4_096_000_000L
+      ~store_root
+      ~context_root
+      genesis >>=? fun (state, chain, _index) ->
+    build_example_tree chain >>= fun vblock ->
+    f { state ; chain ; vblock } >>=? fun () ->
+    return_unit
+  end
+
+let test_init (_ : state) =
+  return_unit
+
+
+
+(****************************************************************************)
+
+(** State.Block.read *)
+
+let test_read_block (s: state) =
+  Lwt_list.iter_s (fun (name, vblock) ->
+      let hash = State.Block.hash vblock in
+      State.Block.read s.chain hash >>= function
+      | Error _ ->
+          Assert.fail_msg "Error while reading valid block %s" name
+      | Ok _vblock' ->
+          (* FIXME COMPARE read operations ??? *)
+          Lwt.return_unit
+    ) (vblocks s) >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain_traversal.path *)
+
+let rec compare_path p1 p2 = match p1, p2 with
+  | [], [] -> true
+  | h1 :: p1, h2 :: p2 -> Block_hash.equal h1 h2 && compare_path p1 p2
+  | _ -> false
+
+let test_path (s: state) =
+  let check_path h1 h2 p2 =
+    Chain_traversal.path (vblock s h1) (vblock s h2) >>= function
+    | None ->
+        Assert.fail_msg "cannot compute path %s -> %s" h1 h2 ;
+    | Some (p: State.Block.t list) ->
+        let p = List.map State.Block.hash p in
+        let p2 = List.map (fun b -> State.Block.hash (vblock s b)) p2 in
+        if not (compare_path p p2) then
+          Assert.fail_msg "bad path %s -> %s" h1 h2 ;
+        Lwt.return_unit in
+  check_path "Genesis" "Genesis" [] >>= fun () ->
+  check_path "A1" "A1" [] >>= fun () ->
+  check_path "A2" "A6" ["A3"; "A4"; "A5"; "A6"] >>= fun () ->
+  check_path "B2" "B6" ["B3"; "B4"; "B5"; "B6"] >>= fun () ->
+  check_path "A1" "B3" ["A2"; "A3"; "B1"; "B2"; "B3"] >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain_traversal.common_ancestor *)
+
+let test_ancestor s =
+  let check_ancestor h1 h2 expected =
+    Chain_traversal.common_ancestor
+      (vblock s h1) (vblock s h2) >>= fun a ->
+    if not (Block_hash.equal (State.Block.hash a) (State.Block.hash expected)) then
+      Assert.fail_msg "bad ancestor %s %s" h1 h2 ;
+    Lwt.return_unit in
+  check_ancestor "Genesis" "Genesis" (vblock s "Genesis") >>= fun () ->
+  check_ancestor "Genesis" "A3" (vblock s "Genesis") >>= fun () ->
+  check_ancestor "A3" "Genesis" (vblock s "Genesis") >>= fun () ->
+  check_ancestor "A1" "A1" (vblock s "A1") >>= fun () ->
+  check_ancestor "A1" "A3" (vblock s "A1") >>= fun () ->
+  check_ancestor "A3" "A1" (vblock s "A1") >>= fun () ->
+  check_ancestor "A6" "B6" (vblock s "A3") >>= fun () ->
+  check_ancestor "B6" "A6" (vblock s "A3") >>= fun () ->
+  check_ancestor "A4" "B1" (vblock s "A3") >>= fun () ->
+  check_ancestor "B1" "A4" (vblock s "A3") >>= fun () ->
+  check_ancestor "A3" "B1" (vblock s "A3") >>= fun () ->
+  check_ancestor "B1" "A3" (vblock s "A3") >>= fun () ->
+  check_ancestor "A2" "B1" (vblock s "A2") >>= fun () ->
+  check_ancestor "B1" "A2" (vblock s "A2") >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+let seed =
+  let receiver_id = P2p_peer.Id.of_string_exn (String.make P2p_peer.Id.size 'r') in
+  let sender_id = P2p_peer.Id.of_string_exn (String.make P2p_peer.Id.size 's') in
+  {Block_locator.receiver_id=receiver_id ; sender_id }
+
+(** Chain_traversal.block_locator *)
+
+let test_locator s =
+  let check_locator length h1 expected =
+    State.compute_locator s.chain
+      ~size:length (vblock s h1) seed >>= fun l ->
+    let _, l = (l : Block_locator.t :> _ * _) in
+    if List.length l <> List.length expected then
+      Assert.fail_msg
+        "Invalid locator length %s (found: %d, expected: %d)"
+        h1 (List.length l) (List.length expected) ;
+    List.iter2
+      (fun h h2 ->
+         if not (Block_hash.equal h (State.Block.hash @@ vblock s h2)) then
+           Assert.fail_msg "Invalid locator %s (expected: %s)" h1 h2)
+      l expected ;
+    Lwt.return_unit in
+  check_locator 6 "A8" ["A7";"A6";"A5";"A4";"A3";"A2"] >>= fun () ->
+  check_locator 8 "B8" ["B7";"B6";"B5";"B4";"B3";"B2";"B1";"A3"] >>= fun () ->
+  check_locator 4 "B8" ["B7";"B6";"B5";"B4"] >>= fun () ->
+  check_locator 0 "A5" [] >>= fun () ->
+  check_locator 100 "A5" ["A4";"A3";"A2";"A1";"Genesis"] >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain.known_heads *)
+
+let compare s name heads l =
+  if List.length heads <> List.length l then
+    Assert.fail_msg
+      "unexpected known_heads size (%s: %d %d)"
+      name (List.length heads) (List.length l) ;
+  List.iter
+    (fun bname ->
+       let hash = State.Block.hash (vblock s bname) in
+       if not (List.exists (fun b -> Block_hash.equal hash (State.Block.hash b)) heads) then
+         Assert.fail_msg "missing block in known_heads (%s: %s)" name bname)
+    l
+
+let test_known_heads s =
+  Chain.known_heads s.chain >>= fun heads ->
+  compare s "initial" heads ["A8";"B8"] ;
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain.head/set_head *)
+
+let test_head s =
+  Chain.head s.chain >>= fun head ->
+  if not (Block_hash.equal (State.Block.hash head) genesis_block) then
+    Assert.fail_msg "unexpected head" ;
+  Chain.set_head s.chain (vblock s "A6") >>= fun _ ->
+  Chain.head s.chain >>= fun head ->
+  if not (Block_hash.equal (State.Block.hash head) (State.Block.hash @@ vblock s "A6")) then
+    Assert.fail_msg "unexpected head" ;
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain.mem *)
+
+let test_mem s =
+  let mem s x =
+    Chain.mem s.chain (State.Block.hash @@ vblock s x) in
+  let test_mem s x =
+    mem s x >>= function
+    | true -> Lwt.return_unit
+    | false -> Assert.fail_msg "mem %s" x in
+  let test_not_mem s x =
+    mem s x >>= function
+    | false -> Lwt.return_unit
+    | true -> Assert.fail_msg "not (mem %s)" x in
+  test_not_mem s "A3" >>= fun () ->
+  test_not_mem s "A6" >>= fun () ->
+  test_not_mem s "A8" >>= fun () ->
+  test_not_mem s "B1" >>= fun () ->
+  test_not_mem s "B6" >>= fun () ->
+  test_not_mem s "B8" >>= fun () ->
+  Chain.set_head s.chain (vblock s "A8") >>= fun _ ->
+  test_mem s "A3" >>= fun () ->
+  test_mem s "A6" >>= fun () ->
+  test_mem s "A8" >>= fun () ->
+  test_not_mem s "B1" >>= fun () ->
+  test_not_mem s "B6" >>= fun () ->
+  test_not_mem s "B8" >>= fun () ->
+  Chain.set_head s.chain (vblock s "A6") >>= fun _ ->
+  test_mem s "A3" >>= fun () ->
+  test_mem s "A6" >>= fun () ->
+  test_not_mem s "A8" >>= fun () ->
+  test_not_mem s "B1" >>= fun () ->
+  test_not_mem s "B6" >>= fun () ->
+  test_not_mem s "B8" >>= fun () ->
+  Chain.set_head s.chain (vblock s "B6") >>= fun _ ->
+  test_mem s "A3" >>= fun () ->
+  test_not_mem s "A4" >>= fun () ->
+  test_not_mem s "A6" >>= fun () ->
+  test_not_mem s "A8" >>= fun () ->
+  test_mem s "B1" >>= fun () ->
+  test_mem s "B6" >>= fun () ->
+  test_not_mem s "B8" >>= fun () ->
+  Chain.set_head s.chain (vblock s "B8") >>= fun _ ->
+  test_mem s "A3" >>= fun () ->
+  test_not_mem s "A4" >>= fun () ->
+  test_not_mem s "A6" >>= fun () ->
+  test_not_mem s "A8" >>= fun () ->
+  test_mem s "B1" >>= fun () ->
+  test_mem s "B6" >>= fun () ->
+  test_mem s "B8" >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+(** Chain_traversal.new_blocks *)
+
+let test_new_blocks s =
+  let test s head h expected_ancestor expected =
+    let to_block = vblock s head
+    and from_block = vblock s h in
+    Chain_traversal.new_blocks ~from_block ~to_block >>= fun (ancestor, blocks) ->
+    if not (Block_hash.equal (State.Block.hash ancestor) (State.Block.hash @@ vblock s expected_ancestor)) then
+      Assert.fail_msg "Invalid ancestor %s -> %s (expected: %s)" head h expected_ancestor ;
+    if List.length blocks <> List.length expected then
+      Assert.fail_msg
+        "Invalid locator length %s (found: %d, expected: %d)"
+        h (List.length blocks) (List.length expected) ;
+    List.iter2
+      (fun h1 h2 ->
+         if not (Block_hash.equal (State.Block.hash h1) (State.Block.hash @@ vblock s h2)) then
+           Assert.fail_msg "Invalid new blocks %s -> %s (expected: %s)" head h h2)
+      blocks expected ;
+    Lwt.return_unit
+  in
+  test s "A6" "A6" "A6" [] >>= fun () ->
+  test s "A8" "A6" "A6" ["A7";"A8"] >>= fun () ->
+  test s "A8" "B7" "A3" ["A4";"A5";"A6";"A7";"A8"] >>= fun () ->
+  return_unit
+
+
+(****************************************************************************)
+
+
+let tests : (string * (state -> unit tzresult Lwt.t)) list = [
+  "init", test_init ;
+  "read_block", test_read_block ;
+  "path", test_path ;
+  "ancestor", test_ancestor ;
+  "locator", test_locator ;
+  "known_heads", test_known_heads ;
+  "head", test_head ;
+  "mem", test_mem ;
+  "new_blocks", test_new_blocks ;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    Lwt_utils_unix.with_tempdir "tezos_test_" begin fun dir ->
+      wrap_state_init f dir >>= function
+      | Ok () -> Lwt.return_unit
+      | Error error ->
+          Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+    end
+  end
+
+let tests = List.map wrap tests
+
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_state_checkpoint.ml b/vendors/tezos-modded/src/lib_shell/test/test_state_checkpoint.ml
new file mode 100644
index 000000000..fe7929c30
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_state_checkpoint.ml
@@ -0,0 +1,518 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 (//) = Filename.concat
+
+(**************************************************************************)
+(** Basic blocks *)
+
+let genesis_block =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+let genesis_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let genesis_time =
+  Time.of_seconds 0L
+
+module Proto = (val Registered_protocol.get_exn genesis_protocol)
+
+let genesis : State.Chain.genesis = {
+  time = genesis_time ;
+  block = genesis_block ;
+  protocol = genesis_protocol ;
+}
+
+let operation op =
+  let op : Operation.t = {
+    shell = { branch = genesis_block } ;
+    proto = MBytes.of_string op ;
+  } in
+  Operation.hash op,
+  op,
+  Data_encoding.Binary.to_bytes Operation.encoding op
+
+let incr_fitness fitness =
+  let new_fitness =
+    match fitness with
+    | [ fitness ] ->
+        Pervasives.(
+          Data_encoding.Binary.of_bytes Data_encoding.int64 fitness
+          |> Option.unopt ~default:0L
+          |> Int64.succ
+          |> Data_encoding.Binary.to_bytes_exn Data_encoding.int64
+        )
+    | _ -> Data_encoding.Binary.to_bytes_exn Data_encoding.int64 1L
+  in
+  [ new_fitness ]
+
+let incr_timestamp timestamp =
+  Time.add timestamp (Int64.add 1L (Random.int64 10L))
+
+let block _state ?(context = Context_hash.zero) ?(operations = []) (pred: State.Block.t) name
+  : Block_header.t =
+  let operations_hash =
+    Operation_list_list_hash.compute
+      [Operation_list_hash.compute operations] in
+  let pred_header = State.Block.shell_header pred in
+  let fitness = incr_fitness pred_header.fitness in
+  let timestamp = incr_timestamp pred_header.timestamp in
+  { shell = { level = Int32.succ pred_header.level ;
+              proto_level = pred_header.proto_level ;
+              predecessor = State.Block.hash pred ;
+              validation_passes = 1 ;
+              timestamp ; operations_hash ; fitness ;
+              context } ;
+    protocol_data = MBytes.of_string name ;
+  }
+
+let parsed_block ({ shell ; protocol_data } : Block_header.t) =
+  let protocol_data =
+    Data_encoding.Binary.of_bytes_exn
+      Proto.block_header_data_encoding
+      protocol_data in
+  ({ shell ; protocol_data } : Proto.block_header)
+
+let zero = MBytes.create 0
+
+let build_valid_chain state vtbl pred names =
+  Lwt_list.fold_left_s
+    (fun pred name ->
+       State.Block.context pred >>= fun predecessor_context ->
+       let rec attempt context =
+         begin
+           let oph, op, _bytes = operation name in
+           let block = block ?context state ~operations:[oph] pred name in
+           let hash = Block_header.hash block in
+           let pred_header = State.Block.header pred in
+           begin
+             Proto.begin_application
+               ~chain_id: Chain_id.zero
+               ~predecessor_context
+               ~predecessor_timestamp: pred_header.shell.timestamp
+               ~predecessor_fitness: pred_header.shell.fitness
+               (parsed_block block) >>=? fun vstate ->
+             (* no operations *)
+             Proto.finalize_block vstate
+           end >>=? fun (result, _metadata) ->
+           Context.commit
+             ~time:(Time.now ())
+             ?message:result.message
+             result.context >>= fun context_hash ->
+           let validation_store =
+             { State.Block.context_hash ; message = result.message ;
+               max_operations_ttl = result.max_operations_ttl ;
+               last_allowed_fork_level = result.last_allowed_fork_level
+             } in
+           State.Block.store state
+             block zero [[op]] [[zero]] validation_store >>=? fun _vblock ->
+           State.Block.read state hash >>=? fun vblock ->
+           Hashtbl.add vtbl name vblock ;
+           return vblock
+         end >>= function
+         | Ok v -> Lwt.return v
+         | Error [ Validation_errors.Inconsistent_hash (got, _) ] ->
+             (* Kind of a hack, but at least it tests idempotence to some extent. *)
+             attempt (Some got)
+         | Error err ->
+             Error_monad.pp_print_error Format.err_formatter err ;
+             assert false in
+       attempt None)
+    pred
+    names >>= fun _ ->
+  Lwt.return_unit
+
+type state = {
+  vblock: (string, State.Block.t) Hashtbl.t ;
+  state: State.t ;
+  chain: State.Chain.t ;
+}
+
+let vblock s = Hashtbl.find s.vblock
+
+exception Found of string
+
+let vblocks s =
+  Hashtbl.fold (fun k v acc -> (k,v) :: acc) s.vblock []
+  |> List.sort Pervasives.compare
+
+(*******************************************************)
+(*
+
+    Genesis - A1 - A2 - A3 - A4 - A5
+                    \
+                     B1 - B2 - B3 - B4 - B5
+*)
+
+let build_example_tree chain =
+  let vtbl = Hashtbl.create 23 in
+  Chain.genesis chain >>= fun genesis ->
+  Hashtbl.add vtbl "Genesis" genesis ;
+  let c = [ "A1" ; "A2" ; "A3" ; "A4" ; "A5" ] in
+  build_valid_chain chain vtbl genesis c >>= fun () ->
+  let a2 = Hashtbl.find vtbl "A2" in
+  let c = [ "B1" ; "B2" ; "B3" ; "B4" ; "B5" ] in
+  build_valid_chain chain vtbl a2 c >>= fun () ->
+  Lwt.return vtbl
+
+let wrap_state_init f base_dir =
+  begin
+    let store_root = base_dir // "store" in
+    let context_root = base_dir // "context" in
+    State.init
+      ~store_mapsize:4_096_000_000L
+      ~context_mapsize:4_096_000_000L
+      ~store_root
+      ~context_root
+      genesis >>=? fun (state, chain, _index) ->
+    build_example_tree chain >>= fun vblock ->
+    f { state ; chain ; vblock } >>=? fun () ->
+    return ()
+  end
+
+(*******************************************************)
+
+(** State.Chain.checkpoint *)
+
+(*
+- Valid branch are kept after setting a checkpoint. Bad branch are cut
+- Setting a checkpoint in the future does not remove anything
+- Reaching a checkpoint in the future with the right block keeps that
+block and remove any concurrent branch
+- Reaching a checkpoint in the future with a bad block remove that block and
+does not prevent a future good block from correctly being reached
+- There are no bad quadratic behaviours *)
+
+(* test genesis/basic check point: (level_0, genesis_block) *)
+
+let test_checkpoint_genesis s =
+  Chain.genesis s.chain >>= fun genesis ->
+  let level = State.Block.level genesis in
+  if not (Block_hash.equal (State.Block.hash genesis) genesis_block)
+  then Assert.fail_msg "unexpected head";
+  (* set checkpoint at genesis *)
+  State.Chain.set_checkpoint s.chain (level, genesis_block) >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  (* if the level is equal and not the same hash then fail *)
+  if Int32.equal level c_level &&
+     not (Block_hash.equal c_block (State.Block.hash genesis))
+  then
+    Assert.fail_msg "unexpected checkpoint"
+  else
+    return ()
+
+let test_basic_checkpoint s =
+  let block = vblock s "A1" in
+  let level = State.Block.level block in
+  let block_hash = State.Block.hash block in
+  State.Chain.set_checkpoint s.chain (level, block_hash) >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  if not (Block_hash.equal c_block block_hash) &&
+     Int32.equal c_level level
+  then
+    Assert.fail_msg "unexpected checkpoint"
+  else return ()
+
+  (*
+   - cp: checkpoint
+
+  Genesis - A1 - A2 (cp) - A3 - A4 - A5
+                  \
+                   B1 - B2 - B3 - B4 - B5
+  *)
+
+(* State.Chain.acceptable_block:
+   will the block is compatible with the current checkpoint? *)
+
+let test_acceptable_block s =
+  let block = vblock s "A2" in
+  let level = State.Block.level block in
+  let block_hash = State.Block.hash block  in
+  State.Chain.set_checkpoint s.chain (level, block_hash) >>= fun () ->
+  (* it is accepted only if the current head is lower than the checkpoint *)
+  let block_1 = vblock s "A1" in
+  let hash = State.Block.hash block_1 in
+  Chain.set_head s.chain block_1 >>= fun head ->
+  let header = State.Block.header head in
+  State.Chain.acceptable_block s.chain hash header >>= fun is_accepted_block ->
+  if is_accepted_block
+  then return ()
+  else Assert.fail_msg "unacceptable block"
+
+ (*
+  Genesis - A1 - A2 (cp) - A3 - A4 - A5
+                  \
+                   B1 - B2 - B3 - B4 - B5
+  *)
+
+(* State.Block.is_valid_for_checkpoint :
+   is the block still valid for a given checkpoint ? *)
+
+let test_is_valid_checkpoint s =
+  let block = vblock s "A2" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  State.Chain.set_checkpoint s.chain (level, block_hash) >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  (* "b3" is valid because:
+     a1 - a2 (checkpoint) - b1 - b2 - b3
+     it is not valid when the checkpoint change to a pick different than a2.
+  *)
+  State.Block.is_valid_for_checkpoint (vblock s "B3") (c_level, c_block) >>= fun is_valid ->
+  if is_valid
+  then return ()
+  else Assert.fail_msg "invalid checkpoint"
+
+(* return a block with the best fitness amongst the known blocks which
+    are compatible with the given checkpoint *)
+
+let test_best_know_head_for_checkpoint s =
+  let block = vblock s "A2" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  Chain.set_head s.chain (vblock s "B3") >>= fun _head ->
+  State.best_known_head_for_checkpoint s.chain checkpoint >>= fun _block ->
+  (* the block returns with the best fitness is B3 at level 5 *)
+  return ()
+
+(*
+   setting checkpoint in the future does not remove anything
+
+   Genesis - A1 - A2(cp) - A3 - A4 - A5
+                  \
+                  B1 - B2 - B3 - B4 - B5
+*)
+
+let test_future_checkpoint s =
+  let block = vblock s "A2" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  if Int32.equal c_level level && not (Block_hash.equal c_block block_hash)
+  then Assert.fail_msg "unexpected checkpoint"
+  else return ()
+
+(*
+   setting checkpoint in the future does not remove anything
+   - iv = invalid
+  - (0): level of this block in the chain
+
+  Two exammples:
+    * Genesis (0)- A1 (1) - A2(2) - A3(3) - A4(4) - A5(5) (invalid)
+                            \
+                            B1(3) - B2(4) - B3 (5)(cp) - B4(6) - B5(7)
+
+    * Genesis - A1 - A2 - A3 - A4 - A5 (cp)
+                      \
+                      B1 - B2 - B3 (iv)- B4 (iv) - B5 (iv)
+*)
+
+let test_future_checkpoint_bad_good_block s =
+  let block = vblock s "A5" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  if Int32.equal c_level level && not (Block_hash.equal c_block block_hash)
+  then Assert.fail_msg "unexpected checkpoint"
+  else
+    State.Block.is_valid_for_checkpoint
+      (vblock s "B2") (c_level, c_block) >>= fun is_valid ->
+    if is_valid
+    then return ()
+    else Assert.fail_msg "invalid checkpoint"
+
+(* check if the checkpoint can be reached
+
+   Genesis - A1 (cp) - A2 (head) - A3 - A4 - A5
+                        \
+                        B1 - B2 - B3 - B4 - B5
+
+*)
+
+let test_reach_checkpoint s =
+  let mem s x =
+    Chain.mem s.chain (State.Block.hash @@ vblock s x)
+  in
+  let test_mem s x = mem s x >>= function
+    | true -> Lwt.return_unit
+    | false -> Assert.fail_msg "mem %s" x
+  in
+  let test_not_mem s x =
+    mem s x >>= function
+    | false -> Lwt.return_unit
+    | true -> Assert.fail_msg "not (mem %s)" x in
+  let block = vblock s "A1" in
+  let block_hash = State.Block.hash block in
+  let header = State.Block.header block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (c_level, c_block) ->
+  let time_now = Time.now () in
+  if Time.(add time_now 15L >= header.shell.timestamp)
+  then
+    if Int32.equal header.shell.level c_level &&
+       not (Block_hash.equal c_block block_hash)
+    then Assert.fail_msg "checkpoint error"
+    else
+      Chain.set_head s.chain (vblock s "A2") >>= fun _ ->
+      Chain.head s.chain >>= fun head ->
+      let checkpoint_reached =
+        (State.Block.header head).shell.level >= c_level
+      in
+      if checkpoint_reached
+      then
+        (* if reached the checkpoint, every block before the checkpoint
+           must be the part of the chain *)
+        if header.shell.level <= c_level
+        then
+          test_mem s "Genesis" >>= fun () ->
+          test_mem s "A1" >>= fun () ->
+          test_mem s "A2" >>= fun () ->
+          test_not_mem s "A3" >>= fun () ->
+          test_not_mem s "B1" >>= fun () ->
+          return ()
+        else Assert.fail_msg "checkpoint error"
+      else
+        Assert.fail_msg "checkpoint error"
+  else Assert.fail_msg "fail future block header"
+
+
+(*
+   Chain.Validator function may_update_checkpoint
+
+   - ncp: new checkpoint
+
+   Genesis - A1 - A2 - A3 (cp) - A4 - A5
+                  \
+                  B1 - B2 - B3 - B4 - B5
+
+   Genesis - A1 (ncp) - A2 - A3 (cp) - A4 (ncp) - A5
+                       \
+                       B1 - B2 - B3 - B4 - B5
+*)
+
+let may_update_checkpoint chain_state new_head =
+  State.Chain.checkpoint chain_state >>= fun (old_level, _) ->
+  (* FIXME: the new level is always return 0l even
+     if the new_head is A4 at level 4l
+     Or TODO: set a level where allow to have a fork
+  *)
+  let new_level = State.Block.last_allowed_fork_level new_head in
+  if new_level <= old_level then
+    Lwt.return_unit
+  else
+    let head_level = State.Block.level new_head in
+    State.Block.predecessor_n new_head
+      (Int32.to_int (Int32.sub head_level new_level)) >>= function
+    | None -> Assert.fail_msg "Unexpected None in predecessor query"
+    | Some new_block ->
+        State.Chain.set_checkpoint chain_state (new_level, new_block)
+
+let test_may_update_checkpoint s =
+  let block = vblock s "A3" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  State.Chain.checkpoint s.chain >>= fun (_, _) ->
+  Chain.set_head s.chain (vblock s "A4") >>= fun _ ->
+  Chain.head s.chain >>= fun head ->
+  may_update_checkpoint s.chain head >>= fun () ->
+  return ()
+
+(* Check function may_update_checkpoint in Node.ml
+
+   Genesis - A1 - A2 (cp) - A3 - A4 - A5
+                  \
+                  B1 - B2 - B3 - B4 - B5
+
+   chain after update:
+   Genesis - A1 - A2 - A3(cp) - A4 - A5
+                  \
+                  B1 - B2 - B3 - B4 - B5
+*)
+
+let note_may_update_checkpoint chain_state checkpoint =
+  match checkpoint with
+  | None ->
+      Lwt.return_unit
+  | Some checkpoint ->
+      State.best_known_head_for_checkpoint
+        chain_state checkpoint >>= fun new_head ->
+      Chain.set_head chain_state new_head >>= fun _ ->
+      State.Chain.set_checkpoint chain_state checkpoint
+
+let test_note_may_update_checkpoint s =
+  (* set checkpoint at (2l, A2) *)
+  let block = vblock s "A2" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  State.Chain.set_checkpoint s.chain checkpoint >>= fun () ->
+  (* set new checkpoint at (3l, A3) *)
+  let block = vblock s "A3" in
+  let block_hash = State.Block.hash block in
+  let level = State.Block.level block in
+  let checkpoint = level, block_hash in
+  note_may_update_checkpoint s.chain (Some checkpoint) >>= fun () ->
+  return ()
+
+(**********************************************************)
+
+let tests: (string * (state -> unit tzresult Lwt.t)) list = [
+  "checkpoint genesis", test_checkpoint_genesis;
+  "basic checkpoint", test_basic_checkpoint;
+  "is valid checkpoint", test_is_valid_checkpoint;
+  "acceptable block", test_acceptable_block ;
+  "best know head", test_best_know_head_for_checkpoint;
+  "future checkpoint", test_future_checkpoint;
+  "future checkpoint bad/good block", test_future_checkpoint_bad_good_block;
+  "test_reach_checkpoint", test_reach_checkpoint;
+  "update checkpoint", test_may_update_checkpoint;
+  "update checkpoint in node", test_note_may_update_checkpoint;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    Lwt_utils_unix.with_tempdir "tezos_test_" begin fun dir ->
+      wrap_state_init f dir >>= function
+      | Ok () -> Lwt.return_unit
+      | Error error ->
+          Tezos_stdlib_unix.Logging_unix.close () >>= fun () ->
+          Format.eprintf "WWW %a@." pp_print_error error ;
+          Lwt.fail Alcotest.Test_error
+    end
+  end
+
+let tests = List.map wrap tests
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_store.ml b/vendors/tezos-modded/src/lib_shell/test/test_store.ml
new file mode 100644
index 000000000..92f27f072
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_store.ml
@@ -0,0 +1,471 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Store
+
+let (>>=) = Lwt.bind
+let (>|=) = Lwt.(>|=)
+let (//) = Filename.concat
+
+(** Basic blocks *)
+
+let genesis_block =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+let genesis_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let genesis_time =
+  Time.of_seconds 0L
+
+(** *)
+
+let mapsize = 4_096_000_000L (* ~4 GiB *)
+
+let wrap_store_init f _ () =
+  Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
+    let root = base_dir // "store" in
+    Store.init ~mapsize root >>= function
+    | Ok store ->
+        Lwt.finalize
+          (fun () -> f store)
+          (fun () -> Store.close store ; Lwt.return_unit)
+    | Error err ->
+        Format.kasprintf Pervasives.failwith
+          "@[Cannot initialize store:@ %a@]" pp_print_error err
+  end
+
+let wrap_raw_store_init f _ () =
+  Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
+    let root = base_dir // "store" in
+    Raw_store.init ~mapsize root >>= function
+    | Ok store ->
+        Lwt.finalize
+          (fun () -> f store)
+          (fun () -> Raw_store.close store ; Lwt.return_unit)
+    | Error err ->
+        Format.kasprintf Pervasives.failwith
+          "@[Cannot initialize store:@ %a@]" pp_print_error err
+  end
+
+let test_init _ = Lwt.return_unit
+
+let chain_id = Chain_id.of_block_hash genesis_block
+
+(** Operation store *)
+
+let make proto : Operation.t =
+  { shell = { branch = genesis_block } ; proto }
+
+let op1 = make (MBytes.of_string "Capadoce")
+let oph1 = Operation.hash op1
+let op2 = make (MBytes.of_string "Kivu")
+let oph2 = Operation.hash op2
+
+
+(** Block store *)
+
+let lolblock ?(operations = []) header =
+  let operations_hash =
+    Operation_list_list_hash.compute
+      [Operation_list_hash.compute operations] in
+  ( { Block_header.shell =
+        { timestamp = Time.of_seconds (Random.int64 1500L) ;
+          level = 0l ; (* dummy *)
+          proto_level = 0 ; (* dummy *)
+          validation_passes = Random.int 32 ;
+          predecessor = genesis_block ; operations_hash ;
+          fitness = [MBytes.of_string @@ string_of_int @@ String.length header;
+                     MBytes.of_string @@ string_of_int @@ 12] ;
+          context = Context_hash.zero } ;
+      protocol_data = MBytes.of_string header ; } ,
+    { Store.Block.metadata = MBytes.create 0 ;
+      max_operations_ttl = 0 ;
+      message = None ;
+      context = Context_hash.zero ;
+      last_allowed_fork_level = 0l ;
+    } )
+
+let (b1_header,b1_contents) as b1 = lolblock "Blop !"
+let bh1 = Block_header.hash b1_header
+let (b2_header,b2_contents) as b2 = lolblock "Tacatlopo"
+let bh2 = Block_header.hash b2_header
+let (b3_header,b3_contents) as b3 = lolblock ~operations:[oph1;oph2] "Persil"
+let bh3 = Block_header.hash b3_header
+let bh3' =
+  let raw = Bytes.of_string @@ Block_hash.to_string bh3 in
+  Bytes.set raw 31 '\000' ;
+  Bytes.set raw 30 '\000' ;
+  Block_hash.of_string_exn @@ Bytes.to_string raw
+
+let equal
+    (b1_header,b1_contents : Block_header.t * Store.Block.contents)
+    (b2_header,b2_contents : Block_header.t * Store.Block.contents) =
+  Block_header.equal b1_header b2_header &&
+  b1_contents.message = b2_contents.message
+
+let check_block s h b =
+  Store.Block.Contents.read (s, h) >>= function
+  | Ok bc' ->
+      begin
+        Store.Block.Header.read (s, h) >>= function
+        | Ok bh' when  equal b (bh',bc') ->
+            Lwt.return_unit
+        | Ok _ ->
+            Format.eprintf
+              "Error while reading block %a\n%!"
+              Block_hash.pp_short h ;
+            exit 1
+        | Error err ->
+            Format.eprintf "@[Error while reading block header %a:@ %a\n@]"
+              Block_hash.pp_short h
+              pp_print_error err ;
+            exit 1
+      end
+  | Error err ->
+      Format.eprintf "@[Error while reading block %a:@ %a\n@]"
+        Block_hash.pp_short h
+        pp_print_error err ;
+      exit 1
+
+let test_block s =
+  let s = Store.Chain.get s chain_id in
+  let s = Store.Block.get s in
+  Block.Contents.store (s, bh1) b1_contents >>= fun () ->
+  Block.Contents.store (s, bh2) b2_contents >>= fun () ->
+  Block.Contents.store (s, bh3) b3_contents >>= fun () ->
+  Block.Header.store (s, bh1) b1_header >>= fun () ->
+  Block.Header.store (s, bh2) b2_header >>= fun () ->
+  Block.Header.store (s, bh3) b3_header >>= fun () ->
+  check_block s bh1 b1 >>= fun () ->
+  check_block s bh2 b2 >>= fun () ->
+  check_block s bh3 b3
+
+let test_expand s =
+  let s = Store.Chain.get s chain_id in
+  let s = Store.Block.get s in
+  Block.Contents.store (s, bh1) b1_contents >>= fun () ->
+  Block.Contents.store (s, bh2) b2_contents >>= fun () ->
+  Block.Contents.store (s, bh3) b3_contents >>= fun () ->
+  Block.Contents.store (s, bh3') b3_contents >>= fun () ->
+  Block.Header.store (s, bh1) b1_header >>= fun () ->
+  Block.Header.store (s, bh2) b2_header >>= fun () ->
+  Block.Header.store (s, bh3) b3_header >>= fun () ->
+  Block.Header.store (s, bh3') b3_header >>= fun () ->
+  Base58.complete (Block_hash.to_short_b58check bh1) >>= fun res ->
+  Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh1] ;
+  Base58.complete (Block_hash.to_short_b58check bh2) >>= fun res ->
+  Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh2] ;
+  Base58.complete (Block_hash.to_short_b58check bh3) >>= fun res ->
+  Assert.equal_string_list ~msg:__LOC__
+    (List.sort String.compare res)
+    [Block_hash.to_b58check bh3' ; Block_hash.to_b58check bh3] ;
+  Lwt.return_unit
+
+
+(** Generic store *)
+
+let check (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) k d =
+  Store.read_opt s k >|= function
+  | Some d' when MBytes.equal d d' -> ()
+  | Some d' ->
+      Assert.fail_msg ~expected:(MBytes.to_string d) ~given:(MBytes.to_string d')
+        "Error while reading key %d %S\n%!"
+        Cstruct.(compare (of_bigarray d) (of_bigarray d')) (String.concat Filename.dir_sep k)
+  | None ->
+      Assert.fail_msg ~expected:(MBytes.to_string d) ~given:""
+        "Error while reading key %S\n%!" (String.concat Filename.dir_sep k)
+
+let check_none (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) k =
+  Store.read_opt s k >|= function
+  | None -> ()
+  | Some _ ->
+      Assert.fail_msg
+        "Error while reading non-existent key %S\n%!"
+        (String.concat Filename.dir_sep k)
+
+let test_generic (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
+  Store.store s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
+  Store.store s ["day";"next"] (MBytes.of_string "Jeudi") >>= fun () ->
+  Store.store s ["day";"truc";"chose"] (MBytes.of_string "Vendredi") >>= fun () ->
+  check (module Store) s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
+  check (module Store) s ["day";"next"] (MBytes.of_string "Jeudi") >>= fun () ->
+  check_none (module Store) s ["day"]
+
+let list (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) k =
+  Store.keys s k
+
+let test_generic_list (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
+  Store.store s ["a"; "b"] (MBytes.of_string "Novembre") >>= fun () ->
+  Store.store s ["a"; "c"] (MBytes.of_string "Juin") >>= fun () ->
+  Store.store s ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun () ->
+  Store.store s ["f";] (MBytes.of_string "Avril") >>= fun () ->
+  Store.store s ["g"; "h"] (MBytes.of_string "Avril") >>= fun () ->
+  list (module Store) s [] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__
+    [["a";"b"];["a";"c"];["a";"d";"e"];["f"];["g";"h"]]
+    (List.sort compare l) ;
+  list (module Store) s ["a"] >>= fun l ->
+  Assert.equal_string_list_list
+    ~msg:__LOC__ [["a";"b"]; ["a";"c"]; ["a";"d";"e"]]
+    (List.sort compare l) ;
+  list (module Store) s ["f"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+  list (module Store) s ["g"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [["g";"h"]] (List.sort compare l) ;
+  list (module Store) s ["i"] >>= fun l ->
+  Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+  Lwt.return_unit
+
+(** HashSet *)
+
+open Store_helpers
+
+let test_hashset (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
+  let module BlockSet = Block_hash.Set in
+  let module StoreSet =
+    Make_buffered_set
+      (Make_substore(Store)(struct let name = ["test_set"] end))
+      (Block_hash)
+      (BlockSet) in
+  let bhset = BlockSet.(add bh2 (add bh1 empty)) in
+  StoreSet.store_all s bhset >>= fun () ->
+  StoreSet.read_all s >>= fun bhset' ->
+  Assert.equal_block_set ~msg:__LOC__ bhset bhset' ;
+  let bhset2 = BlockSet.(bhset |> add bh3 |> remove bh1) in
+  StoreSet.store_all s bhset2 >>= fun () ->
+  StoreSet.read_all s >>= fun bhset2' ->
+  Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2' ;
+  StoreSet.fold s ~init:BlockSet.empty
+    ~f:(fun bh acc -> Lwt.return (BlockSet.add bh acc)) >>= fun bhset2'' ->
+  Assert.equal_block_set ~msg:__LOC__ bhset2 bhset2'' ;
+  Store.store s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
+  StoreSet.remove_all s >>= fun () ->
+  StoreSet.read_all s >>= fun empty ->
+  Assert.equal_block_set ~msg:__LOC__ BlockSet.empty empty ;
+  check (module Store) s ["day";"current"] (MBytes.of_string "Mercredi") >>= fun () ->
+  Lwt.return_unit
+
+
+(** HashMap *)
+
+let test_hashmap (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
+  let module BlockMap = Block_hash.Map in
+  let module StoreMap =
+    Make_buffered_map
+      (Make_substore(Store)(struct let name = ["test_map"] end))
+      (Block_hash)
+      (Make_value(struct
+         type t = int * char
+         let encoding =
+           Data_encoding.(tup2 int31 (conv int_of_char char_of_int int8))
+       end))
+      (BlockMap) in
+  let eq = (=) in
+  let map = BlockMap.(empty |> add bh1 (1, 'a') |> add bh2 (2, 'b')) in
+  StoreMap.store_all s map >>= fun () ->
+  StoreMap.read_all s >>= fun map' ->
+  Assert.equal_block_map ~msg:__LOC__ ~eq map map' ;
+  let map2 = map |> BlockMap.add bh3 (3, 'c') |> BlockMap.remove bh1 in
+  StoreMap.store_all s map2 >>= fun () ->
+  StoreMap.read_all s >>= fun map2' ->
+  Assert.equal_block_map ~msg:__LOC__ ~eq map2 map2' ;
+  Lwt.return_unit
+
+(** Functors *)
+
+let test_single (type t)
+    (module Store: Store_sigs.STORE with type t = t) (s: Store.t) =
+  let module Single =
+    Make_single_store
+      (Store)
+      (struct let name = ["plop"] end)
+      (Make_value(struct
+         type t = int * string
+         let encoding = Data_encoding.(tup2 int31 string)
+       end)) in
+  Single.known s >>= fun known ->
+  Assert.is_false ~msg:__LOC__ known ;
+  Single.read_opt s >>= fun v' ->
+  Assert.equal ~msg:__LOC__ None v' ;
+  let v = (3, "Non!") in
+  Single.store s v >>= fun () ->
+  Single.known s >>= fun known ->
+  Assert.is_true ~msg:__LOC__ known ;
+  Single.read_opt s >>= fun v' ->
+  Assert.equal ~msg:__LOC__ (Some v) v' ;
+  Single.remove s >>= fun () ->
+  Single.known s >>= fun known ->
+  Assert.is_false ~msg:__LOC__ known ;
+  Single.read_opt s >>= fun v' ->
+  Assert.equal ~msg:__LOC__ None v' ;
+  Lwt.return_unit
+
+module Sub =
+  Make_substore(Raw_store)(struct let name = ["plop";"plip"] end)
+
+module SubBlocks =
+  Make_indexed_substore
+    (Make_substore(Raw_store)(struct let name = ["blocks"] end))
+    (Block_hash)
+
+module SubBlocksSet =
+  SubBlocks.Make_buffered_set
+    (struct let name = ["test_set"] end)
+    (Block_hash.Set)
+
+module SubBlocksMap =
+  SubBlocks.Make_buffered_map
+    (struct let name = ["test_map"] end)
+    (Make_value(struct
+       type t = int * string
+       let encoding = Data_encoding.(tup2 int31 string)
+     end))
+    (Block_hash.Map)
+
+let test_subblock s =
+  SubBlocksSet.known s bh1 >>= fun known ->
+  Assert.is_false ~msg:__LOC__ known ;
+  SubBlocksSet.store s bh1 >>= fun () ->
+  SubBlocksSet.store s bh2 >>= fun () ->
+  SubBlocksSet.known s bh2 >>= fun known ->
+  Assert.is_true ~msg:__LOC__ known ;
+  SubBlocksSet.read_all s >>= fun set ->
+  let set' = Block_hash.Set.(empty |> add bh1 |> add bh2) in
+  Assert.equal_block_set ~msg:__LOC__ set set' ;
+  SubBlocksSet.remove s bh2 >>= fun () ->
+  let set = Block_hash.Set.(empty |> add bh3' |> add bh3) in
+  SubBlocksSet.store_all s set >>= fun () ->
+  SubBlocksSet.elements s >>= fun elts ->
+  Assert.equal_block_hash_list ~msg:__LOC__
+    (List.sort Block_hash.compare elts)
+    (List.sort Block_hash.compare [bh3 ; bh3']) ;
+  SubBlocksSet.store s bh2 >>= fun () ->
+  SubBlocksSet.remove s bh3 >>= fun () ->
+  SubBlocksSet.elements s >>= fun elts ->
+  Assert.equal_block_hash_list ~msg:__LOC__
+    (List.sort Block_hash.compare elts)
+    (List.sort Block_hash.compare [bh2 ; bh3']) ;
+  SubBlocksMap.known s bh1 >>= fun known ->
+  Assert.is_false ~msg:__LOC__ known ;
+  let v1 = (3, "Non!")
+  and v2 = (12, "Beurk.") in
+  SubBlocksMap.store s bh1 v1 >>= fun () ->
+  SubBlocksMap.store s bh2 v2 >>= fun () ->
+  SubBlocksMap.known s bh1 >>= fun known ->
+  SubBlocksMap.read_opt s bh1 >>= fun v1' ->
+  Assert.equal ~msg:__LOC__ (Some v1) v1' ;
+  Assert.is_true ~msg:__LOC__ known ;
+  let map = Block_hash.Map.(empty |> add bh1 v1 |> add bh2 v2) in
+  SubBlocksMap.read_all s >>= fun map' ->
+  Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
+
+  SubBlocksSet.remove_all s >>= fun () ->
+  SubBlocksSet.elements s >>= fun elts ->
+  Assert.equal_block_hash_list ~msg:__LOC__ elts [] ;
+
+  SubBlocksMap.read_all s >>= fun map' ->
+  Assert.equal_block_map ~eq:(=) ~msg:__LOC__ map map' ;
+
+  SubBlocksSet.store s bh3 >>= fun () ->
+
+  SubBlocks.indexes s >>= fun keys ->
+  Assert.equal_block_hash_list ~msg:__LOC__
+    (List.sort Block_hash.compare keys)
+    (List.sort Block_hash.compare [bh1;bh2;bh3]) ;
+
+  Lwt.return_unit
+
+module SubSubBlocks =
+  Make_indexed_substore
+    (Make_substore(SubBlocks.Store)(struct let name = ["sub_blocks"] end))
+    (Block_hash)
+
+(** *)
+
+let tests_raw : (string * (Raw_store.t -> unit Lwt.t)) list = [
+
+  "init", test_init ;
+
+  "generic", test_generic (module Raw_store) ;
+  "generic_substore", test_generic (module Sub) ;
+  "generic_indexedstore",
+  (fun s -> test_generic (module SubBlocks.Store) (s, bh1)) ;
+  "generic_indexedsubstore",
+  (fun s -> test_generic (module SubSubBlocks.Store) ((s, bh1), bh2)) ;
+
+  "single", test_single (module Raw_store) ;
+  "single_substore", test_single (module Sub) ;
+  "single_indexedstore",
+  (fun s -> test_single (module SubBlocks.Store) (s, bh1)) ;
+  "single_indexedsubstore",
+  (fun s -> test_single (module SubSubBlocks.Store) ((s, bh1), bh2)) ;
+
+  "generic_list", test_generic_list (module Raw_store);
+  "generic_substore_list", test_generic_list (module Sub);
+  "generic_indexedstore_list",
+  (fun s -> test_generic_list (module SubBlocks.Store) (s, bh1));
+  "generic_indexedsubstore_list",
+  (fun s -> test_generic_list (module SubSubBlocks.Store) ((s, bh1), bh2)) ;
+
+  "hashset", test_hashset (module Raw_store) ;
+  "hashset_substore", test_hashset (module Sub) ;
+  "hashset_indexedstore",
+  (fun s -> test_hashset (module SubBlocks.Store) (s, bh1));
+  "hashset_indexedsubstore",
+  (fun s -> test_hashset (module SubSubBlocks.Store) ((s, bh1), bh2)) ;
+
+  "hashmap", test_hashmap (module Raw_store) ;
+  "hashmap_substore", test_hashmap (module Sub) ;
+  "hashmap_indexedstore",
+  (fun s -> test_hashmap (module SubBlocks.Store) (s, bh1));
+  "hashmap_indexedsubstore",
+  (fun s -> test_hashmap (module SubSubBlocks.Store) ((s, bh1), bh2)) ;
+
+  "subblock", test_subblock ;
+
+]
+
+let tests : (string * (Store.t -> unit Lwt.t)) list = [
+  "expand", test_expand ;
+  "block", test_block ;
+]
+
+let tests =
+  List.map
+    (fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_raw_store_init f))
+    tests_raw @
+  List.map
+    (fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_store_init f))
+    tests
diff --git a/vendors/tezos-modded/src/lib_shell/test/test_store_checkpoint.ml b/vendors/tezos-modded/src/lib_shell/test/test_store_checkpoint.ml
new file mode 100644
index 000000000..3819ec6a4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/test/test_store_checkpoint.ml
@@ -0,0 +1,124 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 mapsize = 4_096_000_000L (* ~4 GiB *)
+
+let (//) = Filename.concat
+
+let wrap_raw_store_init f _ () =
+  Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
+    let root = base_dir // "store" in
+    Raw_store.init ~mapsize root >>= function
+    | Ok store ->
+        Lwt.finalize
+          (fun () -> f store)
+          (fun () -> Raw_store.close store ; Lwt.return_unit)
+    | Error err ->
+        Format.kasprintf Pervasives.failwith
+          "@[Cannot initialize store:@ %a@]" pp_print_error err
+  end
+
+(**************************************************************************)
+(** Basic blocks *)
+
+let genesis_block =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+(**************************************************************************)
+(** Block store *)
+
+let lolblock ?(operations = []) header =
+  let operations_hash =
+    Operation_list_list_hash.compute
+      [Operation_list_hash.compute operations] in
+  ( { Block_header.shell =
+        { timestamp = Time.of_seconds (Random.int64 1500L) ;
+          level = 0l ; (* dummy *)
+          proto_level = 0 ; (* dummy *)
+          validation_passes = Random.int 32 ;
+          predecessor = genesis_block ; operations_hash ;
+          fitness = [MBytes.of_string @@ string_of_int @@ String.length header;
+                     MBytes.of_string @@ string_of_int @@ 12] ;
+          context = Context_hash.zero } ;
+      protocol_data = MBytes.of_string header ; } ,
+    { Store.Block.metadata = MBytes.create 0 ;
+      max_operations_ttl = 0 ;
+      message = None ;
+      context = Context_hash.zero ;
+      last_allowed_fork_level = 0l ;
+    } )
+
+
+let (block_header,_) = lolblock "A1"
+let block_hash = Block_header.hash block_header
+
+(****************************************************)
+
+open Store_helpers
+
+let test_single (type t)
+    (module Store:Store_sigs.STORE with type t = t) (s: Store.t) =
+  let module Single =
+    Make_single_store
+      (Store)
+      (struct let name = ["checkpoint"] end)
+      (Store_helpers.Make_value (struct
+         type t = Int32.t * Block_hash.t
+         let encoding = Data_encoding.(tup2 int32 Block_hash.encoding)
+       end
+       ))
+  in
+  (* is there any checkpoint in store *)
+  Single.known s >>= fun is_known ->
+  Assert.is_false ~msg:__LOC__ is_known;
+  Single.read_opt s >>= fun checkpoint' ->
+  Assert.equal_checkpoint ~msg:__LOC__ None checkpoint';
+  (* store new checkpoint: (1, A1) *)
+  let checkpoint =  (1l, block_hash) in
+  Single.store s checkpoint >>= fun () ->
+  Single.known s >>= fun is_known ->
+  Assert.is_true ~msg:__LOC__ is_known;
+  Single.read_opt s >>= fun checkpoint' ->
+  Assert.equal_checkpoint ~msg:__LOC__ (Some checkpoint) checkpoint';
+  (* remove the checkpoint just store *)
+  Single.remove s >>= fun () ->
+  Single.known s >>= fun is_known ->
+  Assert.is_false ~msg:__LOC__ is_known;
+  Single.read_opt s >>= fun checkpoint' ->
+  Assert.equal_checkpoint ~msg:__LOC__ None checkpoint';
+  Lwt.return_unit
+
+(**************************************************************************)
+
+let tests_raw : (string * (Raw_store.t -> unit Lwt.t)) list =
+  [
+    "single", test_single (module Raw_store)
+
+  ]
+
+let tests =
+  List.map (fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_raw_store_init f))
+    tests_raw
diff --git a/vendors/tezos-modded/src/lib_shell/tezos-shell.opam b/vendors/tezos-modded/src/lib_shell/tezos-shell.opam
new file mode 100644
index 000000000..deb3ba687
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/tezos-shell.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-rpc-http"
+  "tezos-p2p"
+  "tezos-shell-services"
+  "tezos-protocol-updater"
+  "tezos-validation"
+  "alcotest-lwt" { with-test }
+  "tezos-embedded-protocol-demo" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_shell/validator.ml b/vendors/tezos-modded/src/lib_shell/validator.ml
new file mode 100644
index 000000000..f499f94e6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/validator.ml
@@ -0,0 +1,160 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Logging.Make_semantic(struct let name = "node.validator" end)
+
+type t = {
+
+  state: State.t ;
+  db: Distributed_db.t ;
+  block_validator: Block_validator.t ;
+  chain_validator_limits: Chain_validator.limits ;
+  peer_validator_limits: Peer_validator.limits ;
+  block_validator_limits: Block_validator.limits ;
+  prevalidator_limits: Prevalidator.limits ;
+
+  valid_block_input: State.Block.t Lwt_watcher.input ;
+  active_chains: Chain_validator.t Chain_id.Table.t ;
+
+}
+
+let create state db
+    peer_validator_limits
+    block_validator_limits
+    block_validator_kind
+    prevalidator_limits
+    chain_validator_limits
+  =
+  Block_validator.create block_validator_limits db block_validator_kind >>=? fun block_validator ->
+  let valid_block_input = Lwt_watcher.create_input () in
+  return
+    { state ; db ;
+      block_validator ;
+      block_validator_limits ; prevalidator_limits ;
+      peer_validator_limits ; chain_validator_limits ;
+      valid_block_input ;
+      active_chains = Chain_id.Table.create 7 }
+
+let activate v ?max_child_ttl ~start_prevalidator chain_state =
+  let chain_id = State.Chain.id chain_state in
+  lwt_log_notice Tag.DSL.(fun f ->
+      f "activate chain %a"
+      -% t event "active_chain"
+      -% a State_logging.chain_id chain_id) >>= fun () ->
+  match Chain_id.Table.find_opt v.active_chains chain_id with
+  |Some nv -> return nv
+  |None ->
+      Chain_validator.create
+        ?max_child_ttl
+        ~start_prevalidator
+        v.peer_validator_limits v.prevalidator_limits
+        v.block_validator
+        v.valid_block_input v.db chain_state
+        v.chain_validator_limits >>=? fun nv ->
+      Chain_id.Table.add v.active_chains chain_id nv ;
+      return nv
+
+let get_exn { active_chains } chain_id =
+  Chain_id.Table.find active_chains chain_id
+
+let get { active_chains } chain_id =
+  match Chain_id.Table.find_opt active_chains chain_id with
+  |Some nv -> Ok nv
+  |None -> error (Validation_errors.Inactive_chain chain_id)
+
+let validate_block v ?(force = false) ?chain_id bytes operations =
+  let hash = Block_hash.hash_bytes [bytes] in
+  match Block_header.of_bytes bytes with
+  | None -> failwith "Cannot parse block header."
+  | Some block ->
+      begin
+        match chain_id with
+        | None -> begin
+            Distributed_db.read_block_header
+              v.db block.shell.predecessor >>= function
+            | None ->
+                failwith "Unknown predecessor (%a), cannot inject the block."
+                  Block_hash.pp_short block.shell.predecessor
+            | Some (chain_id, _bh) -> Lwt.return (get v chain_id)
+          end
+        | Some chain_id ->
+            Lwt.return (get v chain_id) >>=? fun nv ->
+            if force then
+              return nv
+            else
+              Distributed_db.Block_header.known
+                (Chain_validator.chain_db nv)
+                block.shell.predecessor >>= function
+              | true ->
+                  return nv
+              | false ->
+                  failwith "Unknown predecessor (%a), cannot inject the block."
+                    Block_hash.pp_short block.shell.predecessor
+      end >>=? fun nv ->
+      let validation =
+        Chain_validator.validate_block nv ~force hash block operations in
+      return (hash, validation)
+
+let shutdown { active_chains ; block_validator } =
+  let jobs =
+    Block_validator.shutdown block_validator ::
+    Chain_id.Table.fold
+      (fun _ nv acc -> Chain_validator.shutdown nv :: acc)
+      active_chains [] in
+  Lwt.join jobs >>= fun () ->
+  Lwt.return_unit
+
+let watcher { valid_block_input } =
+  Lwt_watcher.create_stream valid_block_input
+
+let inject_operation v ?chain_id op =
+  begin
+    match chain_id with
+    | None -> begin
+        Distributed_db.read_block_header
+          v.db op.Operation.shell.branch >>= function
+        | None ->
+            failwith "Unknown branch (%a), cannot inject the operation."
+              Block_hash.pp_short op.shell.branch
+        | Some (chain_id, _bh) -> Lwt.return (get v chain_id)
+      end
+    | Some chain_id ->
+        Lwt.return (get v chain_id) >>=? fun nv ->
+        Distributed_db.Block_header.known
+          (Chain_validator.chain_db nv)
+          op.shell.branch >>= function
+        | true ->
+            return nv
+        | false ->
+            failwith "Unknown branch (%a), cannot inject the operation."
+              Block_hash.pp_short op.shell.branch
+  end >>=? fun nv ->
+  let pv_opt = Chain_validator.prevalidator nv in
+  match pv_opt with
+  | Some pv -> Prevalidator.inject_operation pv op
+  | None -> failwith "Prevalidator is not running, cannot inject the operation."
+
+let distributed_db { db } = db
diff --git a/vendors/tezos-modded/src/lib_shell/validator.mli b/vendors/tezos-modded/src/lib_shell/validator.mli
new file mode 100644
index 000000000..aa2855f95
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/validator.mli
@@ -0,0 +1,68 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Shell - Main entry point of the validation scheduler. *)
+
+type t
+
+val create:
+  State.t ->
+  Distributed_db.t ->
+  Peer_validator.limits ->
+  Block_validator.limits ->
+  Block_validator.validator_kind ->
+  Prevalidator.limits ->
+  Chain_validator.limits ->
+  t tzresult Lwt.t
+val shutdown: t -> unit Lwt.t
+
+(** Start the validation scheduler of a given chain. *)
+val activate:
+  t ->
+  ?max_child_ttl:int ->
+  start_prevalidator:bool ->
+  State.Chain.t -> Chain_validator.t tzresult Lwt.t
+
+val get: t -> Chain_id.t -> Chain_validator.t tzresult
+val get_exn: t -> Chain_id.t -> Chain_validator.t
+
+(** Force the validation of a block. *)
+val validate_block:
+  t ->
+  ?force:bool ->
+  ?chain_id:Chain_id.t ->
+  MBytes.t -> Operation.t list list ->
+  (Block_hash.t * State.Block.t option tzresult Lwt.t) tzresult Lwt.t
+
+(** Monitor all the valid block (for all activate chains). *)
+val watcher: t -> State.Block.t Lwt_stream.t * Lwt_watcher.stopper
+
+val inject_operation:
+  t ->
+  ?chain_id:Chain_id.t ->
+  Operation.t -> unit tzresult Lwt.t
+
+val distributed_db: t -> Distributed_db.t
diff --git a/vendors/tezos-modded/src/lib_shell/worker.ml b/vendors/tezos-modded/src/lib_shell/worker.ml
new file mode 100644
index 000000000..344e9563e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker.ml
@@ -0,0 +1,637 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type NAME = sig
+  val base : string list
+  type t
+  val encoding : t Data_encoding.t
+  val pp : Format.formatter -> t -> unit
+end
+
+module type EVENT = sig
+  type t
+
+  val level : t -> Logging.level
+  val encoding : t Data_encoding.t
+  val pp : Format.formatter -> t -> unit
+end
+
+module type REQUEST = sig
+  type 'a t
+  type view
+
+  val view : 'a t -> view
+  val encoding : view Data_encoding.t
+  val pp : Format.formatter -> view -> unit
+end
+
+module type TYPES = sig
+  type state
+  type parameters
+  type view
+
+  val view : state -> parameters -> view
+  val encoding : view Data_encoding.t
+  val pp : Format.formatter -> view -> unit
+end
+
+(** An error returned when trying to communicate with a worker that
+    has been closed.*)
+type worker_name = {base: string; name:string}
+type Error_monad.error += Closed of worker_name
+
+let () =
+  register_error_kind `Permanent
+    ~id:("worker.closed")
+    ~title:("Worker closed")
+    ~description:
+      ("An operation on a worker could not complete \
+        before it was shut down.")
+    ~pp: (fun ppf w ->
+        Format.fprintf ppf
+          "Worker %s[%s] has been shut down."
+          w.base w.name)
+    Data_encoding.(
+      conv
+        (fun { base ; name } -> (base,name))
+        (fun (name,base) -> { base ; name })
+        (obj1
+           (req "worker" (tup2 string string))
+        )
+    )
+    (function Closed w -> Some w | _ -> None)
+    (fun w -> Closed w)
+
+module type T = sig
+
+  module Name: NAME
+  module Event: EVENT
+  module Request: REQUEST
+  module Types: TYPES
+
+  (** A handle to a specific worker, parameterized by the type of
+      internal message buffer. *)
+  type 'kind t
+
+  (** A handle to a table of workers. *)
+  type 'kind table
+
+  (** Internal buffer kinds used as parameters to {!t}. *)
+  type 'a queue and bounded and infinite
+  type dropbox
+
+
+  (** Supported kinds of internal buffers. *)
+  type _ buffer_kind =
+    | Queue : infinite queue buffer_kind
+    | Bounded : { size : int } -> bounded queue buffer_kind
+    | Dropbox :
+        { merge : (dropbox t ->
+                   any_request ->
+                   any_request option ->
+                   any_request option) }
+      -> dropbox buffer_kind
+  and any_request = Any_request : _ Request.t -> any_request
+
+  (** Create a table of workers. *)
+  val create_table : 'kind buffer_kind -> 'kind table
+
+  (** The callback handlers specific to each worker instance. *)
+  module type HANDLERS = sig
+
+    (** Placeholder replaced with {!t} with the right parameters
+        provided by the type of buffer chosen at {!launch}.*)
+    type self
+
+    (** Builds the initial internal state of a worker at launch.
+        It is possible to initialize the message queue.
+        Of course calling {!state} will fail at that point. *)
+    val on_launch :
+      self -> Name.t -> Types.parameters -> Types.state tzresult Lwt.t
+
+    (** The main request processor, i.e. the body of the event loop. *)
+    val on_request :
+      self -> 'a Request.t -> 'a tzresult Lwt.t
+
+    (** Called when no request has been made before the timeout, if
+        the parameter has been passed to {!launch}. *)
+    val on_no_request :
+      self -> unit tzresult Lwt.t
+
+    (** A function called when terminating a worker. *)
+    val on_close :
+      self -> unit Lwt.t
+
+    (** A function called at the end of the worker loop in case of an
+        abnormal error. This function can handle the error by
+        returning [Ok ()], or leave the default unexpected error
+        behaviour by returning its parameter. A possibility is to
+        handle the error for ad-hoc logging, and still use
+        {!trigger_shutdown} to kill the worker. *)
+    val on_error :
+      self ->
+      Request.view ->
+      Worker_types.request_status ->
+      error list ->
+      unit tzresult Lwt.t
+
+    (** A function called at the end of the worker loop in case of a
+        successful treatment of the current request. *)
+    val on_completion :
+      self ->
+      'a Request.t -> 'a ->
+      Worker_types.request_status ->
+      unit Lwt.t
+
+  end
+
+  (** Creates a new worker instance.
+      Parameter [queue_size] not passed means unlimited queue. *)
+  val launch :
+    'kind table -> ?timeout:float ->
+    Worker_types.limits -> Name.t -> Types.parameters ->
+    (module HANDLERS with type self = 'kind t) ->
+    'kind t tzresult Lwt.t
+
+  (** Triggers a worker termination and waits for its completion.
+      Cannot be called from within the handlers.  *)
+  val shutdown :
+    _ t -> unit Lwt.t
+
+  (** Adds a message to the queue and waits for its result.
+      Cannot be called from within the handlers. *)
+  val push_request_and_wait :
+    _ queue t -> 'a Request.t -> 'a tzresult Lwt.t
+
+  (** Adds a message to the queue. *)
+  val push_request :
+    _ queue t -> 'a Request.t -> unit Lwt.t
+
+  (** Adds a message to the queue immediately.
+      Returns [false] if the queue is full. *)
+  val try_push_request_now :
+    bounded queue t -> 'a Request.t -> bool
+
+  (** Adds a message to the queue immediately. *)
+  val push_request_now :
+    infinite queue t -> 'a Request.t -> unit
+
+  (** Sets the current request. *)
+  val drop_request :
+    dropbox t -> 'a Request.t -> unit
+
+  (** Detects cancelation from within the request handler to stop
+      asynchronous operations. *)
+  val protect :
+    _ t ->
+    ?on_error: (error list -> 'b tzresult Lwt.t) ->
+    (unit -> 'b tzresult Lwt.t) ->
+    'b tzresult Lwt.t
+
+  (** Exports the canceler to allow cancelation of other tasks when this
+      worker is shutdowned or when it dies. *)
+  val canceler : _ t -> Lwt_canceler.t
+
+  (** Triggers a worker termination. *)
+  val trigger_shutdown : _ t -> unit
+
+  (** Recod an event in the backlog. *)
+  val record_event : _ t -> Event.t -> unit
+
+  (** Record an event and make sure it is logged. *)
+  val log_event : _ t -> Event.t -> unit Lwt.t
+
+  (** Access the internal state, once initialized. *)
+  val state : _ t -> Types.state
+
+  (** Access the event backlog. *)
+  val last_events : _ t -> (Logging.level * Event.t list) list
+
+  (** Introspect the message queue, gives the times requests were pushed. *)
+  val pending_requests : _ queue t -> (Time.t * Request.view) list
+
+  (** Get the running status of a worker. *)
+  val status : _ t -> Worker_types.worker_status
+
+  (** Get the request being treated by a worker.
+      Gives the time the request was pushed, and the time its
+      treatment started. *)
+  val current_request : _ t -> (Time.t * Time.t * Request.view) option
+
+  (** Introspect the state of a worker. *)
+  val view : _ t -> Types.view
+
+  (** Lists the running workers in this group.
+      After they are killed, workers are kept in the table
+      for a number of seconds given in the {!Worker_types.limits}. *)
+  val list : 'a table -> (Name.t * 'a t) list
+end
+
+module Make
+    (Name : NAME)
+    (Event : EVENT)
+    (Request : REQUEST)
+    (Types : TYPES) = struct
+
+  module Name = Name
+  module Event = Event
+  module Request = Request
+  module Types = Types
+
+  let base_name = String.concat "." Name.base
+
+  type message = Message: 'a Request.t * 'a tzresult Lwt.u option -> message
+
+  type 'a queue and bounded and infinite
+  type dropbox
+
+  type _ buffer_kind =
+    | Queue : infinite queue buffer_kind
+    | Bounded : { size : int } -> bounded queue buffer_kind
+    | Dropbox :
+        { merge : (dropbox t ->
+                   any_request ->
+                   any_request option ->
+                   any_request option) }
+      -> dropbox buffer_kind
+  and any_request = Any_request : _ Request.t -> any_request
+
+  and _ buffer =
+    | Queue_buffer : (Time.t * message) Lwt_pipe.t -> infinite queue buffer
+    | Bounded_buffer : (Time.t * message) Lwt_pipe.t -> bounded queue buffer
+    | Dropbox_buffer : (Time.t * message) Lwt_dropbox.t -> dropbox buffer
+
+  and 'kind t = {
+    limits : Worker_types.limits ;
+    timeout : float option ;
+    parameters : Types.parameters ;
+    mutable (* only for init *) worker : unit Lwt.t ;
+    mutable (* only for init *) state : Types.state option ;
+    buffer : 'kind buffer ;
+    event_log : (Logging.level * Event.t Ring.t) list ;
+    logger : (module Logging.LOG) ;
+    canceler : Lwt_canceler.t ;
+    name : Name.t ;
+    id : int ;
+    mutable status : Worker_types.worker_status ;
+    mutable current_request : (Time.t * Time.t * Request.view) option ;
+    table : 'kind table ;
+  }
+  and 'kind table = {
+    buffer_kind : 'kind buffer_kind ;
+    mutable last_id : int ;
+    instances : (Name.t, 'kind t) Hashtbl.t ;
+    zombies : (int, 'kind t) Hashtbl.t
+  }
+
+  let queue_item ?u r =
+    Time.now (),
+    Message (r, u)
+
+  let drop_request (w : dropbox t) request =
+    let Dropbox { merge } = w.table.buffer_kind in
+    let Dropbox_buffer message_box = w.buffer in
+    try
+      match
+        match Lwt_dropbox.peek message_box with
+        | None ->
+            merge w (Any_request request) None
+        | Some (_, Message (old, _)) ->
+            Lwt.ignore_result (Lwt_dropbox.take message_box) ;
+            merge w (Any_request request) (Some (Any_request old))
+      with
+      | None -> ()
+      | Some (Any_request neu) ->
+          Lwt_dropbox.put message_box (Time.now (), Message (neu, None))
+    with Lwt_dropbox.Closed -> ()
+
+  let push_request (type a) (w : a queue t) request =
+    match w.buffer with
+    | Queue_buffer message_queue ->
+        Lwt_pipe.push message_queue (queue_item request)
+    | Bounded_buffer message_queue ->
+        Lwt_pipe.push message_queue (queue_item request)
+
+  let push_request_now (w : infinite queue t) request =
+    let Queue_buffer message_queue = w.buffer in
+    Lwt_pipe.push_now_exn message_queue (queue_item request)
+
+  let try_push_request_now (w : bounded queue t) request =
+    let Bounded_buffer message_queue = w.buffer in
+    Lwt_pipe.push_now message_queue (queue_item request)
+
+  let push_request_and_wait (type a) (w : a queue t) request =
+    let message_queue = match w.buffer with
+      | Queue_buffer message_queue -> message_queue
+      | Bounded_buffer message_queue -> message_queue in
+    let t, u = Lwt.wait () in
+    Lwt.catch
+      (fun () ->
+         Lwt_pipe.push message_queue (queue_item ~u request) >>= fun () ->
+         t)
+      (function
+        | Lwt_pipe.Closed ->
+            let name = Format.asprintf "%a" Name.pp w.name in
+            fail (Closed {base=base_name; name})
+        | exn -> fail (Exn exn))
+
+  let close (type a) (w : a t) =
+    let wakeup = function
+      | _, Message (_, Some u) ->
+          let name = Format.asprintf "%a" Name.pp w.name in
+          Lwt.wakeup_later u (Error [ Closed {base=base_name; name} ])
+      | _ -> () in
+    let close_queue message_queue =
+      let messages = Lwt_pipe.pop_all_now message_queue in
+      List.iter wakeup messages ;
+      Lwt_pipe.close message_queue in
+    match w.buffer with
+    | Queue_buffer message_queue -> close_queue message_queue
+    | Bounded_buffer message_queue -> close_queue message_queue
+    | Dropbox_buffer message_box ->
+        Option.iter ~f:wakeup (Lwt_dropbox.peek message_box) ;
+        Lwt_dropbox.close message_box
+
+  let pop (type a) (w : a t) =
+    let pop_queue message_queue =
+      match w.timeout with
+      | None ->
+          Lwt_pipe.pop message_queue >>= fun m ->
+          return_some m
+      | Some timeout ->
+          Lwt_pipe.pop_with_timeout
+            (Lwt_unix.sleep timeout) message_queue >>= fun m ->
+          return m in
+    match w.buffer with
+    | Queue_buffer message_queue -> pop_queue message_queue
+    | Bounded_buffer message_queue -> pop_queue message_queue
+    | Dropbox_buffer message_box ->
+        match w.timeout with
+        | None ->
+            Lwt_dropbox.take message_box >>= fun m ->
+            return_some m
+        | Some timeout ->
+            Lwt_dropbox.take_with_timeout
+              (Lwt_unix.sleep timeout) message_box >>= fun m ->
+            return m
+
+  let trigger_shutdown w =
+    Lwt.ignore_result (Lwt_canceler.cancel w.canceler)
+
+  let canceler { canceler } = canceler
+
+  let log_event w evt =
+    let (module Logger) = w.logger in
+    let level = Event.level evt in
+    let log =
+      match level with
+      | Debug -> Logger.lwt_debug
+      | Info -> Logger.lwt_log_info
+      | Notice -> Logger.lwt_log_notice
+      | Warning -> Logger.lwt_warn
+      | Error -> Logger.lwt_log_error
+      | Fatal -> Logger.lwt_fatal_error in
+    log "@[<v 0>%a@]" Event.pp evt >>= fun () ->
+    if level >= w.limits.backlog_level then
+      Ring.add (List.assoc level w.event_log) evt ;
+    Lwt.return_unit
+
+  let record_event w evt =
+    Lwt.ignore_result (log_event w evt)
+
+  module type HANDLERS = sig
+    type self
+    val on_launch :
+      self -> Name.t -> Types.parameters -> Types.state tzresult Lwt.t
+    val on_request :
+      self -> 'a Request.t -> 'a tzresult Lwt.t
+    val on_no_request :
+      self -> unit tzresult Lwt.t
+    val on_close :
+      self -> unit Lwt.t
+    val on_error :
+      self -> Request.view -> Worker_types.request_status -> error list -> unit tzresult Lwt.t
+    val on_completion :
+      self -> 'a Request.t -> 'a -> Worker_types.request_status -> unit Lwt.t
+  end
+
+  let create_table buffer_kind =
+    { buffer_kind ;
+      last_id = 0 ;
+      instances = Hashtbl.create 10 ;
+      zombies = Hashtbl.create 10 }
+
+  let worker_loop (type kind) handlers (w : kind t) =
+    let (module Handlers : HANDLERS with type self = kind t) = handlers in
+    let (module Logger) = w.logger in
+    let do_close errs =
+      let t0 = match w.status with
+        | Running t0 -> t0
+        | _ -> assert false in
+      w.status <- Closing (t0, Time.now ()) ;
+      close w ;
+      Lwt_canceler.cancel w.canceler >>= fun () ->
+      w.status <- Closed (t0, Time.now (), errs) ;
+      Hashtbl.remove w.table.instances w.name ;
+      Handlers.on_close w >>= fun () ->
+      w.state <- None ;
+      Hashtbl.add w.table.zombies w.id w ;
+      Lwt.ignore_result
+        (Lwt_unix.sleep w.limits.zombie_memory >>= fun () ->
+         List.iter (fun (_, ring) -> Ring.clear ring) w.event_log ;
+         Lwt_unix.sleep (w.limits.zombie_lifetime -. w.limits.zombie_memory) >>= fun () ->
+         Hashtbl.remove w.table.zombies w.id ;
+         Lwt.return_unit) ;
+      Lwt.return_unit in
+    let rec loop () =
+      begin
+        protect ~canceler:w.canceler begin fun () ->
+          pop w
+        end >>=? function
+        | None -> Handlers.on_no_request w
+        | Some (pushed, Message (request, u)) ->
+            let current_request = Request.view request in
+            let treated = Time.now () in
+            w.current_request <- Some (pushed, treated, current_request) ;
+            Logger.debug "@[<v 2>Request:@,%a@]"
+              Request.pp current_request ;
+            match u with
+            | None ->
+                Handlers.on_request w request >>=? fun res ->
+                let completed = Time.now () in
+                w.current_request <- None ;
+                Handlers.on_completion w
+                  request res Worker_types.{ pushed ; treated ; completed } >>= fun () ->
+                return_unit
+            | Some u ->
+                Handlers.on_request w request >>= fun res ->
+                Lwt.wakeup_later u res ;
+                Lwt.return res >>=? fun res ->
+                let completed = Time.now () in
+                w.current_request <- None ;
+                Handlers.on_completion w
+                  request res Worker_types.{ pushed ; treated ; completed } >>= fun () ->
+                return_unit
+      end >>= function
+      | Ok () ->
+          loop ()
+      | Error [Canceled | Exn Lwt.Canceled | Exn Lwt_pipe.Closed | Exn Lwt_dropbox.Closed ] ->
+          Logger.lwt_log_notice
+            "@[Worker terminated [%a] @]"
+            Name.pp w.name  >>= fun () ->
+          do_close None
+      | Error errs ->
+          begin match w.current_request with
+            | Some (pushed, treated, request) ->
+                let completed = Time.now () in
+                w.current_request <- None ;
+                Handlers.on_error w
+                  request Worker_types.{ pushed ; treated ; completed } errs
+            | None -> assert false
+          end >>= function
+          | Ok () ->
+              loop ()
+          | Error ([Timeout] as errs) ->
+              Logger.lwt_log_notice
+                "@[Worker terminated with timeout [%a] @]"
+                Name.pp w.name  >>= fun () ->
+              do_close (Some errs)
+          | Error errs ->
+              Logger.lwt_log_error
+                "@[<v 0>Worker crashed [%a]:@,%a@]"
+                Name.pp w.name
+                (Format.pp_print_list Error_monad.pp) errs >>= fun () ->
+              do_close (Some errs) in
+    loop ()
+
+  let launch
+    : type kind.
+      kind table -> ?timeout:float ->
+      Worker_types.limits -> Name.t -> Types.parameters ->
+      (module HANDLERS with type self = kind t) ->
+      kind t tzresult Lwt.t
+    = fun table ?timeout limits name parameters (module Handlers) ->
+      let name_s =
+        Format.asprintf "%a" Name.pp name in
+      let full_name =
+        if name_s = "" then base_name else Format.asprintf "%s(%s)" base_name name_s in
+      let id =
+        table.last_id <- table.last_id + 1 ;
+        table.last_id in
+      let id_name =
+        if name_s = "" then base_name else Format.asprintf "%s(%d)" base_name id in
+      if Hashtbl.mem table.instances name then
+        invalid_arg (Format.asprintf "Worker.launch: duplicate worker %s" full_name) ;
+      let canceler = Lwt_canceler.create () in
+      let buffer : kind buffer =
+        match table.buffer_kind with
+        | Queue ->
+            Queue_buffer (Lwt_pipe.create ())
+        | Bounded { size } ->
+            Bounded_buffer (Lwt_pipe.create ~size:(size, (fun _ -> 1)) ())
+        | Dropbox _ ->
+            Dropbox_buffer (Lwt_dropbox.create ()) in
+      let event_log =
+        let levels =
+          [ Logging.Debug ; Info ; Notice ; Warning ; Error ; Fatal ] in
+        List.map (fun l -> l, Ring.create limits.backlog_size) levels in
+      let module Logger = Logging.Make_unregistered(struct let name = id_name end) in
+      let w = { limits ; parameters ; name ; canceler ;
+                table ; buffer ; logger = (module Logger) ;
+                state = None ; id ;
+                worker = Lwt.return_unit ;
+                event_log ; timeout ;
+                current_request = None ;
+                status = Launching (Time.now ())} in
+      begin
+        if id_name = base_name then
+          Logger.lwt_log_notice "Worker started"
+        else
+          Logger.lwt_log_notice "Worker started for %s" name_s
+      end >>= fun () ->
+      Hashtbl.add table.instances name w ;
+      Handlers.on_launch w name parameters >>=? fun state ->
+      w.status <- Running (Time.now ()) ;
+      w.state <- Some state ;
+      w.worker <-
+        Lwt_utils.worker
+          full_name
+          ~run:(fun () -> worker_loop (module Handlers) w)
+          ~cancel:(fun () -> Lwt_canceler.cancel w.canceler) ;
+      return w
+
+  let shutdown w =
+    let (module Logger) = w.logger in
+    Logger.lwt_debug "Triggering shutdown" >>= fun () ->
+    Lwt_canceler.cancel w.canceler >>= fun () ->
+    w.worker
+
+  let state w =
+    match w.state, w.status with
+    | None, Launching _  ->
+        invalid_arg
+          (Format.asprintf
+             "Worker.state (%s[%a]): \
+              state called before worker was initialized"
+             base_name Name.pp w.name)
+    | None, (Closing _ | Closed _)  ->
+        invalid_arg
+          (Format.asprintf
+             "Worker.state (%s[%a]): \
+              state called after worker was terminated"
+             base_name Name.pp w.name)
+    | None, _  -> assert false
+    | Some state, _ -> state
+
+  let last_events w =
+    List.map
+      (fun (level, ring) -> (level, Ring.elements ring))
+      w.event_log
+
+  let pending_requests (type a) (w : a queue t) =
+    let message_queue = match w.buffer with
+      | Queue_buffer message_queue -> message_queue
+      | Bounded_buffer message_queue -> message_queue in
+    List.map
+      (function (t, Message (req, _)) -> t, Request.view req)
+      (Lwt_pipe.peek_all message_queue)
+
+  let status { status } = status
+
+  let current_request { current_request } = current_request
+
+  let view w =
+    Types.view (state w) w.parameters
+
+  let list { instances } =
+    Hashtbl.fold
+      (fun n w acc -> (n, w) :: acc)
+      instances []
+
+  let protect { canceler } ?on_error f =
+    protect ?on_error ~canceler f
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell/worker.mli b/vendors/tezos-modded/src/lib_shell/worker.mli
new file mode 100644
index 000000000..54288e623
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker.mli
@@ -0,0 +1,301 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Lwt based local event loops with automated introspection *)
+
+(** {2 Parameters to build a worker group} *)
+
+(** The name of the group of workers corresponding to an instanciation
+    of {!Make}, as well as the name of each worker in that group. *)
+module type NAME = sig
+
+  (** The name/path of the worker group *)
+  val base : string list
+
+  (** The abstract name of a single worker *)
+  type t
+
+  (** Serializer for the introspection RPCs *)
+  val encoding : t Data_encoding.t
+
+  (** Pretty printer for displaying the worker name *)
+  val pp : Format.formatter -> t -> unit
+
+end
+
+(** Events that are used for logging and introspection.
+    Events are pretty printed immediately in the log, and stored in
+    the worker's event backlog for introspection. *)
+module type EVENT = sig
+
+  (** The type of an event. *)
+  type t
+
+  (** Assigns a logging level to each event.
+      Events can be ignored for logging w.r.t. the global node configuration.
+      Events can be ignored for introspection w.r.t. to the worker's
+      {!Worker_types.limits}. *)
+  val level : t -> Logging.level
+
+  (** Serializer for the introspection RPCs *)
+  val encoding : t Data_encoding.t
+
+  (** Pretty printer, also used for logging *)
+  val pp : Format.formatter -> t -> unit
+
+end
+
+(** The type of messages that are fed to the worker's event loop. *)
+module type REQUEST = sig
+
+  (** The type of events.
+      It is possible to wait for an event to be processed from outside
+      the worker using {!push_request_and_wait}. In this case, the
+      handler for this event can return a value. The parameter is the
+      type of this value. *)
+  type 'a t
+
+  (** As requests can contain arbitrary data that may not be
+      serializable and are polymorphic, this view type is a
+      monomorphic projection sufficient for introspection. *)
+  type view
+
+  (** The projection function from full request to simple views. *)
+  val view : 'a t -> view
+
+  (** Serializer for the introspection RPCs *)
+  val encoding : view Data_encoding.t
+
+  (** Pretty printer, also used for logging by {!Request_event}. *)
+  val pp : Format.formatter -> view -> unit
+
+end
+
+(** The (imperative) state of the event loop. *)
+module type TYPES = sig
+
+  (** The internal state that is passed to the event handlers. *)
+  type state
+
+  (** The parameters provided when launching a new worker. *)
+  type parameters
+
+  (** A simplified view of the worker's state for introspection. *)
+  type view
+
+  (** The projection function from full state to simple views. *)
+  val view : state -> parameters -> view
+
+  (** Serializer for the introspection RPCs *)
+  val encoding : view Data_encoding.t
+
+  (** Pretty printer for introspection. *)
+  val pp : Format.formatter -> view -> unit
+
+end
+
+(** {2 Worker group maker} *)
+
+(** An error returned when trying to communicate with a worker that
+    has been closed. *)
+type worker_name = {base: string; name:string}
+type Error_monad.error += Closed of worker_name
+
+(** Functor to build a group of workers.
+    At that point, all the types are fixed and introspectable,
+    but the actual parameters and event handlers can be tweaked
+    for each individual worker. *)
+module type T = sig
+
+  module Name: NAME
+  module Event: EVENT
+  module Request: REQUEST
+  module Types: TYPES
+
+  (** A handle to a specific worker, parameterized by the type of
+      internal message buffer. *)
+  type 'kind t
+
+  (** A handle to a table of workers. *)
+  type 'kind table
+
+  (** Internal buffer kinds used as parameters to {!t}. *)
+  type 'a queue and bounded and infinite
+  type dropbox
+
+
+  (** Supported kinds of internal buffers. *)
+  type _ buffer_kind =
+    | Queue : infinite queue buffer_kind
+    | Bounded : { size : int } -> bounded queue buffer_kind
+    | Dropbox :
+        { merge : (dropbox t ->
+                   any_request ->
+                   any_request option ->
+                   any_request option) }
+      -> dropbox buffer_kind
+  and any_request = Any_request : _ Request.t -> any_request
+
+  (** Create a table of workers. *)
+  val create_table : 'kind buffer_kind -> 'kind table
+
+  (** The callback handlers specific to each worker instance. *)
+  module type HANDLERS = sig
+
+    (** Placeholder replaced with {!t} with the right parameters
+        provided by the type of buffer chosen at {!launch}.*)
+    type self
+
+    (** Builds the initial internal state of a worker at launch.
+        It is possible to initialize the message queue.
+        Of course calling {!state} will fail at that point. *)
+    val on_launch :
+      self -> Name.t -> Types.parameters -> Types.state tzresult Lwt.t
+
+    (** The main request processor, i.e. the body of the event loop. *)
+    val on_request :
+      self -> 'a Request.t -> 'a tzresult Lwt.t
+
+    (** Called when no request has been made before the timeout, if
+        the parameter has been passed to {!launch}. *)
+    val on_no_request :
+      self -> unit tzresult Lwt.t
+
+    (** A function called when terminating a worker. *)
+    val on_close :
+      self -> unit Lwt.t
+
+    (** A function called at the end of the worker loop in case of an
+        abnormal error. This function can handle the error by
+        returning [Ok ()], or leave the default unexpected error
+        behaviour by returning its parameter. A possibility is to
+        handle the error for ad-hoc logging, and still use
+        {!trigger_shutdown} to kill the worker. *)
+    val on_error :
+      self ->
+      Request.view ->
+      Worker_types.request_status ->
+      error list ->
+      unit tzresult Lwt.t
+
+    (** A function called at the end of the worker loop in case of a
+        successful treatment of the current request. *)
+    val on_completion :
+      self ->
+      'a Request.t -> 'a ->
+      Worker_types.request_status ->
+      unit Lwt.t
+
+  end
+
+  (** Creates a new worker instance.
+      Parameter [queue_size] not passed means unlimited queue. *)
+  val launch :
+    'kind table -> ?timeout:float ->
+    Worker_types.limits -> Name.t -> Types.parameters ->
+    (module HANDLERS with type self = 'kind t) ->
+    'kind t tzresult Lwt.t
+
+  (** Triggers a worker termination and waits for its completion.
+      Cannot be called from within the handlers.  *)
+  val shutdown :
+    _ t -> unit Lwt.t
+
+  (** Adds a message to the queue and waits for its result.
+      Cannot be called from within the handlers. *)
+  val push_request_and_wait :
+    _ queue t -> 'a Request.t -> 'a tzresult Lwt.t
+
+  (** Adds a message to the queue. *)
+  val push_request :
+    _ queue t -> 'a Request.t -> unit Lwt.t
+
+  (** Adds a message to the queue immediately.
+      Returns [false] if the queue is full. *)
+  val try_push_request_now :
+    bounded queue t -> 'a Request.t -> bool
+
+  (** Adds a message to the queue immediately. *)
+  val push_request_now :
+    infinite queue t -> 'a Request.t -> unit
+
+  (** Sets the current request. *)
+  val drop_request :
+    dropbox t -> 'a Request.t -> unit
+
+  (** Detects cancelation from within the request handler to stop
+      asynchronous operations. *)
+  val protect :
+    _ t ->
+    ?on_error: (error list -> 'b tzresult Lwt.t) ->
+    (unit -> 'b tzresult Lwt.t) ->
+    'b tzresult Lwt.t
+
+  (** Exports the canceler to allow cancelation of other tasks when this
+      worker is shutdowned or when it dies. *)
+  val canceler : _ t -> Lwt_canceler.t
+
+  (** Triggers a worker termination. *)
+  val trigger_shutdown : _ t -> unit
+
+  (** Recod an event in the backlog. *)
+  val record_event : _ t -> Event.t -> unit
+
+  (** Record an event and make sure it is logged. *)
+  val log_event : _ t -> Event.t -> unit Lwt.t
+
+  (** Access the internal state, once initialized. *)
+  val state : _ t -> Types.state
+
+  (** Access the event backlog. *)
+  val last_events : _ t -> (Logging.level * Event.t list) list
+
+  (** Introspect the message queue, gives the times requests were pushed. *)
+  val pending_requests : _ queue t -> (Time.t * Request.view) list
+
+  (** Get the running status of a worker. *)
+  val status : _ t -> Worker_types.worker_status
+
+  (** Get the request being treated by a worker.
+      Gives the time the request was pushed, and the time its
+      treatment started. *)
+  val current_request : _ t -> (Time.t * Time.t * Request.view) option
+
+  (** Introspect the state of a worker. *)
+  val view : _ t -> Types.view
+
+  (** Lists the running workers in this group.
+      After they are killed, workers are kept in the table
+      for a number of seconds given in the {!Worker_types.limits}. *)
+  val list : 'a table -> (Name.t * 'a t) list
+end
+
+
+module Make (Name : NAME) (Event : EVENT) (Request : REQUEST) (Types : TYPES)
+  : T with module Name = Name
+       and module Event = Event
+       and module Request = Request
+       and module Types = Types
diff --git a/vendors/tezos-modded/src/lib_shell/worker_directory.ml b/vendors/tezos-modded/src/lib_shell/worker_directory.ml
new file mode 100644
index 000000000..89ee83adb
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker_directory.ml
@@ -0,0 +1,121 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 build_rpc_directory state =
+
+  let dir : unit RPC_directory.t ref = ref RPC_directory.empty in
+  let register0 s f =
+    dir := RPC_directory.register !dir s (fun () p q -> f p q) in
+  let register1 s f =
+    dir := RPC_directory.register !dir s (fun ((), a) p q -> f a p q) in
+  let register2 s f =
+    dir := RPC_directory.register !dir s (fun (((), a), b) p q -> f a b p q) in
+
+  (* Workers : Prevalidators *)
+
+  register0  Worker_services.Prevalidators.S.list begin fun () () ->
+    let workers = Prevalidator.running_workers () in
+    let statuses =
+      List.map
+        (fun (chain_id, _, t) -> (chain_id, Prevalidator.status t))
+        workers in
+    return statuses
+  end ;
+
+  register1 Worker_services.Prevalidators.S.state begin fun chain () () ->
+    Chain_directory.get_chain_id state chain >>= fun chain_id ->
+    let workers = Prevalidator.running_workers () in
+    let (_, _, t) =
+      (* NOTE: it is technically possible to use the Prevalidator interface to
+       * register multiple Prevalidator for a single chain (using distinct
+       * protocols). However, this is never done. *)
+      List.find (fun (c, _, _) -> Chain_id.equal c chain_id) workers in
+    let status = Prevalidator.status t in
+    let pending_requests = Prevalidator.pending_requests t in
+    let backlog = Prevalidator.last_events t in
+    let current_request = Prevalidator.current_request t in
+    return
+      { Worker_types.
+        status ;
+        pending_requests ;
+        backlog ;
+        current_request }
+  end ;
+
+  (* Workers : Block_validator *)
+
+  register0 Worker_services.Block_validator.S.state begin fun () () ->
+    let w = Block_validator.running_worker () in
+    return
+      { Worker_types.status = Block_validator.status w ;
+        pending_requests = Block_validator.pending_requests w ;
+        backlog = Block_validator.last_events w ;
+        current_request = Block_validator.current_request w }
+  end ;
+
+  (* Workers : Peer validators *)
+
+  register1 Worker_services.Peer_validators.S.list begin fun chain () () ->
+    Chain_directory.get_chain_id state chain >>= fun chain_id ->
+    return
+      (List.filter_map
+         (fun ((id, peer_id), w) ->
+            if Chain_id.equal id chain_id then
+              Some (peer_id, Peer_validator.status w)
+            else None)
+         (Peer_validator.running_workers ()))
+  end ;
+
+  register2 Worker_services.Peer_validators.S.state begin fun chain peer_id () () ->
+    Chain_directory.get_chain_id state chain >>= fun chain_id ->
+    let w = List.assoc (chain_id, peer_id) (Peer_validator.running_workers ()) in
+    return
+      { Worker_types.status = Peer_validator.status w ;
+        pending_requests = [] ;
+        backlog = Peer_validator.last_events w ;
+        current_request = Peer_validator.current_request w }
+  end ;
+
+  (* Workers : Net validators *)
+
+  register0 Worker_services.Chain_validators.S.list begin fun () () ->
+    return
+      (List.map
+         (fun (id, w) -> (id, Chain_validator.status w))
+         (Chain_validator.running_workers ()))
+  end ;
+
+  register1 Worker_services.Chain_validators.S.state begin fun chain () () ->
+    Chain_directory.get_chain_id state chain >>= fun chain_id ->
+    let w = List.assoc chain_id (Chain_validator.running_workers ()) in
+    return
+      { Worker_types.status = Chain_validator.status w ;
+        pending_requests = Chain_validator.pending_requests w ;
+        backlog = Chain_validator.last_events w ;
+        current_request = Chain_validator.current_request w }
+  end ;
+
+  !dir
diff --git a/vendors/tezos-modded/src/lib_shell/worker_directory.mli b/vendors/tezos-modded/src/lib_shell/worker_directory.mli
new file mode 100644
index 000000000..8bb139e7e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker_directory.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 build_rpc_directory: State.t -> unit RPC_directory.t
diff --git a/vendors/tezos-modded/src/lib_shell/worker_logging.ml b/vendors/tezos-modded/src/lib_shell/worker_logging.ml
new file mode 100644
index 000000000..253c2c8c0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker_logging.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "node.worker" end)
diff --git a/vendors/tezos-modded/src/lib_shell/worker_logging.mli b/vendors/tezos-modded/src/lib_shell/worker_logging.mli
new file mode 100644
index 000000000..9626d959f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell/worker_logging.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.SEMLOG
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_services.ml b/vendors/tezos-modded/src/lib_shell_services/block_services.ml
new file mode 100644
index 000000000..9857f97fe
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_services.ml
@@ -0,0 +1,1002 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+type chain = [
+  | `Main
+  | `Test
+  | `Hash of Chain_id.t
+]
+
+let parse_chain s =
+  try
+    match s with
+    | "main" -> Ok `Main
+    | "test" -> Ok `Test
+    | h -> Ok (`Hash (Chain_id.of_b58check_exn h))
+  with _ -> Error "Cannot parse block identifier."
+
+let chain_to_string = function
+  | `Main -> "main"
+  | `Test -> "test"
+  | `Hash h -> Chain_id.to_b58check h
+
+let chain_arg =
+  let name = "chain_id" in
+  let descr =
+    "A chain identifier. This is either a chain hash in Base58Check notation \
+     or a one the predefined aliases: 'main', 'test'." in
+  let construct = chain_to_string in
+  let destruct = parse_chain in
+  RPC_arg.make ~name ~descr ~construct ~destruct ()
+
+type block = [
+  | `Genesis
+  | `Head of int
+  | `Hash of Block_hash.t * int
+  | `Level of Int32.t
+]
+
+let parse_block s =
+  let delims = ['~';'-';'+'] in
+  let count_delims s =
+    List.map
+      (fun d ->
+         (String.fold_left (fun i c -> if c = d then i+1 else i) 0 s), d)
+      delims in
+  let split_on_delim counts =
+    begin
+      match List.fold_left (fun i (v,_) -> i+v) 0 counts with
+      | 0 -> ([s], ' ')
+      | 1 -> let delim = List.assoc 1 counts in
+          (String.split delim s, delim)
+      | _ -> raise Exit
+    end in
+  try
+    match split_on_delim (count_delims s) with
+    | (["genesis"], _) -> Ok `Genesis
+    | (["genesis"; n], '+') -> Ok (`Level (Int32.of_string n))
+    | (["head"], _) -> Ok (`Head 0)
+    | (["head"; n], '~') | (["head"; n], '-') ->
+        Ok (`Head (int_of_string n))
+    | ([hol], _) ->
+        begin
+          match Block_hash.of_b58check_opt hol with
+            Some h -> Ok (`Hash (h , 0))
+          | None ->
+              let l = Int32.of_string s in
+              if Int32.(compare l (of_int 0)) < 0 then raise Exit
+              else Ok (`Level (Int32.of_string s))
+        end
+    | ([h ; n], '~') | ([h ; n], '-') ->
+        Ok (`Hash (Block_hash.of_b58check_exn h, int_of_string n))
+    | ([h ; n], '+') -> Ok (`Hash (Block_hash.of_b58check_exn h, - int_of_string n))
+    | _ -> raise Exit
+  with _ -> Error "Cannot parse block identifier."
+
+let to_string = function
+  | `Genesis -> "genesis"
+  | `Head 0 -> "head"
+  | `Head n when n < 0 -> Printf.sprintf "head+%d" (-n)
+  | `Head n -> Printf.sprintf "head~%d" n
+  | `Hash (h, 0) -> Block_hash.to_b58check h
+  | `Hash (h, n) when n < 0 -> Printf.sprintf "%s+%d" (Block_hash.to_b58check h) (-n)
+  | `Hash (h, n) -> Printf.sprintf "%s~%d" (Block_hash.to_b58check h) n
+  | `Level i -> Printf.sprintf "%d" (Int32.to_int i)
+
+let blocks_arg =
+  let name = "block_id" in
+  let descr =
+    "A block identifier. This is either a block hash in Base58Check notation, \
+     one the predefined aliases: 'genesis', 'head' \
+     or a block level (index in the chain). \
+     One might also use 'head~N' or '<hash>~N' where N is an integer to \
+     denote the Nth predecessor of the designated block.\
+     Also, '<hash>+N' denotes the Nth successor of a block." in
+  let construct = to_string in
+  let destruct = parse_block in
+  RPC_arg.make ~name ~descr ~construct ~destruct ()
+
+type chain_prefix = unit * chain
+type prefix = chain_prefix * block
+let chain_path = RPC_path.(root / "chains" /: chain_arg)
+let mempool_path p = RPC_path.(p / "mempool")
+let live_blocks_path p = RPC_path.(p / "live_blocks")
+let dir_path : (chain_prefix, chain_prefix) RPC_path.t =
+  RPC_path.(open_root / "blocks")
+let path = RPC_path.(dir_path /: blocks_arg)
+
+type operation_list_quota = {
+  max_size: int ;
+  max_op: int option ;
+}
+
+let operation_list_quota_encoding =
+  conv
+    (fun { max_size ; max_op } -> (max_size, max_op))
+    (fun (max_size, max_op) -> { max_size ; max_op })
+    (obj2
+       (req "max_size" int31)
+       (opt "max_op" int31))
+
+type raw_context =
+  | Key of MBytes.t
+  | Dir of (string * raw_context) list
+  | Cut
+
+let rec pp_raw_context ppf = function
+  | Cut -> Format.fprintf ppf "..."
+  | Key v -> Hex.pp ppf (MBytes.to_hex v)
+  | Dir l ->
+      Format.fprintf ppf "{@[<v 1>@,%a@]@,}"
+        (Format.pp_print_list
+           ~pp_sep:Format.pp_print_cut
+           (fun ppf (s, t) -> Format.fprintf ppf "%s : %a" s pp_raw_context t))
+        l
+
+let raw_context_encoding =
+  mu "raw_context"
+    (fun encoding ->
+       union [
+         case (Tag 0) bytes
+           ~title:"Key"
+           (function Key k -> Some k | _ -> None)
+           (fun k -> Key k) ;
+         case (Tag 1) (assoc encoding)
+           ~title:"Dir"
+           (function Dir k -> Some k | _ -> None)
+           (fun k -> Dir k) ;
+         case (Tag 2) null
+           ~title:"Cut"
+           (function Cut -> Some () | _ -> None)
+           (fun () -> Cut) ;
+       ])
+
+type error +=
+  | Invalid_depth_arg of int
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"raw_context.invalid_depth"
+    ~title:"Invalid depth argument"
+    ~description:"The raw context extraction depth argument must be positive."
+    ~pp:(fun ppf depth ->
+        Format.fprintf ppf "Extraction depth %d is invalid" depth)
+    Data_encoding.(obj1 (req "depth" int31))
+    (function Invalid_depth_arg depth -> Some depth | _ -> None)
+    (fun depth -> Invalid_depth_arg depth)
+
+module type PROTO = sig
+  val hash: Protocol_hash.t
+  type block_header_data
+  val block_header_data_encoding: block_header_data Data_encoding.t
+  type block_header_metadata
+  val block_header_metadata_encoding:
+    block_header_metadata Data_encoding.t
+  type operation_data
+  type operation_receipt
+  type operation = {
+    shell: Operation.shell_header ;
+    protocol_data: operation_data ;
+  }
+
+  val operation_data_encoding: operation_data Data_encoding.t
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
+end
+
+
+type protocols = {
+  current_protocol: Protocol_hash.t ;
+  next_protocol: Protocol_hash.t ;
+}
+
+let raw_protocol_encoding =
+  conv
+    (fun { current_protocol ; next_protocol } ->
+       ((current_protocol, next_protocol), ()))
+    (fun ((current_protocol, next_protocol), ()) ->
+       { current_protocol ; next_protocol })
+    (merge_objs
+       (obj2
+          (req "protocol" Protocol_hash.encoding)
+          (req "next_protocol" Protocol_hash.encoding))
+       unit)
+
+module Make(Proto : PROTO)(Next_proto : PROTO) = struct
+
+  let protocol_hash = Protocol_hash.to_b58check Proto.hash
+  let next_protocol_hash = Protocol_hash.to_b58check Next_proto.hash
+
+  type raw_block_header = {
+    shell: Block_header.shell_header ;
+    protocol_data: Proto.block_header_data ;
+  }
+
+  let raw_block_header_encoding =
+    def "raw_block_header" @@
+    conv
+      (fun { shell ; protocol_data } -> (shell, protocol_data))
+      (fun (shell, protocol_data) -> { shell ; protocol_data } )
+      (merge_objs
+         Block_header.shell_header_encoding
+         Proto.block_header_data_encoding)
+
+  type block_header = {
+    chain_id: Chain_id.t ;
+    hash: Block_hash.t ;
+    shell: Block_header.shell_header ;
+    protocol_data: Proto.block_header_data ;
+  }
+
+  let block_header_encoding =
+    def "block_header" @@
+    conv
+      (fun { chain_id ; hash ; shell ; protocol_data } ->
+         (((), chain_id, hash), { shell ; protocol_data }))
+      (fun (((), chain_id, hash), { shell ; protocol_data }) ->
+         { chain_id ; hash ; shell ; protocol_data } )
+      (merge_objs
+         (obj3
+            (req "protocol" (constant protocol_hash))
+            (req "chain_id" Chain_id.encoding)
+            (req "hash" Block_hash.encoding))
+         raw_block_header_encoding)
+
+  type block_metadata = {
+    protocol_data: Proto.block_header_metadata ;
+    test_chain_status: Test_chain_status.t ;
+    (* for the next block: *)
+    max_operations_ttl: int ;
+    max_operation_data_length: int ;
+    max_block_header_length: int ;
+    operation_list_quota: operation_list_quota list ;
+  }
+
+  let block_metadata_encoding =
+    def "block_header_metadata" @@
+    conv
+      (fun { protocol_data ; test_chain_status ; max_operations_ttl ;
+             max_operation_data_length ; max_block_header_length ;
+             operation_list_quota } ->
+        (((), (), test_chain_status,
+          max_operations_ttl, max_operation_data_length,
+          max_block_header_length, operation_list_quota),
+         protocol_data))
+      (fun (((), (), test_chain_status,
+             max_operations_ttl, max_operation_data_length,
+             max_block_header_length, operation_list_quota),
+            protocol_data) ->
+        { protocol_data ; test_chain_status ; max_operations_ttl ;
+          max_operation_data_length ; max_block_header_length ;
+          operation_list_quota })
+      (merge_objs
+         (obj7
+            (req "protocol" (constant protocol_hash))
+            (req "next_protocol" (constant next_protocol_hash))
+            (req "test_chain_status" Test_chain_status.encoding)
+            (req "max_operations_ttl" int31)
+            (req "max_operation_data_length" int31)
+            (req "max_block_header_length" int31)
+            (req "max_operation_list_length"
+               (dynamic_size (list operation_list_quota_encoding))))
+         Proto.block_header_metadata_encoding)
+
+  let next_operation_encoding =
+    let open Data_encoding in
+    def "next_operation" @@
+    conv
+      (fun Next_proto.{ shell ; protocol_data } ->
+         ((), (shell, protocol_data)))
+      (fun ((), (shell, protocol_data)) ->
+         { shell ; protocol_data } )
+      (merge_objs
+         (obj1 (req "protocol" (constant next_protocol_hash)))
+         (merge_objs
+            (dynamic_size Operation.shell_header_encoding)
+            (dynamic_size Next_proto.operation_data_encoding)))
+
+  type operation = {
+    chain_id: Chain_id.t ;
+    hash: Operation_hash.t ;
+    shell: Operation.shell_header ;
+    protocol_data: Proto.operation_data ;
+    receipt: Proto.operation_receipt ;
+  }
+
+  let operation_encoding =
+    def "operation" @@
+    let open Data_encoding in
+    conv
+      (fun { chain_id ; hash ; shell ; protocol_data ; receipt } ->
+         (((), chain_id, hash), (shell, (protocol_data, receipt))))
+      (fun (((), chain_id, hash), (shell, (protocol_data,  receipt))) ->
+         { chain_id ; hash ; shell ; protocol_data ; receipt })
+      (merge_objs
+         (obj3
+            (req "protocol" (constant protocol_hash))
+            (req "chain_id" Chain_id.encoding)
+            (req "hash" Operation_hash.encoding))
+         (merge_objs
+            (dynamic_size Operation.shell_header_encoding)
+            (dynamic_size Proto.operation_data_and_receipt_encoding)))
+
+  type block_info = {
+    chain_id: Chain_id.t ;
+    hash: Block_hash.t ;
+    header: raw_block_header ;
+    metadata: block_metadata ;
+    operations: operation list list ;
+  }
+
+  let block_info_encoding =
+    conv
+      (fun { chain_id ; hash ; header ; metadata ; operations } ->
+         ((), chain_id, hash, header, metadata, operations))
+      (fun ((), chain_id, hash, header, metadata, operations) ->
+         { chain_id ; hash ; header ; metadata ; operations })
+      (obj6
+         (req "protocol" (constant protocol_hash))
+         (req "chain_id" Chain_id.encoding)
+         (req "hash" Block_hash.encoding)
+         (req "header" (dynamic_size raw_block_header_encoding))
+         (req "metadata" (dynamic_size block_metadata_encoding))
+         (req "operations"
+            (list (dynamic_size (list operation_encoding)))))
+
+  module S = struct
+
+    let path : prefix RPC_path.context = RPC_path.open_root
+
+    let hash =
+      RPC_service.get_service
+        ~description:"The block's hash, its unique identifier."
+        ~query: RPC_query.empty
+        ~output: Block_hash.encoding
+        RPC_path.(path / "hash")
+
+    let header =
+      RPC_service.get_service
+        ~description:"The whole block header."
+        ~query: RPC_query.empty
+        ~output: block_header_encoding
+        RPC_path.(path / "header")
+
+    let raw_header =
+      RPC_service.get_service
+        ~description:"The whole block header (unparsed)."
+        ~query: RPC_query.empty
+        ~output: bytes
+        RPC_path.(path / "header" / "raw")
+
+    let metadata =
+      RPC_service.get_service
+        ~description:"All the metadata associated to the block."
+        ~query: RPC_query.empty
+        ~output: block_metadata_encoding
+        RPC_path.(path / "metadata")
+
+    let protocols =
+      (* same endpoint than 'metadata' *)
+      RPC_service.get_service
+        ~description:".. unexported ..."
+        ~query: RPC_query.empty
+        ~output: raw_protocol_encoding
+        RPC_path.(path / "metadata")
+
+    module Header = struct
+
+      let path = RPC_path.(path / "header")
+
+      let shell_header =
+        RPC_service.get_service
+          ~description:"The shell-specific fragment of the block header."
+          ~query: RPC_query.empty
+          ~output: Block_header.shell_header_encoding
+          RPC_path.(path / "shell")
+
+      let protocol_data =
+        RPC_service.get_service
+          ~description:"The version-specific fragment of the block header."
+          ~query: RPC_query.empty
+          ~output:
+            (conv
+               (fun h -> ((), h)) (fun ((), h) -> h)
+               (merge_objs
+                  (obj1 (req "protocol" (constant protocol_hash)))
+                  Proto.block_header_data_encoding))
+          RPC_path.(path / "protocol_data")
+
+      let raw_protocol_data =
+        RPC_service.get_service
+          ~description:"The version-specific fragment of the block header (unparsed)."
+          ~query: RPC_query.empty
+          ~output: bytes
+          RPC_path.(path / "protocol_data" / "raw")
+
+    end
+
+    module Operations = struct
+
+      let path = RPC_path.(path / "operations")
+
+      let operations =
+        RPC_service.get_service
+          ~description:"All the operations included in the block."
+          ~query: RPC_query.empty
+          ~output: (list (dynamic_size (list operation_encoding)))
+          path
+
+      let list_arg =
+        let name = "list_offset" in
+        let descr =
+          "Index `n` of the requested validation pass." in
+        let construct = string_of_int in
+        let destruct s =
+          try Ok (int_of_string s)
+          with _ -> Error (Format.sprintf "Invalid list offset (%s)" s) in
+        RPC_arg.make ~name ~descr ~construct ~destruct ()
+
+      let offset_arg =
+        let name = "operation_offset" in
+        let descr =
+          "Index `m` of the requested operation in its validation pass." in
+        let construct = string_of_int in
+        let destruct s =
+          try Ok (int_of_string s)
+          with _ -> Error (Format.sprintf "Invalid operation offset (%s)" s) in
+        RPC_arg.make ~name ~descr ~construct ~destruct ()
+
+      let operations_in_pass =
+        RPC_service.get_service
+          ~description:
+            "All the operations included in `n-th` validation pass of the block."
+          ~query: RPC_query.empty
+          ~output: (list operation_encoding)
+          RPC_path.(path /: list_arg)
+
+      let operation =
+        RPC_service.get_service
+          ~description:
+            "The `m-th` operation in the `n-th` validation pass of the block."
+          ~query: RPC_query.empty
+          ~output: operation_encoding
+          RPC_path.(path /: list_arg /: offset_arg)
+
+    end
+
+    module Operation_hashes = struct
+
+      let path = RPC_path.(path / "operation_hashes")
+
+      let operation_hashes =
+        RPC_service.get_service
+          ~description:"The hashes of all the operations included in the block."
+          ~query: RPC_query.empty
+          ~output: (list (list Operation_hash.encoding))
+          path
+
+      let operation_hashes_in_pass =
+        RPC_service.get_service
+          ~description:
+            "All the operations included in `n-th` validation pass of the block."
+          ~query: RPC_query.empty
+          ~output: (list Operation_hash.encoding)
+          RPC_path.(path /: Operations.list_arg)
+
+      let operation_hash =
+        RPC_service.get_service
+          ~description:
+            "The hash of then `m-th` operation in the `n-th` validation pass of the block."
+          ~query: RPC_query.empty
+          ~output: Operation_hash.encoding
+          RPC_path.(path /: Operations.list_arg /: Operations.offset_arg)
+    end
+
+    module Helpers = struct
+
+      let path = RPC_path.(path / "helpers")
+
+      module Forge = struct
+
+        let block_header =
+          RPC_service.post_service
+            ~description: "Forge a block header"
+            ~query: RPC_query.empty
+            ~input: Block_header.encoding
+            ~output: (obj1 (req "block" bytes))
+            RPC_path.(path / "forge_block_header")
+
+      end
+
+      module Preapply = struct
+
+        let path = RPC_path.(path / "preapply")
+
+        let block_result_encoding =
+          obj2
+            (req "shell_header" Block_header.shell_header_encoding)
+            (req "operations"
+               (list (Preapply_result.encoding RPC_error.encoding)))
+
+        type block_param = {
+          protocol_data: Next_proto.block_header_data ;
+          operations: Next_proto.operation list list ;
+        }
+
+        let block_param_encoding =
+          (conv
+             (fun { protocol_data ; operations } ->
+                (protocol_data, operations))
+             (fun (protocol_data, operations) ->
+                { protocol_data ; operations })
+             (obj2
+                (req "protocol_data"
+                   (conv
+                      (fun h -> ((), h)) (fun ((), h) -> h)
+                      (merge_objs
+                         (obj1 (req "protocol" (constant next_protocol_hash)))
+                         (dynamic_size Next_proto.block_header_data_encoding))))
+                (req "operations"
+                   (list (dynamic_size (list next_operation_encoding))))))
+
+        let block_query =
+          let open RPC_query in
+          query (fun sort timestamp -> object
+                  method sort_operations = sort
+                  method timestamp = timestamp
+                end)
+          |+ flag "sort" (fun t -> t#sort_operations)
+          |+ opt_field "timestamp" Time.rpc_arg (fun t -> t#timestamp)
+          |> seal
+
+        let block =
+          RPC_service.post_service
+            ~description:
+              "Simulate the validation of a block that would contain \
+               the given operations and return the resulting fitness \
+               and context hash."
+            ~query: block_query
+            ~input: block_param_encoding
+            ~output: block_result_encoding
+            RPC_path.(path / "block")
+
+        let operations =
+          RPC_service.post_service
+            ~description:
+              "Simulate the validation of an operation."
+            ~query: RPC_query.empty
+            ~input: (list next_operation_encoding)
+            ~output: (list (dynamic_size Next_proto.operation_data_and_receipt_encoding))
+            RPC_path.(path / "operations")
+
+      end
+
+      let complete =
+        let prefix_arg =
+          let destruct s = Ok s
+          and construct s = s in
+          RPC_arg.make ~name:"prefix" ~destruct ~construct () in
+        RPC_service.get_service
+          ~description: "Try to complete a prefix of a Base58Check-encoded data. \
+                         This RPC is actually able to complete hashes of \
+                         block, operations, public_keys and contracts."
+          ~query: RPC_query.empty
+          ~output: (list string)
+          RPC_path.(path / "complete" /: prefix_arg )
+
+    end
+
+    module Context = struct
+
+      let path = RPC_path.(path / "context" / "raw" / "bytes")
+
+      let context_path_arg : string RPC_arg.t =
+        let name = "context_path" in
+        let descr = "A path inside the context" in
+        let construct = fun s -> s in
+        let destruct = fun s -> Ok s in
+        RPC_arg.make ~name ~descr ~construct ~destruct ()
+
+      let raw_context_query : < depth: int option > RPC_query.t =
+        let open RPC_query in
+        query (fun depth -> object
+                method depth = depth
+              end)
+        |+ opt_field "depth" RPC_arg.int (fun t -> t#depth)
+        |> seal
+
+      let read =
+        RPC_service.get_service
+          ~description:"Returns the raw context."
+          ~query: raw_context_query
+          ~output: raw_context_encoding
+          RPC_path.(path /:* context_path_arg)
+
+    end
+
+    let info =
+      RPC_service.get_service
+        ~description:"All the information about a block."
+        ~query: RPC_query.empty
+        ~output: block_info_encoding
+        path
+
+    module Mempool = struct
+
+      type t = {
+        applied: (Operation_hash.t * Next_proto.operation) list ;
+        refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+        branch_refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+        branch_delayed: (Next_proto.operation * error list) Operation_hash.Map.t ;
+        unprocessed: Next_proto.operation Operation_hash.Map.t ;
+      }
+
+      let encoding =
+        conv
+          (fun
+            { applied ;
+              refused ; branch_refused ; branch_delayed ;
+              unprocessed } ->
+            (applied, refused, branch_refused, branch_delayed, unprocessed))
+          (fun
+            (applied, refused, branch_refused, branch_delayed, unprocessed) ->
+            { applied ;
+              refused ; branch_refused ; branch_delayed ;
+              unprocessed })
+          (obj5
+             (req "applied"
+                (list
+                   (conv
+                      (fun (hash, (op : Next_proto.operation)) ->
+                         ((hash, op.shell), (op.protocol_data)))
+                      (fun ((hash, shell), (protocol_data)) ->
+                         (hash, { shell ; protocol_data }))
+                      (merge_objs
+                         (merge_objs
+                            (obj1 (req "hash" Operation_hash.encoding))
+                            (dynamic_size Operation.shell_header_encoding))
+                         (dynamic_size Next_proto.operation_data_encoding)
+                      ))))
+             (req "refused"
+                (Operation_hash.Map.encoding
+                   (merge_objs
+                      (dynamic_size next_operation_encoding)
+                      (obj1 (req "error" RPC_error.encoding)))))
+             (req "branch_refused"
+                (Operation_hash.Map.encoding
+                   (merge_objs
+                      (dynamic_size next_operation_encoding)
+                      (obj1 (req "error" RPC_error.encoding)))))
+             (req "branch_delayed"
+                (Operation_hash.Map.encoding
+                   (merge_objs
+                      (dynamic_size next_operation_encoding)
+                      (obj1 (req "error" RPC_error.encoding)))))
+             (req "unprocessed"
+                (Operation_hash.Map.encoding
+                   (dynamic_size next_operation_encoding))))
+
+      let pending_operations path =
+        (* TODO: branch_delayed/... *)
+        RPC_service.get_service
+          ~description: "List the prevalidated operations."
+          ~query: RPC_query.empty
+          ~output: encoding
+          RPC_path.(path / "pending_operations")
+
+      let mempool_query =
+        let open RPC_query in
+        query (fun applied refused
+                branch_refused branch_delayed -> object
+                method applied = applied
+                method refused = refused
+                method branch_refused = branch_refused
+                method branch_delayed = branch_delayed
+              end)
+        |+ flag ~descr:"Include applied operations (set by default)"
+          "applied" (fun t -> t#applied)
+        |+ flag ~descr:"Include refused operations"
+          "refused" (fun t -> t#refused)
+        |+ flag ~descr:"Include branch refused operations"
+          "branch_refused" (fun t -> t#branch_refused)
+        |+ flag ~descr:"Include branch delayed operations (set by default)"
+          "branch_delayed" (fun t -> t#branch_delayed)
+        |> seal
+
+      let monitor_operations path =
+        RPC_service.get_service
+          ~description:"Monitor the mempool operations."
+          ~query: mempool_query
+          ~output: (list next_operation_encoding)
+          RPC_path.(path / "monitor_operations")
+
+      let request_operations path =
+        RPC_service.post_service
+          ~description:"Request the operations of your peers."
+          ~input: Data_encoding.empty
+          ~query: RPC_query.empty
+          ~output: Data_encoding.empty
+          RPC_path.(path / "request_operations")
+
+    end
+
+    let live_blocks =
+      RPC_service.get_service
+        ~description:"List the ancestors of the given block which, if \
+                      referred to as the branch in an operation \
+                      header, are recent enough for that operation to \
+                      be included in the current block."
+        ~query: RPC_query.empty
+        ~output: Block_hash.Set.encoding
+        RPC_path.(live_blocks_path open_root)
+
+  end
+
+  let path = RPC_path.prefix chain_path path
+
+  let make_call0 s ctxt a b q p =
+    let s = RPC_service.prefix path s in
+    RPC_context.make_call2 s ctxt a b q p
+
+  let make_call1 s ctxt a b c q p =
+    let s = RPC_service.prefix path s in
+    RPC_context.make_call3 s ctxt a b c q p
+
+  let make_call2 s ctxt a b c d q p =
+    let s = RPC_service.prefix path s in
+    RPC_context.make_call s ctxt (((((), a), b), c), d) q p
+
+  let hash ctxt =
+    let f = make_call0 S.hash ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      match block with
+      | `Hash (h, 0) -> return h
+      | _ -> f chain block () ()
+
+  let header ctxt =
+    let f = make_call0 S.header ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+  let raw_header ctxt =
+    let f = make_call0 S.raw_header ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+  let metadata ctxt =
+    let f = make_call0 S.metadata ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+  let protocols ctxt =
+    let f = make_call0 S.protocols ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+  module Header = struct
+
+    module S = S.Header
+
+    let shell_header ctxt =
+      let f = make_call0 S.shell_header ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) () ->
+        f chain block () ()
+    let protocol_data ctxt =
+      let f = make_call0 S.protocol_data ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) () ->
+        f chain block () ()
+    let raw_protocol_data ctxt =
+      let f = make_call0 S.raw_protocol_data ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) () ->
+        f chain block () ()
+
+  end
+
+  module Operations = struct
+
+    module S = S.Operations
+
+    let operations ctxt =
+      let f = make_call0 S.operations ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) () ->
+        f chain block () ()
+
+    let operations_in_pass ctxt =
+      let f = make_call1 S.operations_in_pass ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) n ->
+        f chain block n () ()
+
+    let operation ctxt =
+      let f = make_call2 S.operation ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) n m ->
+        f chain block n m () ()
+
+  end
+
+  module Operation_hashes = struct
+
+    module S = S.Operation_hashes
+
+    let operation_hashes ctxt =
+      let f = make_call0 S.operation_hashes ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) () ->
+        f chain block () ()
+
+    let operation_hashes_in_pass ctxt =
+      let f = make_call1 S.operation_hashes_in_pass ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) n ->
+        f chain block n () ()
+
+    let operation_hash ctxt =
+      let f = make_call2 S.operation_hash ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) n m ->
+        f chain block n m () ()
+
+  end
+
+  module Context = struct
+
+    module S = S.Context
+
+    let read ctxt =
+      let f = make_call1 S.read ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) ?depth path ->
+        f chain block path
+          (object method depth = depth end) ()
+
+  end
+
+  module Helpers = struct
+
+    module S = S.Helpers
+
+    module Forge = struct
+
+      module S = S.Forge
+
+      let block_header ctxt =
+        let f = make_call0 S.block_header ctxt in
+        fun
+          ?(chain = `Main) ?(block = `Head 0)
+          header ->
+          f chain block () header
+
+    end
+
+    module Preapply = struct
+
+      module S = S.Preapply
+
+      let block ctxt =
+        let f = make_call0 S.block ctxt in
+        fun
+          ?(chain = `Main) ?(block = `Head 0)
+          ?(sort = false) ?timestamp ~protocol_data operations ->
+          f chain block
+            (object method sort_operations = sort method timestamp = timestamp end)
+            { protocol_data ; operations  }
+
+      let operations ctxt =
+        let f = make_call0 S.operations ctxt in
+        fun ?(chain = `Main) ?(block = `Head 0) operations ->
+          f chain block () operations
+
+    end
+
+    let complete ctxt =
+      let f = make_call1 S.complete ctxt in
+      fun ?(chain = `Main) ?(block = `Head 0) s ->
+        f chain block s () ()
+
+  end
+
+  let info ctxt =
+    let f = make_call0 S.info ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+  module Mempool = struct
+
+    type t = S.Mempool.t = {
+      applied: (Operation_hash.t * Next_proto.operation) list ;
+      refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      branch_refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      branch_delayed: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      unprocessed: Next_proto.operation Operation_hash.Map.t ;
+    }
+
+    let pending_operations ctxt ?(chain = `Main) () =
+      let s = S.Mempool.pending_operations (mempool_path chain_path) in
+      RPC_context.make_call1 s ctxt chain () ()
+
+    let monitor_operations ctxt
+        ?(chain = `Main)
+        ?(applied = true)
+        ?(branch_delayed = true)
+        ?(branch_refused = false)
+        ?(refused=false)
+        () =
+      let s = S.Mempool.monitor_operations (mempool_path chain_path) in
+      RPC_context.make_streamed_call s ctxt
+        ((), chain)
+        (object
+          method applied = applied
+          method refused = refused
+          method branch_refused = branch_refused
+          method branch_delayed = branch_delayed
+        end)
+        ()
+
+    let request_operations ctxt ?(chain = `Main) () =
+      let s = S.Mempool.request_operations (mempool_path chain_path) in
+      RPC_context.make_call1 s ctxt chain () ()
+  end
+
+  let live_blocks ctxt =
+    let f = make_call0 S.live_blocks ctxt in
+    fun ?(chain = `Main) ?(block = `Head 0) () ->
+      f chain block () ()
+
+end
+
+module Fake_protocol = struct
+  let hash = Protocol_hash.zero
+  type block_header_data = unit
+  let block_header_data_encoding = Data_encoding.empty
+  type block_header_metadata = unit
+  let block_header_metadata_encoding = Data_encoding.empty
+  type operation_data = unit
+  type operation_receipt = unit
+  type operation = {
+    shell: Operation.shell_header ;
+    protocol_data: operation_data ;
+  }
+  let operation_data_encoding = Data_encoding.empty
+  let operation_receipt_encoding = Data_encoding.empty
+  let operation_data_and_receipt_encoding =
+    Data_encoding.conv
+      (fun ((), ()) -> ())
+      (fun () -> ((), ()))
+      Data_encoding.empty
+end
+
+module Empty = Make(Fake_protocol)(Fake_protocol)
+
+let () =
+  Printexc.register_printer
+    (function
+      | (Json_schema.Cannot_parse _
+        | Json_schema.Dangling_reference _
+        | Json_schema.Bad_reference _
+        | Json_schema.Unexpected _
+        | Json_schema.Duplicate_definition _ ) as exn ->
+          Some (Format.asprintf "%a" (fun ppf -> Json_schema.print_error ppf) exn)
+      | _ -> None)
+
+let protocols = Empty.protocols
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_services.mli b/vendors/tezos-modded/src/lib_shell_services/block_services.mli
new file mode 100644
index 000000000..6913d4806
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_services.mli
@@ -0,0 +1,451 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type chain = [
+  | `Main
+  | `Test
+  | `Hash of Chain_id.t
+]
+
+type chain_prefix = unit * chain
+val chain_path: (unit, chain_prefix) RPC_path.t
+
+val parse_chain: string -> (chain, string) result
+val chain_to_string: chain -> string
+
+val chain_arg: chain RPC_arg.t
+
+type block = [
+  | `Genesis
+  | `Head of int
+  | `Hash of Block_hash.t * int
+  | `Level of Int32.t
+]
+val parse_block: string -> (block, string) result
+val to_string: block -> string
+
+type prefix = (unit * chain) * block
+val dir_path: (chain_prefix, chain_prefix) RPC_path.t
+val path: (chain_prefix, chain_prefix * block) RPC_path.t
+val mempool_path : ('a, 'b) RPC_path.t -> ('a, 'b) RPC_path.t
+val live_blocks_path : ('a, 'b) RPC_path.t -> ('a, 'b) RPC_path.t
+
+type operation_list_quota = {
+  max_size: int ;
+  max_op: int option ;
+}
+
+type raw_context =
+  | Key of MBytes.t
+  | Dir of (string * raw_context) list
+  | Cut
+
+val pp_raw_context: Format.formatter -> raw_context -> unit
+
+type error +=
+  | Invalid_depth_arg of int
+
+module type PROTO = sig
+  val hash: Protocol_hash.t
+  type block_header_data
+  val block_header_data_encoding: block_header_data Data_encoding.t
+  type block_header_metadata
+  val block_header_metadata_encoding:
+    block_header_metadata Data_encoding.t
+  type operation_data
+  type operation_receipt
+  type operation = {
+    shell: Operation.shell_header ;
+    protocol_data: operation_data ;
+  }
+
+  val operation_data_encoding: operation_data Data_encoding.t
+  val operation_receipt_encoding: operation_receipt Data_encoding.t
+  val operation_data_and_receipt_encoding:
+    (operation_data * operation_receipt) Data_encoding.t
+end
+
+module Make(Proto : PROTO)(Next_proto : PROTO) : sig
+
+  val path: (unit, chain_prefix * block) RPC_path.t
+
+  type raw_block_header = {
+    shell: Block_header.shell_header ;
+    protocol_data: Proto.block_header_data ;
+  }
+
+  type block_header = {
+    chain_id: Chain_id.t ;
+    hash: Block_hash.t ;
+    shell: Block_header.shell_header ;
+    protocol_data: Proto.block_header_data ;
+  }
+
+  type block_metadata = {
+    protocol_data: Proto.block_header_metadata ;
+    test_chain_status: Test_chain_status.t ;
+    max_operations_ttl: int ;
+    max_operation_data_length: int ;
+    max_block_header_length: int ;
+    operation_list_quota: operation_list_quota list ;
+  }
+
+  type operation = {
+    chain_id: Chain_id.t ;
+    hash: Operation_hash.t ;
+    shell: Operation.shell_header ;
+    protocol_data: Proto.operation_data ;
+    receipt: Proto.operation_receipt ;
+  }
+
+  type block_info = {
+    chain_id: Chain_id.t ;
+    hash: Block_hash.t ;
+    header: raw_block_header ;
+    metadata: block_metadata ;
+    operations: operation list list ;
+  }
+
+  open RPC_context
+
+  val info:
+    #simple -> ?chain:chain -> ?block:block ->
+    unit -> block_info tzresult Lwt.t
+
+  val hash:
+    #simple -> ?chain:chain -> ?block:block ->
+    unit -> Block_hash.t tzresult Lwt.t
+
+  val raw_header:
+    #simple -> ?chain:chain -> ?block:block ->
+    unit -> MBytes.t tzresult Lwt.t
+
+  val header:
+    #simple -> ?chain:chain -> ?block:block ->
+    unit -> block_header tzresult Lwt.t
+
+  val metadata:
+    #simple -> ?chain:chain -> ?block:block ->
+    unit -> block_metadata tzresult Lwt.t
+
+  module Header : sig
+
+    val shell_header:
+      #simple -> ?chain:chain -> ?block:block ->
+      unit -> Block_header.shell_header tzresult Lwt.t
+    val protocol_data:
+      #simple -> ?chain:chain -> ?block:block ->
+      unit -> Proto.block_header_data tzresult Lwt.t
+    val raw_protocol_data:
+      #simple -> ?chain:chain -> ?block:block ->
+      unit -> MBytes.t tzresult Lwt.t
+
+  end
+
+  module Operations : sig
+
+    val operations:
+      #simple -> ?chain:chain -> ?block:block ->
+      unit -> operation list list tzresult Lwt.t
+    val operations_in_pass:
+      #simple -> ?chain:chain -> ?block:block ->
+      int -> operation list tzresult Lwt.t
+    val operation:
+      #simple -> ?chain:chain -> ?block:block ->
+      int -> int -> operation tzresult Lwt.t
+
+  end
+
+  module Operation_hashes : sig
+
+    val operation_hashes:
+      #simple -> ?chain:chain -> ?block:block ->
+      unit -> Operation_hash.t list list tzresult Lwt.t
+    val operation_hashes_in_pass:
+      #simple -> ?chain:chain -> ?block:block ->
+      int -> Operation_hash.t list tzresult Lwt.t
+    val operation_hash:
+      #simple -> ?chain:chain -> ?block:block ->
+      int -> int -> Operation_hash.t tzresult Lwt.t
+
+  end
+
+  module Context : sig
+
+    val read:
+      #simple -> ?chain:chain -> ?block:block ->
+      ?depth: int ->
+      string list -> raw_context tzresult Lwt.t
+
+  end
+
+  module Helpers : sig
+
+    module Forge : sig
+
+      val block_header:
+        #RPC_context.simple ->
+        ?chain:chain ->
+        ?block:block ->
+        Block_header.t ->
+        MBytes.t tzresult Lwt.t
+
+    end
+
+    module Preapply : sig
+
+      val block:
+        #simple -> ?chain:chain -> ?block:block ->
+        ?sort:bool ->
+        ?timestamp:Time.t ->
+        protocol_data:Next_proto.block_header_data ->
+        Next_proto.operation list list ->
+        (Block_header.shell_header * error Preapply_result.t list) tzresult Lwt.t
+
+      val operations:
+        #simple -> ?chain:chain -> ?block:block ->
+        Next_proto.operation list ->
+        (Next_proto.operation_data * Next_proto.operation_receipt) list tzresult Lwt.t
+
+    end
+
+    val complete:
+      #simple -> ?chain:chain -> ?block:block ->
+      string -> string list tzresult Lwt.t
+
+  end
+
+  module Mempool : sig
+
+    type t = {
+      applied: (Operation_hash.t * Next_proto.operation) list ;
+      refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      branch_refused: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      branch_delayed: (Next_proto.operation * error list) Operation_hash.Map.t ;
+      unprocessed: Next_proto.operation Operation_hash.Map.t ;
+    }
+
+    val pending_operations:
+      #simple ->
+      ?chain:chain ->
+      unit -> t tzresult Lwt.t
+
+    val monitor_operations:
+      #streamed ->
+      ?chain:chain ->
+      ?applied:bool ->
+      ?branch_delayed:bool ->
+      ?branch_refused:bool ->
+      ?refused:bool ->
+      unit -> (Next_proto.operation list Lwt_stream.t * stopper) tzresult Lwt.t
+
+    val request_operations:
+      #simple ->
+      ?chain:chain ->
+      unit -> unit tzresult Lwt.t
+
+  end
+
+  val live_blocks:
+    #simple ->
+    ?chain:chain ->
+    ?block:block ->
+    unit -> Block_hash.Set.t tzresult Lwt.t
+
+  module S : sig
+
+    val hash:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       Block_hash.t) RPC_service.t
+
+    val info:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       block_info)   RPC_service.t
+
+    val header:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       block_header) RPC_service.t
+
+    val raw_header:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       MBytes.t) RPC_service.t
+
+    val metadata:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       block_metadata) RPC_service.t
+
+    module Header : sig
+
+      val shell_header:
+        ([ `GET ], prefix,
+         prefix, unit, unit,
+         Block_header.shell_header) RPC_service.t
+
+      val protocol_data:
+        ([ `GET ], prefix,
+         prefix, unit, unit,
+         Proto.block_header_data) RPC_service.t
+
+      val raw_protocol_data:
+        ([ `GET ], prefix,
+         prefix, unit, unit,
+         MBytes.t) RPC_service.t
+
+    end
+
+    module Operations : sig
+
+      val operations:
+        ([ `GET ], prefix,
+         prefix, unit, unit,
+         operation list list) RPC_service.t
+
+      val operations_in_pass:
+        ([ `GET ], prefix,
+         prefix * int, unit, unit,
+         operation list) RPC_service.t
+
+      val operation:
+        ([ `GET ], prefix,
+         (prefix * int) * int, unit, unit,
+         operation) RPC_service.t
+
+    end
+
+    module Operation_hashes : sig
+
+      val operation_hashes:
+        ([ `GET ], prefix,
+         prefix, unit, unit,
+         Tezos_crypto.Operation_hash.t list list) RPC_service.t
+
+      val operation_hashes_in_pass:
+        ([ `GET ], prefix,
+         prefix * int, unit, unit,
+         Tezos_crypto.Operation_hash.t list) RPC_service.t
+
+      val operation_hash:
+        ([ `GET ], prefix,
+         (prefix * int) * int, unit, unit,
+         Tezos_crypto.Operation_hash.t) RPC_service.t
+
+    end
+
+    module Context : sig
+
+      val read:
+        ([ `GET ], prefix,
+         prefix * string list, < depth : int option >, unit,
+         raw_context) RPC_service.t
+
+    end
+
+    module Helpers : sig
+
+      module Forge : sig
+
+        val block_header:
+          ([ `POST ], prefix,
+           prefix, unit, Block_header.t, MBytes.t) RPC_service.service
+
+      end
+
+      module Preapply : sig
+
+        type block_param = {
+          protocol_data: Next_proto.block_header_data ;
+          operations: Next_proto.operation list list ;
+        }
+
+        val block:
+          ([ `POST ], prefix,
+           prefix, < sort_operations : bool;
+                     timestamp : Time.t option >, block_param,
+           Block_header.shell_header * error Preapply_result.t list) RPC_service.t
+
+        val operations:
+          ([ `POST ], prefix,
+           prefix, unit, Next_proto.operation list,
+           (Next_proto.operation_data * Next_proto.operation_receipt) list) RPC_service.t
+
+      end
+
+      val complete:
+        ([ `GET ], prefix,
+         prefix * string, unit, unit,
+         string list) RPC_service.t
+
+    end
+
+    module Mempool : sig
+
+      val encoding: Mempool.t Data_encoding.t
+
+      val pending_operations:
+        ('a, 'b) RPC_path.t ->
+        ([ `GET ], 'a,
+         'b , unit, unit,
+         Mempool.t) RPC_service.t
+
+      val monitor_operations:
+        ('a, 'b) RPC_path.t ->
+        ([ `GET ], 'a, 'b,
+         < applied : bool ; branch_delayed : bool ;
+           branch_refused : bool ; refused : bool ; >,
+         unit,
+         Next_proto.operation list) RPC_service.t
+
+      val request_operations :
+        ('a, 'b) RPC_path.t ->
+        ([ `POST ], 'a,
+         'b , unit, unit, unit) RPC_service.t
+
+    end
+
+    val live_blocks:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       Block_hash.Set.t) RPC_service.t
+
+  end
+
+end
+
+module Fake_protocol : PROTO
+module Empty : (module type of Make(Fake_protocol)(Fake_protocol))
+
+type protocols = {
+  current_protocol: Protocol_hash.t ;
+  next_protocol: Protocol_hash.t ;
+}
+
+val protocols:
+  #RPC_context.simple -> ?chain:chain -> ?block:block ->
+  unit -> protocols tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.ml b/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.ml
new file mode 100644
index 000000000..270752525
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.ml
@@ -0,0 +1,445 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type block_error =
+  | Cannot_parse_operation of Operation_hash.t
+  | Invalid_fitness of { expected: Fitness.t ; found: Fitness.t }
+  | Non_increasing_timestamp
+  | Non_increasing_fitness
+  | Invalid_level of { expected: Int32.t ; found: Int32.t }
+  | Invalid_proto_level of { expected: int ; found: int }
+  | Replayed_operation of Operation_hash.t
+  | Outdated_operation of
+      { operation: Operation_hash.t;
+        originating_block: Block_hash.t }
+  | Expired_chain of
+      { chain_id: Chain_id.t ;
+        expiration: Time.t ;
+        timestamp: Time.t ;
+      }
+  | Unexpected_number_of_validation_passes of int (* uint8 *)
+  | Too_many_operations of { pass: int; found: int; max: int }
+  | Oversized_operation of { operation: Operation_hash.t;
+                             size: int; max: int }
+  | Unallowed_pass of { operation: Operation_hash.t ;
+                        pass: int ;
+                        allowed_pass: int list }
+  | Cannot_parse_block_header
+
+let errno : Unix.error Data_encoding.t =
+  let open Data_encoding in
+  union [
+    case
+      ~title:"unknown_unix_error"
+      (Tag 0) int8
+      (function Unix.EUNKNOWNERR i -> Some i | _ -> None)
+      (fun i -> EUNKNOWNERR i) ;
+    case
+      ~title:"unix_error"
+      (Tag 1)
+      (string_enum
+         Unix.[
+           "2big", E2BIG ;
+           "acces", EACCES ;
+           "again", EAGAIN ;
+           "badf", EBADF ;
+           "busy", EBUSY ;
+           "child", ECHILD ;
+           "deadlk", EDEADLK ;
+           "dom", EDOM ;
+           "exist", EEXIST ;
+           "fault", EFAULT ;
+           "fbig", EFBIG ;
+           "intr", EINTR ;
+           "inval", EINVAL ;
+           "io", EIO ;
+           "isdir", EISDIR ;
+           "mfile", EMFILE ;
+           "mlink", EMLINK ;
+           "nametoolong", ENAMETOOLONG ;
+           "nfile", ENFILE ;
+           "nodev", ENODEV ;
+           "noent", ENOENT ;
+           "noexec", ENOEXEC ;
+           "nolck", ENOLCK ;
+           "nomem", ENOMEM ;
+           "nospc", ENOSPC ;
+           "nosys", ENOSYS ;
+           "notdir", ENOTDIR ;
+           "notempty", ENOTEMPTY ;
+           "notty", ENOTTY ;
+           "nxio", ENXIO ;
+           "perm", EPERM ;
+           "pipe", EPIPE ;
+           "range", ERANGE ;
+           "rofs", EROFS ;
+           "spipe", ESPIPE ;
+           "srch", ESRCH ;
+           "xdev", EXDEV ;
+           "wouldblock", EWOULDBLOCK ;
+           "inprogress", EINPROGRESS ;
+           "already", EALREADY ;
+           "notsock", ENOTSOCK ;
+           "destaddrreq", EDESTADDRREQ ;
+           "msgsize", EMSGSIZE ;
+           "prototype", EPROTOTYPE ;
+           "noprotoopt", ENOPROTOOPT ;
+           "protonosupport", EPROTONOSUPPORT ;
+           "socktnosupport", ESOCKTNOSUPPORT ;
+           "opnotsupp", EOPNOTSUPP ;
+           "pfnosupport", EPFNOSUPPORT ;
+           "afnosupport", EAFNOSUPPORT ;
+           "addrinuse", EADDRINUSE ;
+           "addrnotavail", EADDRNOTAVAIL ;
+           "netdown", ENETDOWN ;
+           "netunreach", ENETUNREACH ;
+           "netreset", ENETRESET ;
+           "connaborted", ECONNABORTED ;
+           "connreset", ECONNRESET ;
+           "nobufs", ENOBUFS ;
+           "isconn", EISCONN ;
+           "notconn", ENOTCONN ;
+           "shutdown", ESHUTDOWN ;
+           "toomanyrefs", ETOOMANYREFS ;
+           "timedout", ETIMEDOUT ;
+           "connrefused", ECONNREFUSED ;
+           "hostdown", EHOSTDOWN ;
+           "hostunreach", EHOSTUNREACH ;
+           "loop", ELOOP ;
+           "overflow", EOVERFLOW ])
+      (fun x -> Some x)
+      (fun x -> x)
+  ]
+
+let block_error_encoding =
+  let open Data_encoding in
+  union
+    [
+      case (Tag 0)
+        ~title:"Cannot_parse_operation"
+        (obj2
+           (req "error" (constant "cannot_parse_operation"))
+           (req "operation" Operation_hash.encoding))
+        (function Cannot_parse_operation operation -> Some ((), operation)
+                | _ -> None)
+        (fun ((), operation) -> Cannot_parse_operation operation) ;
+      case (Tag 1)
+        ~title:"Invalid_fitness"
+        (obj3
+           (req "error" (constant "invalid_fitness"))
+           (req "expected" Fitness.encoding)
+           (req "found" Fitness.encoding))
+        (function
+          | Invalid_fitness { expected ; found } ->
+              Some ((), expected, found)
+          | _ -> None)
+        (fun ((), expected, found) -> Invalid_fitness { expected ; found }) ;
+      case (Tag 2)
+        ~title:"Non_increasing_timestamp"
+        (obj1
+           (req "error" (constant "non_increasing_timestamp")))
+        (function Non_increasing_timestamp -> Some ()
+                | _ -> None)
+        (fun () -> Non_increasing_timestamp) ;
+      case (Tag 3)
+        ~title:"Non_increasing_fitness"
+        (obj1
+           (req "error" (constant "non_increasing_fitness")))
+        (function Non_increasing_fitness -> Some ()
+                | _ -> None)
+        (fun () -> Non_increasing_fitness) ;
+      case (Tag 4)
+        ~title:"Invalid_level"
+        (obj3
+           (req "error" (constant "invalid_level"))
+           (req "expected" int32)
+           (req "found" int32))
+        (function
+          | Invalid_level { expected ; found } ->
+              Some ((), expected, found)
+          | _ -> None)
+        (fun ((), expected, found) -> Invalid_level { expected ; found }) ;
+      case (Tag 5)
+        ~title:"Invalid_proto_level"
+        (obj3
+           (req "error" (constant "invalid_proto_level"))
+           (req "expected" uint8)
+           (req "found" uint8))
+        (function
+          | Invalid_proto_level { expected ; found } ->
+              Some ((), expected, found)
+          | _ -> None)
+        (fun ((), expected, found) ->
+           Invalid_proto_level { expected ; found }) ;
+      case (Tag 6)
+        ~title:"Replayed_operation"
+        (obj2
+           (req "error" (constant "replayed_operation"))
+           (req "operation" Operation_hash.encoding))
+        (function Replayed_operation operation -> Some ((), operation)
+                | _ -> None)
+        (fun ((), operation) -> Replayed_operation operation) ;
+      case (Tag 7)
+        ~title:"Outdated_operation"
+        (obj3
+           (req "error" (constant "outdated_operation"))
+           (req "operation" Operation_hash.encoding)
+           (req "originating_block" Block_hash.encoding))
+        (function
+          | Outdated_operation { operation ; originating_block } ->
+              Some ((), operation, originating_block)
+          | _ -> None)
+        (fun ((), operation, originating_block) ->
+           Outdated_operation { operation ; originating_block }) ;
+      case (Tag 8)
+        ~title:"Unexpected_number_of_validation_passes"
+        (obj2
+           (req "error" (constant "unexpected_number_of_passes"))
+           (req "found" uint8))
+        (function
+          | Unexpected_number_of_validation_passes n -> Some ((), n)
+          | _ -> None)
+        (fun ((), n) -> Unexpected_number_of_validation_passes n) ;
+      case (Tag 9)
+        ~title:"Too_many_operations"
+        (obj4
+           (req "error" (constant "too_many_operations"))
+           (req "validation_pass" uint8)
+           (req "found" uint16)
+           (req "max" uint16))
+        (function
+          | Too_many_operations { pass ; found ; max } ->
+              Some ((), pass, found, max)
+          | _ -> None)
+        (fun ((), pass, found, max) ->
+           Too_many_operations { pass ; found ; max }) ;
+      case (Tag 10)
+        ~title:"Oversized_operation"
+        (obj4
+           (req "error" (constant "oversized_operation"))
+           (req "operation" Operation_hash.encoding)
+           (req "found" int31)
+           (req "max" int31))
+        (function
+          | Oversized_operation { operation ; size ; max } ->
+              Some ((), operation, size, max)
+          | _ -> None)
+        (fun ((), operation, size, max) ->
+           Oversized_operation { operation ; size ; max }) ;
+      case (Tag 11)
+        ~title:"Unallowed_pass"
+        (obj4
+           (req "error" (constant "invalid_pass"))
+           (req "operation" Operation_hash.encoding)
+           (req "pass" uint8)
+           (req "allowed_pass" (list uint8)))
+        (function
+          | Unallowed_pass { operation ; pass ; allowed_pass } ->
+              Some ((), operation, pass, allowed_pass)
+          | _ -> None)
+        (fun ((), operation, pass, allowed_pass) ->
+           Unallowed_pass { operation ; pass ; allowed_pass }) ;
+    ]
+
+let pp_block_error ppf = function
+  | Cannot_parse_operation oph ->
+      Format.fprintf ppf
+        "Failed to parse the operation %a."
+        Operation_hash.pp_short oph
+  | Invalid_fitness { expected ; found } ->
+      Format.fprintf ppf
+        "@[<v 2>Invalid fitness:@ \
+        \ expected %a@ \
+        \ found %a@]"
+        Fitness.pp expected
+        Fitness.pp found
+  | Non_increasing_timestamp ->
+      Format.fprintf ppf "Non increasing timestamp"
+  | Non_increasing_fitness ->
+      Format.fprintf ppf "Non increasing fitness"
+  | Invalid_level { expected ; found } ->
+      Format.fprintf ppf
+        "Invalid level:@ \
+        \ expected %ld@ \
+        \ found %ld"
+        expected
+        found
+  | Invalid_proto_level { expected ; found } ->
+      Format.fprintf ppf
+        "Invalid protocol level:@ \
+        \ expected %d@ \
+        \ found %d"
+        expected
+        found
+  | Replayed_operation oph ->
+      Format.fprintf ppf
+        "The operation %a was previously included in the chain."
+        Operation_hash.pp_short oph
+  | Outdated_operation { operation ; originating_block } ->
+      Format.fprintf ppf
+        "The operation %a is outdated (originated in block: %a)"
+        Operation_hash.pp_short operation
+        Block_hash.pp_short originating_block
+  | Expired_chain { chain_id ; expiration ; timestamp } ->
+      Format.fprintf ppf
+        "The block timestamp (%a) is later than \
+         its chain expiration date: %a (chain: %a)."
+        Time.pp_hum timestamp
+        Time.pp_hum expiration
+        Chain_id.pp_short chain_id
+  | Unexpected_number_of_validation_passes n ->
+      Format.fprintf ppf
+        "Invalid number of validation passes (found: %d)"
+        n
+  | Too_many_operations { pass ; found ; max } ->
+      Format.fprintf ppf
+        "Too many operations in validation pass %d (found: %d, max: %d)"
+        pass found max
+  | Oversized_operation { operation ; size ; max } ->
+      Format.fprintf ppf
+        "Oversized operation %a (size: %d, max: %d)"
+        Operation_hash.pp_short operation size max
+  | Unallowed_pass { operation ; pass ; allowed_pass } ->
+      Format.fprintf ppf
+        "Operation %a included in validation pass %d, \
+        \ while only the following passes are allowed: @[<h>%a@]"
+        Operation_hash.pp_short operation pass
+        Format.(pp_print_list pp_print_int) allowed_pass
+  | Cannot_parse_block_header ->
+      Format.fprintf ppf "Failed to parse the block header."
+
+type error +=
+  | Invalid_block of
+      { block: Block_hash.t ; error: block_error }
+  | Unavailable_protocol of
+      { block: Block_hash.t ; protocol: Protocol_hash.t }
+  | Inconsistent_operations_hash of
+      { block: Block_hash.t ;
+        expected: Operation_list_list_hash.t ;
+        found: Operation_list_list_hash.t }
+  | Failed_to_checkout_context of Context_hash.t
+  | System_error of { errno: Unix.error ;
+                      fn: string ;
+                      msg: string }
+
+let () =
+  Error_monad.register_error_kind
+    `Permanent
+    ~id:"validator.invalid_block"
+    ~title:"Invalid block"
+    ~description:"Invalid block."
+    ~pp:begin fun ppf (block, error) ->
+      Format.fprintf ppf
+        "@[<v 2>Invalid block %a@ %a@]"
+        Block_hash.pp_short block pp_block_error error
+    end
+    Data_encoding.(merge_objs
+                     (obj1 (req "invalid_block" Block_hash.encoding))
+                     block_error_encoding)
+    (function Invalid_block { block ; error } ->
+       Some (block, error) | _ -> None)
+    (fun (block, error) ->
+       Invalid_block { block ; error }) ;
+  Error_monad.register_error_kind
+    `Temporary
+    ~id:"validator.unavailable_protocol"
+    ~title:"Missing protocol"
+    ~description:"The protocol required for validating a block is missing."
+    ~pp:begin fun ppf (block, protocol) ->
+      Format.fprintf ppf
+        "Missing protocol (%a) when validating the block %a."
+        Protocol_hash.pp_short protocol
+        Block_hash.pp_short block
+    end
+    Data_encoding.(
+      obj2
+        (req "block" Block_hash.encoding)
+        (req "missing_protocol" Protocol_hash.encoding))
+    (function
+      | Unavailable_protocol { block ; protocol } ->
+          Some (block, protocol)
+      | _ -> None)
+    (fun (block, protocol) -> Unavailable_protocol { block ; protocol }) ;
+  Error_monad.register_error_kind
+    `Temporary
+    ~id:"validator.inconsistent_operations_hash"
+    ~title:"Invalid merkle tree"
+    ~description:"The provided list of operations is inconsistent with \
+                  the block header."
+    ~pp:begin fun ppf (block, expected, found) ->
+      Format.fprintf ppf
+        "@[<v 2>The provided list of operations for block %a \
+        \ is inconsistent with the block header@ \
+        \ expected: %a@ \
+        \ found: %a@]"
+        Block_hash.pp_short block
+        Operation_list_list_hash.pp_short expected
+        Operation_list_list_hash.pp_short found
+    end
+    Data_encoding.(
+      obj3
+        (req "block" Block_hash.encoding)
+        (req "expected" Operation_list_list_hash.encoding)
+        (req "found" Operation_list_list_hash.encoding))
+    (function
+      | Inconsistent_operations_hash { block ; expected ; found } ->
+          Some (block, expected, found)
+      | _ -> None)
+    (fun (block, expected, found) ->
+       Inconsistent_operations_hash { block ; expected ; found });
+  Error_monad.register_error_kind
+    `Permanent
+    ~id:"Validator_process.failed_to_checkout_context"
+    ~title: "Fail during checkout context"
+    ~description: "The context checkout failed using a given hash"
+    ~pp:(fun ppf (hash:Context_hash.t) ->
+        Format.fprintf ppf
+          "@[Failed to checkout the context with hash %a@]"
+          Context_hash.pp_short hash)
+    Data_encoding.(obj1 (req "hash" Context_hash.encoding))
+    (function
+      | Failed_to_checkout_context h -> Some h
+      | _ -> None)
+    (fun h -> Failed_to_checkout_context h) ;
+  Error_monad.register_error_kind
+    `Temporary
+    ~id:"Validator_process.system_error_while_validating"
+    ~title: "Failed to validate block because of a system error"
+    ~description: "The validator failed because of a system error"
+    ~pp:(fun ppf (errno, fn, msg) ->
+        Format.fprintf ppf
+          "System error while validating a block (in function %s(%s)):@ %s"
+          fn msg (Unix.error_message errno))
+    Data_encoding.(obj3
+                     (req "errno" errno)
+                     (req "function" string)
+                     (req "msg" string))
+    (function
+      | System_error { errno ; fn ; msg } -> Some (errno, fn, msg)
+      | _ -> None)
+    (fun (errno, fn, msg) -> System_error { errno ; fn ; msg })
+
+let invalid_block block error = Invalid_block { block ; error }
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.mli b/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.mli
new file mode 100644
index 000000000..a7a86e30a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_validator_errors.mli
@@ -0,0 +1,66 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type block_error =
+  | Cannot_parse_operation of Operation_hash.t
+  | Invalid_fitness of { expected: Fitness.t ; found: Fitness.t }
+  | Non_increasing_timestamp
+  | Non_increasing_fitness
+  | Invalid_level of { expected: Int32.t ; found: Int32.t }
+  | Invalid_proto_level of { expected: int ; found: int }
+  | Replayed_operation of Operation_hash.t
+  | Outdated_operation of
+      { operation: Operation_hash.t;
+        originating_block: Block_hash.t }
+  | Expired_chain of
+      { chain_id: Chain_id.t ;
+        expiration: Time.t ;
+        timestamp: Time.t ;
+      }
+  | Unexpected_number_of_validation_passes of int (* uint8 *)
+  | Too_many_operations of { pass: int; found: int; max: int }
+  | Oversized_operation of { operation: Operation_hash.t;
+                             size: int; max: int }
+  | Unallowed_pass of { operation: Operation_hash.t ;
+                        pass: int ;
+                        allowed_pass: int list }
+  | Cannot_parse_block_header
+
+type error +=
+  | Invalid_block of
+      { block: Block_hash.t ; error: block_error }
+  | Unavailable_protocol of
+      { block: Block_hash.t ; protocol: Protocol_hash.t }
+  | Inconsistent_operations_hash of
+      { block: Block_hash.t ;
+        expected: Operation_list_list_hash.t ;
+        found: Operation_list_list_hash.t }
+  | Failed_to_checkout_context of Context_hash.t
+  | System_error of { errno: Unix.error ;
+                      fn: string ;
+                      msg: string }
+
+val invalid_block : Block_hash.t -> block_error -> error
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.ml b/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.ml
new file mode 100644
index 000000000..4c93d26cd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.ml
@@ -0,0 +1,108 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request = struct
+  type view = {
+    chain_id : Chain_id.t ;
+    block : Block_hash.t ;
+    peer : P2p_peer.Id.t option ;
+  }
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { chain_id ; block ; peer } -> (block, chain_id, peer))
+      (fun (block, chain_id, peer) -> { chain_id ; block ; peer })
+      (obj3
+         (req "block" Block_hash.encoding)
+         (req "chain_id" Chain_id.encoding)
+         (opt "peer" P2p_peer.Id.encoding))
+
+  let pp ppf { chain_id ; block ; peer } =
+    Format.fprintf ppf "Validation of %a (chain: %a)"
+      Block_hash.pp block
+      Chain_id.pp_short chain_id ;
+    match peer with
+    | None -> ()
+    | Some peer ->
+        Format.fprintf ppf "from peer %a"
+          P2p_peer.Id.pp_short peer
+end
+
+module Event = struct
+  type t =
+    | Validation_success of Request.view * Worker_types.request_status
+    | Validation_failure of Request.view * Worker_types.request_status * error list
+    | Debug of string
+
+  let level req =
+    match req with
+    | Debug _ -> Logging.Debug
+    | Validation_success _
+    | Validation_failure _ -> Logging.Notice
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0) ~title:"Debug"
+          (obj1 (req "message" string))
+          (function Debug msg -> Some msg | _ -> None)
+          (fun msg -> Debug msg) ;
+        case (Tag 1) ~title:"Validation_success"
+          (obj2
+             (req "successful_validation" Request.encoding)
+             (req "status" Worker_types.request_status_encoding))
+          (function Validation_success (r, s) -> Some (r, s) | _ -> None)
+          (fun (r, s) -> Validation_success (r, s)) ;
+        case (Tag 2) ~title:"Validation_failure"
+          (obj3
+             (req "failed_validation" Request.encoding)
+             (req "status" Worker_types.request_status_encoding)
+             (dft "errors" RPC_error.encoding []))
+          (function Validation_failure (r, s, err) -> Some (r, s, err) | _ -> None)
+          (fun (r, s, err) -> Validation_failure (r, s, err)) ]
+
+  let pp ppf = function
+    | Debug msg -> Format.fprintf ppf "%s" msg
+    | Validation_success (req, { pushed ; treated ; completed }) ->
+        Format.fprintf ppf
+          "@[<v 0>Block %a successfully validated@,\
+           Pushed: %a, Treated: %a, Completed: %a@]"
+          Block_hash.pp req.block
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+    | Validation_failure (req, { pushed ; treated ; completed }, errs)->
+        Format.fprintf ppf
+          "@[<v 0>Validation of block %a failed@,\
+           Pushed: %a, Treated: %a, Failed: %a@,\
+           %a@]"
+          Block_hash.pp req.block
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+          (Format.pp_print_list Error_monad.pp) errs
+end
+
+module Worker_state = struct
+  type view = unit
+  let encoding = Data_encoding.empty
+  let pp _ppf _view = ()
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.mli b/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.mli
new file mode 100644
index 000000000..89c0e3578
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/block_validator_worker_state.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request : sig
+  type view = {
+    chain_id : Chain_id.t ;
+    block : Block_hash.t ;
+    peer: P2p_peer.Id.t option ;
+  }
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
+
+module Event : sig
+  type t =
+    | Validation_success of Request.view * Worker_types.request_status
+    | Validation_failure of Request.view * Worker_types.request_status * error list
+    | Debug of string
+  val level : t -> Logging.level
+  val encoding : t Data_encoding.encoding
+  val pp : Format.formatter -> t -> unit
+end
+
+module Worker_state : sig
+  type view = unit
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/chain_services.ml b/vendors/tezos-modded/src/lib_shell_services/chain_services.ml
new file mode 100644
index 000000000..0699f44f8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/chain_services.ml
@@ -0,0 +1,198 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+type chain = [
+  | `Main
+  | `Test
+  | `Hash of Chain_id.t
+]
+
+let chain_arg = Block_services.chain_arg
+let to_string = Block_services.chain_to_string
+let parse_chain = Block_services.parse_chain
+
+type invalid_block = {
+  hash: Block_hash.t ;
+  level: Int32.t ;
+  errors: error list ;
+}
+
+type prefix = Block_services.chain_prefix
+let path = Block_services.chain_path
+
+let invalid_block_encoding =
+  conv
+    (fun { hash ; level ; errors } -> (hash, level, errors))
+    (fun (hash, level, errors) -> { hash ; level ; errors })
+    (obj3
+       (req "block" Block_hash.encoding)
+       (req "level" int32)
+       (req "errors" RPC_error.encoding))
+
+module S = struct
+
+  let path : prefix RPC_path.context = RPC_path.open_root
+
+  let chain_id =
+    RPC_service.get_service
+      ~description:"The chain unique identifier."
+      ~query: RPC_query.empty
+      ~output: Chain_id.encoding
+      RPC_path.(path / "chain_id")
+
+  module Blocks = struct
+
+    let list_query =
+      let open RPC_query in
+      query (fun length heads min_date ->
+          object
+            method length = length
+            method heads = heads
+            method min_date = min_date
+          end)
+      |+ opt_field "length"
+        ~descr:
+          "The requested number of predecessors to returns (per \
+           requested head)."
+        RPC_arg.int (fun x -> x#length)
+      |+ multi_field "head"
+        ~descr:
+          "An empty argument requests blocks from the current heads. \
+           A non empty list allow to request specific fragment \
+           of the chain."
+        Block_hash.rpc_arg (fun x -> x#heads)
+      |+ opt_field "min_date"
+        ~descr: "When `min_date` is provided, heads with a \
+                 timestamp before `min_date` are filtered out"
+        Time.rpc_arg (fun x -> x#min_date)
+      |> seal
+
+    let path = RPC_path.(path / "blocks")
+
+    let list =
+      let open Data_encoding in
+      RPC_service.get_service
+        ~description:
+          "Lists known heads of the blockchain sorted with decreasing fitness. \
+           Optional arguments allows to returns the list of predecessors for \
+           known heads or the list of predecessors for a given list of blocks."
+        ~query: list_query
+        ~output: (list (list Block_hash.encoding))
+        path
+
+  end
+
+  module Invalid_blocks = struct
+
+    let path = RPC_path.(path / "invalid_blocks")
+
+    let list =
+      RPC_service.get_service
+        ~description:
+          "Lists blocks that have been declared invalid along with the errors \
+           that led to them being declared invalid."
+        ~query: RPC_query.empty
+        ~output: (list invalid_block_encoding)
+        path
+
+    let get =
+      RPC_service.get_service
+        ~description: "The errors that appears during the block (in)validation."
+        ~query: RPC_query.empty
+        ~output: invalid_block_encoding
+        RPC_path.(path /: Block_hash.rpc_arg)
+
+    let delete =
+      RPC_service.delete_service
+        ~description: "Remove an invalid block for the tezos storage"
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        RPC_path.(path /: Block_hash.rpc_arg)
+
+  end
+
+end
+
+let make_call0 s ctxt chain q p =
+  let s = RPC_service.prefix path s in
+  RPC_context.make_call1 s ctxt chain q p
+
+let make_call1 s ctxt chain a q p =
+  let s = RPC_service.prefix path s in
+  RPC_context.make_call2 s ctxt chain a q p
+
+let chain_id ctxt =
+  let f = make_call0 S.chain_id ctxt in
+  fun ?(chain = `Main) () ->
+    match chain with
+    | `Hash h -> return h
+    | _ -> f chain () ()
+
+module Blocks = struct
+
+  let list ctxt =
+    let f = make_call0 S.Blocks.list ctxt in
+    fun ?(chain = `Main) ?(heads = []) ?length ?min_date () ->
+      f chain
+        (object
+          method heads = heads
+          method length = length
+          method min_date = min_date
+        end)
+        ()
+
+  include Block_services.Empty
+
+  type protocols = Block_services.protocols = {
+    current_protocol: Protocol_hash.t ;
+    next_protocol: Protocol_hash.t ;
+  }
+
+  let protocols = Block_services.protocols
+
+end
+
+module Mempool = Block_services.Empty.Mempool
+
+module Invalid_blocks = struct
+
+  let list ctxt =
+    let f = make_call0 S.Invalid_blocks.list ctxt in
+    fun ?(chain = `Main) () ->
+      f chain () ()
+
+  let get ctxt =
+    let f = make_call1 S.Invalid_blocks.get ctxt in
+    fun ?(chain = `Main) block  ->
+      f chain block () ()
+
+  let delete ctxt =
+    let f = make_call1 S.Invalid_blocks.delete ctxt in
+    fun ?(chain = `Main) block ->
+      f chain block () ()
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/chain_services.mli b/vendors/tezos-modded/src/lib_shell_services/chain_services.mli
new file mode 100644
index 000000000..332efe014
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/chain_services.mli
@@ -0,0 +1,136 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type chain = [
+  | `Main
+  | `Test
+  | `Hash of Chain_id.t
+]
+
+val parse_chain: string -> (chain, string) result
+val to_string: chain -> string
+
+val chain_arg: chain RPC_arg.t
+
+type invalid_block = {
+  hash: Block_hash.t ;
+  level: Int32.t ;
+  errors: error list ;
+}
+
+type prefix = unit * chain
+val path: (unit, prefix) RPC_path.path
+
+open RPC_context
+
+val chain_id:
+  #simple ->
+  ?chain:chain ->
+  unit -> Chain_id.t tzresult Lwt.t
+
+module Mempool = Block_services.Empty.Mempool
+
+module Blocks : sig
+
+  val list:
+    #simple ->
+    ?chain:chain ->
+    ?heads:Block_hash.t list ->
+    ?length:int ->
+    ?min_date:Time.t ->
+    unit -> Block_hash.t list list tzresult Lwt.t
+
+  include (module type of Block_services.Empty)
+
+  type protocols = {
+    current_protocol: Protocol_hash.t ;
+    next_protocol: Protocol_hash.t ;
+  }
+
+  val protocols:
+    #RPC_context.simple -> ?chain:chain -> ?block:Block_services.block ->
+    unit -> protocols tzresult Lwt.t
+
+end
+
+module Invalid_blocks : sig
+
+  val list:
+    #simple ->
+    ?chain:chain ->
+    unit -> invalid_block list tzresult Lwt.t
+
+  val get:
+    #simple ->
+    ?chain:chain ->
+    Block_hash.t -> invalid_block tzresult Lwt.t
+
+  val delete:
+    #simple ->
+    ?chain:chain ->
+    Block_hash.t -> unit tzresult Lwt.t
+
+end
+
+module S : sig
+
+  val chain_id:
+    ([ `GET ], prefix,
+     prefix, unit, unit,
+     Chain_id.t) RPC_service.t
+
+  module Blocks : sig
+
+    val path: (prefix, prefix) RPC_path.t
+
+    val list:
+      ([ `GET ], prefix,
+       prefix, < heads : Block_hash.t list;
+                 length : int option;
+                 min_date : Time.t option >, unit,
+       Block_hash.t list list) RPC_service.t
+
+  end
+
+  module Invalid_blocks : sig
+
+    val list:
+      ([ `GET ], prefix,
+       prefix, unit, unit,
+       invalid_block list) RPC_service.t
+
+    val get:
+      ([ `GET ], prefix,
+       prefix * Block_hash.t, unit, unit,
+       invalid_block) RPC_service.t
+
+    val delete:
+      ([ `DELETE ], prefix,
+       prefix * Block_hash.t, unit, unit,
+       unit) RPC_service.t
+
+  end
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.ml b/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.ml
new file mode 100644
index 000000000..be545db31
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.ml
@@ -0,0 +1,135 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request = struct
+  type view = Block_hash.t
+
+  let encoding = Block_hash.encoding
+  let pp = Block_hash.pp
+end
+
+module Event = struct
+  type update =
+    | Ignored_head
+    | Branch_switch
+    | Head_incrememt
+  type t =
+    | Processed_block of
+        { request : Request.view ;
+          request_status : Worker_types.request_status ;
+          update : update ;
+          fitness : Fitness.t }
+    | Could_not_switch_testchain of error list
+
+  let level = function
+    | Processed_block req ->
+        begin match req.update with
+          | Ignored_head -> Logging.Info
+          | Branch_switch | Head_incrememt -> Logging.Notice
+        end
+    | Could_not_switch_testchain _ -> Logging.Error
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Processed_block"
+          (obj4
+             (req "request" Request.encoding)
+             (req "status" Worker_types.request_status_encoding)
+             (req "outcome"
+                (string_enum [ "ignored", Ignored_head ;
+                               "branch", Branch_switch ;
+                               "increment", Head_incrememt ]))
+             (req "fitness" Fitness.encoding))
+          (function
+            | Processed_block { request ; request_status ; update ; fitness } ->
+                Some (request, request_status, update, fitness)
+            | _ -> None)
+          (fun (request, request_status, update, fitness) ->
+             Processed_block { request ; request_status ; update ; fitness }) ;
+        case (Tag 1)
+          ~title:"Could_not_switch_testchain"
+          RPC_error.encoding
+          (function
+            | Could_not_switch_testchain err -> Some err
+            | _ -> None)
+          (fun err -> Could_not_switch_testchain err) ]
+
+  let pp ppf = function
+    | Processed_block req ->
+        Format.fprintf ppf "@[<v 0>" ;
+        begin match req.update with
+          | Ignored_head ->
+              Format.fprintf ppf
+                "Current head is better than %a (fitness %a), we do not switch@,"
+          | Branch_switch ->
+              Format.fprintf ppf
+                "Update current head to %a (fitness %a), changing branch@,"
+          | Head_incrememt ->
+              Format.fprintf ppf
+                "Update current head to %a (fitness %a), same branch@,"
+        end
+          Request.pp req.request
+          Fitness.pp req.fitness ;
+        Format.fprintf ppf
+          "Pushed: %a, Treated: %a, Completed: %a@]"
+          Time.pp_hum req.request_status.pushed
+          Time.pp_hum req.request_status.treated
+          Time.pp_hum req.request_status.completed
+    | Could_not_switch_testchain err ->
+        Format.fprintf ppf "@[<v 0>Error while switching test chain:@ %a@]"
+          (Format.pp_print_list Error_monad.pp) err
+
+end
+
+module Worker_state = struct
+  type view =
+    { active_peers : P2p_peer.Id.t list ;
+      bootstrapped_peers : P2p_peer.Id.t list ;
+      bootstrapped : bool }
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { bootstrapped ; bootstrapped_peers ; active_peers } ->
+         (bootstrapped, bootstrapped_peers, active_peers))
+      (fun (bootstrapped, bootstrapped_peers, active_peers) ->
+         { bootstrapped ; bootstrapped_peers ; active_peers })
+      (obj3
+         (req "bootstrapped" bool)
+         (req "bootstrapped_peers" (list P2p_peer.Id.encoding))
+         (req "active_peers" (list P2p_peer.Id.encoding)))
+
+  let pp ppf { bootstrapped ; bootstrapped_peers ; active_peers } =
+    Format.fprintf ppf
+      "@[<v 0>Network is%s bootstrapped.@,\
+       @[<v 2>Active peers:%a@]@,\
+       @[<v 2>Bootstrapped peers:%a@]@]"
+      (if bootstrapped then "" else " not yet")
+      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp))
+      active_peers
+      (fun ppf -> List.iter (Format.fprintf ppf "@,- %a" P2p_peer.Id.pp))
+      bootstrapped_peers
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.mli b/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.mli
new file mode 100644
index 000000000..5fa936ef7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/chain_validator_worker_state.mli
@@ -0,0 +1,56 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request : sig
+  type view = Block_hash.t
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
+
+module Event : sig
+  type update =
+    | Ignored_head
+    | Branch_switch
+    | Head_incrememt
+  type t =
+    | Processed_block of
+        { request : Request.view ;
+          request_status : Worker_types.request_status ;
+          update : update ;
+          fitness : Fitness.t }
+    | Could_not_switch_testchain of error list
+  val level : t -> Logging.level
+  val encoding : t Data_encoding.encoding
+  val pp : Format.formatter -> t -> unit
+end
+
+module Worker_state : sig
+  type view =
+    { active_peers : P2p_peer.Id.t list ;
+      bootstrapped_peers : P2p_peer.Id.t list ;
+      bootstrapped : bool }
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/connection_metadata.ml b/vendors/tezos-modded/src/lib_shell_services/connection_metadata.ml
new file mode 100644
index 000000000..7d910fc4d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/connection_metadata.ml
@@ -0,0 +1,42 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  disable_mempool : bool ;
+  private_node : bool ;
+}
+
+let encoding =
+  let open Data_encoding in
+  (conv
+     (fun { disable_mempool ; private_node } ->
+        disable_mempool , private_node)
+     (fun (disable_mempool , private_node) ->
+        { disable_mempool ; private_node }))
+    (obj2
+       (req "disable_mempool" bool)
+       (req "private_node" bool))
+
+let pp _ppf _ = ()
diff --git a/vendors/tezos-modded/src/lib_shell_services/connection_metadata.mli b/vendors/tezos-modded/src/lib_shell_services/connection_metadata.mli
new file mode 100644
index 000000000..60ec26b49
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/connection_metadata.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** All the metadata associated to a running connection. *)
+
+type t = {
+  disable_mempool : bool ;
+  private_node : bool ;
+}
+
+val encoding: t Data_encoding.t
+val pp: Format.formatter -> t -> unit
diff --git a/vendors/tezos-modded/src/lib_shell_services/dune b/vendors/tezos-modded/src/lib_shell_services/dune
new file mode 100644
index 000000000..2011ac862
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/dune
@@ -0,0 +1,13 @@
+(library
+ (name tezos_shell_services)
+ (public_name tezos-shell-services)
+ (libraries tezos-base)
+ (flags (:standard -w +27@8
+                   -safe-string
+                   -linkall
+                   -open Tezos_base__TzPervasives)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_shell_services/injection_services.ml b/vendors/tezos-modded/src/lib_shell_services/injection_services.ml
new file mode 100644
index 000000000..a5bef93ee
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/injection_services.ml
@@ -0,0 +1,138 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module S = struct
+
+  open Data_encoding
+
+  let path = RPC_path.(root / "injection")
+
+  let block_query =
+    let open RPC_query in
+    query (fun async force chain -> object
+            method async = async
+            method force = force
+            method chain = chain
+          end)
+    |+ flag "async" (fun t -> t#async)
+    |+ flag "force" (fun t -> t#force)
+    |+ opt_field "chain" Chain_services.chain_arg (fun t -> t#chain)
+    |> seal
+
+  let block_param =
+    obj2
+      (req "data" bytes)
+      (req "operations"
+         (list (dynamic_size (list (dynamic_size Operation.encoding)))))
+
+  let block =
+    RPC_service.post_service
+      ~description:
+        "Inject a block in the node and broadcast it. The `operations` \
+         embedded in `blockHeader` might be pre-validated using a \
+         contextual RPCs from the latest block \
+         (e.g. '/blocks/head/context/preapply'). Returns the ID of the \
+         block. By default, the RPC will wait for the block to be \
+         validated before answering."
+      ~query: block_query
+      ~input: block_param
+      ~output: Block_hash.encoding
+      RPC_path.(path / "block")
+
+  let operation_query =
+    let open RPC_query in
+    query (fun async chain -> object
+            method async = async
+            method chain = chain
+          end)
+    |+ flag "async" (fun t -> t#async)
+    |+ opt_field "chain" Chain_services.chain_arg (fun t -> t#chain)
+    |> seal
+
+  let operation =
+    RPC_service.post_service
+      ~description:
+        "Inject an operation in node and broadcast it. Returns the \
+         ID of the operation. The `signedOperationContents` should be \
+         constructed using a contextual RPCs from the latest block \
+         and signed by the client. By default, the RPC will wait for \
+         the operation to be (pre-)validated before answering. See \
+         RPCs under /blocks/prevalidation for more details on the \
+         prevalidation context."
+      ~query: operation_query
+      ~input: bytes
+      ~output: Operation_hash.encoding
+      RPC_path.(path / "operation")
+
+  let protocol_query =
+    let open RPC_query in
+    query (fun async force -> object
+            method async = async
+            method force = force
+          end)
+    |+ flag "async" (fun t -> t#async)
+    |+ flag "force" (fun t -> t#force)
+    |> seal
+
+
+  let protocol =
+    RPC_service.post_service
+      ~description:
+        "Inject a protocol in node. Returns the ID of the protocol."
+      ~query: protocol_query
+      ~input: Protocol.encoding
+      ~output: Protocol_hash.encoding
+      RPC_path.(path / "protocol")
+
+end
+
+open RPC_context
+
+let block ctxt
+    ?(async = false) ?(force = false) ?chain
+    raw operations =
+  make_call S.block ctxt ()
+    (object
+      method async = async
+      method force = force
+      method chain = chain
+    end)
+    (raw, operations)
+
+let operation ctxt ?(async = false) ?chain operation =
+  make_call S.operation ctxt ()
+    (object
+      method async = async
+      method chain = chain
+    end)
+    operation
+
+let protocol ctxt ?(async = false) ?(force = false) protocol =
+  make_call S.protocol ctxt ()
+    (object
+      method async = async
+      method force = force
+    end)
+    protocol
diff --git a/vendors/tezos-modded/src/lib_shell_services/injection_services.mli b/vendors/tezos-modded/src/lib_shell_services/injection_services.mli
new file mode 100644
index 000000000..e81841c90
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/injection_services.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 RPC_context
+
+val block:
+  #simple ->
+  ?async:bool -> ?force:bool -> ?chain:Chain_services.chain ->
+  MBytes.t -> Operation.t list list ->
+  Block_hash.t tzresult Lwt.t
+(** [block cctxt ?async ?force raw_block] tries to inject
+    [raw_block] inside the node. If [?async] is [true], [raw_block]
+    will be validated before the result is returned. If [?force] is
+    true, the block will be injected even on non strictly increasing
+    fitness. *)
+
+val operation:
+  #simple ->
+  ?async:bool -> ?chain:Chain_services.chain ->
+  MBytes.t ->
+  Operation_hash.t tzresult Lwt.t
+
+val protocol:
+  #simple ->
+  ?async:bool -> ?force:bool ->
+  Protocol.t ->
+  Protocol_hash.t tzresult Lwt.t
+
+module S : sig
+
+  val block:
+    ([ `POST ], unit,
+     unit, < async: bool ;
+             force: bool ;
+             chain: Chain_services.chain option >, MBytes.t * Operation.t list list,
+     Block_hash.t) RPC_service.t
+
+  val operation:
+    ([ `POST ], unit,
+     unit, < async : bool;
+             chain : Chain_services.chain option >, MBytes.t,
+     Operation_hash.t) RPC_service.t
+
+  val protocol:
+    ([ `POST ], unit,
+     unit, < async : bool;
+             force : bool >, Protocol.t,
+     Protocol_hash.t) RPC_service.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/monitor_services.ml b/vendors/tezos-modded/src/lib_shell_services/monitor_services.ml
new file mode 100644
index 000000000..db0ffffc0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/monitor_services.ml
@@ -0,0 +1,134 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module S = struct
+
+  open Data_encoding
+
+  let path = RPC_path.(root / "monitor")
+
+  let bootstrapped =
+    RPC_service.get_service
+      ~description:
+        "Wait for the node to have synchronized its chain with a few \
+         peers (configured by the node's administrator), streaming \
+         head updates that happen during the bootstrapping process, \
+         and closing the stream at the end. If the node was already \
+         bootstrapped, returns the current head immediately."
+      ~query: RPC_query.empty
+      ~output: (obj2
+                  (req "block" Block_hash.encoding)
+                  (req "timestamp" Time.encoding))
+      RPC_path.(path / "bootstrapped")
+
+  let valid_blocks_query =
+    let open RPC_query in
+    query (fun protocols next_protocols chains -> object
+            method protocols = protocols
+            method next_protocols = next_protocols
+            method chains = chains
+          end)
+    |+ multi_field "protocol"
+      Protocol_hash.rpc_arg (fun t -> t#protocols)
+    |+ multi_field "next_protocol"
+      Protocol_hash.rpc_arg (fun t -> t#next_protocols)
+    |+ multi_field "chain"
+      Chain_services.chain_arg (fun t -> t#chains)
+    |> seal
+
+  let valid_blocks =
+    RPC_service.get_service
+      ~description:"Monitor all blocks that are successfully validated \
+                    by the node, disregarding whether they were \
+                    selected as the new head or not."
+      ~query: valid_blocks_query
+      ~output: (merge_objs
+                  (obj2
+                     (req "chain_id" Chain_id.encoding)
+                     (req "hash" Block_hash.encoding))
+                  Block_header.encoding)
+      RPC_path.(path / "valid_blocks")
+
+  let heads_query =
+    let open RPC_query in
+    query (fun next_protocols -> object
+            method next_protocols = next_protocols
+          end)
+    |+ multi_field "next_protocol"
+      Protocol_hash.rpc_arg (fun t -> t#next_protocols)
+    |> seal
+
+  let heads =
+    RPC_service.get_service
+      ~description:"Monitor all blocks that are successfully validated \
+                    by the node and selected as the new head of the \
+                    given chain."
+      ~query: heads_query
+      ~output: (merge_objs
+                  (obj1
+                     (req "hash" Block_hash.encoding))
+                  Block_header.encoding)
+      RPC_path.(path / "heads" /: Chain_services.chain_arg)
+
+  let protocols =
+    RPC_service.get_service
+      ~description:"Monitor all economic protocols that are retrieved \
+                    and successfully loaded and compiled by the node."
+      ~query: RPC_query.empty
+      ~output: Protocol_hash.encoding
+      RPC_path.(path / "protocols")
+
+  let commit_hash =
+    RPC_service.get_service
+      ~description:"Get information on the build of the node."
+      ~query: RPC_query.empty
+      ~output: string
+      RPC_path.(path / "commit_hash")
+
+end
+
+open RPC_context
+
+let bootstrapped ctxt =
+  make_streamed_call S.bootstrapped ctxt () () ()
+
+let valid_blocks
+    ctxt ?(chains = [`Main]) ?(protocols = []) ?(next_protocols = []) () =
+  make_streamed_call S.valid_blocks ctxt () (object
+    method chains = chains
+    method protocols = protocols
+    method next_protocols = next_protocols
+  end) ()
+
+let heads ctxt ?(next_protocols = []) chain =
+  make_streamed_call S.heads ctxt ((), chain) (object
+    method next_protocols = next_protocols
+  end) ()
+
+let protocols ctxt =
+  make_streamed_call S.protocols ctxt () () ()
+
+let commit_hash ctxt =
+  make_call S.commit_hash ctxt () () ()
diff --git a/vendors/tezos-modded/src/lib_shell_services/monitor_services.mli b/vendors/tezos-modded/src/lib_shell_services/monitor_services.mli
new file mode 100644
index 000000000..c64af75d3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/monitor_services.mli
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 RPC_context
+
+val bootstrapped:
+  #streamed -> ((Block_hash.t * Time.t) Lwt_stream.t * stopper) tzresult Lwt.t
+
+val valid_blocks:
+  #streamed ->
+  ?chains:Chain_services.chain list ->
+  ?protocols:Protocol_hash.t list ->
+  ?next_protocols:Protocol_hash.t list ->
+  unit -> (((Chain_id.t * Block_hash.t) * Block_header.t) Lwt_stream.t * stopper) tzresult Lwt.t
+
+val heads:
+  #streamed ->
+  ?next_protocols:Protocol_hash.t list ->
+  Chain_services.chain ->
+  ((Block_hash.t * Block_header.t) Lwt_stream.t * stopper) tzresult Lwt.t
+
+val protocols:
+  #streamed ->
+  (Protocol_hash.t Lwt_stream.t * stopper) tzresult Lwt.t
+
+val commit_hash: #simple -> string tzresult Lwt.t
+
+module S : sig
+
+  val bootstrapped:
+    ([ `GET ], unit,
+     unit, unit, unit,
+     Block_hash.t * Time.t) RPC_service.t
+
+  val valid_blocks:
+    ([ `GET ], unit,
+     unit, < chains : Chain_services.chain list;
+             next_protocols : Protocol_hash.t list;
+             protocols : Protocol_hash.t list >, unit,
+     (Chain_id.t * Block_hash.t) * Block_header.t) RPC_service.t
+
+  val heads:
+    ([ `GET ], unit,
+     unit * Chain_services.chain,
+     < next_protocols : Protocol_hash.t list >, unit,
+     Block_hash.t * Block_header.t) RPC_service.t
+
+  val protocols:
+    ([ `GET ], unit,
+     unit, unit, unit,
+     Protocol_hash.t) RPC_service.t
+
+  val commit_hash:
+    ([ `GET ], unit, unit, unit, unit, string) RPC_service.t
+end
+
diff --git a/vendors/tezos-modded/src/lib_shell_services/p2p_errors.ml b/vendors/tezos-modded/src/lib_shell_services/p2p_errors.ml
new file mode 100644
index 000000000..6d2998388
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/p2p_errors.ml
@@ -0,0 +1,254 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(************************ p2p io scheduler ********************************)
+
+type error += Connection_closed
+
+let () =
+  (* Connection closed *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_io_scheduler.connection_closed"
+    ~title:"Connection closed"
+    ~description:"IO error: connection with a peer is closed."
+    ~pp:(fun ppf () -> Format.fprintf ppf "IO error: connection with a peer is closed.")
+    Data_encoding.empty
+    (function Connection_closed -> Some () | _ -> None)
+    (fun () -> Connection_closed)
+
+(***************************** p2p socket *********************************)
+
+type error += Decipher_error
+type error += Invalid_message_size
+type error += Encoding_error
+type error += Rejected_socket_connection
+type error += Decoding_error
+type error += Myself of P2p_connection.Id.t
+type error += Not_enough_proof_of_work of P2p_peer.Id.t
+type error += Invalid_auth
+type error += Invalid_chunks_size of { value: int ; min: int ; max: int }
+
+let () =
+  (* Decipher error *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.decipher_error"
+    ~title:"Decipher error"
+    ~description:"An error occurred while deciphering."
+    ~pp:(fun ppf () -> Format.fprintf ppf "An error occurred while deciphering.")
+    Data_encoding.empty
+    (function Decipher_error -> Some () | _ -> None)
+    (fun () -> Decipher_error) ;
+  (* Invalid message size *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.invalid_message_size"
+    ~title:"Invalid message size"
+    ~description:"The size of the message to be written is invalid."
+    ~pp:(fun ppf () -> Format.fprintf ppf "The size of the message to be written is invalid.")
+    Data_encoding.empty
+    (function Invalid_message_size -> Some () | _ -> None)
+    (fun () -> Invalid_message_size) ;
+  (* Encoding error *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.encoding_error"
+    ~title:"Encoding error"
+    ~description:"An error occurred while encoding."
+    ~pp:(fun ppf () -> Format.fprintf ppf "An error occurred while encoding.")
+    Data_encoding.empty
+    (function Encoding_error -> Some () | _ -> None)
+    (fun () -> Encoding_error) ;
+  (* Rejected socket connection *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.rejected_socket_connection"
+    ~title:"Rejected socket connection"
+    ~description:"Rejected peer connection: rejected socket connection."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Rejected peer connection: rejected socket connection.")
+    Data_encoding.empty
+    (function Rejected_socket_connection -> Some () | _ -> None)
+    (fun () -> Rejected_socket_connection) ;
+  (* Decoding error *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.decoding_error"
+    ~title:"Decoding error"
+    ~description:"An error occurred while decoding."
+    ~pp:(fun ppf () -> Format.fprintf ppf "An error occurred while decoding.")
+    Data_encoding.empty
+    (function Decoding_error -> Some () | _ -> None)
+    (fun () -> Decoding_error) ;
+  (* Myself *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.myself"
+    ~title:"Myself"
+    ~description:"Remote peer is actually yourself."
+    ~pp:(fun ppf id -> Format.fprintf ppf
+            "Remote peer %a cannot be authenticated: peer is actually yourself."
+            P2p_connection.Id.pp id)
+    Data_encoding.(obj1 (req "connection id" P2p_connection.Id.encoding))
+    (function Myself id -> Some id | _ -> None)
+    (fun id -> Myself id) ;
+  (* Not enough proof of work *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.not_enough_proof_of_work"
+    ~title:"Not enough proof of work"
+    ~description:"Remote peer cannot be authenticated: not enough proof of work."
+    ~pp:(fun ppf id ->
+        Format.fprintf ppf
+          "Remote peer %a cannot be authenticated: not enough proof of work."
+          P2p_peer.Id.pp id)
+    Data_encoding.(obj1 (req "peer id" P2p_peer.Id.encoding))
+    (function Not_enough_proof_of_work id -> Some id | _ -> None)
+    (fun id -> Not_enough_proof_of_work id) ;
+  (* Invalid authentication *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.invalid_auth"
+    ~title:"Invalid authentication"
+    ~description:"Rejected peer connection: invalid authentication."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Rejected peer connection: invalid authentication.")
+    Data_encoding.empty
+    (function Invalid_auth -> Some () | _ -> None)
+    (fun () -> Invalid_auth) ;
+  (* Invalid chunks size *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_socket.invalid_chunks_size"
+    ~title:"Invalid chunks size"
+    ~description:"Size of chunks is not valid."
+    ~pp:(fun ppf (value, min, max) ->
+        Format.fprintf ppf "Size of chunks is invalid: should be between %d and %d but is %d" min max value)
+    Data_encoding.(obj3
+                     (req "value" int31)
+                     (req "min" int31)
+                     (req "max" int31))
+    (function Invalid_chunks_size { value ; min ; max }
+      -> Some (value, min, max) | _ -> None)
+    (fun (value, min, max) -> Invalid_chunks_size { value ; min ; max })
+
+(***************************** p2p pool ***********************************)
+
+type error += Pending_connection
+type error += Connected
+type error += Connection_refused
+type error += Rejected of P2p_peer.Id.t
+type error += Too_many_connections
+type error += Private_mode
+type error += Point_banned of P2p_point.Id.t
+type error += Peer_banned of P2p_peer.Id.t
+
+let () =
+  (* Pending connection *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.pending_connection"
+    ~title:"Pending connection"
+    ~description:"Fail to connect with a peer: a connection is already pending."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Fail to connect with a peer: a connection is already pending.")
+    Data_encoding.empty
+    (function Pending_connection -> Some () | _ -> None)
+    (fun () -> Pending_connection) ;
+  (* Connected *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.connected"
+    ~title:"Connected"
+    ~description:"Fail to connect with a peer: a connection is already established."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Fail to connect with a peer: a connection is already established.")
+    Data_encoding.empty
+    (function Connected -> Some () | _ -> None)
+    (fun () -> Connected) ;
+  (* Connected refused *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.connection_refused"
+    ~title:"Connection refused"
+    ~description:"Connection was refused."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Connection was refused.")
+    Data_encoding.empty
+    (function Connection_refused -> Some () | _ -> None)
+    (fun () -> Connection_refused) ;
+  (* Rejected *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.rejected"
+    ~title:"Rejected peer"
+    ~description:"Connection to peer was rejected."
+    ~pp:(fun ppf id ->
+        Format.fprintf ppf "Connection to peer %a was rejected." P2p_peer.Id.pp id)
+    Data_encoding.(obj1 (req "peer id" P2p_peer.Id.encoding))
+    (function Rejected id -> Some id | _ -> None)
+    (fun id -> Rejected id) ;
+  (* Too many connections *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.too_many_connections"
+    ~title:"Too many connections"
+    ~description:"Too many connections."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Too many connections.")
+    Data_encoding.empty
+    (function Too_many_connections -> Some () | _ -> None)
+    (fun () -> Too_many_connections) ;
+  (* Private mode *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.private_mode"
+    ~title:"Private mode"
+    ~description:"Node is in private mode."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Node is in private mode.")
+    Data_encoding.empty
+    (function Private_mode -> Some () | _ -> None)
+    (fun () -> Private_mode) ;
+  (* Point Banned *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.point_banned"
+    ~title:"Point Banned"
+    ~description:"The addr you tried to connect is banned."
+    ~pp:(fun ppf (addr, _port) ->
+        Format.fprintf ppf
+          "The addr you tried to connect (%a) is banned."
+          P2p_addr.pp addr)
+    Data_encoding.(obj1 (req "point" P2p_point.Id.encoding))
+    (function Point_banned point -> Some point | _ -> None)
+    (fun point -> Point_banned point) ;
+  (* Peer Banned *)
+  register_error_kind
+    `Permanent
+    ~id:"node.p2p_pool.peer_banned"
+    ~title:"Peer Banned"
+    ~description:"The peer identity you tried to connect is banned."
+    ~pp:(fun ppf peer_id ->
+        Format.fprintf ppf
+          "The peer identity you tried to connect (%a) is banned."
+          P2p_peer.Id.pp peer_id)
+    Data_encoding.(obj1 (req "peer" P2p_peer.Id.encoding))
+    (function Peer_banned peer_id -> Some peer_id | _ -> None)
+    (fun peer_id -> Peer_banned peer_id)
diff --git a/vendors/tezos-modded/src/lib_shell_services/p2p_services.ml b/vendors/tezos-modded/src/lib_shell_services/p2p_services.ml
new file mode 100644
index 000000000..9cec46c3c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/p2p_services.ml
@@ -0,0 +1,339 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 wait_query =
+  let open RPC_query in
+  query (fun wait -> object
+          method wait = wait
+        end)
+  |+ flag "wait" (fun t -> t#wait)
+  |> seal
+
+let monitor_query =
+  let open RPC_query in
+  query (fun monitor -> object
+          method monitor = monitor
+        end)
+  |+ flag "monitor" (fun t -> t#monitor)
+  |> seal
+
+let timeout_query =
+  let open RPC_query in
+  query (fun timeout -> object
+          method timeout = timeout
+        end)
+  |+ field "timeout" RPC_arg.float 10. (fun t -> t#timeout)
+  |> seal
+
+module S = struct
+
+  let self =
+    RPC_service.get_service
+      ~description:"Return the node's peer id"
+      ~query: RPC_query.empty
+      ~output: P2p_peer.Id.encoding
+      RPC_path.(root / "network" / "self")
+
+  let versions =
+    RPC_service.get_service
+      ~description:"Supported network layer versions."
+      ~query: RPC_query.empty
+      ~output: (Data_encoding.list P2p_version.encoding)
+      RPC_path.(root / "network" / "versions")
+
+  let stat =
+    RPC_service.get_service
+      ~description:"Global network bandwidth statistics in B/s."
+      ~query: RPC_query.empty
+      ~output: P2p_stat.encoding
+      RPC_path.(root / "network" / "stat")
+
+  let events =
+    RPC_service.get_service
+      ~description:"Stream of all network events"
+      ~query: RPC_query.empty
+      ~output: P2p_connection.Pool_event.encoding
+      RPC_path.(root / "network" / "log")
+
+  let connect =
+    RPC_service.put_service
+      ~description:"Connect to a peer"
+      ~query: timeout_query
+      ~input: Data_encoding.empty
+      ~output: Data_encoding.empty
+      RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg)
+
+end
+
+open RPC_context
+let self ctxt = make_call S.self ctxt () () ()
+let stat ctxt = make_call S.stat ctxt () () ()
+let versions ctxt = make_call S.versions ctxt () () ()
+let events ctxt = make_streamed_call S.events ctxt () () ()
+let connect ctxt ~timeout peer_id =
+  make_call1 S.connect ctxt peer_id (object method timeout = timeout end) ()
+
+module Connections = struct
+
+  type connection_info = Connection_metadata.t P2p_connection.Info.t
+
+  let connection_info_encoding =
+    P2p_connection.Info.encoding Connection_metadata.encoding
+
+  module S = struct
+
+    let list =
+      RPC_service.get_service
+        ~description:"List the running P2P connection."
+        ~query: RPC_query.empty
+        ~output: (Data_encoding.list connection_info_encoding)
+        RPC_path.(root / "network" / "connections")
+
+    let info =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: connection_info_encoding
+        ~description:"Details about the current P2P connection to the given peer."
+        RPC_path.(root / "network" / "connections" /: P2p_peer.Id.rpc_arg)
+
+    let kick =
+      RPC_service.delete_service
+        ~query: wait_query
+        ~output: Data_encoding.empty
+        ~description:"Forced close of the current P2P connection to the given peer."
+        RPC_path.(root / "network" / "connections" /: P2p_peer.Id.rpc_arg)
+
+  end
+
+  let list ctxt = make_call S.list ctxt () () ()
+  let info ctxt peer_id = make_call1 S.info ctxt peer_id () ()
+  let kick ctxt ?(wait = false) peer_id =
+    make_call1 S.kick ctxt peer_id (object method wait = wait end) ()
+
+end
+
+module Points = struct
+
+  module S = struct
+
+    let info =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: P2p_point.Info.encoding
+        ~description: "Details about a given `IP:addr`."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg)
+
+    let events =
+      RPC_service.get_service
+        ~query: monitor_query
+        ~output: (Data_encoding.list
+                    P2p_point.Pool_event.encoding)
+        ~description: "Monitor network events related to an `IP:addr`."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "log")
+
+    let list =
+      let filter_query =
+        let open RPC_query in
+        query (fun filters -> object
+                method filters = filters
+              end)
+        |+ multi_field "filter" P2p_point.Filter.rpc_arg (fun t -> t#filters)
+        |> seal in
+      RPC_service.get_service
+        ~query: filter_query
+        ~output:
+          Data_encoding.(list (tup2
+                                 P2p_point.Id.encoding
+                                 P2p_point.Info.encoding))
+        ~description:"List the pool of known `IP:port` \
+                      used for establishing P2P connections."
+        RPC_path.(root / "network" / "points")
+
+    let ban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Blacklist the given address and remove it from the \
+                      whitelist if present."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "ban" )
+
+    let unban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove an address from the blacklist."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "unban" )
+
+    let trust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Trust a given address permanently and remove it \
+                      from the blacklist if present. Connections from \
+                      this address can still be closed on \
+                      authentication if the peer is greylisted."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "trust" )
+
+    let untrust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove an address from the whitelist."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "untrust" )
+
+    let banned =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.bool
+        ~description:"Check is a given address is blacklisted or \
+                      greylisted."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "banned" )
+
+  end
+
+  open RPC_context
+  let info ctxt peer_id = make_call1 S.info ctxt peer_id () ()
+  let events ctxt point =
+    make_streamed_call S.events ctxt ((), point)
+      (object method monitor = true end) ()
+  let list ?(filter = []) ctxt = make_call S.list ctxt ()
+      (object method filters = filter end) ()
+  let ban ctxt peer_id = make_call1 S.ban ctxt peer_id () ()
+  let unban ctxt peer_id = make_call1 S.unban ctxt peer_id () ()
+  let trust ctxt peer_id = make_call1 S.trust ctxt peer_id () ()
+  let untrust ctxt peer_id = make_call1 S.untrust ctxt peer_id () ()
+  let banned ctxt peer_id = make_call1 S.banned ctxt peer_id () ()
+
+end
+
+module Peers = struct
+
+  module S = struct
+
+    let info =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: (P2p_peer.Info.encoding Peer_metadata.encoding
+                    Connection_metadata.encoding)
+        ~description:"Details about a given peer."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg)
+
+    let events =
+      RPC_service.get_service
+        ~query: monitor_query
+        ~output: (Data_encoding.list
+                    P2p_peer.Pool_event.encoding)
+        ~description:"Monitor network events related to a given peer."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "log")
+
+    let list =
+      let filter =
+        let open RPC_query in
+        query (fun filters -> object
+                method filters = filters
+              end)
+        |+ multi_field "filter" P2p_peer.Filter.rpc_arg (fun t -> t#filters)
+        |> seal in
+      RPC_service.get_service
+        ~query: filter
+        ~output:
+          Data_encoding.(list (tup2
+                                 P2p_peer.Id.encoding
+                                 (P2p_peer.Info.encoding Peer_metadata.encoding
+                                    Connection_metadata.encoding)))
+        ~description:"List the peers the node ever met."
+        RPC_path.(root / "network" / "peers")
+
+    let ban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Blacklist the given peer and remove it from the \
+                      whitelist if present."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "ban" )
+
+    let unban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove the given peer from the blacklist."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "unban" )
+
+    let trust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Whitelist a given peer permanently and remove it \
+                      from the blacklist if present. The peer cannot \
+                      be blocked (but its host IP still can)."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "trust" )
+
+    let untrust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove a given peer from the whitelist."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "untrust" )
+
+    let banned =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.bool
+        ~description:"Check if a given peer is blacklisted or \
+                      greylisted."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "banned" )
+
+  end
+
+  let info ctxt peer_id = make_call1 S.info ctxt peer_id () ()
+  let events ctxt point =
+    make_streamed_call S.events ctxt ((), point)
+      (object method monitor = true end) ()
+  let list ?(filter = []) ctxt =
+    make_call S.list ctxt () (object method filters = filter end) ()
+  let ban ctxt point_id = make_call1 S.ban ctxt point_id () ()
+  let unban ctxt point_id = make_call1 S.unban ctxt point_id () ()
+  let trust ctxt point_id = make_call1 S.trust ctxt point_id () ()
+  let untrust ctxt point_id = make_call1 S.untrust ctxt point_id () ()
+  let banned ctxt point_id = make_call1 S.banned ctxt point_id () ()
+
+end
+
+module ACL = struct
+
+  module S = struct
+
+    let clear =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Clear all greylists tables."
+        RPC_path.(root / "network" / "greylist" / "clear" )
+
+  end
+
+  let clear ctxt = make_call S.clear ctxt () ()
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/p2p_services.mli b/vendors/tezos-modded/src/lib_shell_services/p2p_services.mli
new file mode 100644
index 000000000..38b9d2913
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/p2p_services.mli
@@ -0,0 +1,255 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 RPC_context
+
+val self: #simple -> P2p_peer.Id.t tzresult Lwt.t
+
+val stat: #simple -> P2p_stat.t tzresult Lwt.t
+
+val versions: #simple -> P2p_version.t list tzresult Lwt.t
+
+val events: #streamed ->
+  (P2p_connection.Pool_event.t Lwt_stream.t * stopper) tzresult Lwt.t
+
+val connect: #simple -> timeout:float -> P2p_point.Id.t -> unit tzresult Lwt.t
+
+module S : sig
+
+  val self :
+    ([ `GET ], unit,
+     unit, unit, unit,
+     P2p_peer.Id.t) RPC_service.t
+
+  val stat :
+    ([ `GET ], unit,
+     unit, unit, unit,
+     P2p_stat.t) RPC_service.t
+
+  val versions :
+    ([ `GET ], unit,
+     unit, unit, unit,
+     P2p_version.t list) RPC_service.t
+
+  val events :
+    ([ `GET ], unit,
+     unit, unit, unit,
+     P2p_connection.Pool_event.t) RPC_service.t
+
+  val connect :
+    ([ `PUT ], unit,
+     unit * P2p_point.Id.t, < timeout: float >, unit,
+     unit) RPC_service.t
+
+end
+
+module Connections : sig
+
+  open RPC_context
+
+  type connection_info = Connection_metadata.t P2p_connection.Info.t
+
+  val list: #simple -> connection_info list tzresult Lwt.t
+
+  val info: #simple -> P2p_peer.Id.t -> connection_info tzresult Lwt.t
+
+  val kick: #simple -> ?wait:bool -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ], unit,
+       unit, unit, unit,
+       connection_info list) RPC_service.t
+
+    val info :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       connection_info) RPC_service.t
+
+    val kick :
+      ([ `DELETE ], unit,
+       unit * P2p_peer.Id.t, < wait: bool >, unit,
+       unit) RPC_service.t
+
+  end
+
+end
+
+
+module Points : sig
+
+  val list:
+    ?filter:(P2p_point.Filter.t list) ->
+    #simple -> (P2p_point.Id.t * P2p_point.Info.t) list tzresult Lwt.t
+
+  val info: #simple -> P2p_point.Id.t -> P2p_point.Info.t tzresult Lwt.t
+
+  val events:
+    #streamed ->
+    P2p_point.Id.t ->
+    (P2p_point.Pool_event.t list Lwt_stream.t * stopper) tzresult Lwt.t
+
+  val ban: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
+  val unban: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
+  val trust: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
+  val untrust: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
+  val banned: #simple -> P2p_point.Id.t -> bool tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ], unit,
+       unit, < filters: P2p_point.Filter.t list >, unit,
+       (P2p_point.Id.t * P2p_point.Info.t) list) RPC_service.t
+
+    val info :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       P2p_point.Info.t) RPC_service.t
+
+    val events :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, < monitor: bool>, unit,
+       P2p_point.Pool_event.t list) RPC_service.t
+
+    val ban :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val unban :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val trust :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val untrust :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val banned :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       bool) RPC_service.t
+
+  end
+
+end
+
+module Peers : sig
+
+  val list:
+    ?filter:(P2p_peer.Filter.t list) ->
+    #simple ->
+    (P2p_peer.Id.t * (Peer_metadata.t, Connection_metadata.t) P2p_peer.Info.t) list tzresult Lwt.t
+
+  val info:
+    #simple -> P2p_peer.Id.t ->
+    (Peer_metadata.t, Connection_metadata.t) P2p_peer.Info.t tzresult Lwt.t
+
+  val events:
+    #streamed -> P2p_peer.Id.t ->
+    (P2p_peer.Pool_event.t list Lwt_stream.t * stopper) tzresult Lwt.t
+
+  val ban: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
+  val unban: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
+  val trust: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
+  val untrust: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
+  val banned: #simple -> P2p_peer.Id.t -> bool tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ], unit,
+       unit, < filters: P2p_peer.Filter.t list >, unit,
+       (P2p_peer.Id.t * (Peer_metadata.t, Connection_metadata.t) P2p_peer.Info.t) list) RPC_service.t
+
+    val info :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       (Peer_metadata.t, Connection_metadata.t) P2p_peer.Info.t) RPC_service.t
+
+    val events :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, < monitor: bool>, unit,
+       P2p_peer.Pool_event.t list) RPC_service.t
+
+    val ban :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val unban :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val trust :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val untrust :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
+    val banned :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       bool) RPC_service.t
+
+  end
+
+end
+
+module ACL : sig
+
+  val clear: #simple -> unit -> unit tzresult Lwt.t
+
+  module S : sig
+
+    val clear :
+      ([ `GET ], unit,
+       unit, unit, unit,
+       unit) RPC_service.t
+
+  end
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/peer_metadata.ml b/vendors/tezos-modded/src/lib_shell_services/peer_metadata.ml
new file mode 100644
index 000000000..e6b524304
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/peer_metadata.ml
@@ -0,0 +1,559 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type counter = Z.t
+let counter = Data_encoding.z
+let ((+) : counter -> counter -> counter) = Z.add
+
+let zero : counter = Z.zero
+let one : counter = Z.one
+
+(* Distributed DB peer metadata *)
+type messages =
+  {
+    mutable branch: counter ;
+    mutable head: counter ;
+    mutable block_header: counter ;
+    mutable operations: counter ;
+    mutable protocols: counter ;
+    mutable operation_hashes_for_block: counter ;
+    mutable operations_for_block: counter ;
+    mutable other: counter ;
+  }
+
+let sent_requests_encoding =
+  let open Data_encoding in
+  (conv
+     (fun { branch ; head ; block_header ;
+            operations ; protocols ;
+            operation_hashes_for_block ;
+            operations_for_block ;
+            other ; } -> (branch, head, block_header,
+                          operations, protocols,
+                          operation_hashes_for_block,
+                          operations_for_block,
+                          other ))
+     (fun (branch, head, block_header,
+           operations, protocols,
+           operation_hashes_for_block,
+           operations_for_block,
+           other) -> { branch ; head ; block_header ;
+                       operations ; protocols ;
+                       operation_hashes_for_block ;
+                       operations_for_block ;
+                       other })
+  )
+    (obj8
+       (req "branch" counter)
+       (req "head" counter)
+       (req "block_header" counter)
+       (req "operations" counter)
+       (req "protocols" counter)
+       (req "operation_hashes_for_block" counter)
+       (req "operations_for_block" counter)
+       (req "other" counter)
+    )
+
+type requests_kind =
+  | Branch | Head | Block_header | Operations
+  | Protocols | Operation_hashes_for_block
+  | Operations_for_block | Other
+
+
+type requests = {
+  sent : messages ;
+  (** p2p sent messages of type requests *)
+  received : messages ;
+  (** p2p received messages of type requests *)
+  failed : messages ;
+  (** p2p messages of type requests that we failed to send *)
+  scheduled : messages ;
+  (** p2p messages ent via request scheduler *)
+}
+
+let requests_encoding =
+  let open Data_encoding in
+  (conv
+     (fun
+       { sent ; received ;
+         failed ; scheduled } -> (sent, received,
+                                  failed, scheduled))
+     (fun (sent, received,
+           failed, scheduled) -> { sent ; received ;
+                                   failed ; scheduled })
+  )
+    (obj4
+       (req "sent" sent_requests_encoding)
+       (req "received" sent_requests_encoding)
+       (req "failed" sent_requests_encoding)
+       (req "scheduled" sent_requests_encoding)
+    )
+
+
+(* Prevalidator peer metadata *)
+type prevalidator_results =
+  { cannot_download : counter ; cannot_parse : counter ;
+    refused_by_prefilter : counter ;
+    refused_by_postfilter : counter ;
+    (* prevalidation results *)
+    applied : counter ; branch_delayed : counter ;
+    branch_refused : counter ;
+    refused : counter ; duplicate : counter ; outdated : counter }
+
+let prevalidator_results_encoding =
+  let open Data_encoding in
+  (conv
+     (fun { cannot_download ;
+            cannot_parse ;
+            refused_by_prefilter ;
+            refused_by_postfilter ;
+            applied ; branch_delayed;
+            branch_refused ;
+            refused ; duplicate ;
+            outdated } -> (cannot_download, cannot_parse,
+                           refused_by_prefilter,
+                           refused_by_postfilter,
+                           applied, branch_delayed,
+                           branch_refused,
+                           refused, duplicate, outdated))
+     (fun (cannot_download,
+           cannot_parse,
+           refused_by_prefilter,
+           refused_by_postfilter,
+           applied, branch_delayed,
+           branch_refused,
+           refused, duplicate,
+           outdated) -> { cannot_download ; cannot_parse ;
+                          refused_by_prefilter ;
+                          refused_by_postfilter ;
+                          applied ; branch_delayed;
+                          branch_refused ;
+                          refused ; duplicate ; outdated }
+
+     )
+     (obj10
+        (req "cannot_download" counter)
+        (req "cannot_parse" counter)
+        (req "refused_by_prefilter" counter)
+        (req "refused_by_postfilter" counter)
+        (req "applied" counter)
+        (req "branch_delayed" counter)
+        (req "branch_refused" counter)
+        (req "refused" counter)
+        (req "duplicate" counter)
+        (req "outdated" counter)
+     )
+  )
+
+
+type resource_kind =
+  | Block | Operations | Protocol
+
+type advertisement = Head | Branch
+
+type metadata =
+  (* Distributed_db *)
+  | Received_request of requests_kind
+  | Sent_request of requests_kind
+  | Failed_request of requests_kind
+  | Scheduled_request of requests_kind
+  | Received_response of requests_kind
+  | Sent_response of requests_kind
+  | Unexpected_response
+  | Unactivated_chain
+  | Inactive_chain
+  | Future_block
+  | Unadvertised of resource_kind
+  | Sent_advertisement of advertisement
+  | Received_advertisement of advertisement
+  | Outdated_response (* TODO : unused *)
+  (* Peer validator *)
+  | Valid_blocks | Old_heads
+  (* Prevalidation *)
+  | Cannot_download | Cannot_parse
+  | Refused_by_prefilter
+  | Refused_by_postfilter
+  | Applied | Branch_delayed
+  | Branch_refused
+  | Refused | Duplicate | Outdated
+
+
+
+
+type responses = {
+  mutable sent : messages ;
+  (** p2p sent messages of type responses *)
+  mutable failed : messages ;
+  (** p2p sent messages of type responses *)
+  mutable received : messages ;
+  (** p2p received responses *)
+  mutable unexpected : counter ;
+  (** p2p received responses that were unexpected *)
+  mutable outdated : counter ;
+  (** p2p received responses that are now outdated *)
+}
+
+
+let responses_encoding =
+  let open Data_encoding in
+  (conv
+     (fun
+       { sent ; failed ; received ;
+         unexpected ; outdated ; } -> (sent, failed, received,
+                                       unexpected, outdated))
+     (fun
+       (sent, failed, received,
+        unexpected, outdated) -> { sent ; failed ; received ;
+                                   unexpected ; outdated })
+  )
+    (obj5
+       (req "sent" sent_requests_encoding)
+       (req "failed" sent_requests_encoding)
+       (req "received" sent_requests_encoding)
+       (req "unexpected" counter)
+       (req "outdated" counter)
+    )
+
+
+type unadvertised = {
+  mutable block : counter ;
+  (** requests for unadvertised block *)
+  mutable operations : counter ;
+  (** requests for unadvertised operations *)
+  mutable protocol : counter ;
+  (** requests for unadvertised protocol *)
+}
+
+let unadvertised_encoding =
+  let open Data_encoding in
+  (conv
+     (fun
+       { block ; operations ; protocol ; } -> (block, operations, protocol))
+     (fun
+       (block, operations, protocol) -> { block ; operations ; protocol ; })
+  )
+    (obj3
+       (req "block" counter)
+       (req "operations" counter)
+       (req "protocol" counter)
+    )
+
+
+type advertisements_kind = {
+  mutable head : counter ;
+  mutable branch : counter ;
+}
+
+let advertisements_kind_encoding =
+  let open Data_encoding in
+  (conv
+     (fun
+       { head ; branch ; } -> (head, branch))
+     (fun
+       (head, branch) -> { head ; branch ; })
+  )
+    (obj2
+       (req "head" counter)
+       (req "branch" counter)
+    )
+
+type advertisements = {
+  mutable sent: advertisements_kind ;
+  mutable received: advertisements_kind ;
+}
+
+
+let advertisements_encoding =
+  let open Data_encoding in
+  (conv
+     (fun
+       { sent ; received ; } -> (sent, received))
+     (fun
+       (sent, received) -> { sent ; received ; })
+  )
+    (obj2
+       (req "sent" advertisements_kind_encoding)
+       (req "received" advertisements_kind_encoding)
+    )
+
+type t = {
+  mutable responses : responses ;
+  (** responses sent/received *)
+  mutable requests : requests ;
+  (** requests sent/received  *)
+  mutable valid_blocks : counter ;
+  (** new valid blocks advertized by a peer *)
+  mutable old_heads : counter ;
+  (** previously validated blocks from a peer *)
+  mutable prevalidator_results : prevalidator_results ;
+  (** prevalidator metadata *)
+  mutable unactivated_chains : counter ;
+  (** requests from unactivated chains *)
+  mutable inactive_chains : counter ;
+  (** advertise inactive chains *)
+  mutable future_blocks_advertised : counter ;
+  (** future blocks *)
+  mutable unadvertised : unadvertised ;
+  (** requests for unadvertised resources *)
+  mutable advertisements : advertisements ;
+  (** advertisements sent *)
+}
+
+let empty () =
+  let empty_request () =
+    { branch = zero ; head = zero ; block_header = zero ;
+      operations = zero ; protocols = zero ;
+      operation_hashes_for_block = zero ;
+      operations_for_block = zero ;
+      other = zero ;
+    } in
+  {
+    responses = { sent = empty_request () ;
+                  failed = empty_request () ;
+                  received = empty_request () ;
+                  unexpected = zero ;
+                  outdated = zero ;
+                } ;
+    requests =
+      { sent = empty_request () ;
+        failed = empty_request () ;
+        scheduled = empty_request () ;
+        received = empty_request () ;
+      } ;
+    valid_blocks = zero ;
+    old_heads = zero ;
+    prevalidator_results =
+      { cannot_download = zero ; cannot_parse = zero ;
+        refused_by_prefilter = zero ; refused_by_postfilter = zero ;
+        applied  = zero ; branch_delayed = zero ; branch_refused = zero ;
+        refused = zero ; duplicate = zero ; outdated = zero
+      } ;
+    unactivated_chains = zero ;
+    inactive_chains = zero ;
+    future_blocks_advertised = zero ;
+    unadvertised = {block = zero ; operations = zero ; protocol = zero } ;
+    advertisements = { sent = { head = zero ; branch = zero ; } ;
+                       received = { head = zero ; branch = zero ; } }
+  }
+
+
+let encoding =
+  let open Data_encoding in
+  (conv
+     (fun { responses ; requests ;
+            valid_blocks ; old_heads ;
+            prevalidator_results ;
+            unactivated_chains ;
+            inactive_chains ;
+            future_blocks_advertised ;
+            unadvertised ;
+            advertisements } ->
+       ((responses, requests,
+         valid_blocks, old_heads,
+         prevalidator_results,
+         unactivated_chains,
+         inactive_chains,
+         future_blocks_advertised),
+        (unadvertised,
+         advertisements))
+     )
+     (fun ((responses, requests,
+            valid_blocks, old_heads,
+            prevalidator_results,
+            unactivated_chains,
+            inactive_chains,
+            future_blocks_advertised),
+           (unadvertised,
+            advertisements)) ->
+       { responses ; requests ;
+         valid_blocks ; old_heads ;
+         prevalidator_results ;
+         unactivated_chains ;
+         inactive_chains ;
+         future_blocks_advertised ;
+         unadvertised ;
+         advertisements ; }
+     )
+  )
+    (merge_objs
+       (obj8
+          (req "responses" responses_encoding)
+          (req "requests" requests_encoding)
+          (req "valid_blocks" counter)
+          (req "old_heads" counter)
+          (req "prevalidator_results" prevalidator_results_encoding)
+          (req "unactivated_chains" counter)
+          (req "inactive_chains" counter)
+          (req "future_blocks_advertised" counter)
+
+       )
+       (obj2
+          (req "unadvertised" unadvertised_encoding)
+          (req "advertisements" advertisements_encoding)
+       )
+    )
+
+let incr_requests (msgs : messages) (req : requests_kind) =
+  match req with
+  | Branch -> msgs.branch <- msgs.branch + one
+  | Head -> msgs.head <- msgs.head + one
+  | Block_header -> msgs.block_header <- msgs.block_header + one
+  | Operations -> msgs.operations <- msgs.operations + one
+  | Protocols -> msgs.protocols <- msgs.protocols + one
+  | Operation_hashes_for_block ->
+      msgs.operation_hashes_for_block <- msgs.operation_hashes_for_block + one
+  | Operations_for_block ->
+      msgs.operations_for_block <- msgs.operations_for_block + one
+  | Other ->
+      msgs.other <- msgs.other + one
+
+
+
+let incr_unadvertised { unadvertised = u ; _ } = function
+  | Block -> u.block <- u.block + one
+  | Operations -> u.operations <- u.operations + one
+  | Protocol -> u.protocol <- u.protocol + one
+
+
+let incr ({responses = rsps ; requests = rqst ; _ } as m) metadata =
+  match metadata with
+  (* requests *)
+  | Received_request req ->
+      incr_requests rqst.received req
+  | Sent_request req ->
+      incr_requests rqst.sent req
+  | Scheduled_request req ->
+      incr_requests rqst.scheduled req
+  | Failed_request req ->
+      incr_requests rqst.failed req
+  (* responses *)
+  | Received_response req ->
+      incr_requests rsps.received req
+  | Sent_response req ->
+      incr_requests rsps.sent req
+  | Unexpected_response ->
+      rsps.unexpected <- rsps.unexpected + one
+  | Outdated_response ->
+      rsps.outdated <- rsps.outdated + one
+  (* Advertisements *)
+  | Sent_advertisement ad ->
+      begin match ad with
+        | Head ->
+            m.advertisements.sent.head <- m.advertisements.sent.head + one
+        | Branch ->
+            m.advertisements.sent.branch <- m.advertisements.sent.branch + one
+      end
+  | Received_advertisement ad ->
+      begin match ad with
+        | Head ->
+            m.advertisements.received.head <- m.advertisements.received.head + one
+        | Branch ->
+            m.advertisements.received.branch <- m.advertisements.received.branch + one
+      end
+  (* Unexpected erroneous msg *)
+  | Unactivated_chain ->
+      m.unactivated_chains <- m.unactivated_chains + one
+  | Inactive_chain ->
+      m.inactive_chains <- m.inactive_chains + one
+  | Future_block ->
+      m.future_blocks_advertised <- m.future_blocks_advertised + one
+  | Unadvertised u -> incr_unadvertised m u
+  (* Peer validator *)
+  | Valid_blocks ->
+      m.valid_blocks <- m.valid_blocks + one
+  | Old_heads ->
+      m.old_heads <- m.old_heads + one
+  (* prevalidation *)
+  | Cannot_download ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          cannot_download = m.prevalidator_results.cannot_download + one }
+  | Cannot_parse -> m.prevalidator_results <-
+        { m.prevalidator_results with
+          cannot_parse = m.prevalidator_results.cannot_parse + one }
+  | Refused_by_prefilter -> m.prevalidator_results <-
+        { m.prevalidator_results with
+          refused_by_prefilter =
+            m.prevalidator_results.refused_by_prefilter + one }
+  | Refused_by_postfilter -> m.prevalidator_results <-
+        { m.prevalidator_results with
+          refused_by_postfilter =
+            m.prevalidator_results.refused_by_postfilter + one }
+  | Applied ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          applied = m.prevalidator_results.applied + one }
+  | Branch_delayed ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          branch_delayed = m.prevalidator_results.branch_delayed + one }
+  | Branch_refused ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          branch_refused = m.prevalidator_results.branch_refused + one }
+  | Refused ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          refused = m.prevalidator_results.refused + one }
+  | Duplicate ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          duplicate = m.prevalidator_results.duplicate + one }
+  | Outdated ->
+      m.prevalidator_results <-
+        { m.prevalidator_results with
+          outdated = m.prevalidator_results.outdated + one }
+
+
+(* shortcuts to update sent/failed requests/responses *)
+let update_requests { requests = { sent ; failed ; _  } ; _ } kind = function
+  | true -> incr_requests sent kind
+  | false -> incr_requests failed kind
+
+let update_responses { responses = { sent ; failed ; _ } ; _ } kind = function
+  | true -> incr_requests sent kind
+  | false -> incr_requests failed kind
+
+
+(* Scores computation *)
+(* TODO:
+   - scores cannot be kept as integers (use big numbers?)
+   - they scores should probably be reset frequently (at each block/cycle?)
+   - we might still need to keep some kind of score history
+       - store only best/worst/last_value/mean/variance... ?
+   - do we need to keep "good" scores ?
+        - maybe "bad" scores are enough to reduce resources
+          allocated to misbehaving peers *)
+let distributed_db_score _ =
+  (* TODO *)
+  1.0
+
+let prevalidation_score { prevalidator_results = _ ; _ }  =
+  (* TODO *)
+  1.0
+
+let score _ =
+  (* TODO *)
+  1.0
diff --git a/vendors/tezos-modded/src/lib_shell_services/peer_metadata.mli b/vendors/tezos-modded/src/lib_shell_services/peer_metadata.mli
new file mode 100644
index 000000000..36bc1f585
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/peer_metadata.mli
@@ -0,0 +1,83 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** All the (persistent) metadata associated to a peer. *)
+
+type t
+
+val encoding: t Data_encoding.t
+val empty : unit -> t
+
+
+
+(** the aggregate score function computed from
+    the metadata collected for a peer *)
+val distributed_db_score : t -> float
+val prevalidation_score : t -> float
+val score : t -> float
+
+type requests_kind =
+  | Branch | Head | Block_header
+  | Operations | Protocols
+  | Operation_hashes_for_block | Operations_for_block
+  | Other
+
+type resource_kind =
+  | Block | Operations | Protocol
+
+type advertisement = Head | Branch
+
+type metadata =
+  (* Distributed_db *)
+  | Received_request of requests_kind
+  | Sent_request of requests_kind
+  | Failed_request of requests_kind
+  | Scheduled_request of requests_kind
+  | Received_response of requests_kind
+  | Sent_response of requests_kind
+  | Unexpected_response
+  | Unactivated_chain
+  | Inactive_chain
+  | Future_block
+  | Unadvertised of resource_kind
+  | Sent_advertisement of advertisement
+  | Received_advertisement of advertisement
+  | Outdated_response (* TODO : unused *)
+  (* Peer validator *)
+  | Valid_blocks | Old_heads
+  (* Prevalidation *)
+  | Cannot_download | Cannot_parse
+  | Refused_by_prefilter
+  | Refused_by_postfilter
+  | Applied | Branch_delayed
+  | Branch_refused
+  | Refused | Duplicate | Outdated
+
+(** incr score counters . Used to compute the final score for a peer *)
+val incr : t ->   metadata -> unit
+val update_requests : t -> requests_kind -> bool -> unit
+val update_responses : t -> requests_kind -> bool -> unit
+
+
diff --git a/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.ml b/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.ml
new file mode 100644
index 000000000..ee6dba842
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.ml
@@ -0,0 +1,134 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request = struct
+  type view =
+    | New_head of Block_hash.t
+    | New_branch of Block_hash.t * int
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0) ~title:"New_head"
+          (obj2
+             (req "request" (constant "new_head"))
+             (req "block" Block_hash.encoding))
+          (function New_head h -> Some ((), h) | _ -> None)
+          (fun ((), h) -> New_head h) ;
+        case (Tag 1) ~title:"New_branch"
+          (obj3
+             (req "request" (constant "new_branch"))
+             (req "block" Block_hash.encoding)
+             (req "locator_length" uint16))
+          (function New_branch (h, l) -> Some ((), h, l) | _ -> None)
+          (fun ((), h, l) -> New_branch (h, l)) ]
+
+  let pp ppf = function
+    | New_head hash ->
+        Format.fprintf ppf "New head %a" Block_hash.pp hash
+    | New_branch (hash, len) ->
+        Format.fprintf ppf "New branch %a, locator length %d"
+          Block_hash.pp hash len
+end
+
+module Event = struct
+  type t =
+    | Request of (Request.view * Worker_types.request_status * error list option)
+    | Debug of string
+
+  let level req =
+    match req with
+    | Debug _ -> Logging.Debug
+    | Request _ -> Logging.Info
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Debug"
+          (obj1 (req "message" string))
+          (function Debug msg -> Some msg | _ -> None)
+          (fun msg -> Debug msg) ;
+        case (Tag 1)
+          ~title:"Request"
+          (obj2
+             (req "request" Request.encoding)
+             (req "status" Worker_types.request_status_encoding))
+          (function Request (req, t, None) -> Some (req, t) | _ -> None)
+          (fun (req, t) -> Request (req, t, None)) ;
+        case (Tag 2)
+          ~title:"Failed request"
+          (obj3
+             (req "error" RPC_error.encoding)
+             (req "failed_request" Request.encoding)
+             (req "status" Worker_types.request_status_encoding))
+          (function Request (req, t, Some errs) -> Some (errs, req, t) | _ -> None)
+          (fun (errs, req, t) -> Request (req, t, Some errs)) ]
+
+  let pp ppf = function
+    | Debug msg -> Format.fprintf ppf "%s" msg
+    | Request (view, { pushed ; treated ; completed }, None)  ->
+        Format.fprintf ppf
+          "@[<v 0>%a@,\
+           Pushed: %a, Treated: %a, Completed: %a@]"
+          Request.pp view
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+    | Request (view, { pushed ; treated ; completed }, Some errors)  ->
+        Format.fprintf ppf
+          "@[<v 0>%a@,\
+           Pushed: %a, Treated: %a, Failed: %a@,\
+           %a@]"
+          Request.pp view
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+          (Format.pp_print_list Error_monad.pp) errors
+end
+
+module Worker_state = struct
+  type view =
+    { bootstrapped : bool ;
+      mutable last_validated_head: Block_hash.t ;
+      mutable last_advertised_head: Block_hash.t }
+  let encoding =
+    let open Data_encoding in
+    conv
+      (function { bootstrapped ; last_validated_head ; last_advertised_head } ->
+         (bootstrapped, last_validated_head, last_advertised_head))
+      (function (bootstrapped, last_validated_head, last_advertised_head) ->
+         { bootstrapped ; last_validated_head ; last_advertised_head })
+      (obj3
+         (req "bootstrapped" bool)
+         (req "last_validated_head" Block_hash.encoding)
+         (req "last_advertised_head" Block_hash.encoding))
+
+  let pp ppf state =
+    Format.fprintf ppf
+      "@[<v 0>Bootstrapped: %s@,\
+       Last validated head: %a@,\
+       Last advertised head: %a@]"
+      (if state.bootstrapped then "yes" else "no")
+      Block_hash.pp state.last_validated_head
+      Block_hash.pp state.last_advertised_head
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.mli b/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.mli
new file mode 100644
index 000000000..a9faf9cb7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/peer_validator_worker_state.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request : sig
+  type view =
+    | New_head of Block_hash.t
+    | New_branch of Block_hash.t * int
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
+
+module Event : sig
+  type t =
+    | Request of (Request.view * Worker_types.request_status * error list option)
+    | Debug of string
+  val level : t -> Logging.level
+  val encoding : t Data_encoding.encoding
+  val pp : Format.formatter -> t -> unit
+end
+
+module Worker_state : sig
+  type view =
+    { bootstrapped : bool ;
+      mutable last_validated_head: Block_hash.t ;
+      mutable last_advertised_head: Block_hash.t }
+  val encoding : view Data_encoding.encoding
+  val pp : Format.formatter -> view -> unit
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.ml b/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.ml
new file mode 100644
index 000000000..e9f695524
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.ml
@@ -0,0 +1,206 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request = struct
+  type 'a t =
+    | Flush : Block_hash.t -> unit t
+    | Notify : P2p_peer.Id.t * Mempool.t -> unit t
+    | Inject : Operation.t -> unit t
+    | Arrived : Operation_hash.t * Operation.t -> unit t
+    | Advertise : unit t
+  type view = View : _ t -> view
+
+  let view req = View req
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Flush"
+          (obj2
+             (req "request" (constant "flush"))
+             (req "block" Block_hash.encoding))
+          (function View (Flush hash) -> Some ((), hash) | _ -> None)
+          (fun ((), hash) -> View (Flush hash)) ;
+        case (Tag 1)
+          ~title:"Notify"
+          (obj3
+             (req "request" (constant "notify"))
+             (req "peer" P2p_peer.Id.encoding)
+             (req "mempool" Mempool.encoding))
+          (function View (Notify (peer, mempool)) -> Some ((), peer, mempool) | _ -> None)
+          (fun ((), peer, mempool) -> View (Notify (peer, mempool))) ;
+        case (Tag 2)
+          ~title:"Inject"
+          (obj2
+             (req "request" (constant "inject"))
+             (req "operation" Operation.encoding))
+          (function View (Inject op) -> Some ((), op) | _ -> None)
+          (fun ((), op) -> View (Inject op)) ;
+        case (Tag 3)
+          ~title:"Arrived"
+          (obj3
+             (req "request" (constant "arrived"))
+             (req "operation_hash" Operation_hash.encoding)
+             (req "operation" Operation.encoding))
+          (function View (Arrived (oph, op)) -> Some ((), oph, op) | _ -> None)
+          (fun ((), oph, op) -> View (Arrived (oph, op))) ;
+        case (Tag 4)
+          ~title:"Advertise"
+          (obj1 (req "request" (constant "advertise")))
+          (function View Advertise -> Some () | _ -> None)
+          (fun () -> View Advertise) ]
+
+  let pp ppf (View r) = match r with
+    | Flush hash ->
+        Format.fprintf ppf "switching to new head %a"
+          Block_hash.pp hash
+    | Notify (id, { Mempool.known_valid ; pending }) ->
+        Format.fprintf ppf "@[<v 2>notified by %a of operations"
+          P2p_peer.Id.pp id ;
+        List.iter
+          (fun oph ->
+             Format.fprintf ppf "@,%a (applied)"
+               Operation_hash.pp oph)
+          known_valid ;
+        List.iter
+          (fun oph ->
+             Format.fprintf ppf "@,%a (pending)"
+               Operation_hash.pp oph)
+          (Operation_hash.Set.elements pending) ;
+        Format.fprintf ppf "@]"
+    | Inject op ->
+        Format.fprintf ppf "injecting operation %a"
+          Operation_hash.pp (Operation.hash op)
+    | Arrived (oph, _) ->
+        Format.fprintf ppf "operation %a arrived"
+          Operation_hash.pp oph
+    | Advertise ->
+        Format.fprintf ppf "advertising pending operations"
+end
+
+module Event = struct
+  type t =
+    | Request of (Request.view * Worker_types.request_status * error list option)
+    | Debug of string
+
+  let level req =
+    let open Request in
+    match req with
+    | Debug _ -> Logging.Debug
+    | Request (View (Flush _), _, _) -> Logging.Notice
+    | Request (View (Notify _), _, _) -> Logging.Debug
+    | Request (View (Inject _), _, _) -> Logging.Notice
+    | Request (View (Arrived _), _, _) -> Logging.Debug
+    | Request (View Advertise, _, _) -> Logging.Debug
+
+  let encoding =
+    let open Data_encoding in
+    union
+      [ case (Tag 0)
+          ~title:"Debug"
+          (obj1 (req "message" string))
+          (function Debug msg -> Some msg | _ -> None)
+          (fun msg -> Debug msg) ;
+        case (Tag 1)
+          ~title:"Request"
+          (obj2
+             (req "request" Request.encoding)
+             (req "status" Worker_types.request_status_encoding))
+          (function Request (req, t, None) -> Some (req, t) | _ -> None)
+          (fun (req, t) -> Request (req, t, None)) ;
+        case (Tag 2)
+          ~title:"Failed request"
+          (obj3
+             (req "error" RPC_error.encoding)
+             (req "failed_request" Request.encoding)
+             (req "status" Worker_types.request_status_encoding))
+          (function Request (req, t, Some errs) -> Some (errs, req, t) | _ -> None)
+          (fun (errs, req, t) -> Request (req, t, Some errs)) ]
+
+  let pp ppf = function
+    | Debug msg -> Format.fprintf ppf "%s" msg
+    | Request (view, { pushed ; treated ; completed }, None)  ->
+        Format.fprintf ppf
+          "@[<v 0>%a@,\
+           Pushed: %a, Treated: %a, Completed: %a@]"
+          Request.pp view
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+    | Request (view, { pushed ; treated ; completed }, Some errors)  ->
+        Format.fprintf ppf
+          "@[<v 0>%a@,\
+           Pushed: %a, Treated: %a, Failed: %a@,\
+           %a@]"
+          Request.pp view
+          Time.pp_hum pushed Time.pp_hum treated Time.pp_hum completed
+          (Format.pp_print_list Error_monad.pp) errors
+end
+
+module Worker_state = struct
+  type view =
+    { head : Block_hash.t ;
+      timestamp : Time.t ;
+      fetching : Operation_hash.Set.t ;
+      pending : Operation_hash.Set.t ;
+      applied : Operation_hash.t list ;
+      delayed : Operation_hash.Set.t }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { head ; timestamp ; fetching ; pending ; applied ; delayed } ->
+         (head, timestamp, fetching, pending, applied, delayed))
+      (fun (head, timestamp, fetching, pending, applied, delayed) ->
+         { head ; timestamp ; fetching ; pending ; applied ; delayed })
+      (obj6
+         (req "head" Block_hash.encoding)
+         (req "timestamp" Time.encoding)
+         (req "fetching" Operation_hash.Set.encoding)
+         (req "pending" Operation_hash.Set.encoding)
+         (req "applied" (list Operation_hash.encoding))
+         (req "delayed" Operation_hash.Set.encoding))
+
+  let pp ppf view =
+    Format.fprintf ppf
+      "@[<v 0>\
+       Head: %a@,\
+       Timestamp: %a@,
+       @[<v 2>Fetching: %a@]@,
+       @[<v 2>Pending: %a@]@,
+       @[<v 2>Applied: %a@]@,
+       @[<v 2>Delayed: %a@]@]"
+      Block_hash.pp
+      view.head
+      Time.pp_hum
+      view.timestamp
+      (Format.pp_print_list Operation_hash.pp)
+      (Operation_hash.Set.elements view.fetching)
+      (Format.pp_print_list Operation_hash.pp)
+      (Operation_hash.Set.elements  view.pending)
+      (Format.pp_print_list Operation_hash.pp)
+      view.applied
+      (Format.pp_print_list Operation_hash.pp)
+      (Operation_hash.Set.elements  view.delayed)
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.mli b/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.mli
new file mode 100644
index 000000000..b0db4d9be
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/prevalidator_worker_state.mli
@@ -0,0 +1,58 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Request : sig
+  type 'a t =
+    | Flush : Block_hash.t -> unit t
+    | Notify : P2p_peer.Id.t * Mempool.t -> unit t
+    | Inject : Operation.t -> unit t
+    | Arrived : Operation_hash.t * Operation.t -> unit t
+    | Advertise : unit t
+  type view = View : _ t -> view
+  val view : 'a t -> view
+  val encoding : view Data_encoding.t
+  val pp : Format.formatter -> view -> unit
+end
+
+module Event : sig
+  type t =
+    | Request of (Request.view * Worker_types.request_status * error list option)
+    | Debug of string
+  val level : t -> Logging.level
+  val encoding : t Data_encoding.t
+  val pp : Format.formatter -> t -> unit
+end
+
+module Worker_state : sig
+  type view =
+    { head : Block_hash.t ;
+      timestamp : Time.t ;
+      fetching : Operation_hash.Set.t ;
+      pending : Operation_hash.Set.t ;
+      applied : Operation_hash.t list ;
+      delayed : Operation_hash.Set.t }
+  val encoding : view Data_encoding.t
+  val pp : Format.formatter -> view -> unit
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/protocol_services.ml b/vendors/tezos-modded/src/lib_shell_services/protocol_services.ml
new file mode 100644
index 000000000..0e43baa0c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/protocol_services.ml
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+module S = struct
+
+  let protocols_arg = Protocol_hash.rpc_arg
+
+  let contents =
+    RPC_service.get_service
+      ~query: RPC_query.empty
+      ~output: Protocol.encoding
+      RPC_path.(root / "protocols" /: protocols_arg)
+
+  let list =
+    RPC_service.get_service
+      ~query: RPC_query.empty
+      ~output: (list Protocol_hash.encoding)
+      RPC_path.(root / "protocols")
+
+end
+
+open RPC_context
+let contents ctxt h =
+  make_call1 S.contents ctxt h () ()
+let list ctxt =
+  make_call S.list ctxt () () ()
+
diff --git a/vendors/tezos-modded/src/lib_shell_services/protocol_services.mli b/vendors/tezos-modded/src/lib_shell_services/protocol_services.mli
new file mode 100644
index 000000000..2f985d432
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/protocol_services.mli
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 RPC_context
+
+val contents:
+  #simple -> Protocol_hash.t -> Protocol.t tzresult Lwt.t
+
+val list:
+  #simple ->
+  Protocol_hash.t list tzresult Lwt.t
+
+module S : sig
+
+  val contents:
+    ([ `GET ], unit,
+     unit * Protocol_hash.t, unit, unit,
+     Protocol.t) RPC_service.t
+
+  val list:
+    ([ `GET ], unit,
+     unit, unit, unit,
+     Protocol_hash.t list) RPC_service.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/shell_services.ml b/vendors/tezos-modded/src/lib_shell_services/shell_services.ml
new file mode 100644
index 000000000..b57a8dd23
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/shell_services.ml
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type chain = Chain_services.chain
+type block = Block_services.block
+
+module Chain = Chain_services
+module Blocks = Chain.Blocks
+module Invalid_blocks = Chain.Invalid_blocks
+module Mempool = Chain.Mempool
+
+module Protocol = Protocol_services
+
+module Monitor = Monitor_services
+module Injection = Injection_services
+
+module P2p = P2p_services
+module Worker = Worker_services
diff --git a/vendors/tezos-modded/src/lib_shell_services/shell_services.mli b/vendors/tezos-modded/src/lib_shell_services/shell_services.mli
new file mode 100644
index 000000000..b57a8dd23
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/shell_services.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type chain = Chain_services.chain
+type block = Block_services.block
+
+module Chain = Chain_services
+module Blocks = Chain.Blocks
+module Invalid_blocks = Chain.Invalid_blocks
+module Mempool = Chain.Mempool
+
+module Protocol = Protocol_services
+
+module Monitor = Monitor_services
+module Injection = Injection_services
+
+module P2p = P2p_services
+module Worker = Worker_services
diff --git a/vendors/tezos-modded/src/lib_shell_services/state_logging.ml b/vendors/tezos-modded/src/lib_shell_services/state_logging.ml
new file mode 100644
index 000000000..bf90c297a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/state_logging.ml
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "node.state" end)
+
+let chain_id = Tag.def ~doc:"Chain ID" "chain_id" Chain_id.pp
diff --git a/vendors/tezos-modded/src/lib_shell_services/state_logging.mli b/vendors/tezos-modded/src/lib_shell_services/state_logging.mli
new file mode 100644
index 000000000..787883155
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/state_logging.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.SEMLOG
+
+val chain_id: Chain_id.t Tag.def
diff --git a/vendors/tezos-modded/src/lib_shell_services/tezos-shell-services.opam b/vendors/tezos-modded/src/lib_shell_services/tezos-shell-services.opam
new file mode 100644
index 000000000..d8ddbe960
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/tezos-shell-services.opam
@@ -0,0 +1,18 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_shell_services/validation_errors.ml b/vendors/tezos-modded/src/lib_shell_services/validation_errors.ml
new file mode 100644
index 000000000..65db8cba1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/validation_errors.ml
@@ -0,0 +1,305 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(***************** Prevalidation errors ***********************************)
+
+type error += Parse_error
+type error += Too_many_operations
+type error += Oversized_operation of { size: int ; max: int }
+type error += Future_block_header of { block: Block_hash.t ; block_time : Time.t ; time : Time.t }
+
+let () =
+  (* Parse error *)
+  register_error_kind
+    `Permanent
+    ~id:"node.prevalidation.parse_error"
+    ~title:"Parsing error in prevalidation"
+    ~description:"Raised when an operation has not been parsed correctly during prevalidation."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Operation parsing error in prevalidation.")
+    Data_encoding.empty
+    (function Parse_error -> Some () | _ -> None)
+    (fun () -> Parse_error) ;
+  (* Too many operations *)
+  register_error_kind
+    `Temporary
+    ~id:"node.prevalidation.too_many_operations"
+    ~title:"Too many pending operations in prevalidation"
+    ~description:"The prevalidation context is full."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Too many operations in prevalidation context.")
+    Data_encoding.empty
+    (function Too_many_operations -> Some () | _ -> None)
+    (fun () -> Too_many_operations) ;
+  (* Oversized operation *)
+  register_error_kind
+    `Permanent
+    ~id:"node.prevalidation.oversized_operation"
+    ~title:"Oversized operation"
+    ~description:"The operation size is bigger than allowed."
+    ~pp:(fun ppf (size, max) ->
+        Format.fprintf ppf "Oversized operation (size: %d, max: %d)"
+          size max)
+    Data_encoding.(obj2
+                     (req "size" int31)
+                     (req "max_size" int31))
+    (function Oversized_operation { size ; max } -> Some (size, max) | _ -> None)
+    (fun (size, max) -> Oversized_operation { size ; max }) ;
+  (* Block from the future *)
+  register_error_kind
+    `Temporary
+    ~id:"node.prevalidation.future_block_header"
+    ~title:"Future block header"
+    ~description:"The block was annotated with a time too far in the future."
+    ~pp:(fun ppf (block, block_time, time) ->
+        Format.fprintf ppf "Future block header (block: %a, block_time: %a, time: %a)"
+          Block_hash.pp block Time.pp_hum block_time Time.pp_hum time)
+    Data_encoding.(obj3
+                     (req "block" Block_hash.encoding)
+                     (req "block_time" Time.encoding)
+                     (req "time" Time.encoding))
+    (function Future_block_header { block ; block_time ; time } -> Some (block, block_time, time) | _ -> None)
+    (fun (block, block_time, time) -> Future_block_header { block ; block_time ; time })
+
+
+(************************* State errors ***********************************)
+
+type error +=  Unknown_chain of Chain_id.t
+
+type error += Bad_data_dir
+
+type error += Block_not_invalid of Block_hash.t
+
+let () =
+  (* Unknown network *)
+  register_error_kind
+    `Permanent
+    ~id:"node.state.unknown_chain"
+    ~title:"Unknown chain"
+    ~description:"The chain identifier could not be found in \
+                  the chain identifiers table."
+    ~pp:(fun ppf id ->
+        Format.fprintf ppf "Unknown chain %a" Chain_id.pp id)
+    Data_encoding.(obj1 (req "chain" Chain_id.encoding))
+    (function Unknown_chain x -> Some x | _ -> None)
+    (fun x -> Unknown_chain x) ;
+  register_error_kind
+    `Permanent
+    ~id:"node.state.bad_data_dir"
+    ~title:"Bad data directory"
+    ~description:"The data directory could not be read. \
+                  This could be because it was generated with an \
+                  old version of the tezos-node program. \
+                  Deleting and regenerating this directory \
+                  may fix the problem."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Bad data directory.")
+    Data_encoding.empty
+    (function Bad_data_dir -> Some () | _ -> None)
+    (fun () -> Bad_data_dir) ;
+  (* Block not invalid *)
+  register_error_kind
+    `Permanent
+    ~id:"node.state.block_not_invalid"
+    ~title:"Block not invalid"
+    ~description:"The invalid block to be unmarked was not actually invalid."
+    ~pp:(fun ppf block ->
+        Format.fprintf ppf "Block %a was expected to be invalid, but was not actually invalid."
+          Block_hash.pp block)
+    Data_encoding.(obj1 (req "block" Block_hash.encoding))
+    (function Block_not_invalid block -> Some block | _ -> None)
+    (fun block -> Block_not_invalid block)
+
+(* Block database error *)
+
+type error += Inconsistent_hash of Context_hash.t * Context_hash.t
+
+let () =
+  (* Inconsistent hash *)
+  register_error_kind
+    `Permanent
+    ~id:"node.state.block.inconsistent_context_hash"
+    ~title:"Inconsistent commit hash"
+    ~description:
+      "When commiting the context of a block, the announced context \
+       hash was not the one computed at commit time."
+    ~pp: (fun ppf (got, exp) ->
+        Format.fprintf ppf
+          "@[<v 2>Inconsistant hash:@ got: %a@ expected: %a"
+          Context_hash.pp got
+          Context_hash.pp exp)
+    Data_encoding.(obj2
+                     (req "wrong_context_hash" Context_hash.encoding)
+                     (req "expected_context_hash" Context_hash.encoding))
+    (function Inconsistent_hash (got, exp) -> Some (got, exp) | _ -> None)
+    (fun (got, exp) -> Inconsistent_hash (got, exp))
+
+(******************* Bootstrap pipeline errors ****************************)
+
+type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t
+
+let () =
+  (* Invalid locator *)
+  register_error_kind
+    `Permanent
+    ~id:"node.bootstrap_pipeline.invalid_locator"
+    ~title:"Invalid block locator"
+    ~description:"Block locator is invalid."
+    ~pp: (fun ppf (id, locator) ->
+        Format.fprintf ppf
+          "Invalid block locator on peer %a:\n%a"
+          P2p_peer.Id.pp id
+          Block_locator.pp locator)
+    Data_encoding.(obj2
+                     (req "id" P2p_peer.Id.encoding)
+                     (req "locator" Block_locator.encoding))
+    (function | Invalid_locator (id, loc) -> Some (id, loc) | _ -> None)
+    (fun (id, loc) -> Invalid_locator (id, loc))
+
+(******************* Protocol validator errors ****************************)
+
+type protocol_error =
+  | Compilation_failed
+  | Dynlinking_failed
+
+type error += Invalid_protocol of { hash: Protocol_hash.t ; error: protocol_error }
+
+let protocol_error_encoding =
+  let open Data_encoding in
+  union
+    [
+      case (Tag 0)
+        ~title:"Compilation failed"
+        (obj1
+           (req "error" (constant "compilation_failed")))
+        (function Compilation_failed -> Some ()
+                | _ -> None)
+        (fun () -> Compilation_failed) ;
+      case (Tag 1)
+        ~title:"Dynlinking failed"
+        (obj1
+           (req "error" (constant "dynlinking_failed")))
+        (function Dynlinking_failed -> Some ()
+                | _ -> None)
+        (fun () -> Dynlinking_failed) ;
+    ]
+
+let pp_protocol_error ppf = function
+  | Compilation_failed ->
+      Format.fprintf ppf "compilation error"
+  | Dynlinking_failed ->
+      Format.fprintf ppf "dynlinking error"
+
+let () =
+  (* Invalid protocol *)
+  register_error_kind
+    `Permanent
+    ~id:"node.protocol_validator.invalid_protocol"
+    ~title:"Invalid protocol"
+    ~description:"Invalid protocol."
+    ~pp:begin fun ppf (protocol, error) ->
+      Format.fprintf ppf
+        "@[<v 2>Invalid protocol %a@ %a@]"
+        Protocol_hash.pp_short protocol pp_protocol_error error
+    end
+    Data_encoding.(merge_objs
+                     (obj1 (req "invalid_protocol" Protocol_hash.encoding))
+                     protocol_error_encoding)
+    (function Invalid_protocol { hash ; error } ->
+       Some (hash, error) | _ -> None)
+    (fun (hash, error) ->
+       Invalid_protocol { hash ; error })
+
+(********************* Peer validator errors ******************************)
+
+type error +=
+  | Unknown_ancestor
+  | Known_invalid
+
+let () =
+  (* Unknown ancestor *)
+  register_error_kind
+    `Permanent
+    ~id: "node.peer_validator.unknown_ancestor"
+    ~title: "Unknown ancestor"
+    ~description: "Unknown ancestor block found in the peer's chain"
+    ~pp: (fun ppf () -> Format.fprintf ppf "Unknown ancestor")
+    Data_encoding.empty
+    (function Unknown_ancestor -> Some () | _ -> None)
+    (fun () -> Unknown_ancestor) ;
+  (* Known invalid *)
+  register_error_kind
+    `Permanent
+    ~id: "node.peer_validator.known_invalid"
+    ~title: "Known invalid"
+    ~description: "Known invalid block found in the peer's chain"
+    ~pp: (fun ppf () -> Format.fprintf ppf "Known invalid")
+    Data_encoding.empty
+    (function Known_invalid -> Some () | _ -> None)
+    (fun () -> Known_invalid)
+
+(************************ Validator errors ********************************)
+
+type error +=  Inactive_chain of Chain_id.t
+type error += Checkpoint_error of Block_hash.t * P2p_peer.Id.t option
+
+let () =
+  (* Inactive network *)
+  register_error_kind
+    `Branch
+    ~id: "node.validator.inactive_chain"
+    ~title: "Inactive chain"
+    ~description: "Attempted validation of a block from an inactive chain."
+    ~pp: (fun ppf chain ->
+        Format.fprintf ppf
+          "Tried to validate a block from chain %a, \
+           that is not currently considered active."
+          Chain_id.pp chain)
+    Data_encoding.(obj1 (req "inactive_chain" Chain_id.encoding))
+    (function Inactive_chain chain -> Some chain | _ -> None)
+    (fun chain -> Inactive_chain chain) ;
+  register_error_kind
+    `Branch
+    ~id:"node.validator.checkpoint_error"
+    ~title: "Block incompatble with the current checkpoint."
+    ~description: "The block belongs to a branch that is not compatible \
+                   with the current checkpoint."
+    ~pp: (fun ppf (block, peer) ->
+        match peer with
+        | None ->
+            Format.fprintf ppf
+              "The block %a is incompatible with the current checkpoint."
+              Block_hash.pp_short block
+        | Some peer ->
+            Format.fprintf ppf
+              "The peer %a send us a block which is a sibling \
+               of the configured checkpoint (%a)."
+              P2p_peer.Id.pp peer
+              Block_hash.pp_short block)
+    Data_encoding.(obj2
+                     (req "block" Block_hash.encoding)
+                     (opt "peer" P2p_peer.Id.encoding))
+    (function Checkpoint_error (block, peer) -> Some (block, peer) | _ -> None)
+    (fun (block, peer) -> Checkpoint_error (block, peer))
+
diff --git a/vendors/tezos-modded/src/lib_shell_services/validation_errors.mli b/vendors/tezos-modded/src/lib_shell_services/validation_errors.mli
new file mode 100644
index 000000000..d51ba507e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/validation_errors.mli
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(***************** Prevalidation errors ***********************************)
+
+type error += Parse_error
+type error += Too_many_operations
+type error += Oversized_operation of { size: int ; max: int }
+type error += Future_block_header of { block: Block_hash.t ; block_time : Time.t ; time : Time.t }
+
+(************************* State errors ***********************************)
+
+type error +=  Unknown_chain of Chain_id.t
+type error += Bad_data_dir
+type error += Block_not_invalid of Block_hash.t
+
+(* Block database error *)
+
+type error += Inconsistent_hash of Context_hash.t * Context_hash.t
+
+(******************* Bootstrap pipeline errors ****************************)
+
+type error += Invalid_locator of P2p_peer.Id.t * Block_locator.t
+
+(******************* Protocol validator errors ****************************)
+
+type protocol_error =
+  | Compilation_failed
+  | Dynlinking_failed
+
+type error += Invalid_protocol of { hash: Protocol_hash.t ; error: protocol_error }
+
+(********************* Peer validator errors ******************************)
+
+type error +=
+  | Unknown_ancestor
+  | Known_invalid
+
+(************************ Validator errors ********************************)
+
+type error +=  Inactive_chain of Chain_id.t
+type error += Checkpoint_error of Block_hash.t * P2p_peer.Id.t option
diff --git a/vendors/tezos-modded/src/lib_shell_services/worker_services.ml b/vendors/tezos-modded/src/lib_shell_services/worker_services.ml
new file mode 100644
index 000000000..747a5ce63
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/worker_services.ml
@@ -0,0 +1,150 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Data_encoding
+
+module Prevalidators = struct
+
+  module S = struct
+
+    let list =
+      RPC_service.get_service
+        ~description:"Lists the Prevalidator workers and their status."
+        ~query: RPC_query.empty
+        ~output:
+          (list
+             (obj2
+                (req "chain_id" Chain_id.encoding)
+                (req "status" (Worker_types.worker_status_encoding  RPC_error.encoding))))
+        RPC_path.(root / "workers" / "prevalidators")
+
+    let state =
+      RPC_service.get_service
+        ~description:"Introspect the state of prevalidator workers."
+        ~query: RPC_query.empty
+        ~output:
+          (Worker_types.full_status_encoding
+             Prevalidator_worker_state.Request.encoding
+             Prevalidator_worker_state.Event.encoding
+             RPC_error.encoding)
+        RPC_path.(root / "workers" / "prevalidators" /: Chain_services.chain_arg )
+
+  end
+
+  open RPC_context
+  let list ctxt = make_call S.list ctxt () () ()
+  let state ctxt h = make_call1 S.state ctxt h () ()
+
+end
+
+module Block_validator = struct
+
+  module S = struct
+
+    let state =
+      RPC_service.get_service
+        ~description:"Introspect the state of the block_validator worker."
+        ~query: RPC_query.empty
+        ~output:
+          (Worker_types.full_status_encoding
+             Block_validator_worker_state.Request.encoding
+             Block_validator_worker_state.Event.encoding
+             RPC_error.encoding)
+        RPC_path.(root / "workers" / "block_validator")
+
+  end
+
+  open RPC_context
+  let state ctxt = make_call S.state ctxt () () ()
+
+end
+
+module Peer_validators = struct
+
+  module S = struct
+
+    let list =
+      RPC_service.get_service
+        ~description:"Lists the peer validator workers and their status."
+        ~query: RPC_query.empty
+        ~output:
+          (list
+             (obj2
+                (req "peer_id" P2p_peer.Id.encoding)
+                (req "status" (Worker_types.worker_status_encoding RPC_error.encoding))))
+        RPC_path.(root / "workers" / "chain_validators" /: Chain_services.chain_arg / "peers_validators" )
+
+    let state =
+      RPC_service.get_service
+        ~description:"Introspect the state of a peer validator worker."
+        ~query: RPC_query.empty
+        ~output:
+          (Worker_types.full_status_encoding
+             Peer_validator_worker_state.Request.encoding
+             Peer_validator_worker_state.Event.encoding
+             RPC_error.encoding)
+        RPC_path.(root / "workers" / "chain_validators" /: Chain_services.chain_arg / "peers_validators" /: P2p_peer.Id.rpc_arg)
+
+  end
+
+  open RPC_context
+  let list ctxt n = make_call1 S.list ctxt n () ()
+  let state ctxt n h = make_call2 S.state ctxt n h () ()
+
+end
+
+module Chain_validators = struct
+
+  module S = struct
+
+    let list =
+      RPC_service.get_service
+        ~description:"Lists the chain validator workers and their status."
+        ~query: RPC_query.empty
+        ~output:
+          (list
+             (obj2
+                (req "chain_id" Chain_id.encoding)
+                (req "status" (Worker_types.worker_status_encoding RPC_error.encoding))))
+        RPC_path.(root / "workers" / "chain_validators")
+
+    let state =
+      RPC_service.get_service
+        ~description:"Introspect the state of a chain validator worker."
+        ~query: RPC_query.empty
+        ~output:
+          (Worker_types.full_status_encoding
+             Chain_validator_worker_state.Request.encoding
+             Chain_validator_worker_state.Event.encoding
+             RPC_error.encoding)
+        RPC_path.(root / "workers" / "chain_validators" /: Chain_services.chain_arg )
+
+  end
+
+  open RPC_context
+  let list ctxt = make_call S.list ctxt () () ()
+  let state ctxt h = make_call1 S.state ctxt h () ()
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/worker_services.mli b/vendors/tezos-modded/src/lib_shell_services/worker_services.mli
new file mode 100644
index 000000000..ec1014eaf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/worker_services.mli
@@ -0,0 +1,122 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 RPC_context
+
+module Prevalidators : sig
+
+  open Prevalidator_worker_state
+
+  val list:
+    #simple -> (Chain_id.t * Worker_types.worker_status) list tzresult Lwt.t
+  val state:
+    #simple -> Chain_services.chain -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ],  unit,
+       unit, unit, unit,
+       (Chain_id.t * Worker_types.worker_status) list) RPC_service.t
+
+    val state :
+      ([ `GET ], unit,
+       unit * Chain_services.chain, unit, unit,
+       (Request.view, Event.t) Worker_types.full_status) RPC_service.t
+
+  end
+
+end
+
+module Block_validator : sig
+
+  open Block_validator_worker_state
+
+  val state:
+    #simple -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
+
+  module S : sig
+
+    val state :
+      ([ `GET ], unit,
+       unit, unit, unit,
+       (Request.view, Event.t) Worker_types.full_status) RPC_service.t
+
+  end
+
+end
+
+module Peer_validators : sig
+
+  open Peer_validator_worker_state
+
+  val list:
+    #simple -> Chain_services.chain ->
+    (P2p_peer.Id.t * Worker_types.worker_status) list tzresult Lwt.t
+
+  val state:
+    #simple ->
+    Chain_services.chain -> P2p_peer.Id.t -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ],  unit,
+       unit * Chain_services.chain, unit, unit,
+       (P2p_peer.Id.t * Worker_types.worker_status) list) RPC_service.t
+
+    val state :
+      ([ `GET ], unit,
+       (unit * Chain_services.chain) * P2p_peer.Id.t, unit, unit,
+       (Request.view, Event.t) Worker_types.full_status) RPC_service.t
+
+  end
+
+end
+
+module Chain_validators : sig
+
+  open Chain_validator_worker_state
+
+  val list:
+    #simple -> (Chain_id.t * Worker_types.worker_status) list tzresult Lwt.t
+  val state:
+    #simple -> Chain_services.chain -> (Request.view, Event.t) Worker_types.full_status tzresult Lwt.t
+
+  module S : sig
+
+    val list :
+      ([ `GET ],  unit,
+       unit, unit, unit,
+       (Chain_id.t * Worker_types.worker_status) list) RPC_service.t
+
+    val state :
+      ([ `GET ], unit,
+       unit * Chain_services.chain, unit, unit,
+       (Request.view, Event.t) Worker_types.full_status) RPC_service.t
+
+  end
+
+end
diff --git a/vendors/tezos-modded/src/lib_shell_services/worker_types.ml b/vendors/tezos-modded/src/lib_shell_services/worker_types.ml
new file mode 100644
index 000000000..b65ff7d14
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/worker_types.ml
@@ -0,0 +1,151 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 level_encoding =
+  let open Logging in
+  let open Data_encoding in
+  conv
+    (function
+      | Fatal -> "fatal"
+      | Error -> "error"
+      | Warning -> "warning"
+      | Notice -> "notice"
+      | Info -> "info"
+      | Debug -> "debug")
+    (function
+      | "error" -> Error
+      | "warn" -> Warning
+      | "notice" -> Notice
+      | "info" -> Info
+      | "debug" -> Debug
+      | "fatal" -> Fatal
+      | _ -> invalid_arg "Logging.level")
+    string
+
+type limits =
+  { backlog_size : int ;
+    backlog_level : Logging.level ;
+    zombie_lifetime : float ;
+    zombie_memory : float }
+
+type worker_status =
+  | Launching of Time.t
+  | Running of Time.t
+  | Closing of Time.t * Time.t
+  | Closed of Time.t * Time.t * error list option
+
+let worker_status_encoding error_encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag 0)
+        ~title:"Launching"
+        (obj2
+           (req "phase" (constant "launching"))
+           (req "since" Time.encoding))
+        (function Launching t -> Some ((), t) | _ -> None)
+        (fun ((), t) -> Launching t) ;
+      case (Tag 1)
+        ~title:"Running"
+        (obj2
+           (req "phase" (constant "running"))
+           (req "since" Time.encoding))
+        (function Running t -> Some ((), t) | _ -> None)
+        (fun ((), t) -> Running t) ;
+      case (Tag 2)
+        ~title:"Closing"
+        (obj3
+           (req "phase" (constant "closing"))
+           (req "birth" Time.encoding)
+           (req "since" Time.encoding))
+        (function Closing (t0, t) -> Some ((), t0, t) | _ -> None)
+        (fun ((), t0, t) -> Closing (t0, t))  ;
+      case (Tag 3)
+        ~title:"Closed"
+        (obj3
+           (req "phase" (constant "closed"))
+           (req "birth" Time.encoding)
+           (req "since" Time.encoding))
+        (function Closed (t0, t, None) -> Some ((), t0, t) | _ -> None)
+        (fun ((), t0, t) -> Closed (t0, t, None)) ;
+      case (Tag 4)
+        ~title:"Crashed"
+        (obj4
+           (req "phase" (constant "crashed"))
+           (req "birth" Time.encoding)
+           (req "since" Time.encoding)
+           (req "errors" error_encoding))
+        (function Closed (t0, t, Some errs) -> Some ((), t0, t, errs) | _ -> None)
+        (fun ((), t0, t, errs) -> Closed (t0, t, Some errs )) ]
+
+type request_status =
+  { pushed : Time.t ;
+    treated : Time.t ;
+    completed : Time.t }
+
+let request_status_encoding =
+  let open Data_encoding in
+  conv
+    (fun { pushed ; treated ; completed } ->
+       (pushed, treated, completed))
+    (fun (pushed, treated, completed) ->
+       { pushed ; treated ; completed })
+    (obj3
+       (req "pushed" Time.encoding)
+       (req "treated" Time.encoding)
+       (req "completed" Time.encoding))
+
+type ('req, 'evt) full_status =
+  { status : worker_status ;
+    pending_requests : (Time.t * 'req) list ;
+    backlog : (Logging.level * 'evt list) list ;
+    current_request : (Time.t * Time.t * 'req) option }
+
+let full_status_encoding req_encoding evt_encoding error_encoding =
+  let open Data_encoding in
+  let requests_encoding =
+    list
+      (obj2
+         (req "pushed" Time.encoding)
+         (req "request" (dynamic_size req_encoding))) in
+  let events_encoding =
+    list
+      (obj2
+         (req "level" level_encoding)
+         (req "events" (dynamic_size (list (dynamic_size evt_encoding))))) in
+  let current_request_encoding =
+    obj3
+      (req "pushed" Time.encoding)
+      (req "treated" Time.encoding)
+      (req "request" req_encoding) in
+  conv
+    (fun { status  ; pending_requests ; backlog ; current_request } ->
+       (status, pending_requests, backlog, current_request))
+    (fun (status, pending_requests, backlog, current_request) ->
+       { status  ; pending_requests ; backlog ; current_request })
+    (obj4
+       (req "status" (worker_status_encoding error_encoding))
+       (req "pending_requests" requests_encoding)
+       (req "backlog" events_encoding)
+       (opt "current_request" current_request_encoding))
diff --git a/vendors/tezos-modded/src/lib_shell_services/worker_types.mli b/vendors/tezos-modded/src/lib_shell_services/worker_types.mli
new file mode 100644
index 000000000..a9fd9c89e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_shell_services/worker_types.mli
@@ -0,0 +1,68 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Some memory and time limits. *)
+type limits =
+  { backlog_size : int
+  (** Number of event stored in the backlog for each debug level. *) ;
+    backlog_level : Logging.level
+  (** Stores events at least as important as this value. *) ;
+    zombie_lifetime : float
+  (** How long dead workers are kept in the introspection table. *) ;
+    zombie_memory : float
+    (** How long zombie workers' logs are kept. *) }
+
+(** The running status of an individual worker. *)
+type worker_status =
+  | Launching of Time.t
+  | Running of Time.t
+  | Closing of Time.t * Time.t
+  | Closed of Time.t * Time.t * error list option
+
+(** Worker status serializer for RPCs. *)
+val worker_status_encoding : error list Data_encoding.t -> worker_status Data_encoding.t
+
+(** The runnning status of an individual request. *)
+type request_status =
+  { pushed : Time.t ;
+    treated : Time.t ;
+    completed : Time.t }
+
+(** Request status serializer for RPCs. *)
+val request_status_encoding : request_status Data_encoding.t
+
+(** The full status of an individual worker. *)
+type ('req, 'evt) full_status =
+  { status : worker_status ;
+    pending_requests : (Time.t * 'req) list ;
+    backlog : (Logging.level * 'evt list) list ;
+    current_request : (Time.t * Time.t * 'req) option }
+
+(** Full worker status serializer for RPCs. *)
+val full_status_encoding :
+  'req Data_encoding.t ->
+  'evt Data_encoding.t ->
+  error list Data_encoding.t ->
+  ('req, 'evt) full_status Data_encoding.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/dune b/vendors/tezos-modded/src/lib_signer_backends/dune
new file mode 100644
index 000000000..7817f02fe
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/dune
@@ -0,0 +1,23 @@
+(library
+ (name tezos_signer_backends)
+ (public_name tezos-signer-backends)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-client-base
+            tezos-rpc-http
+            tezos-signer-services
+            tezos-shell-services
+            pbkdf
+            bip39
+            ledgerwallet-tezos)
+ (flags (:standard -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_client_base
+                   -open Tezos_signer_services
+                   -open Tezos_shell_services
+                   -open Tezos_rpc_http)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_signer_backends/encrypted.ml b/vendors/tezos-modded/src/lib_signer_backends/encrypted.ml
new file mode 100644
index 000000000..a7835807f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/encrypted.ml
@@ -0,0 +1,286 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type Base58.data += Encrypted_ed25519 of MBytes.t
+type Base58.data += Encrypted_secp256k1 of MBytes.t
+type Base58.data += Encrypted_p256 of MBytes.t
+
+open Client_keys
+
+let scheme = "encrypted"
+
+module Raw = struct
+
+  (* https://tools.ietf.org/html/rfc2898#section-4.1 *)
+  let salt_len = 8
+
+  (* Fixed zero nonce *)
+  let nonce = Crypto_box.zero_nonce
+
+  (* Secret keys for Ed25519, secp256k1, P256 are 32 bytes long. *)
+  let encrypted_size = Crypto_box.boxzerobytes + 32
+
+  let pbkdf ~salt ~password =
+    Pbkdf.SHA512.pbkdf2 ~count:32768 ~dk_len:32l ~salt ~password
+
+  let encrypt ~password sk =
+    let salt = Rand.generate salt_len in
+    let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in
+    let msg =
+      match (sk : Signature.secret_key) with
+      | Ed25519 sk ->
+          Data_encoding.Binary.to_bytes_exn Ed25519.Secret_key.encoding sk
+      | Secp256k1 sk ->
+          Data_encoding.Binary.to_bytes_exn Secp256k1.Secret_key.encoding sk
+      | P256 sk ->
+          Data_encoding.Binary.to_bytes_exn P256.Secret_key.encoding sk in
+    MBytes.concat "" [ salt ;
+                       Crypto_box.Secretbox.box key msg nonce ]
+
+  let decrypt algo ~password ~encrypted_sk =
+    let salt = MBytes.sub encrypted_sk 0 salt_len in
+    let encrypted_sk =
+      MBytes.sub encrypted_sk salt_len encrypted_size in
+    let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~salt ~password) in
+    match Crypto_box.Secretbox.box_open key encrypted_sk nonce, algo with
+    | None, _ -> return_none
+    | Some bytes, Signature.Ed25519 -> begin
+        match Data_encoding.Binary.of_bytes Ed25519.Secret_key.encoding bytes with
+        | Some sk -> return_some (Ed25519 sk : Signature.Secret_key.t)
+        | None -> failwith "Corrupted wallet, deciphered key is not a \
+                            valid Ed25519 secret key"
+      end
+    | Some bytes, Signature.Secp256k1 -> begin
+        match Data_encoding.Binary.of_bytes Secp256k1.Secret_key.encoding bytes with
+        | Some sk -> return_some (Secp256k1 sk : Signature.Secret_key.t)
+        | None -> failwith "Corrupted wallet, deciphered key is not a \
+                            valid Secp256k1 secret key"
+      end
+    | Some bytes, Signature.P256 -> begin
+        match Data_encoding.Binary.of_bytes P256.Secret_key.encoding bytes with
+        | Some sk -> return_some (P256 sk : Signature.Secret_key.t)
+        | None -> failwith "Corrupted wallet, deciphered key is not a \
+                            valid P256 secret key"
+      end
+end
+
+module Encodings = struct
+
+  let ed25519 =
+    let length =
+      Hacl.Sign.skbytes + Crypto_box.boxzerobytes + Raw.salt_len in
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.ed25519_encrypted_seed
+      ~length
+      ~to_raw: (fun sk -> MBytes.to_string sk)
+      ~of_raw: (fun buf ->
+          if String.length buf <> length then None
+          else Some (MBytes.of_string buf))
+      ~wrap: (fun sk -> Encrypted_ed25519 sk)
+
+  let secp256k1 =
+    let open Libsecp256k1.External in
+    let length =
+      Key.secret_bytes + Crypto_box.boxzerobytes + Raw.salt_len in
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.secp256k1_encrypted_secret_key
+      ~length
+      ~to_raw: (fun sk -> MBytes.to_string sk)
+      ~of_raw: (fun buf ->
+          if String.length buf <> length then None
+          else Some (MBytes.of_string buf))
+      ~wrap: (fun sk -> Encrypted_secp256k1 sk)
+
+  let p256 =
+    let length =
+      Uecc.(sk_size secp256r1) + Crypto_box.boxzerobytes + Raw.salt_len in
+    Base58.register_encoding
+      ~prefix: Base58.Prefix.p256_encrypted_secret_key
+      ~length
+      ~to_raw: (fun sk -> MBytes.to_string sk)
+      ~of_raw: (fun buf ->
+          if String.length buf <> length then None
+          else Some (MBytes.of_string buf))
+      ~wrap: (fun sk -> Encrypted_p256 sk)
+
+  let () =
+    Base58.check_encoded_prefix ed25519 "edesk" 88 ;
+    Base58.check_encoded_prefix secp256k1 "spesk" 88 ;
+    Base58.check_encoded_prefix p256 "p2esk" 88
+end
+
+let decrypted = Hashtbl.create 13
+
+(* we cache the password in this list to avoid
+   asking the user all the time *)
+let passwords = ref []
+
+let rec interactive_decrypt_loop
+    (cctxt : #Client_context.prompter)
+    ?name ~encrypted_sk algo =
+  begin match name with
+    | None ->
+        cctxt#prompt_password
+          "Enter password for encrypted key: "
+    | Some name ->
+        cctxt#prompt_password
+          "Enter password for encrypted key \"%s\": " name
+  end >>=? fun password ->
+  Raw.decrypt algo ~password ~encrypted_sk >>=? function
+  | Some sk ->
+      passwords := password :: !passwords ;
+      return sk
+  | None ->
+      interactive_decrypt_loop cctxt ?name ~encrypted_sk algo
+
+(* add all passwords in [filename] to the list of known passwords *)
+let password_file_load = function
+  |Some filename ->
+      if Sys.file_exists filename then begin
+        let stream = Lwt_io.lines_of_file filename in
+        Lwt_stream.iter
+          (fun p ->
+             passwords := MBytes.of_string p :: !passwords)
+          stream >>= fun () ->
+        return_unit
+      end
+      else
+        return_unit
+  | None -> return_unit
+
+let rec noninteractive_decrypt_loop algo ~encrypted_sk = function
+  | [] -> return_none
+  | password :: passwords ->
+      Raw.decrypt algo ~password ~encrypted_sk >>=? function
+      | None -> noninteractive_decrypt_loop algo ~encrypted_sk passwords
+      | Some sk -> return_some sk
+
+let decrypt_payload cctxt ?name encrypted_sk =
+  begin match Base58.decode encrypted_sk with
+    | Some (Encrypted_ed25519 encrypted_sk) ->
+        return (Signature.Ed25519, encrypted_sk)
+    | Some (Encrypted_secp256k1 encrypted_sk) ->
+        return (Signature.Secp256k1, encrypted_sk)
+    | Some (Encrypted_p256 encrypted_sk) ->
+        return (Signature.P256, encrypted_sk)
+    | _ -> failwith "Not a Base58Check-encoded encrypted key"
+  end >>=? fun (algo, encrypted_sk) ->
+  noninteractive_decrypt_loop algo ~encrypted_sk !passwords >>=? function
+  | Some sk -> return sk
+  | None -> interactive_decrypt_loop cctxt ?name ~encrypted_sk algo
+
+let decrypt (cctxt : #Client_context.prompter) ?name sk_uri =
+  let payload = Uri.path (sk_uri : sk_uri :> Uri.t) in
+  decrypt_payload cctxt ?name payload >>=? fun sk ->
+  Hashtbl.replace decrypted sk_uri sk ;
+  return sk
+
+let decrypt_all (cctxt : #Client_context.io_wallet) =
+  Secret_key.load cctxt >>=? fun sks ->
+  password_file_load cctxt#password_filename >>=? fun () ->
+  iter_s begin fun (name, sk_uri) ->
+    if Uri.scheme (sk_uri : sk_uri :> Uri.t) <> Some scheme then
+      return_unit
+    else
+      decrypt cctxt ~name sk_uri >>=? fun _ ->
+      return_unit
+  end sks
+
+let decrypt_list (cctxt : #Client_context.io_wallet) keys =
+  Secret_key.load cctxt >>=? fun sks ->
+  password_file_load cctxt#password_filename >>=? fun () ->
+  iter_s begin fun (name, sk_uri) ->
+    if Uri.scheme (sk_uri : sk_uri :> Uri.t) = Some scheme &&
+       (keys = [] || List.mem name keys) then
+      decrypt cctxt ~name sk_uri >>=? fun _ ->
+      return_unit
+    else
+      return_unit
+  end sks
+
+let rec read_password (cctxt : #Client_context.io) =
+  cctxt#prompt_password
+    "Enter password to encrypt your key: " >>=? fun password ->
+  cctxt#prompt_password
+    "Confirm password: " >>=? fun confirm ->
+  if not (MBytes.equal password confirm) then
+    cctxt#message "Passwords do not match." >>= fun () ->
+    read_password cctxt
+  else
+    return password
+
+let encrypt cctxt sk =
+  read_password cctxt >>=? fun password ->
+  let payload = Raw.encrypt ~password sk in
+  let encoding = match sk with
+    | Ed25519 _ -> Encodings.ed25519
+    | Secp256k1 _ -> Encodings.secp256k1
+    | P256 _ -> Encodings.p256 in
+  let path = Base58.simple_encode encoding payload in
+  let sk_uri = Client_keys.make_sk_uri (Uri.make ~scheme ~path ()) in
+  Hashtbl.replace decrypted sk_uri sk ;
+  return sk_uri
+
+module Make(C : sig val cctxt: Client_context.prompter end) = struct
+
+  let scheme = "encrypted"
+
+  let title =
+    "Built-in signer using encrypted keys."
+
+  let description =
+    "Valid secret key URIs are of the form\n\
+    \ - encrypted:<encrypted_key>\n\
+     where <encrypted_key> is the encrypted (password protected \
+     using Nacl's cryptobox and pbkdf) secret key, formatted in \
+     unprefixed Base58.\n\
+     Valid public key URIs are of the form\n\
+    \ - encrypted:<public_key>\n\
+     where <public_key> is the public key in Base58."
+
+  let public_key = Unencrypted.public_key
+
+  let public_key_hash = Unencrypted.public_key_hash
+
+  let neuterize sk_uri =
+    decrypt C.cctxt sk_uri >>=? fun sk ->
+    return (Unencrypted.make_pk (Signature.Secret_key.to_public_key sk))
+
+  let sign ?watermark sk_uri buf =
+    decrypt C.cctxt sk_uri >>=? fun sk ->
+    return (Signature.sign ?watermark sk buf)
+
+  let deterministic_nonce sk_uri buf =
+    decrypt C.cctxt sk_uri >>=? fun sk ->
+    return (Signature.deterministic_nonce sk buf)
+
+  let deterministic_nonce_hash sk_uri buf =
+    decrypt C.cctxt sk_uri >>=? fun sk ->
+    return (Signature.deterministic_nonce_hash sk buf)
+
+  let supports_deterministic_nonces _ = return_true
+
+end
diff --git a/vendors/tezos-modded/src/lib_signer_backends/encrypted.mli b/vendors/tezos-modded/src/lib_signer_backends/encrypted.mli
new file mode 100644
index 000000000..09096e718
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/encrypted.mli
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(C : sig val cctxt: Client_context.prompter end) : Client_keys.SIGNER
+
+val decrypt:
+  #Client_context.prompter ->
+  ?name:string ->
+  Client_keys.sk_uri -> Signature.secret_key tzresult Lwt.t
+
+val decrypt_all:
+  #Client_context.io_wallet -> unit tzresult Lwt.t
+
+val decrypt_list:
+  #Client_context.io_wallet -> string list -> unit tzresult Lwt.t
+
+val encrypt:
+  #Client_context.io ->
+  Signature.secret_key -> Client_keys.sk_uri tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/http.ml b/vendors/tezos-modded/src/lib_signer_backends/http.ml
new file mode 100644
index 000000000..51fb58fa1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/http.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Http_gen.Make(struct let scheme = "http" end)
diff --git a/vendors/tezos-modded/src/lib_signer_backends/http.mli b/vendors/tezos-modded/src/lib_signer_backends/http.mli
new file mode 100644
index 000000000..bd7ef1092
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/http.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(P : sig
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+    val logger: RPC_client.logger
+  end)
+  : Client_keys.SIGNER
+
+val make_base: string -> int -> Uri.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/http_gen.ml b/vendors/tezos-modded/src/lib_signer_backends/http_gen.ml
new file mode 100644
index 000000000..635a8be40
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/http_gen.ml
@@ -0,0 +1,172 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(N : sig val scheme : string end) = struct
+
+  open Client_keys
+
+  let scheme = N.scheme
+
+  module Make(P : sig
+      val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+      val logger: RPC_client.logger
+    end) = struct
+
+    let scheme = scheme
+
+    let title =
+      "Built-in tezos-signer using remote signer through hardcoded " ^ scheme ^ " requests."
+
+    let description =
+      "Valid locators are of this form:\n"
+      ^ " - " ^ scheme ^ "://host/tz1...\n"
+      ^ " - " ^ scheme ^ "://host:port/path/to/service/tz1...\n"
+      ^ "Environment variable TEZOS_SIGNER_HTTP_HEADERS can be specified \
+         to add headers to the requests (only 'host' and custom 'x-...' headers are supported)."
+
+    let headers = match Sys.getenv_opt "TEZOS_SIGNER_HTTP_HEADERS" with
+      | None -> None
+      | Some contents ->
+          let lines = String.split_on_char '\n' contents in
+          Some
+            (List.fold_left (fun acc line ->
+                 match String.index_opt line ':' with
+                 | None ->
+                     Pervasives.failwith
+                       "Http signer: invalid TEZOS_SIGNER_HTTP_HEADERS environment variable, missing colon"
+                 | Some pos ->
+                     let header = String.trim (String.sub line 0 pos) in
+                     let header = String.lowercase_ascii header in
+                     if header <> "host"
+                     && (String.length header < 2
+                         || String.sub header 0 2 <> "x-") then
+                       Pervasives.failwith
+                         "Http signer: invalid TEZOS_SIGNER_HTTP_HEADERS environment variable, \
+                          only 'host' or 'x-' headers are supported" ;
+                     let value = String.trim (String.sub line (pos + 1) (String.length line - pos - 1)) in
+                     (header, value) :: acc) [] lines)
+
+    let parse uri =
+      (* extract `tz1..` from the last component of the path *)
+      assert (Uri.scheme uri = Some scheme) ;
+      let path = Uri.path uri in
+      begin match String.rindex_opt path '/' with
+        | None ->
+            failwith "Invalid locator %a" Uri.pp_hum uri
+        | Some i ->
+            let pkh =
+              try String.sub path (i + 1) (String.length path - i - 1)
+              with _ -> "" in
+            let path = String.sub path 0 i in
+            return (Uri.with_path uri path, pkh)
+      end >>=? fun (base, pkh) ->
+      Lwt.return (Signature.Public_key_hash.of_b58check pkh) >>=? fun pkh ->
+      return (base, pkh)
+
+    let public_key ?interactive:_ uri =
+      parse (uri : pk_uri :> Uri.t) >>=? fun (base, pkh) ->
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.public_key ((), pkh) () ()
+
+    let neuterize uri =
+      return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
+
+    let public_key_hash ?interactive uri =
+      public_key ?interactive uri >>=? fun pk ->
+      return (Signature.Public_key.hash pk, Some pk)
+
+    let get_signature base pkh msg =
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.authorized_keys () () ()
+      >>=? function
+      | Some authorized_keys ->
+          P.authenticate
+            authorized_keys
+            (Signer_messages.Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature ->
+          return_some signature
+      | None -> return_none
+
+    let sign ?watermark uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (base, pkh) ->
+      let msg =
+        match watermark with
+        | None -> msg
+        | Some watermark ->
+            MBytes.concat "" [ Signature.bytes_of_watermark watermark ; msg ] in
+      get_signature base pkh msg >>=? fun signature ->
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.sign ((), pkh)
+        signature
+        msg
+
+    let deterministic_nonce uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (base, pkh) ->
+      get_signature base pkh msg >>=? fun signature ->
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.deterministic_nonce ((), pkh)
+        signature
+        msg
+
+    let deterministic_nonce_hash uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (base, pkh) ->
+      get_signature base pkh msg >>=? fun signature ->
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.deterministic_nonce_hash ((), pkh)
+        signature
+        msg
+
+    let supports_deterministic_nonces uri =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (base, pkh) ->
+      RPC_client.call_service
+        ~logger: P.logger
+        ?headers
+        Media_type.all_media_types
+        ~base Signer_services.supports_deterministic_nonces ((), pkh) () () >>= function
+      | Ok ans -> return ans
+      | Error ((RPC_context.Not_found _) :: _) -> return false
+      | Error _ as res -> Lwt.return res
+
+
+  end
+
+  let make_base host port =
+    Uri.make ~scheme ~host ~port ()
+
+end
diff --git a/vendors/tezos-modded/src/lib_signer_backends/http_gen.mli b/vendors/tezos-modded/src/lib_signer_backends/http_gen.mli
new file mode 100644
index 000000000..cb6253e4b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/http_gen.mli
@@ -0,0 +1,36 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(N : sig val scheme : string end) : sig
+
+  module Make(P : sig
+      val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+      val logger: RPC_client.logger
+    end)
+    : Client_keys.SIGNER
+
+  val make_base: string -> int -> Uri.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_signer_backends/https.ml b/vendors/tezos-modded/src/lib_signer_backends/https.ml
new file mode 100644
index 000000000..0d27a06ab
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/https.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Http_gen.Make(struct let scheme = "https" end)
diff --git a/vendors/tezos-modded/src/lib_signer_backends/https.mli b/vendors/tezos-modded/src/lib_signer_backends/https.mli
new file mode 100644
index 000000000..bd7ef1092
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/https.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(P : sig
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+    val logger: RPC_client.logger
+  end)
+  : Client_keys.SIGNER
+
+val make_base: string -> int -> Uri.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/ledger.ml b/vendors/tezos-modded/src/lib_signer_backends/ledger.ml
new file mode 100644
index 000000000..b55ae127c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/ledger.ml
@@ -0,0 +1,947 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_keys
+
+include Tezos_stdlib.Logging.Make(struct let name = "client.signer.ledger" end)
+
+let scheme = "ledger"
+
+let title =
+  "Built-in signer using Ledger Nano S."
+
+let description =
+  "Valid URIs are of the form\n\
+  \ - ledger://<root_pkh>[/<path>]\n\
+   where <root_pkh> is the Base58-encoded public key hash of the key \
+   at m/44'/1729' and <path> is a BIP32 path anchored at \
+   m/44'/1729'. Ledger does not yet support non-hardened path so each \
+   node of the path must be hardened.\n\
+   Use `tezos-client list connected ledgers` to get the <root_pkh> of \
+   all connected devices."
+
+let hard = Int32.logor 0x8000_0000l
+let unhard = Int32.logand 0x7fff_ffffl
+let is_hard n = Int32.logand 0x8000_0000l n <> 0l
+let tezos_root = [hard 44l ; hard 1729l]
+
+module Bip32_path = struct
+  let node_of_string str =
+    match Int32.of_string_opt str with
+    | Some node -> Some node
+    | None ->
+        match Int32.of_string_opt String.(sub str 0 ((length str) - 1)) with
+        | None -> None
+        | Some node -> Some (hard node)
+
+  let node_of_string_exn str =
+    match node_of_string str with
+    | None ->
+        invalid_arg (Printf.sprintf "node_of_string_exn: got %S" str)
+    | Some str -> str
+
+  let pp_node ppf node =
+    match is_hard node with
+    | true -> Fmt.pf ppf "%ld'" (unhard node)
+    | false -> Fmt.pf ppf "%ld" node
+
+  let string_of_node = Fmt.to_to_string pp_node
+
+  let path_of_string_exn s =
+    match String.split_on_char '/' s with
+    | [""] -> []
+    | nodes ->
+        List.map node_of_string_exn nodes
+
+  let path_of_string s =
+    try Some (path_of_string_exn s) with _ -> None
+
+  let pp_path =
+    Fmt.(list ~sep:(const char '/') pp_node)
+
+  let string_of_path = Fmt.to_to_string pp_path
+end
+
+(* Those are always valid on Ledger Nano S with latest firmware. *)
+let vendor_id = 0x2c97
+let product_id = 0x0001
+
+let pks : (pk_uri, Signature.Public_key.t) Hashtbl.t =
+  Hashtbl.create 13
+
+let pkhs : (pk_uri, Signature.Public_key_hash.t) Hashtbl.t =
+  Hashtbl.create 13
+
+let curve_of_pkh :
+  Signature.public_key_hash -> Ledgerwallet_tezos.curve = function
+  | Ed25519 _ -> Ledgerwallet_tezos.Ed25519
+  | Secp256k1 _ -> Secp256k1
+  | P256 _ -> Secp256r1
+
+let secp256k1_ctx =
+  Libsecp256k1.External.Context.create ~sign:false ~verify:false ()
+
+type error +=
+  | LedgerError of Ledgerwallet.Transport.error
+  | Ledger_deterministic_nonce_not_implemented
+
+let error_encoding =
+  let open Data_encoding in
+  conv
+    (fun e -> Format.asprintf "%a" Ledgerwallet.Transport.pp_error e)
+    (fun _ ->invalid_arg "Ledger error is not deserializable")
+    (obj1 (req "ledger-error" string))
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id: "signer.ledger"
+    ~title: "Ledger error"
+    ~description: "Error when communication to a Ledger Nano S device"
+    ~pp:(fun ppf e ->
+        Format.fprintf ppf "Ledger %a" Ledgerwallet.Transport.pp_error e)
+    error_encoding
+    (function LedgerError e -> Some e | _ -> None)
+    (fun e -> LedgerError e)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id: "signer.ledger.deterministic_nonce_not_implemented"
+    ~title: "Ledger deterministic_nonce(_hash) not implemented"
+    ~description: "The deterministic_nonce(_hash) functionality \
+                   is not implemented by the ledger"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Asked the ledger to generate a  deterministic nonce (hash), \
+                            but this functionality is not yet implemented")
+    Data_encoding.unit
+    (function Ledger_deterministic_nonce_not_implemented -> Some () | _ -> None)
+    (fun () -> Ledger_deterministic_nonce_not_implemented)
+
+type id =
+  | Animals of Ledger_names.t * Ledgerwallet_tezos.curve option
+  | Pkh of Signature.Public_key_hash.t
+
+let pp_id ppf = function
+  | Pkh pkh -> Signature.Public_key_hash.pp ppf pkh
+  | Animals (cthd, curve) ->
+      Format.fprintf ppf "%a%a" Ledger_names.pp cthd
+        (fun fmt -> function
+           | None -> Format.fprintf fmt ""
+           | Some a -> Format.fprintf fmt "/%a" Ledgerwallet_tezos.pp_curve a)
+        curve
+
+let pp_animals_uri ppf (names, curve, path) =
+  let (root, path_without_root) = List.split_n (List.length tezos_root) path in
+  if root <> tezos_root then
+    Format.kasprintf Pervasives.failwith "BIP32 path is missing Tezos BIP32 prefix of %a: %a" Bip32_path.pp_path tezos_root Bip32_path.pp_path path
+  else
+    Format.fprintf ppf "ledger://%a%a" pp_id (Animals (names, Some curve))
+      (fun fmt -> function
+         | [] -> Format.fprintf fmt ""
+         | xs -> Format.fprintf fmt "/%a" Bip32_path.pp_path xs)
+      path_without_root
+
+let parse_animals animals =
+  match String.split '-' animals with
+  | [c; t; h; d] -> Some { Ledger_names.c ; t ; h ; d }
+  | _ -> None
+
+let id_of_uri uri =
+  let host = Uri.host uri in
+  match Option.apply host
+          ~f:Signature.Public_key_hash.of_b58check_opt with
+  | Some pkh -> return (Pkh pkh)
+  | None ->
+      match Option.apply host ~f:parse_animals,
+            Option.apply (List.hd_opt (String.split '/' (Uri.path uri)))
+              ~f:Ledgerwallet_tezos.curve_of_string with
+      | Some animals, curve ->
+          return (Animals (animals, curve))
+      | (ann, curr) ->
+          failwith "No public key hash or animal names in %a (%a, %a)"
+            Uri.pp_hum uri
+            (fun fmt -> function
+               | None -> Format.fprintf fmt "NONE"
+               | Some a -> Format.fprintf fmt "%a" Ledger_names.pp a)
+            ann
+            (fun fmt -> function
+               | None -> Format.fprintf fmt "NONE"
+               | Some a -> Format.fprintf fmt "%a" Ledgerwallet_tezos.pp_curve a)
+            curr
+
+let id_of_pk_uri (uri : pk_uri) = id_of_uri (uri :> Uri.t)
+let id_of_sk_uri (uri : sk_uri) = id_of_uri (uri :> Uri.t)
+
+let sk_or_alias_param next =
+  let name = "account-alias-or-ledger-uri" in
+  let desc = "An imported ledger alias or a ledger URI (e.g. 'ledger://animal/curve/path')." in
+  let open Clic in
+  (* Order of parsers is important: The secret key parser accepts far more inputs so must come last. *)
+  param ~name ~desc (compose_parameters
+                       (map_parameter ~f:(fun (_, (x, _)) -> `Pk_uri x) (Public_key.alias_parameter ()))
+                       (map_parameter ~f:(fun x -> `Sk_uri x) (Client_keys.sk_uri_parameter ())))
+    next
+
+let id_of_sk_or_pk = function
+  | `Sk_uri sk -> id_of_sk_uri sk
+  | `Pk_uri pk -> id_of_pk_uri pk
+
+let wrap_ledger_cmd f =
+  let buf = Buffer.create 100 in
+  let pp = Format.formatter_of_buffer buf in
+  let res = f pp in
+  debug "%s" (Buffer.contents buf) ;
+  match res with
+  | Error err ->
+      fail (LedgerError err)
+  | Ok v ->
+      return v
+
+let public_key_returning_instruction which
+    ?(prompt=false)
+    ledger curve path =
+  let path = tezos_root @ path in
+  begin match which with
+    | `Get_public_key -> wrap_ledger_cmd begin fun pp ->
+        Ledgerwallet_tezos.get_public_key ~prompt ~pp ledger curve path
+      end
+    | `Authorize_baking ->
+        wrap_ledger_cmd begin fun pp ->
+          Ledgerwallet_tezos.authorize_baking ~pp ledger curve path
+        end
+    | `Setup (main_chain_id, main_hwm, test_hwm) ->
+        wrap_ledger_cmd begin fun pp ->
+          Ledgerwallet_tezos.setup_baking ~pp ledger curve path
+            ~main_chain_id ~main_hwm ~test_hwm
+        end
+  end >>|? fun pk ->
+  let pk = Cstruct.to_bigarray pk in
+  match curve with
+  | Ledgerwallet_tezos.Ed25519 ->
+      MBytes.set_int8 pk 0 0 ; (* hackish, but works. *)
+      Data_encoding.Binary.of_bytes_exn Signature.Public_key.encoding pk
+  | Secp256k1 ->
+      let open Libsecp256k1.External in
+      let buf = MBytes.create (Key.compressed_pk_bytes + 1) in
+      let pk = Key.read_pk_exn secp256k1_ctx pk in
+      MBytes.set_int8 buf 0 1 ;
+      let _nb_written = Key.write secp256k1_ctx ~pos:1 buf pk in
+      Data_encoding.Binary.of_bytes_exn Signature.Public_key.encoding buf
+  | Secp256r1 ->
+      let open Uecc in
+      let pklen = compressed_size secp256r1 in
+      let buf = MBytes.create (pklen + 1) in
+      match pk_of_bytes secp256r1 pk with
+      | None ->
+          Pervasives.failwith "Impossible to read P256 public key from Ledger"
+      | Some pk ->
+          MBytes.set_int8 buf 0 2 ;
+          let _nb_written = write_key ~compress:true (MBytes.sub buf 1 pklen) pk in
+          Data_encoding.Binary.of_bytes_exn Signature.Public_key.encoding buf
+
+let get_public_key = public_key_returning_instruction `Get_public_key
+
+module Ledger = struct
+  type t = {
+    device_info : Hidapi.device_info ;
+    version : Ledgerwallet_tezos.Version.t ;
+    git_commit : string option ;
+    of_curve : (Ledgerwallet_tezos.curve *
+                (Signature.Public_key.t *
+                 Signature.Public_key_hash.t)) list ;
+    of_pkh : (Signature.Public_key_hash.t *
+              (Signature.Public_key.t *
+               Ledgerwallet_tezos.curve)) list ;
+  }
+
+  let create ?git_commit ~device_info ~version ~of_curve ~of_pkh () =
+    { device_info ; version ; git_commit ; of_curve ; of_pkh }
+
+  let curves { Ledgerwallet_tezos.Version.major ; minor ; patch ; _ } =
+    let open Ledgerwallet_tezos in
+    if (major, minor, patch) <= (0, 1, 0) then
+      [ Ed25519 ; Secp256k1 ]
+    else
+      [ Ed25519 ; Secp256k1 ; Secp256r1 ]
+
+  let animals_of_pkh pkh =
+    pkh |> Signature.Public_key_hash.to_string |>
+    Ledger_names.crouching_tiger
+
+  let find_ledgers ?id ?git_commit h device_info version =
+    fold_left_s begin fun (ledger_found, of_curve, of_pkh) curve ->
+      get_public_key h curve [] >>|? fun pk ->
+      let cur_pkh = Signature.Public_key.hash pk in
+      let cur_animals = animals_of_pkh cur_pkh in
+      log_info "Found PK: %a" Signature.Public_key.pp pk ;
+      log_info "Found PKH: %a" Signature.Public_key_hash.pp cur_pkh ;
+      log_info "Found Animals: %a" Ledger_names.pp cur_animals ;
+      ledger_found ||
+      (match id with
+       | Some (Pkh pkh) when pkh = cur_pkh -> true
+       | Some (Animals (animals, _)) when animals = cur_animals -> true
+       | _ -> false),
+      (curve, (pk, cur_pkh)) :: of_curve,
+      (cur_pkh, (pk, curve)) :: of_pkh
+    end (false, [], []) (curves version)
+    >>=? fun (ledger_found, of_curve, of_pkh) ->
+    match id with
+    | None ->
+        return_some
+          (create ?git_commit ~device_info ~version
+             ~of_curve ~of_pkh ())
+    | Some _ when ledger_found ->
+        return_some
+          (create ?git_commit ~device_info ~version
+             ~of_curve ~of_pkh ())
+    | _ -> return_none
+
+  let of_hidapi ?id device_info h =
+    let buf = Buffer.create 100 in
+    let pp = Format.formatter_of_buffer buf in
+    let version = Ledgerwallet_tezos.get_version ~pp h in
+    debug "%s" (Buffer.contents buf) ;
+    match version with
+    | Error (AppError { status = Ledgerwallet.Transport.Status.Ins_not_supported ; _ })
+    | Error (AppError { status = Ledgerwallet_tezos.Version.Tezos_impossible_to_read_version ; _ }) ->
+        (* version is < 0.1.1. Assume it is 0.0.1, Tezos app. *)
+        let version =
+          { Ledgerwallet_tezos.Version.app_class = Tezos ;
+            major = 0 ;
+            minor = 0 ;
+            patch = 1 ;
+          } in
+        warn "Impossible to read Tezos version, assuming %a"
+          Ledgerwallet_tezos.Version.pp version ;
+        find_ledgers ?id h device_info version
+    | Error e ->
+        warn "WARNING:@ The device at [%s] is not a Tezos application@ \
+              %a"
+          device_info.Hidapi.path
+          Ledgerwallet.Transport.pp_error e ;
+        return_none
+    | Ok ({ major; minor; patch; _ } as version) ->
+        log_info "Found a %a application at [%s]"
+          Ledgerwallet_tezos.Version.pp version device_info.path ;
+        begin
+          if (major, minor, patch) >= (1, 4, 0) then
+            wrap_ledger_cmd (fun pp ->
+                Ledgerwallet_tezos.get_git_commit ~pp h) >>=? fun c ->
+            return_some c
+          else return_none
+        end >>=? fun git_commit ->
+        find_ledgers ?id ?git_commit h device_info version
+end
+
+let find_ledgers ?id () =
+  let ledgers = Hidapi.enumerate ~vendor_id ~product_id () in
+  log_info "Found %d Ledger(s)" (List.length ledgers) ;
+  filter_map_s begin fun device_info ->
+    log_info "Processing Ledger at path [%s]" device_info.Hidapi.path ;
+    (* HID interfaces get the number 0
+       (cf. https://github.com/LedgerHQ/ledger-nano-s/issues/48)
+       *BUT* on MacOSX the Hidapi library does not report the interface-number
+       so we look at the usage-page (which is even more unspecified but used by
+       prominent Ledger users:
+       https://github.com/LedgerHQ/ledgerjs/commit/333ade0d55dc9c59bcc4b451cf7c976e78629681).
+    *)
+    if
+      (device_info.Hidapi.interface_number = 0)
+      ||
+      (device_info.Hidapi.interface_number = -1
+       && device_info.Hidapi.usage_page = 0xffa0)
+    then
+      begin match Hidapi.(open_path device_info.path) with
+        | None -> return_none
+        | Some h ->
+            Lwt.finalize
+              (fun () -> Ledger.of_hidapi ?id device_info h)
+              (fun () -> Hidapi.close h ; Lwt.return_unit)
+      end
+    else
+      return_none
+  end ledgers
+
+let with_ledger id f =
+  find_ledgers ~id () >>=? function
+  | [] ->
+      failwith "No Ledger found for %a" pp_id id
+  | { device_info ; version ; of_curve ; of_pkh ; _ } :: _ ->
+      match Hidapi.open_path device_info.path with
+      | None ->
+          failwith "Cannot open Ledger %a at path %s"
+            pp_id id device_info.path
+      | Some h ->
+          Lwt.finalize
+            (fun () -> f h version of_curve of_pkh)
+            (fun () -> Hidapi.close h; Lwt.return_unit)
+
+let int32_of_path_element x =
+  match Int32.of_string_opt x with
+  | Some i -> Some i
+  | None ->
+      let len = String.length x in
+      if len < 2 then None else
+        Option.map
+          ~f:hard (Int32.of_string_opt (String.sub x 0 (len - 1)))
+
+let int32_of_path_element_exn x =
+  match int32_of_path_element x with
+  | None -> invalid_arg "int32_of_path_element_exn"
+  | Some p -> p
+
+let neuterize (sk : sk_uri) = return (make_pk_uri (sk :> Uri.t))
+
+let path_of_sk_uri (uri : sk_uri) =
+  match TzString.split_path (Uri.path (uri :> Uri.t)) with
+  | [] -> []
+  | curve :: path when Ledgerwallet_tezos.curve_of_string curve <> None ->
+      List.map int32_of_path_element_exn path
+  | path -> List.map int32_of_path_element_exn path
+
+let path_of_pk_uri (uri : pk_uri) =
+  match TzString.split_path (Uri.path (uri :> Uri.t)) with
+  | [] -> []
+  | curve :: path when Ledgerwallet_tezos.curve_of_string curve <> None ->
+      List.map int32_of_path_element_exn path
+  | path -> List.map int32_of_path_element_exn path
+
+let unopt_curve annimal = function
+  | Some curve -> return curve
+  | None ->
+      failwith "A curve specification is required for this operation,@ e.g.@ \
+                \"ledger://%a/{ed25519,...}\"" Ledger_names.pp annimal
+
+let public_key
+    ?(interactive : Client_context.io_wallet option) (pk_uri : pk_uri) =
+  let find_curve of_pkh = function
+    | Pkh pkh ->
+        protect (fun () -> return (snd (List.assoc pkh of_pkh)))
+    | Animals (a, curve_opt) -> unopt_curve a curve_opt
+  in
+  match Hashtbl.find_opt pks pk_uri with
+  | Some pk -> return pk
+  | None ->
+      id_of_pk_uri pk_uri >>=? fun id ->
+      with_ledger id begin fun ledger _version _of_curve of_pkh  ->
+        find_curve of_pkh id >>=? fun curve  ->
+        let path = path_of_pk_uri pk_uri in
+        begin
+          match interactive with
+          | Some cctxt ->
+              get_public_key ~prompt:false ledger curve path >>=? fun pk ->
+              let pkh = Signature.Public_key.hash pk in
+              cctxt#message
+                "Please validate@ (and write down)@ the public key hash\
+                 @ displayed@ on the Ledger,@ it should be equal@ to `%a`:"
+                Signature.Public_key_hash.pp pkh >>= fun () ->
+              get_public_key ~prompt:true ledger curve path
+          | None ->
+              get_public_key ~prompt:false ledger curve path
+        end >>=? fun pk ->
+        let pkh = Signature.Public_key.hash pk in
+        Hashtbl.replace pks pk_uri pk ;
+        Hashtbl.replace pkhs pk_uri pkh ;
+        return pk
+      end >>= function
+      | Error err -> failwith "%a" pp_print_error err
+      | Ok v -> return v
+
+let public_key_hash ?interactive pk_uri =
+  match Hashtbl.find_opt pkhs pk_uri with
+  | Some pkh -> return (pkh, None)
+  | None ->
+      public_key ?interactive pk_uri >>=? fun pk ->
+      return (Hashtbl.find pkhs pk_uri, Some pk)
+
+let curve_of_id = function
+  | Pkh pkh -> return (curve_of_pkh pkh)
+  | Animals (a, curve_opt) -> unopt_curve a curve_opt
+
+(* The Ledger uses a special value 0x00000000 for the “any” chain-id: *)
+let pp_ledger_chain_id fmt s =
+  match s with
+  | "\x00\x00\x00\x00" -> Format.fprintf fmt "'Unspecified'"
+  | other -> Format.fprintf fmt "%a" Chain_id.pp (Chain_id.of_string_exn other)
+
+let sign ?watermark sk_uri msg =
+  id_of_sk_uri sk_uri >>=? fun id ->
+  with_ledger id begin fun ledger { major; minor; patch; _ } _of_curve _of_pkh ->
+    let msg = Option.unopt_map watermark
+        ~default:msg ~f:begin fun watermark ->
+        MBytes.concat "" [Signature.bytes_of_watermark watermark ;
+                          msg]
+      end in
+    curve_of_id id >>=? fun curve ->
+    let path = tezos_root @ path_of_sk_uri sk_uri in
+    let msg_len = MBytes.length msg in
+    wrap_ledger_cmd begin fun pp ->
+      if msg_len > 1024 && (major, minor, patch) < (1, 1, 0) then
+        Ledgerwallet_tezos.sign ~hash_on_ledger:false
+          ~pp ledger curve path
+          (Cstruct.of_bigarray (Blake2B.(to_bytes (hash_bytes [ msg ]))))
+      else
+        Ledgerwallet_tezos.sign
+          ~pp ledger curve path (Cstruct.of_bigarray msg)
+    end >>=? fun signature ->
+    match curve with
+    | Ed25519 ->
+        let signature = Cstruct.to_bigarray signature in
+        let signature = Ed25519.of_bytes_exn signature in
+        return (Signature.of_ed25519 signature)
+    | Secp256k1 ->
+        (* Remove parity info *)
+        Cstruct.(set_uint8 signature 0 (get_uint8 signature 0 land 0xfe)) ;
+        let signature = Cstruct.to_bigarray signature in
+        let open Libsecp256k1.External in
+        let signature = Sign.read_der_exn secp256k1_ctx signature in
+        let bytes = Sign.to_bytes secp256k1_ctx signature in
+        let signature = Secp256k1.of_bytes_exn bytes in
+        return (Signature.of_secp256k1 signature)
+    | Secp256r1 ->
+        (* Remove parity info *)
+        Cstruct.(set_uint8 signature 0 (get_uint8 signature 0 land 0xfe)) ;
+        let signature = Cstruct.to_bigarray signature in
+        let open Libsecp256k1.External in
+        (* We use secp256r1 library to extract P256 DER signature. *)
+        let signature = Sign.read_der_exn secp256k1_ctx signature in
+        let buf = Sign.to_bytes secp256k1_ctx signature in
+        let signature = P256.of_bytes_exn buf in
+        return (Signature.of_p256 signature)
+  end
+
+
+let deterministic_nonce _ _ = fail Ledger_deterministic_nonce_not_implemented
+let deterministic_nonce_hash _ _ = fail Ledger_deterministic_nonce_not_implemented
+let supports_deterministic_nonces _ = return_false
+
+let commands =
+  let open Clic in
+  let group =
+    { Clic.name = "ledger" ;
+      title = "Commands for managing the connected Ledger Nano S devices" } in
+  fun () -> [
+      Clic.command ~group
+        ~desc: "List supported Ledger Nano S devices connected."
+        no_options
+        (fixed [ "list" ; "connected" ; "ledgers" ])
+        (fun () (cctxt : Client_context.full) ->
+           find_ledgers () >>=? function
+           | [] ->
+               cctxt#message "No device found." >>= fun () ->
+               cctxt#message "Make sure a Ledger Nano S is connected and in the Tezos Wallet or Tezos Baking app." >>= fun () ->
+               return_unit
+           | ledgers ->
+               iter_s begin fun { Ledger.device_info = { Hidapi.path ;
+                                                         manufacturer_string ;
+                                                         product_string ; _ } ;
+                                  of_curve ; version ; git_commit ; _ } ->
+                 let manufacturer = Option.unopt ~default:"(none)" manufacturer_string in
+                 let product = Option.unopt ~default:"(none)" product_string in
+                 cctxt#message "Found a %a (commit %s) application running on %s %s at [%s]."
+                   Ledgerwallet_tezos.Version.pp version
+                   (match git_commit with None -> "unknown" | Some c -> c)
+                   manufacturer product path >>= fun () ->
+                 let of_curve = List.rev of_curve in
+                 begin match List.hd_opt of_curve with
+                   | None ->
+                       failwith "No curve available, upgrade Ledger software"
+                   | Some (_, (_, pkh)) ->
+                       return (Ledger_names.crouching_tiger
+                                 (Signature.Public_key_hash.to_string pkh))
+                 end >>=? fun animals ->
+                 cctxt#message
+                   "@[<v 0>@,To use keys at BIP32 path \
+                    m/44'/1729'/0'/0' (default Tezos key path), use \
+                    one of@, @[<v 0>%a@]@]"
+                   (Format.pp_print_list
+                      (fun ppf (curve, _) ->
+                         Format.fprintf ppf
+                           "tezos-client import secret key \
+                            ledger_%s \"ledger://%a/0'/0'\""
+                           (Sys.getenv "USER")
+                           pp_id (Animals (animals, Some curve))))
+                   of_curve >>= fun () ->
+                 return_unit
+               end ledgers) ;
+
+      Clic.command ~group
+        ~desc: "Display version/public-key/address information for a Ledger URI"
+        (args1 (switch ~doc:"Test signing operation" ~long:"test-sign" ()))
+        (prefixes [ "show" ; "ledger" ]
+         @@ Client_keys.sk_uri_param
+         @@ stop)
+        (fun test_sign sk_uri (cctxt : Client_context.full) ->
+           neuterize sk_uri >>=? fun pk_uri ->
+           id_of_pk_uri pk_uri >>=? fun id ->
+           find_ledgers ~id () >>=? function
+           | [] ->
+               failwith "No ledger found for %a" pp_id id
+           | { Ledger.device_info ; version ; _ } :: _ ->
+               let manufacturer =
+                 Option.unopt ~default:"(none)" device_info.manufacturer_string in
+               let product =
+                 Option.unopt ~default:"(none)" device_info.product_string in
+               cctxt#message
+                 "Found a %a application running on a \
+                  %s %s at [%s]."
+                 Ledgerwallet_tezos.Version.pp version
+                 manufacturer product device_info.path >>= fun () ->
+               begin match id with
+                 | (Pkh _ | Animals (_, Some _)) -> (* → Can public keys. *)
+                     public_key pk_uri >>=? fun pk ->
+                     public_key_hash pk_uri >>=? fun (pkh, _) ->
+                     cctxt#message
+                       "@[<v 0>Tezos address at this path/curve: %a@,\
+                        Corresponding full public key: %a@]"
+                       Signature.Public_key_hash.pp pkh
+                       Signature.Public_key.pp pk >>= fun () ->
+                     begin match test_sign, version.app_class with
+                       | true, Tezos ->
+                           let pkh_bytes = Signature.Public_key_hash.to_bytes pkh in
+                           (* Signing requires validation on the device.  *)
+                           cctxt#message "Attempting a signature, please \
+                                          validate on the ledger." >>= fun () ->
+                           sign ~watermark:Generic_operation
+                             sk_uri pkh_bytes >>=? fun signature ->
+                           begin match Signature.check ~watermark:Generic_operation
+                                         pk signature pkh_bytes with
+                           | false ->
+                               failwith "Fatal: Ledger cannot sign with %a"
+                                 Signature.Public_key_hash.pp pkh
+                           | true ->
+                               cctxt#message "Tezos Wallet successfully signed."
+                               >>= fun () ->
+                               return_unit
+                           end
+                       | true, TezBake ->
+                           failwith "Option --test-sign only works \
+                                     for the Tezos Wallet app."
+                       | false, _ ->
+                           return_unit
+                     end
+                 | Animals (_, None) when test_sign ->
+                     failwith "Option --test-sign only works \
+                               for the Tezos Wallet app with a \
+                               curve/path specification."
+                 | Animals (_, None) ->
+                     cctxt#message "No curve was provided, \
+                                    there is no Tezos-address/public-key \
+                                    to show/test."
+                     >>= fun () ->
+                     return_unit
+               end
+        ) ;
+
+      Clic.command ~group
+        ~desc: "Query the path of the authorized key"
+        no_options
+        (prefixes [ "get" ; "ledger" ; "authorized" ; "path" ; "for" ]
+         @@ sk_or_alias_param
+         @@ stop)
+        (fun () uri (cctxt : Client_context.full) ->
+           id_of_sk_or_pk uri >>=? fun root_id ->
+           with_ledger root_id begin fun h version _of_curve _to_curve ->
+             (if version.major < 2 then
+                wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_key ~pp h)
+                >>|? fun path -> (path, None)
+              else
+                wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_path_and_curve ~pp h)
+                >>= function
+                | Error (LedgerError (AppError {status = Ledgerwallet.Transport.Status.Referenced_data_not_found; _}) :: _) -> return ([], None)
+                | Error _ as e -> Lwt.return e
+                | Ok (path, curve) -> return (path, Some curve))
+             >>=? function
+             | ([], _) ->
+                 cctxt#message
+                   "@[<v 0>No baking key authorized for %a@]" pp_id root_id
+                 >>= fun () ->
+                 return_unit
+             | (path, None) ->
+                 cctxt#message
+                   "@[<v 0>Authorized baking path: %a@]"
+                   Bip32_path.pp_path path >>= fun () ->
+                 return_unit
+             | (path, Some curve) ->
+                 cctxt#message
+                   "@[<v 0>Authorized baking path: %a@]"
+                   Bip32_path.pp_path path >>= fun () ->
+                 cctxt#message
+                   "@[<v 0>Authorized baking curve: %a@]"
+                   Ledgerwallet_tezos.pp_curve curve >>= fun () ->
+                 (match root_id with
+                  | Pkh _ -> cctxt#message "@[<v 0>Authorized baking PKH: %a@]"
+                               pp_id root_id
+                  | Animals (cthd, _) -> cctxt#message "@[<v 0>Authorized baking URI: %a@]"
+                                           pp_animals_uri (cthd, curve, path))
+                 >>= fun () ->
+                 return_unit
+           end) ;
+
+      Clic.command ~group
+        ~desc: "Authorize a Ledger to bake for a key (deprecated, \
+                use `setup ledger ...` with recent versions of the Baking app)"
+        no_options
+        (prefixes [ "authorize" ; "ledger" ; "to" ; "bake" ; "for" ]
+         @@ Public_key.alias_param
+         @@ stop)
+        (fun () (_, (pk_uri, _)) (cctxt : Client_context.full) ->
+           id_of_pk_uri pk_uri >>=? fun root_id ->
+           with_ledger root_id begin fun h version _of_curve _of_pkh ->
+             begin match version with
+               | { Ledgerwallet_tezos.Version.app_class = Tezos ; _ } ->
+                   failwith "This command (`authorize ledger ...`) only \
+                             works with the Tezos Baking app"
+               | { Ledgerwallet_tezos.Version.app_class = TezBake ;
+                   major ; _ } when major >= 2 ->
+                   failwith
+                     "This command (`authorize ledger ...`) is@ \
+                      not compatible with@ this version of the Ledger@ \
+                      Baking app (%a >= 2.0.0),@ please use the command@ \
+                      `setup ledger to bake for ...`@ from now on."
+                     Ledgerwallet_tezos.Version.pp version
+               | _ ->
+                   cctxt#message
+                     "This Ledger Baking app is outdated (%a)@ running@ \
+                      in backwards@ compatibility mode."
+                     Ledgerwallet_tezos.Version.pp version
+                   >>= fun () ->
+                   return_unit
+             end
+             >>=? fun () ->
+             let path = path_of_pk_uri pk_uri in
+             curve_of_id root_id >>=? fun curve ->
+             public_key_returning_instruction `Authorize_baking h curve path
+             >>=? fun pk ->
+             let pkh = Signature.Public_key.hash pk in
+             cctxt#message
+               "@[<v 0>Authorized baking for address: %a@,\
+                Corresponding full public key: %a@]"
+               Signature.Public_key_hash.pp pkh
+               Signature.Public_key.pp pk >>= fun () ->
+             return_unit
+           end) ;
+
+      Clic.command ~group
+        ~desc: "Setup a Ledger to bake for a key"
+        (let hwm_arg kind =
+           let doc =
+             Printf.sprintf
+               "Use <HWM> as %s chain high watermark instead of asking the ledger."
+               kind in
+           let long = kind ^ "-hwm" in
+           default_arg ~doc ~long ~placeholder:"HWM"
+             ~default:"ASK-LEDGER"
+             (parameter
+                (fun _ -> function
+                   | "ASK-LEDGER" -> return None
+                   | s ->
+                       try return (Some (Int32.of_string s)) with _ ->
+                         failwith "Parameter %S should be a 32-bits integer" s))
+         in
+         args3
+           (default_arg
+              ~doc:"Use <ID> as main chain-id instead of asking the node."
+              ~long:"main-chain-id" ~placeholder:"ID"
+              ~default:"ASK-NODE"
+              (parameter
+                 (fun _ -> function
+                    | "ASK-NODE" -> return `Ask_node
+                    | s ->
+                        try return (`Int32 (Int32.of_string s))
+                        with _ ->
+                          (try return (`Chain_id (Chain_id.of_b58check_exn s))
+                           with _ ->
+                             failwith "Parameter %S should be a 32-bits integer \
+                                       or a Base58 chain-id" s))))
+           (hwm_arg "main") (hwm_arg "test"))
+        (prefixes [ "setup" ; "ledger" ; "to" ; "bake" ; "for" ]
+         @@ Public_key.alias_param
+         @@ stop)
+        (fun (chain_id_opt, main_hwm_opt, test_hwm_opt)
+          (_, (pk_uri, _)) (cctxt : Client_context.full) ->
+          id_of_pk_uri pk_uri >>=? fun root_id ->
+          with_ledger root_id begin fun h version _of_curve _of_pkh ->
+            begin
+              let open Ledgerwallet_tezos.Version in
+              match version with
+              | { app_class = Tezos ; _ } ->
+                  failwith "This command (`setup ledger ...`) only \
+                            works with the Tezos Baking app"
+              | { app_class = TezBake ;
+                  major ; _ } when major < 2 ->
+                  failwith
+                    "This command (`setup ledger ...`)@ is not@ compatible@ with \
+                     this version@ of the Ledger Baking app@ (%a < 2.0.0),@ \
+                     please upgrade@ your ledger@ or use the command@ \
+                     `authorize ledger to bake for ...`"
+                    pp version
+              | _ -> return_unit
+            end
+            >>=? fun () ->
+            let chain_id_of_int32 i32 =
+              let open Int32 in
+              let byte n =
+                logand 0xFFl (shift_right i32 (n * 8))
+                |> Int32.to_int |> char_of_int in
+              Chain_id.of_string_exn
+                (Stringext.of_array (Array.init 4 (fun i -> byte (3 - i)))) in
+            begin match chain_id_opt with
+              | `Ask_node ->
+                  Chain_services.chain_id cctxt ()
+              | `Int32 s -> return (chain_id_of_int32 s)
+              | `Chain_id chid -> return chid
+            end
+            >>=? fun main_chain_id ->
+            let path = path_of_pk_uri pk_uri in
+            curve_of_id root_id >>=? fun curve ->
+            wrap_ledger_cmd begin fun pp ->
+              Ledgerwallet_tezos.get_all_high_watermarks ~pp h
+            end
+            >>=? fun (`Main_hwm current_mh, `Test_hwm current_th, `Chain_id current_ci) ->
+            let main_hwm = Option.unopt main_hwm_opt ~default:current_mh in
+            let test_hwm = Option.unopt test_hwm_opt ~default:current_th in
+            cctxt#message "Setting up the ledger:@.\
+                           * Main chain ID: %a -> %a@.\
+                           * Main chain High Watermark: %ld -> %ld@.\
+                           * Test chain High Watermark: %ld -> %ld"
+              pp_ledger_chain_id current_ci
+              Chain_id.pp main_chain_id
+              current_mh main_hwm
+              current_th test_hwm
+            >>= fun () ->
+            public_key_returning_instruction
+              (`Setup (Chain_id.to_string main_chain_id, main_hwm, test_hwm))
+              h curve path
+            >>=? fun pk ->
+            let pkh = Signature.Public_key.hash pk in
+            cctxt#message
+              "@[<v 0>Authorized baking for address: %a@,\
+               Corresponding full public key: %a@]"
+              Signature.Public_key_hash.pp pkh
+              Signature.Public_key.pp pk >>= fun () ->
+            return_unit
+          end) ;
+
+      Clic.command ~group
+        ~desc: "Deauthorize Ledger from baking"
+        no_options
+        (prefixes [ "deauthorize" ; "ledger" ; "baking" ; "for" ]
+         @@ sk_or_alias_param
+         @@ stop)
+        (fun () uri (_ : Client_context.full) ->
+           id_of_sk_or_pk uri >>=? fun id ->
+           with_ledger id begin fun h version _ _ ->
+             match version.app_class with
+             | Tezos ->
+                 failwith "Fatal: this operation is only valid with the \
+                           Tezos Baking application"
+             | TezBake when version.major < 2 ->
+                 failwith "Fatal: this operation is only available with \
+                           Tezos Baking application version 2 or higher"
+             | TezBake ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.deauthorize_baking ~pp h
+                 end
+           end
+        );
+
+      Clic.command ~group
+        ~desc: "Get high water mark of a Ledger"
+        (args1 (switch ~doc:"Prevent the fallback to the (deprecated) Ledger \
+                             instructions (for 1.x.y versions of the Baking app)"
+                  ~long:"no-legacy-instructions" ()))
+        (prefixes [ "get" ; "ledger" ; "high" ; "watermark" ; "for" ]
+         @@ sk_or_alias_param
+         @@ stop)
+        (fun no_legacy_apdu uri (cctxt : Client_context.full) ->
+           id_of_sk_or_pk uri >>=? fun id ->
+           with_ledger id begin fun h version _ _ ->
+             match version.app_class with
+             | Tezos ->
+                 failwith "Fatal: this operation is only valid with the \
+                           Tezos Baking application"
+             | TezBake when not no_legacy_apdu && version.major < 2 ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.get_high_watermark ~pp h
+                 end
+                 >>=? fun hwm ->
+                 cctxt#message "The high water mark for@ %a@ is %ld."
+                   pp_id id hwm >>= fun () ->
+                 return_unit
+             | TezBake when no_legacy_apdu && version.major < 2 ->
+                 failwith
+                   "Cannot get the high water mark with@ \
+                    `--no-legacy-instructions` and version %a"
+                   Ledgerwallet_tezos.Version.pp version
+             | TezBake ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.get_all_high_watermarks ~pp h
+                 end
+                 >>=? fun (`Main_hwm mh, `Test_hwm th, `Chain_id ci) ->
+                 cctxt#message
+                   "The high water mark values for@ %a@ are\
+                    @ %ld for the main-chain@ (%a)@ \
+                    and@ %ld for the test-chain."
+                   pp_id id mh pp_ledger_chain_id ci th
+                 >>= fun () ->
+                 return_unit
+           end
+        ) ;
+
+      Clic.command ~group
+        ~desc: "Set high water mark of a Ledger"
+        no_options
+        (prefixes [ "set" ; "ledger" ; "high" ; "watermark" ; "for" ]
+         @@ sk_or_alias_param
+         @@ (prefix "to")
+         @@ (param
+               ~name: "high watermark"
+               ~desc: "High watermark"
+               (parameter (fun _ctx s ->
+                    try return (Int32.of_string s)
+                    with _ -> failwith "%s is not an int32 value" s)))
+         @@ stop)
+        (fun () uri hwm (cctxt : Client_context.full) ->
+           id_of_sk_or_pk uri >>=? fun id ->
+           with_ledger id begin fun h version _ _ ->
+             match version.app_class with
+             | Tezos ->
+                 failwith "Fatal: this operation is only valid with TezBake"
+             | TezBake ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.set_high_watermark ~pp h hwm
+                 end >>=? fun () ->
+                 wrap_ledger_cmd begin fun pp ->
+                   Ledgerwallet_tezos.get_high_watermark ~pp h
+                 end >>=? fun new_hwm ->
+                 cctxt#message
+                   "@[<v 0>%a has now high water mark: %ld@]"
+                   pp_id id new_hwm >>= fun () ->
+                 return_unit
+           end
+        ) ;
+    ]
diff --git a/vendors/tezos-modded/src/lib_signer_backends/ledger.mli b/vendors/tezos-modded/src/lib_signer_backends/ledger.mli
new file mode 100644
index 000000000..aa4c749f3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/ledger.mli
@@ -0,0 +1,42 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Bip32_path : sig
+  val node_of_string : string -> int32 option
+  val node_of_string_exn : string -> int32
+  val pp_node : int32 Fmt.t
+  val string_of_node : int32 -> string
+
+  val path_of_string : string -> int32 list option
+  val path_of_string_exn : string -> int32 list
+  val pp_path : int32 list Fmt.t
+  val string_of_path : int32 list -> string
+end
+
+include Client_keys.SIGNER
+
+
+
+val commands : unit -> Client_context.full Clic.command list
diff --git a/vendors/tezos-modded/src/lib_signer_backends/ledger_names.ml b/vendors/tezos-modded/src/lib_signer_backends/ledger_names.ml
new file mode 100644
index 000000000..dec54c4db
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/ledger_names.ml
@@ -0,0 +1,266 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 adjectives = [|
+  "abandoned";"able";"absolute";"adorable";"adventurous";"academic";"acceptable";
+  "acclaimed";"accomplished";"accurate";"aching";"acidic";"acrobatic";"active";
+  "actual";"adept";"admirable";"admired";"adolescent";"adorable";"adored";
+  "advanced";"afraid";"affectionate";"aged";"aggravating";"aggressive";"agile";
+  "agitated";"agonizing";"agreeable";"ajar";"alarmed";"alarming";"alert";
+  "alienated";"alive";"all";"altruistic";"amazing";"ambitious";"ample";"amused";
+  "amusing";"anchored";"ancient";"angelic";"angry";"anguished";"animated";
+  "annual";"another";"antique";"anxious";"any";"apprehensive";"appropriate";
+  "apt";"arctic";"arid";"aromatic";"artistic";"ashamed";"assured";"astonishing";
+  "athletic";"attached";"attentive";"attractive";"austere";"authentic";
+  "authorized";"automatic";"avaricious";"average";"aware";"awesome";"awful";
+  "awkward";"babyish";"bad";"back";"baggy";"bare";"barren";"basic";"beautiful";
+  "belated";"beloved";"beneficial";"better";"best";"bewitched";"big";
+  "biodegradable";"bitter";"black";"bland";"blank";"blaring";"bleak";"blind";
+  "blissful";"blond";"blue";"blushing";"bogus";"boiling";"bold";"bony";"boring";
+  "bossy";"both";"bouncy";"bountiful";"bowed";"brave";"breakable";"brief";
+  "bright";"brilliant";"brisk";"broken";"bronze";"brown";"bruised";"bubbly";
+  "bulky";"bumpy";"buoyant";"burdensome";"burly";"bustling";"busy";"buttery";
+  "buzzing";"calculating";"calm";"candid";"canine";"capital";"carefree";
+  "careful";"careless";"caring";"cautious";"cavernous";"celebrated";"charming";
+  "cheap";"cheerful";"cheery";"chief";"chilly";"chubby";"circular";"classic";
+  "clean";"clear";"clever";"close";"closed";"cloudy";"clueless";"clumsy";
+  "cluttered";"coarse";"cold";"colorful";"colorless";"colossal";"comfortable";
+  "common";"compassionate";"competent";"complete";"complex";"complicated";
+  "composed";"concerned";"concrete";"confused";"conscious";"considerate";
+  "constant";"content";"conventional";"cooked";"cool";"cooperative";
+  "coordinated";"corny";"corrupt";"costly";"courageous";"courteous";"crafty";
+  "crazy";"creamy";"creative";"creepy";"criminal";"crisp";"critical";"crooked";
+  "crowded";"cruel";"crushing";"cuddly";"cultivated";"cultured";"cumbersome";
+  "curly";"curvy";"cute";"cylindrical";"damaged";"damp";"dangerous";"dapper";
+  "daring";"darling";"dark";"dazzling";"dead";"deadly";"deafening";"dear";
+  "dearest";"decent";"decimal";"decisive";"deep";"defenseless";"defensive";
+  "defiant";"deficient";"definite";"definitive";"delayed";"delectable";
+  "delicious";"delightful";"delirious";"demanding";"dense";"dental";"dependable";
+  "dependent";"descriptive";"deserted";"detailed";"determined";"devoted";
+  "different";"difficult";"digital";"diligent";"dim";"dimpled";"dimwitted";
+  "direct";"disastrous";"discrete";"disfigured";"disgusting";"disloyal";"dismal";
+  "distant";"downright";"dreary";"dirty";"disguised";"dishonest";"dismal";
+  "distant";"distinct";"distorted";"dizzy";"dopey";"doting";"double";"downright";
+  "drab";"drafty";"dramatic";"dreary";"droopy";"dry";"dual";"dull";"dutiful";
+  "eager";"earnest";"early";"easy";"ecstatic";"edible";"educated";"elaborate";
+  "elastic";"elated";"elderly";"electric";"elegant";"elementary";"elliptical";
+  "embarrassed";"embellished";"eminent";"emotional";"empty";"enchanted";
+  "enchanting";"energetic";"enlightened";"enormous";"enraged";"entire";"envious";
+  "equal";"equatorial";"essential";"esteemed";"ethical";"euphoric";"even";
+  "evergreen";"everlasting";"every";"evil";"exalted";"excellent";"exemplary";
+  "exhausted";"excitable";"excited";"exciting";"exotic";"expensive";
+  "experienced";"expert";"extraneous";"extroverted";"fabulous";"failing";"faint";
+  "fair";"faithful";"fake";"false";"familiar";"famous";"fancy";"fantastic";"far";
+  "faraway";"fast";"fat";"fatal";"fatherly";"favorable";"favorite";"fearful";
+  "fearless";"feisty";"feline";"female";"feminine";"few";"fickle";"filthy";
+  "fine";"finished";"firm";"first";"firsthand";"fitting";"fixed";"flaky";
+  "flamboyant";"flashy";"flat";"flawed";"flawless";"flickering";"flimsy";
+  "flippant";"flowery";"fluffy";"fluid";"flustered";"focused";"fond";"foolhardy";
+  "foolish";"forceful";"forked";"formal";"forsaken";"forthright";"fortunate";
+  "fragrant";"frail";"frank";"frayed";"free";"french";"fresh";"frequent";
+  "friendly";"frightened";"frightening";"frigid";"frilly";"frizzy";"frivolous";
+  "front";"frosty";"frozen";"frugal";"fruitful";"full";"fumbling";"functional";
+  "funny";"fussy";"fuzzy";"gargantuan";"gaseous";"general";"generous";"gentle";
+  "genuine";"giant";"giddy";"gigantic";"gifted";"giving";"glamorous";"glaring";
+  "glass";"gleaming";"gleeful";"glistening";"glittering";"gloomy";"glorious";
+  "glossy";"glum";"golden";"good";"gorgeous";"graceful";"gracious";"grand";
+  "grandiose";"granular";"grateful";"grave";"gray";"great";"greedy";"green";
+  "gregarious";"grim";"grimy";"gripping";"grizzled";"gross";"grotesque";
+  "grouchy";"grounded";"growing";"growling";"grown";"grubby";"gruesome";"grumpy";
+  "guilty";"gullible";"gummy";"hairy";"half";"handmade";"handsome";"handy";
+  "happy";"hard";"harmful";"harmless";"harmonious";"harsh";"hasty";"hateful";
+  "haunting";"healthy";"heartfelt";"hearty";"heavenly";"heavy";"hefty";"helpful";
+  "helpless";"hidden";"hideous";"high";"hilarious";"hoarse";"hollow";"homely";
+  "honest";"honorable";"honored";"hopeful";"horrible";"hospitable";"hot";"huge";
+  "humble";"humiliating";"humming";"humongous";"hungry";"hurtful";"husky";"icky";
+  "icy";"ideal";"idealistic";"identical";"idle";"idiotic";"idolized";"ignorant";
+  "ill";"illegal";"illiterate";"illustrious";"imaginary";"imaginative";
+  "immaculate";"immaterial";"immediate";"immense";"impassioned";"impeccable";
+  "impartial";"imperfect";"imperturbable";"impish";"impolite";"important";
+  "impossible";"impractical";"impressionable";"impressive";"improbable";"impure";
+  "inborn";"incomparable";"incompatible";"incomplete";"inconsequential";
+  "incredible";"indelible";"inexperienced";"indolent";"infamous";"infantile";
+  "infatuated";"inferior";"infinite";"informal";"innocent";"insecure";
+  "insidious";"insignificant";"insistent";"instructive";"insubstantial";
+  "intelligent";"intent";"intentional";"interesting";"internal";"international";
+  "intrepid";"ironclad";"irresponsible";"irritating";"itchy";"jaded";"jagged";
+  "jaunty";"jealous";"jittery";"joint";"jolly";"jovial";"joyful";"joyous";
+  "jubilant";"judicious";"juicy";"jumbo";"junior";"jumpy";"juvenile";
+  "kaleidoscopic";"keen";"key";"kind";"kindhearted";"kindly";"klutzy";"knobby";
+  "knotty";"knowledgeable";"knowing";"known";"kooky";"lame";"lanky";"large";
+  "last";"lasting";"late";"lavish";"lawful";"lazy";"leading";"lean";"leafy";
+  "left";"legal";"legitimate";"light";"lighthearted";"likable";"likely";
+  "limited";"limp";"limping";"linear";"lined";"liquid";"little";"live";"lively";
+  "livid";"loathsome";"lone";"lonely";"long";"loose";"lopsided";"lost";"loud";
+  "lovable";"lovely";"loving";"low";"loyal";"lucky";"lumbering";"luminous";
+  "lumpy";"lustrous";"luxurious";"mad";"magnificent";"majestic";"major";"male";
+  "mammoth";"married";"marvelous";"masculine";"massive";"mature";"meager";
+  "mealy";"mean";"measly";"meaty";"medical";"mediocre";"medium";"meek";"mellow";
+  "melodic";"memorable";"menacing";"merry";"messy";"metallic";"mild";"milky";
+  "mindless";"miniature";"minor";"minty";"miserable";"miserly";"misguided";
+  "misty";"mixed";"modern";"modest";"moist";"monstrous";"monthly";"monumental";
+  "moral";"mortified";"motherly";"motionless";"mountainous";"muddy";"muffled";
+  "multicolored";"mundane";"murky";"mushy";"musty";"muted";"mysterious";"naive";
+  "narrow";"nasty";"natural";"naughty";"nautical";"near";"neat";"necessary";
+  "needy";"negative";"neglected";"negligible";"neighboring";"nervous";"new";
+  "nice";"nifty";"nimble";"nippy";"nocturnal";"noisy";"nonstop";"normal";
+  "notable";"noted";"noteworthy";"novel";"noxious";"numb";"nutritious";"nutty";
+  "obedient";"obese";"oblong";"oily";"oblong";"obvious";"occasional";"odd";
+  "oddball";"offbeat";"offensive";"official";"old";"only";"open";"optimal";
+  "optimistic";"opulent";"orange";"orderly";"organic";"ornate";"ornery";
+  "ordinary";"original";"other";"our";"outlying";"outgoing";"outlandish";
+  "outrageous";"outstanding";"oval";"overcooked";"overdue";"overjoyed";
+  "overlooked";"palatable";"pale";"paltry";"parallel";"parched";"partial";
+  "passionate";"past";"pastel";"peaceful";"peppery";"perfect";"perfumed";
+  "periodic";"perky";"personal";"pertinent";"pesky";"pessimistic";"petty";
+  "phony";"physical";"piercing";"pink";"pitiful";"plain";"plaintive";"plastic";
+  "playful";"pleasant";"pleased";"pleasing";"plump";"plush";"polished";"polite";
+  "political";"pointed";"pointless";"poised";"poor";"popular";"portly";"posh";
+  "positive";"possible";"potable";"powerful";"powerless";"practical";"precious";
+  "present";"prestigious";"pretty";"precious";"previous";"pricey";"prickly";
+  "primary";"prime";"pristine";"private";"prize";"probable";"productive";
+  "profitable";"profuse";"proper";"proud";"prudent";"punctual";"pungent";"puny";
+  "pure";"purple";"pushy";"putrid";"puzzled";"puzzling";"quaint";"qualified";
+  "quarrelsome";"quarterly";"queasy";"querulous";"questionable";"quick";"quiet";
+  "quintessential";"quirky";"quixotic";"quizzical";"radiant";"ragged";"rapid";
+  "rare";"rash";"raw";"recent";"reckless";"rectangular";"ready";"real";
+  "realistic";"reasonable";"red";"reflecting";"regal";"regular";"reliable";
+  "relieved";"remarkable";"remorseful";"remote";"repentant";"required";
+  "respectful";"responsible";"repulsive";"revolving";"rewarding";"rich";"rigid";
+  "right";"ringed";"ripe";"roasted";"robust";"rosy";"rotating";"rotten";"rough";
+  "round";"rowdy";"royal";"rubbery";"rundown";"ruddy";"rude";"runny";"rural";
+  "rusty";"sad";"safe";"salty";"same";"sandy";"sane";"sarcastic";"sardonic";
+  "satisfied";"scaly";"scarce";"scared";"scary";"scented";"scholarly";
+  "scientific";"scornful";"scratchy";"scrawny";"second";"secondary";"secret";
+  "selfish";"sentimental";"separate";"serene";"serious";"serpentine";"several";
+  "severe";"shabby";"shadowy";"shady";"shallow";"shameful";"shameless";"sharp";
+  "shimmering";"shiny";"shocked";"shocking";"shoddy";"short";"showy";"shrill";
+  "shy";"sick";"silent";"silky";"silly";"silver";"similar";"simple";"simplistic";
+  "sinful";"single";"sizzling";"skeletal";"skinny";"sleepy";"slight";"slim";
+  "slimy";"slippery";"slow";"slushy";"small";"smart";"smoggy";"smooth";"smug";
+  "snappy";"snarling";"sneaky";"sniveling";"snoopy";"sociable";"soft";"soggy";
+  "solid";"somber";"some";"spherical";"sophisticated";"sore";"sorrowful";
+  "soulful";"soupy";"sour";"spanish";"sparkling";"sparse";"specific";
+  "spectacular";"speedy";"spicy";"spiffy";"spirited";"spiteful";"splendid";
+  "spotless";"spotted";"spry";"square";"squeaky";"squiggly";"stable";"staid";
+  "stained";"stale";"standard";"starchy";"stark";"starry";"steep";"sticky";
+  "stiff";"stimulating";"stingy";"stormy";"straight";"strange";"steel";"strict";
+  "strident";"striking";"striped";"strong";"studious";"stunning";"stupendous";
+  "stupid";"sturdy";"stylish";"subdued";"submissive";"substantial";"subtle";
+  "suburban";"sudden";"sugary";"sunny";"super";"superb";"superficial";"superior";
+  "supportive";"surprised";"suspicious";"svelte";"sweaty";"sweet";"sweltering";
+  "swift";"sympathetic";"tall";"talkative";"tame";"tan";"tangible";"tart";
+  "tasty";"tattered";"taut";"tedious";"teeming";"tempting";"tender";"tense";
+  "tepid";"terrible";"terrific";"testy";"thankful";"that";"these";"thick";"thin";
+  "third";"thirsty";"this";"thorough";"thorny";"those";"thoughtful";"threadbare";
+  "thrifty";"thunderous";"tidy";"tight";"timely";"tinted";"tiny";"tired";"torn";
+  "total";"tough";"traumatic";"treasured";"tremendous";"tragic";"trained";
+  "tremendous";"triangular";"tricky";"trifling";"trim";"trivial";"troubled";
+  "true";"trusting";"trustworthy";"trusty";"truthful";"tubby";"turbulent";"twin";
+  "ugly";"ultimate";"unacceptable";"unaware";"uncomfortable";"uncommon";
+  "unconscious";"understated";"unequaled";"uneven";"unfinished";"unfit";
+  "unfolded";"unfortunate";"unhappy";"unhealthy";"uniform";"unimportant";
+  "unique";"united";"unkempt";"unknown";"unlawful";"unlined";"unlucky";
+  "unnatural";"unpleasant";"unrealistic";"unripe";"unruly";"unselfish";
+  "unsightly";"unsteady";"unsung";"untidy";"untimely";"untried";"untrue";
+  "unused";"unusual";"unwelcome";"unwieldy";"unwilling";"unwitting";"unwritten";
+  "upbeat";"upright";"upset";"urban";"usable";"used";"useful";"useless";
+  "utilized";"utter";"vacant";"vague";"vain";"valid";"valuable";"vapid";
+  "variable";"vast";"velvety";"venerated";"vengeful";"verifiable";"vibrant";
+  "vicious";"victorious";"vigilant";"vigorous";"villainous";"violet";"violent";
+  "virtual";"virtuous";"visible";"vital";"vivacious";"vivid";"voluminous";
+  "warlike";"warm";"warmhearted";"warped";"wary";"wasteful";"watchful";
+  "waterlogged";"watery";"wavy";"wealthy";"weak";"weary";"webbed";"wee";"weekly";
+  "weepy";"weighty";"weird";"welcome";"wet";"which";"whimsical";"whirlwind";
+  "whispered";"white";"whole";"whopping";"wicked";"wide";"wiggly";"wild";
+  "willing";"wilted";"winding";"windy";"winged";"wiry";"wise";"witty";"wobbly";
+  "woeful";"wonderful";"wooden";"woozy";"wordy";"worldly";"worn";"worried";
+  "worrisome";"worse";"worst";"worthless";"worthwhile";"worthy";"wrathful";
+  "wretched";"writhing";"wrong";"wry";"yawning";"yearly";"yellow";"yellowish";
+  "young";"youthful";"yummy";"zany";"zealous";"zesty";
+|]
+
+let animals = [|
+  "aardvark";"abyssinian";"affenpinscher";"akbash";"akita";"albatross";
+  "alligator";"angelfish";"ant";"anteater";"antelope";"armadillo";"avocet";
+  "axolotl";"baboon";"badger";"balinese";"bandicoot";"barb";"barnacle";
+  "barracuda";"bat";"beagle";"bear";"beaver";"beetle";"binturong";"birman";
+  "bison";"bloodhound";"bobcat";"bombay";"bongo";"bonobo";"booby";"budgerigar";
+  "buffalo";"bulldog";"bullfrog";"burmese";"butterfly";"caiman";"camel";
+  "capybara";"caracal";"cassowary";"cat";"caterpillar";"catfish";"centipede";
+  "chameleon";"chamois";"cheetah";"chicken";"chihuahua";"chimpanzee";
+  "chinchilla";"chinook";"chipmunk";"cichlid";"coati";"cockroach";"collie";
+  "coral";"cougar";"cow";"coyote";"crab";"crane";"crocodile";"cuscus";
+  "cuttlefish";"dachshund";"dalmatian";"deer";"dhole";"dingo";"discus";"dodo";
+  "dog";"dolphin";"donkey";"dormouse";"dragonfly";"drever";"duck";"dugong";
+  "dunker";"eagle";"earwig";"echidna";"elephant";"emu";"falcon";"fennec";
+  "ferret";"fish";"flamingo";"flounder";"fly";"fossa";"fox";"frigatebird";"frog";
+  "gar";"gecko";"gerbil";"gharial";"gibbon";"giraffe";"goat";"goose";"gopher";
+  "gorilla";"grasshopper";"greyhound";"grouse";"guppy";"hamster";"hare";
+  "harrier";"havanese";"hedgehog";"heron";"himalayan";"hippopotamus";"horse";
+  "human";"hummingbird";"hyena";"ibis";"iguana";"impala";"indri";"insect";
+  "jackal";"jaguar";"javanese";"jellyfish";"kakapo";"kangaroo";"kingfisher";
+  "kiwi";"koala";"kudu";"labradoodle";"ladybird";"lemming";"lemur";"leopard";
+  "liger";"lion";"lionfish";"lizard";"llama";"lobster";"lynx";"macaw";"magpie";
+  "maltese";"manatee";"mandrill";"markhor";"mastiff";"mayfly";"meerkat";
+  "millipede";"mole";"molly";"mongoose";"mongrel";"monkey";"moorhen";"moose";
+  "moth";"mouse";"mule";"neanderthal";"newfoundland";"newt";"nightingale";
+  "numbat";"ocelot";"octopus";"okapi";"olm";"opossum";"ostrich";"otter";"oyster";
+  "pademelon";"panther";"parrot";"peacock";"pekingese";"pelican";"penguin";
+  "persian";"pheasant";"pig";"pika";"pike";"piranha";"platypus";"pointer";
+  "poodle";"porcupine";"possum";"prawn";"puffin";"pug";"puma";"quail";"quetzal";
+  "quokka";"quoll";"rabbit";"raccoon";"ragdoll";"rat";"rattlesnake";"reindeer";
+  "rhinoceros";"robin";"rottweiler";"salamander";"saola";"scorpion";"seahorse";
+  "seal";"serval";"sheep";"shrimp";"siamese";"siberian";"skunk";"sloth";"snail";
+  "snake";"snowshoe";"somali";"sparrow";"sponge";"squid";"squirrel";"starfish";
+  "stingray";"stoat";"swan";"tang";"tapir";"tarsier";"termite";"tetra";"tiffany";
+  "tiger";"tortoise";"toucan";"tropicbird";"tuatara";"turkey";"uakari";"uguisu";
+  "umbrellabird";"vulture";"wallaby";"walrus";"warthog";"wasp";"weasel";
+  "whippet";"wildebeest";"wolf";"wolverine";"wombat";"woodlouse";"woodpecker";
+  "wrasse";"yak";"zebra";"zebu";"zonkey";"zorse";
+|]
+
+let pick a z =
+  a.(Z.rem z (Array.length a |> Z.of_int) |> Z.to_int)
+
+let hash a =
+  Blake2B.hash_string [a] |> Blake2B.to_string
+
+type t = {
+  c : string ;
+  t : string ;
+  h : string ;
+  d : string ;
+}
+
+let pp ppf { c ; t ; h ; d } =
+  Format.fprintf ppf "%s-%s-%s-%s" c t h d
+
+let crouching_tiger string =
+  let c = pick adjectives (string |> hash |> Z.of_bits) in
+  let t = pick animals    (string |> hash |> hash |> Z.of_bits) in
+  let h = pick adjectives (string |> hash |> hash |> hash |> Z.of_bits) in
+  let d = pick animals    (string |> hash |> hash |> hash |> hash |> Z.of_bits) in
+  { c ; t ; h ; d }
diff --git a/vendors/tezos-modded/src/lib_signer_backends/ledger_names.mli b/vendors/tezos-modded/src/lib_signer_backends/ledger_names.mli
new file mode 100644
index 000000000..9723d11df
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/ledger_names.mli
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  c : string ;
+  t : string ;
+  h : string ;
+  d : string ;
+}
+
+val pp : Format.formatter -> t -> unit
+
+val crouching_tiger : string -> t
+(** [crouching_tiger str] is a sentence derived deterministically from
+    [str] with the form adjective-animal-adjective-animal.
+    E.g. crouching-tiger-hidden-dragon *)
diff --git a/vendors/tezos-modded/src/lib_signer_backends/remote.ml b/vendors/tezos-modded/src/lib_signer_backends/remote.ml
new file mode 100644
index 000000000..86a708e4b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/remote.ml
@@ -0,0 +1,202 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_keys
+
+let scheme = "remote"
+
+module Make(S : sig
+    val default : Uri.t
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+    val logger: RPC_client.logger
+  end) = struct
+
+  let scheme = scheme
+
+  let title =
+    "Built-in tezos-signer using remote wallet."
+
+  let description =
+    "Valid locators are of the form\n\
+    \ - remote://tz1...\n\
+     The key will be queried to current remote signer, which can be \
+     configured with the `--remote-signer` or `-R` options, \
+     or by defining the following environment variables:\n\
+    \ - $TEZOS_SIGNER_UNIX_PATH,\n\
+    \ - $TEZOS_SIGNER_TCP_HOST and $TEZOS_SIGNER_TCP_PORT (default: 7732),\n\
+    \ - $TEZOS_SIGNER_HTTP_HOST and $TEZOS_SIGNER_HTTP_PORT (default: 6732),\n\
+    \ - $TEZOS_SIGNER_HTTPS_HOST and $TEZOS_SIGNER_HTTPS_PORT (default: 443)."
+
+  module Socket = Socket.Make(S)
+  module Http = Http.Make(S)
+  module Https = Https.Make(S)
+
+  let get_remote () =
+    match Uri.scheme S.default with
+    | Some "unix" -> (module Socket.Unix : SIGNER)
+    | Some "tcp" -> (module Socket.Tcp : SIGNER)
+    | Some "http" -> (module Http : SIGNER)
+    | Some "https" -> (module Https : SIGNER)
+    | _ -> assert false
+
+  module Remote = (val get_remote () : SIGNER)
+  let key =
+    match Uri.scheme S.default with
+    | Some "unix" ->
+        (fun uri ->
+           let key = Uri.path uri in
+           Uri.add_query_param' S.default ("pkh", key))
+    | Some "tcp" ->
+        (fun uri ->
+           let key = Uri.path uri in
+           Uri.with_path S.default key)
+    | Some ("https" | "http") ->
+        (fun uri ->
+           let key = Uri.path uri in
+           match Uri.path S.default with
+           | "" -> Uri.with_path S.default key
+           | path -> Uri.with_path S.default (path ^ "/" ^ key))
+    | _ -> assert false
+
+  let public_key ?interactive pk_uri =
+    Remote.public_key ?interactive
+      (Client_keys.make_pk_uri (key (pk_uri : pk_uri :> Uri.t)))
+
+  let public_key_hash ?interactive pk_uri =
+    Remote.public_key_hash ?interactive
+      (Client_keys.make_pk_uri (key (pk_uri : pk_uri :> Uri.t)))
+
+  let neuterize sk_uri =
+    return (Client_keys.make_pk_uri (sk_uri : sk_uri :> Uri.t))
+
+  let sign ?watermark sk_uri msg =
+    Remote.sign
+      ?watermark
+      (Client_keys.make_sk_uri (key (sk_uri : sk_uri :> Uri.t)))
+      msg
+
+  let deterministic_nonce sk_uri msg =
+    Remote.deterministic_nonce
+      (Client_keys.make_sk_uri (key (sk_uri : sk_uri :> Uri.t)))
+      msg
+
+  let deterministic_nonce_hash sk_uri msg =
+    Remote.deterministic_nonce_hash
+      (Client_keys.make_sk_uri (key (sk_uri : sk_uri :> Uri.t)))
+      msg
+
+  let supports_deterministic_nonces sk_uri =
+    Remote.supports_deterministic_nonces
+      (Client_keys.make_sk_uri (key (sk_uri : sk_uri :> Uri.t)))
+
+end
+
+let make_sk sk =
+  Client_keys.make_sk_uri
+    (Uri.make ~scheme ~path:(Signature.Secret_key.to_b58check sk) ())
+
+let make_pk pk =
+  Client_keys.make_pk_uri
+    (Uri.make ~scheme ~path:(Signature.Public_key.to_b58check pk) ())
+
+let read_base_uri_from_env () =
+  match Sys.getenv_opt "TEZOS_SIGNER_UNIX_PATH",
+        Sys.getenv_opt "TEZOS_SIGNER_TCP_HOST",
+        Sys.getenv_opt "TEZOS_SIGNER_HTTP_HOST",
+        Sys.getenv_opt "TEZOS_SIGNER_HTTPS_HOST" with
+  | None, None, None, None -> return_none
+  | Some path, None, None, None ->
+      return_some (Socket.make_unix_base path)
+  | None, Some host, None, None -> begin
+      try
+        let port =
+          match Sys.getenv_opt "TEZOS_SIGNER_TCP_PORT" with
+          | None -> 7732
+          | Some port -> int_of_string port in
+        return_some (Socket.make_tcp_base host port)
+      with Invalid_argument _ ->
+        failwith "Failed to parse TEZOS_SIGNER_TCP_PORT.@."
+    end
+  | None, None, Some host, None -> begin
+      try
+        let port =
+          match Sys.getenv_opt "TEZOS_SIGNER_HTTP_PORT" with
+          | None -> 6732
+          | Some port -> int_of_string port in
+        return_some (Http.make_base host port)
+      with Invalid_argument _ ->
+        failwith "Failed to parse TEZOS_SIGNER_HTTP_PORT.@."
+    end
+  | None, None, None, Some host -> begin
+      try
+        let port =
+          match Sys.getenv_opt "TEZOS_SIGNER_HTTPS_PORT" with
+          | None -> 443
+          | Some port -> int_of_string port in
+        return_some (Https.make_base host port)
+      with Invalid_argument _ ->
+        failwith "Failed to parse TEZOS_SIGNER_HTTPS_PORT.@."
+    end
+  | _, _, _, _ ->
+      failwith
+        "Only one the following environment variable must be defined: \
+         TEZOS_SIGNER_UNIX_PATH, \
+         TEZOS_SIGNER_TCP_HOST, \
+         TEZOS_SIGNER_HTTP_HOST, \
+         TEZOS_SIGNER_HTTPS_HOST@."
+
+type error += Invalid_remote_signer of string
+
+let () =
+  register_error_kind
+    `Branch
+    ~id: "invalid_remote_signer"
+    ~title: "Unexpected URI fot remote signer"
+    ~description: "The provided remote signer is invalid."
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf
+           "@[<v 0>Value '%s' is not a valid URI for a remote signer.@,\
+            Supported URIs for remote signers are of the form:@,\
+           \ - unix:///path/to/socket/file@,\
+           \ - tcp://host:port@,\
+           \ - http://host[:port][/prefix]@,\
+           \ - https://host[:port][/prefix]@]" s)
+    Data_encoding.(obj1 (req "uri" string))
+    (function Invalid_remote_signer s -> Some s | _ -> None)
+    (fun s -> Invalid_remote_signer s)
+
+let parse_base_uri s =
+  trace (Invalid_remote_signer s) @@
+  try
+    let uri = Uri.of_string s in
+    match Uri.scheme uri with
+    | Some "http" -> return uri
+    | Some "https" -> return uri
+    | Some "tcp" -> return uri
+    | Some "unix" -> return uri
+    | Some scheme -> failwith "Unknown scheme: %s" scheme
+    | None -> failwith "Unknown scheme: <empty>"
+  with Invalid_argument msg -> failwith "Malformed URI: %s" msg
diff --git a/vendors/tezos-modded/src/lib_signer_backends/remote.mli b/vendors/tezos-modded/src/lib_signer_backends/remote.mli
new file mode 100644
index 000000000..f29a009d7
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/remote.mli
@@ -0,0 +1,36 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(S : sig
+    val default : Uri.t
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+    val logger: RPC_client.logger
+  end) : Client_keys.SIGNER
+
+val make_pk: Signature.public_key -> Client_keys.pk_uri
+val make_sk: Signature.secret_key -> Client_keys.sk_uri
+
+val read_base_uri_from_env: unit -> Uri.t option tzresult Lwt.t
+val parse_base_uri: string -> Uri.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/socket.ml b/vendors/tezos-modded/src/lib_signer_backends/socket.ml
new file mode 100644
index 000000000..6991880b4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/socket.ml
@@ -0,0 +1,231 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_keys
+open Signer_messages
+
+let tcp_scheme = "tcp"
+let unix_scheme = "unix"
+
+module Make(P : sig
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+  end) = struct
+
+  type request_type =
+    | Sign_request
+    | Deterministic_nonce_request
+    | Deterministic_nonce_hash_request
+
+  let build_request pkh data signature = function
+    | Sign_request ->
+        Request.Sign { Sign.Request.pkh ; data ; signature }
+    | Deterministic_nonce_request ->
+        Request.Deterministic_nonce
+          { Deterministic_nonce.Request.pkh ; data ; signature }
+    | Deterministic_nonce_hash_request ->
+        Request.Deterministic_nonce_hash
+          { Deterministic_nonce_hash.Request.pkh ; data ; signature }
+
+  let signer_operation path pkh msg request_type =
+    begin
+      Lwt_utils_unix.Socket.connect path >>=? fun conn ->
+      Lwt_utils_unix.Socket.send
+        conn Request.encoding Request.Authorized_keys >>=? fun () ->
+      Lwt_utils_unix.Socket.recv conn
+        (result_encoding Authorized_keys.Response.encoding) >>=? fun authorized_keys ->
+      Lwt.return authorized_keys >>=? fun authorized_keys ->
+      Lwt_unix.close conn >>= fun () ->
+      begin match authorized_keys with
+        | No_authentication -> return_none
+        | Authorized_keys authorized_keys ->
+            P.authenticate authorized_keys
+              (Sign.Request.to_sign ~pkh ~data:msg) >>=? fun signature ->
+            return_some signature
+      end
+    end >>=? fun signature ->
+    Lwt_utils_unix.Socket.connect path >>=? fun conn ->
+    let req = build_request pkh msg signature request_type in
+    Lwt_utils_unix.Socket.send conn Request.encoding req >>=? fun () ->
+    return conn
+
+  let sign ?watermark path pkh msg =
+    let msg =
+      match watermark with
+      | None -> msg
+      | Some watermark ->
+          MBytes.concat "" [ Signature.bytes_of_watermark watermark ; msg ] in
+    signer_operation path pkh msg Sign_request >>=? fun conn ->
+    Lwt_utils_unix.Socket.recv conn
+      (result_encoding Sign.Response.encoding) >>=? fun res ->
+    Lwt_unix.close conn >>= fun () ->
+    Lwt.return res
+
+  let deterministic_nonce path pkh msg =
+    signer_operation path pkh msg Deterministic_nonce_request >>=? fun conn ->
+    Lwt_utils_unix.Socket.recv conn
+      (result_encoding Deterministic_nonce.Response.encoding) >>=? fun res ->
+    Lwt_unix.close conn >>= fun () ->
+    Lwt.return res
+
+  let deterministic_nonce_hash path pkh msg =
+    signer_operation path pkh msg Deterministic_nonce_hash_request >>=? fun conn ->
+    Lwt_utils_unix.Socket.recv conn
+      (result_encoding Deterministic_nonce_hash.Response.encoding) >>=? fun res ->
+    Lwt_unix.close conn >>= fun () ->
+    Lwt.return res
+
+  let supports_deterministic_nonces path pkh =
+    Lwt_utils_unix.Socket.connect path >>=? fun conn ->
+    Lwt_utils_unix.Socket.send
+      conn Request.encoding (Request.Supports_deterministic_nonces pkh) >>=? fun () ->
+    Lwt_utils_unix.Socket.recv conn
+      (result_encoding Supports_deterministic_nonces.Response.encoding) >>=? fun res ->
+    Lwt_unix.close conn >>= fun () ->
+    Lwt.return res
+
+  let public_key path pkh =
+    Lwt_utils_unix.Socket.connect path >>=? fun conn ->
+    Lwt_utils_unix.Socket.send
+      conn Request.encoding (Request.Public_key pkh) >>=? fun () ->
+    let encoding = result_encoding Public_key.Response.encoding in
+    Lwt_utils_unix.Socket.recv conn encoding >>=? fun res ->
+    Lwt_unix.close conn >>= fun () ->
+    Lwt.return res
+
+  module Unix = struct
+
+    let scheme = unix_scheme
+
+    let title =
+      "Built-in tezos-signer using remote signer through hardcoded unix socket."
+
+    let description =
+      "Valid locators are of the form\n\
+      \ - unix:/path/to/socket?pkh=tz1..."
+
+    let parse uri =
+      assert (Uri.scheme uri = Some scheme) ;
+      trace (Invalid_uri uri) @@
+      match Uri.get_query_param uri "pkh" with
+      | None -> failwith "Missing the query parameter: 'pkh=tz1...'"
+      | Some key ->
+          Lwt.return (Signature.Public_key_hash.of_b58check key) >>=? fun key ->
+          return (Lwt_utils_unix.Socket.Unix (Uri.path uri), key)
+
+    let public_key ?interactive:(_) uri =
+      parse (uri : pk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      public_key path pkh
+
+    let neuterize uri =
+      return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
+
+    let public_key_hash ?interactive:(_) uri =
+      public_key uri >>=? fun pk ->
+      return (Signature.Public_key.hash pk, Some pk)
+
+    let sign ?watermark uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      sign ?watermark path pkh msg
+
+    let deterministic_nonce uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      deterministic_nonce path pkh msg
+
+    let deterministic_nonce_hash uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      deterministic_nonce_hash path pkh msg
+
+    let supports_deterministic_nonces uri =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      supports_deterministic_nonces path pkh
+
+  end
+
+  module Tcp = struct
+
+    let scheme = tcp_scheme
+
+    let title =
+      "Built-in tezos-signer using remote signer through hardcoded tcp socket."
+
+    let description =
+      "Valid locators are of the form\n\
+      \ - tcp://host:port/tz1..."
+
+    let parse uri =
+      assert (Uri.scheme uri = Some scheme) ;
+      trace (Invalid_uri uri) @@
+      match Uri.host uri, Uri.port uri with
+      | None, _ ->
+          failwith "Missing host address"
+      | _, None ->
+          failwith "Missing host port"
+      | Some path, Some port ->
+          let pkh = Uri.path uri in
+          let pkh =
+            try String.(sub pkh 1 (length pkh - 1))
+            with _ -> "" in
+          Lwt.return
+            (Signature.Public_key_hash.of_b58check pkh) >>=? fun pkh ->
+          return (Lwt_utils_unix.Socket.Tcp (path, string_of_int port,
+                                             [Lwt_unix.AI_SOCKTYPE SOCK_STREAM]), pkh)
+
+    let public_key ?interactive:(_) uri =
+      parse (uri : pk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      public_key path pkh
+
+    let neuterize uri =
+      return (Client_keys.make_pk_uri (uri : sk_uri :> Uri.t))
+
+    let public_key_hash ?interactive uri =
+      public_key ?interactive uri >>=? fun pk ->
+      return (Signature.Public_key.hash pk, Some pk)
+
+    let sign ?watermark uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      sign ?watermark path pkh msg
+
+    let deterministic_nonce uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      deterministic_nonce path pkh msg
+
+    let deterministic_nonce_hash uri msg =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      deterministic_nonce_hash path pkh msg
+
+    let supports_deterministic_nonces uri =
+      parse (uri : sk_uri :> Uri.t) >>=? fun (path, pkh) ->
+      supports_deterministic_nonces path pkh
+
+  end
+
+end
+
+
+let make_unix_base path =
+  Uri.make ~scheme:unix_scheme ~path ()
+
+let make_tcp_base host port =
+  Uri.make ~scheme:tcp_scheme ~host ~port ()
diff --git a/vendors/tezos-modded/src/lib_signer_backends/socket.mli b/vendors/tezos-modded/src/lib_signer_backends/socket.mli
new file mode 100644
index 000000000..b42a769dd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/socket.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(P : sig
+    val authenticate: Signature.Public_key_hash.t list -> MBytes.t -> Signature.t tzresult Lwt.t
+  end) : sig
+  module Unix : Client_keys.SIGNER
+  module Tcp : Client_keys.SIGNER
+end
+
+val make_unix_base: string -> Uri.t
+val make_tcp_base: string -> int -> Uri.t
diff --git a/vendors/tezos-modded/src/lib_signer_backends/test/dune b/vendors/tezos-modded/src/lib_signer_backends/test/dune
new file mode 100644
index 000000000..db81120cc
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/test/dune
@@ -0,0 +1,33 @@
+(executables
+ (names test_encrypted test_crouching)
+ (libraries tezos-signer-backends
+            alcotest-lwt)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_error_monad
+                   -open Tezos_stdlib
+                   -open Tezos_crypto
+                   -open Tezos_client_base
+                   -open Tezos_signer_backends)))
+
+(alias
+ (name buildtest)
+ (deps test_encrypted.exe test_crouching.exe))
+
+(alias
+ (name runtest_signer_encrypted)
+ (action (run %{exe:test_encrypted.exe})))
+
+(alias
+ (name runtest_crouching)
+ (action (run %{exe:test_crouching.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_signer_encrypted)
+       (alias runtest_crouching)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_signer_backends/test/test_crouching.ml b/vendors/tezos-modded/src/lib_signer_backends/test/test_crouching.ml
new file mode 100644
index 000000000..bf6756ece
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/test/test_crouching.ml
@@ -0,0 +1,13 @@
+
+let test_example () =
+  let name = Ledger_names.crouching_tiger "12345" in
+  assert (name = { c = "calculating" ; t = "meerkat" ; h = "straight" ; d = "beetle" })
+
+let tests = [
+  Alcotest.test_case "print_example" `Quick test_example;
+]
+
+let () =
+  Alcotest.run "tezos-signed-backends" [
+    "ledger-names", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_signer_backends/test/test_encrypted.ml b/vendors/tezos-modded/src/lib_signer_backends/test/test_encrypted.ml
new file mode 100644
index 000000000..f04bd8e44
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/test/test_encrypted.ml
@@ -0,0 +1,132 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
+(*                                                                        *)
+(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Error_monad
+
+let loops = 10
+
+let passwords = List.map MBytes.of_string [
+    "ahThie5H"; "aVah7eid"; "Hihohh1n"; "mui0Hoox"; "Piu7pual"; "paik6aiW";
+    "caeS5me5"; "boh5dauL"; "zaiK1Oht"; "Oogh4hah"; "kiY5ohlo"; "booth0Ei";
+    "xa2Aidao"; "aju6oXu4"; "gooruGh9"; "ahy4Daih"; "chosh0Wu"; "Cheij6za";
+    "quee9ooL"; "Sohs9are"; "Pae3gay7"; "Naif5iel"; " eir6Aed1"; "aa6Aesai";
+    "";
+  ]
+
+let nb_passwds = List.length passwords
+
+let fake_ctx () = object
+  val mutable i = 0;
+  val mutable distributed = false;
+  inherit Client_context.simple_printer (fun _ _ -> Lwt.return_unit)
+  method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a =
+    Format.kasprintf (fun _ -> return "")
+  method prompt_password : type a. (a, MBytes.t tzresult) Client_context.lwt_format -> a =
+    Format.kasprintf begin fun _ -> (* return Bigstring.empty *)
+      match distributed with
+      | false ->
+          distributed <- true ;
+          return (List.nth passwords 0)
+      | true ->
+          i <- if i = nb_passwds - 1 then 0 else succ i ;
+          distributed <- false ;
+          return (List.nth passwords i)
+    end
+end
+
+let make_sk_uris =
+  List.map begin fun path ->
+    Client_keys.make_sk_uri (Uri.make ~scheme:"encrypted" ~path ())
+  end
+
+let ed25519_sks = [
+  "edsk3kMNLNdzLPbbABASDLARft8JRZ3Wpwibn8SMAb4KmuWSMJmAFd";
+  "edsk3Kqr8VHRx9kmR8Pj5qRGcmvQH34cForiMaMz1Ahhq5DkZp7FxJ";
+  "edsk2mBu4w9sMGhryvvXK53dXgpcNdZWi8pJQ1QL2rAgRPrE5y12az" ]
+
+let ed25519_sks_encrypted = make_sk_uris [
+    "edesk1oGXxunJ5FTGpQ6o1xdop8VGKdT36Fj7LwWF9HLjzEqaCC4V6tdRVN1jaeJTfCHS8bYf7U2YhMK2yW6jSUy" ;
+    "edesk1s4xEifbUdUkghHHimbNUuyQ4eidDVJdc8JtPRUon758hBqZNZsQxadUDFRSRiUdLoFqBG35HAiLKafyczw" ;
+    "edesk1zY5jEs4QXrF9tXxFq1mfW9PkatdRxCKQ2Q598y5LLz65nQj4eWxefYFp8YLerya1haRdGe5NWckHDb5ApM" ;
+  ]
+
+let secp256k1_sks = [
+  "spsk24attf9uuQ7PUKFHxTm6E3TMqB6SPkFiMbXPBur7JNrvupW2xg";
+  "spsk2H32XfWL7MkW58r76q6Yu5tJg77YGgVyjwq7EvLUHhn4JmAtEG";
+  "spsk3KQ56REAUGc6Gn87xCRnWyPwR2Un667vegQVuU16ZcgNyLCooh" ]
+
+let secp256k1_sks_encrypted = make_sk_uris [
+    "spesk2CXQHDbzrcNatRzmg83Dto6kX6BWwpP2zGs4Zks9LDsXzaX6mAYRj5ZrrdgyZQap4DS9YRRLNSpaVC2TSsk" ;
+    "spesk1upiFp23osWSUTgHcx8DCVpTrMr9xtdqVQkQDWj5sFG7vqcWLDaNv9AKKcF27Nb266YfuAGF2hEbcyAxHmK" ;
+    "spesk1w7d68hzTWJusk5Xn5oz8EgDXbotDW9BXb5ksFjr8Jd94Kxnu5yKAhgRszojhMUoJ1EEt5BtPpGpkgCjELq" ;
+  ]
+
+let p256_sks = [
+  "p2sk2YQcwF5h7qgRztocEMrfizUwZaM41f4v7zWneiig2Y5AxajqYC";
+  "p2sk2XiSoQC9tvejVBDJyvkbHUq2kvcQHdJJ2wM8rii228DkjKV2b5";
+  "p2sk3ZsfsEaxDNn74orv91Ruu35fomzF373aT9ForA4fDo54c47o6H" ]
+
+let p256_sks_encrypted = make_sk_uris [
+    "p2esk2JMFpR9yaSpgsaKQYLqFnv16t4gowJ4cgjj7D7iMfoaJz2vZuH7Tdi11MrX6FC2yhfs2nvy5VRxAvzH1STE" ;
+    "p2esk1nfobVL73mY5Y18W8Ltb3Vm6Nf5Th7trN3yA3ucyyP4AH93XfyRatkh9AxxaDtnju1EtArykjroEQHDT97k" ;
+    "p2esk2Ge1jrVak7NhxksimzaQjRCTLx5vxUZ4Akgq3spGQLx6N41h6aKXeEYDgxN5eztnPwD6QiCHCfVAKXLPNm8" ;
+  ]
+
+let sk_testable =
+  Alcotest.testable
+    Signature.Secret_key.pp
+    Signature.Secret_key.equal
+
+let test_vectors () =
+  let open Encrypted in
+  iter_s begin fun (sks, encrypted_sks) ->
+    let ctx = fake_ctx () in
+    let sks = List.map Signature.Secret_key.of_b58check_exn sks in
+    map_s (decrypt ctx) encrypted_sks >>=? fun decs ->
+    assert (decs = sks) ;
+    return_unit
+  end [
+    ed25519_sks, ed25519_sks_encrypted ;
+    secp256k1_sks, secp256k1_sks_encrypted ;
+    p256_sks, p256_sks_encrypted ;
+  ]
+
+let test_random algo =
+  let open Encrypted in
+  let ctx = fake_ctx () in
+  let decrypt_ctx = (ctx :> Client_context.prompter) in
+  let rec inner i =
+    if i >= loops then return_unit
+    else
+      let _, _, sk = Signature.generate_key ~algo () in
+      encrypt ctx sk >>=? fun sk_uri ->
+      decrypt decrypt_ctx sk_uri >>=? fun decrypted_sk ->
+      Alcotest.check sk_testable "test_encrypt: decrypt" sk decrypted_sk ;
+      inner (succ i)
+  in inner 0
+
+let test_random _switch () =
+  iter_s test_random Signature.[Ed25519 ; Secp256k1 ; P256] >>= function
+  | Ok _ -> Lwt.return_unit
+  | Error _ -> Lwt.fail_with "test_random"
+
+let test_vectors _switch () =
+  test_vectors () >>= function
+  | Ok _ -> Lwt.return_unit
+  | Error _ -> Lwt.fail_with "test_vectors"
+
+let tests = [
+  Alcotest_lwt.test_case "random_roundtrip" `Quick test_random ;
+  Alcotest_lwt.test_case "vectors_decrypt" `Quick test_vectors ;
+]
+
+let () =
+  Alcotest.run "tezos-signer-backends" [
+    "encrypted", tests
+  ]
diff --git a/vendors/tezos-modded/src/lib_signer_backends/tezos-signer-backends.opam b/vendors/tezos-modded/src/lib_signer_backends/tezos-signer-backends.opam
new file mode 100644
index 000000000..96e885218
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/tezos-signer-backends.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-stdlib-unix"
+  "tezos-client-base"
+  "tezos-rpc-http"
+  "tezos-signer-services"
+  "tezos-shell-services"
+  "pbkdf"
+  "bip39"
+  "ledgerwallet-tezos"
+  "alcotest" {with-test & >= "0.8.1"}
+  "alcotest-lwt" {with-test & >= "0.8.0"}
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_signer_backends/unencrypted.ml b/vendors/tezos-modded/src/lib_signer_backends/unencrypted.ml
new file mode 100644
index 000000000..52a2f3c98
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/unencrypted.ml
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_keys
+
+let scheme = "unencrypted"
+
+let title =
+  "Built-in signer using raw unencrypted keys."
+
+let description =
+  "Please DO NOT USE this signer outside of test environments.\n\
+   Valid secret key URIs are of the form\n\
+  \ - unencrypted:<key>\n\
+   where <key> is the secret key in Base58.\n\
+   Valid public key URIs are of the form\n\
+  \ - unencrypted:<public_key>\n\
+   where <public_key> is the public key in Base58."
+
+let secret_key sk_uri =
+  Lwt.return
+    (Signature.Secret_key.of_b58check (Uri.path (sk_uri : sk_uri :> Uri.t)))
+
+let make_sk sk =
+  Client_keys.make_sk_uri
+    (Uri.make ~scheme ~path:(Signature.Secret_key.to_b58check sk) ())
+
+let public_key ?interactive:(_) pk_uri =
+  Lwt.return
+    (Signature.Public_key.of_b58check (Uri.path (pk_uri : pk_uri :> Uri.t)))
+
+let make_pk pk =
+  Client_keys.make_pk_uri
+    (Uri.make ~scheme ~path:(Signature.Public_key.to_b58check pk) ())
+
+let neuterize sk_uri =
+  secret_key sk_uri >>=? fun sk ->
+  return (make_pk (Signature.Secret_key.to_public_key sk))
+
+let public_key_hash ?interactive pk_uri =
+  public_key ?interactive pk_uri >>=? fun pk ->
+  return (Signature.Public_key.hash pk, Some pk)
+
+let sign ?watermark sk_uri buf =
+  secret_key sk_uri >>=? fun sk ->
+  return (Signature.sign ?watermark sk buf)
+
+let deterministic_nonce sk_uri buf =
+  secret_key sk_uri >>=? fun sk ->
+  return (Signature.deterministic_nonce sk buf)
+
+let deterministic_nonce_hash sk_uri buf =
+  secret_key sk_uri >>=? fun sk ->
+  return (Signature.deterministic_nonce_hash sk buf)
+
+let supports_deterministic_nonces _ = return_true
diff --git a/vendors/tezos-modded/src/lib_signer_backends/unencrypted.mli b/vendors/tezos-modded/src/lib_signer_backends/unencrypted.mli
new file mode 100644
index 000000000..f5a3dfca2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_backends/unencrypted.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Client_keys.SIGNER
+
+val make_pk: Signature.public_key -> Client_keys.pk_uri
+val make_sk: Signature.secret_key -> Client_keys.sk_uri
diff --git a/vendors/tezos-modded/src/lib_signer_services/dune b/vendors/tezos-modded/src/lib_signer_services/dune
new file mode 100644
index 000000000..7d0575380
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/dune
@@ -0,0 +1,17 @@
+(library
+ (name tezos_signer_services)
+ (public_name tezos-signer-services)
+ (libraries tezos-base
+            tezos-client-base
+            tezos-rpc)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc
+                   -open Tezos_client_base
+                   -linkall)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_signer_services/signer_messages.ml b/vendors/tezos-modded/src/lib_signer_services/signer_messages.ml
new file mode 100644
index 000000000..6b0c52898
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/signer_messages.ml
@@ -0,0 +1,244 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type Authenticated_request = sig
+  type t = {
+    pkh: Signature.Public_key_hash.t ;
+    data: MBytes.t ;
+    signature: Signature.t option ;
+  }
+  val to_sign:
+    pkh: Signature.Public_key_hash.t ->
+    data: MBytes.t ->
+    MBytes.t
+  val encoding : t Data_encoding.t
+end
+
+module type Tag = sig
+  val tag: int
+end
+
+module Make_authenticated_request(T: Tag) : Authenticated_request = struct
+
+  type t = {
+    pkh: Signature.Public_key_hash.t ;
+    data: MBytes.t ;
+    signature: Signature.t option ;
+  }
+
+  let to_sign ~pkh ~data =
+    let tag = MBytes.make 1 '0' in
+    MBytes.set_int8 tag 0 T.tag;
+    MBytes.concat ""
+      [ MBytes.of_string "\x04" ;
+        tag;
+        Signature.Public_key_hash.to_bytes pkh ;
+        data ]
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { pkh ; data ; signature } ->
+         (pkh, data, signature))
+      (fun (pkh, data, signature)  ->
+         { pkh ; data ; signature })
+      (obj3
+         (req "pkh" Signature.Public_key_hash.encoding)
+         (req "data" bytes)
+         (opt "signature" Signature.encoding))
+
+end
+
+module Sign = struct
+
+  module Request = Make_authenticated_request (struct let tag = 1 end)
+
+  module Response = struct
+
+    type t = Signature.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "signature" Signature.encoding))
+
+  end
+
+end
+
+module Deterministic_nonce = struct
+
+  module Request = Make_authenticated_request (struct let tag = 2 end)
+
+  module Response = struct
+
+    type t = MBytes.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "deterministic_nonce" bytes))
+
+  end
+
+end
+
+module Deterministic_nonce_hash = struct
+
+  module Request = Make_authenticated_request (struct let tag = 3 end)
+
+  module Response = struct
+
+    type t = MBytes.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "deterministic_nonce_hash" bytes))
+
+  end
+
+end
+
+module Supports_deterministic_nonces = struct
+
+  module Request = struct
+
+    type t = Signature.Public_key_hash.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "pkh" Signature.Public_key_hash.encoding))
+
+  end
+
+  module Response = struct
+
+    type t = bool
+
+    let encoding = Data_encoding.(obj1 (req "bool" bool))
+  end
+
+end
+
+
+
+module Public_key = struct
+
+  module Request = struct
+
+    type t = Signature.Public_key_hash.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "pkh" Signature.Public_key_hash.encoding))
+
+  end
+
+  module Response = struct
+
+    type t = Signature.Public_key.t
+
+    let encoding =
+      Data_encoding.(obj1 (req "pubkey" Signature.Public_key.encoding))
+
+  end
+
+end
+
+module Authorized_keys = struct
+
+  module Response = struct
+
+    type t =
+      | No_authentication
+      | Authorized_keys of Signature.Public_key_hash.t list
+
+    let encoding =
+      let open Data_encoding in
+      union
+        [ case (Tag 0)
+            ~title: "No_authentication"
+            (constant "no_authentication_required")
+            (function No_authentication -> Some () | _ -> None)
+            (fun () -> No_authentication) ;
+          case (Tag 1)
+            ~title: "Authorized_keys"
+            (list Signature.Public_key_hash.encoding)
+            (function Authorized_keys l -> Some l | _ -> None)
+            (fun l -> Authorized_keys l) ]
+
+  end
+
+end
+
+module Request = struct
+
+  type t =
+    | Sign of Sign.Request.t
+    | Public_key of Public_key.Request.t
+    | Authorized_keys
+    | Deterministic_nonce of Deterministic_nonce.Request.t
+    | Deterministic_nonce_hash of Deterministic_nonce_hash.Request.t
+    | Supports_deterministic_nonces of Supports_deterministic_nonces.Request.t
+
+  let encoding =
+    let open Data_encoding in
+    union [
+      case (Tag 0)
+        ~title:"Sign"
+        (merge_objs
+           (obj1 (req "kind" (constant "sign")))
+           Sign.Request.encoding)
+        (function Sign req -> Some ((), req) | _ -> None)
+        (fun ((), req) -> Sign req) ;
+      case (Tag 1)
+        ~title:"Public_key"
+        (merge_objs
+           (obj1 (req "kind" (constant "public_key")))
+           Public_key.Request.encoding)
+        (function Public_key req -> Some ((), req) | _ -> None)
+        (fun ((), req) -> Public_key req) ;
+      case (Tag 2)
+        ~title:"Authorized_keys"
+        (obj1 (req "kind" (constant "authorized_keys")))
+        (function Authorized_keys -> Some () | _ -> None)
+        (fun () -> Authorized_keys) ;
+      case (Tag 3)
+        ~title:"Deterministic_nonce"
+        (merge_objs
+           (obj1 (req "kind" (constant "deterministic_nonce")))
+           Deterministic_nonce.Request.encoding)
+        (function Deterministic_nonce req -> Some ((), req) | _ -> None)
+        (fun ((), req) -> Deterministic_nonce req) ;
+      case (Tag 4)
+        ~title:"Deterministic_nonce_hash"
+        (merge_objs
+           (obj1 (req "kind" (constant "deterministic_nonce_hash")))
+           Deterministic_nonce_hash.Request.encoding)
+        (function Deterministic_nonce_hash req -> Some ((), req) | _ -> None)
+        (fun ((), req) -> Deterministic_nonce_hash req) ;
+      case (Tag 5)
+        ~title:"Supports_deterministic_nonces"
+        (merge_objs
+           (obj1 (req "kind" (constant "supports_deterministic_nonces")))
+           Supports_deterministic_nonces.Request.encoding)
+        (function Supports_deterministic_nonces req -> Some ((), req) | _ -> None)
+        (fun ((), req) -> Supports_deterministic_nonces req) ;
+    ]
+
+end
diff --git a/vendors/tezos-modded/src/lib_signer_services/signer_messages.mli b/vendors/tezos-modded/src/lib_signer_services/signer_messages.mli
new file mode 100644
index 000000000..2a0f0794c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/signer_messages.mli
@@ -0,0 +1,123 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type Authenticated_request = sig
+  type t = {
+    pkh: Signature.Public_key_hash.t ;
+    data: MBytes.t ;
+    signature: Signature.t option ;
+  }
+  val to_sign:
+    pkh: Signature.Public_key_hash.t ->
+    data: MBytes.t ->
+    MBytes.t
+  val encoding : t Data_encoding.t
+end
+
+module Sign : sig
+
+  module Request : Authenticated_request
+
+  module Response : sig
+    type t = Signature.t
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+module Deterministic_nonce : sig
+
+  module Request : Authenticated_request
+
+  module Response : sig
+    type t = MBytes.t
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+module Deterministic_nonce_hash : sig
+
+  module Request : Authenticated_request
+
+  module Response : sig
+    type t = MBytes.t
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+module Supports_deterministic_nonces : sig
+
+  module Request : sig
+    type t = Signature.Public_key_hash.t
+    val encoding : t Data_encoding.t
+  end
+
+  module Response : sig
+    type t = bool
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+module Public_key : sig
+
+  module Request : sig
+    type t = Signature.Public_key_hash.t
+    val encoding : t Data_encoding.t
+  end
+
+  module Response : sig
+    type t = Signature.Public_key.t
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+module Authorized_keys : sig
+
+  module Response : sig
+    type t =
+      | No_authentication
+      | Authorized_keys of Signature.Public_key_hash.t list
+    val encoding : t Data_encoding.t
+  end
+
+end
+
+
+module Request : sig
+
+  type t =
+    | Sign of Sign.Request.t
+    | Public_key of Public_key.Request.t
+    | Authorized_keys
+    | Deterministic_nonce of Deterministic_nonce.Request.t
+    | Deterministic_nonce_hash of Deterministic_nonce_hash.Request.t
+    | Supports_deterministic_nonces of Supports_deterministic_nonces.Request.t
+  val encoding : t Data_encoding.t
+
+end
diff --git a/vendors/tezos-modded/src/lib_signer_services/signer_services.ml b/vendors/tezos-modded/src/lib_signer_services/signer_services.ml
new file mode 100644
index 000000000..694125b08
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/signer_services.ml
@@ -0,0 +1,84 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 query =
+  let open RPC_query in
+  query (fun signature -> signature)
+  |+ opt_field
+    ~descr: "Must be provided if the signer requires \
+             authentication. In this case, it must be the signature \
+             of the public key hash and message concatenated, by one \
+             of the keys authorized by the signer."
+    "authentication" Signature.rpc_arg (fun signature -> signature)
+  |> seal
+
+let sign =
+  RPC_service.post_service
+    ~description: "Sign a piece of data with a given remote key"
+    ~query
+    ~input: Data_encoding.bytes
+    ~output: Data_encoding.(obj1 (req "signature" Signature.encoding))
+    RPC_path.(root / "keys" /: Signature.Public_key_hash.rpc_arg)
+
+let deterministic_nonce =
+  RPC_service.post_service
+    ~description: "Obtain some random data generated deterministically from some piece of data with a given remote key"
+    ~query
+    ~input: Data_encoding.bytes
+    ~output: Data_encoding.(obj1 (req "deterministic_nonce" bytes))
+    RPC_path.(root / "keys" /: Signature.Public_key_hash.rpc_arg)
+
+let deterministic_nonce_hash =
+  RPC_service.post_service
+    ~description: "Obtain the hash of some random data generated deterministically from some piece of data with a given remote key"
+    ~query
+    ~input: Data_encoding.bytes
+    ~output: Data_encoding.(obj1 (req "deterministic_nonce_hash" bytes))
+    RPC_path.(root / "keys" /: Signature.Public_key_hash.rpc_arg)
+
+let supports_deterministic_nonces =
+  RPC_service.get_service
+    ~description: "Obtain whether the signing service suppports the determinstic nonces functionality"
+    ~query: RPC_query.empty
+    ~output: Data_encoding.(obj1 (req "supports_deterministic_nonces" bool))
+    RPC_path.(root / "keys" /: Signature.Public_key_hash.rpc_arg)
+
+let public_key =
+  RPC_service.get_service
+    ~description: "Retrieve the public key of a given remote key"
+    ~query: RPC_query.empty
+    ~output: Data_encoding.(obj1 (req "public_key" Signature.Public_key.encoding))
+    RPC_path.(root / "keys" /: Signature.Public_key_hash.rpc_arg)
+
+let authorized_keys =
+  RPC_service.get_service
+    ~description: "Retrieve the public keys that can be used to \
+                   authenticate signing commands.\n\
+                   If the empty object is returned, the signer has \
+                   been set to accept unsigned commands."
+    ~query: RPC_query.empty
+    ~output: Data_encoding.(obj1 (opt "authorized_keys" (list Signature.Public_key_hash.encoding)))
+    RPC_path.(root / "authorized_keys")
diff --git a/vendors/tezos-modded/src/lib_signer_services/signer_services.mli b/vendors/tezos-modded/src/lib_signer_services/signer_services.mli
new file mode 100644
index 000000000..2785dec0e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/signer_services.mli
@@ -0,0 +1,48 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 sign :
+  ([ `POST ], unit, unit * Signature.Public_key_hash.t,
+   Signature.t option, MBytes.t, Signature.t) RPC_service.t
+
+val deterministic_nonce :
+  ([ `POST ], unit, unit * Signature.Public_key_hash.t,
+   Signature.t option, MBytes.t, MBytes.t) RPC_service.t
+
+val deterministic_nonce_hash :
+  ([ `POST ], unit, unit * Signature.Public_key_hash.t,
+   Signature.t option, MBytes.t, MBytes.t) RPC_service.t
+
+val supports_deterministic_nonces :
+  ([ `GET ], unit, unit * Signature.Public_key_hash.t,
+   unit, unit, bool) RPC_service.t
+
+val public_key :
+  ([ `GET ], unit, unit * Signature.Public_key_hash.t,
+   unit, unit, Signature.Public_key.t) RPC_service.t
+
+val authorized_keys :
+  ([ `GET ], unit, unit,
+   unit, unit, Signature.Public_key_hash.t list option) RPC_service.t
diff --git a/vendors/tezos-modded/src/lib_signer_services/tezos-signer-services.opam b/vendors/tezos-modded/src/lib_signer_services/tezos-signer-services.opam
new file mode 100644
index 000000000..decc2863c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_signer_services/tezos-signer-services.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-base"
+  "tezos-rpc"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_stdlib/binary_stream.ml b/vendors/tezos-modded/src/lib_stdlib/binary_stream.ml
new file mode 100644
index 000000000..f175b21ff
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/binary_stream.ml
@@ -0,0 +1,97 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Facilities to decode streams of binary data *)
+
+type buffer = {
+  buffer : MBytes.t ;
+  ofs : int ;
+  len : int ;
+}
+
+type t = {
+  current : buffer ;
+  (* buffer queue (classical double list implementation) *)
+  pending : MBytes.t list ;
+  pending_rev : MBytes.t list ;
+  (* number unread bytes in 'current + pending + pending_rev' *)
+  unread : int ;
+}
+
+let is_empty { unread ; _ } = unread = 0
+
+let of_buffer current =
+  { current ;
+    pending = [] ;
+    pending_rev = [] ;
+    unread = current.len }
+
+let of_bytes buffer =
+  let len = MBytes.length buffer in
+  of_buffer { buffer ; ofs = 0 ; len }
+
+let empty = of_bytes (MBytes.create 0)
+
+let push buffer stream =
+  { stream with pending_rev = buffer :: stream.pending_rev ;
+                unread = stream.unread + MBytes.length buffer }
+
+exception Need_more_data
+
+let split buffer len =
+  assert (len <= buffer.len) ;
+  { buffer with len },
+  { buffer with ofs = buffer.ofs + len ; len = buffer.len - len }
+
+let read stream len =
+  if len > stream.unread then raise Need_more_data ;
+  if len <= stream.current.len then
+    let res, current = split stream.current len in
+    res, { stream with current ; unread = stream.unread - len }
+  else
+    let res = { buffer = MBytes.create len ; ofs = 0 ; len } in
+    MBytes.blit
+      stream.current.buffer stream.current.ofs
+      res.buffer 0
+      stream.current.len ;
+    let rec loop ofs pending_rev = function
+      | [] -> loop ofs [] (List.rev pending_rev)
+      | buffer :: pending ->
+          let current = { buffer ; ofs = 0 ; len = MBytes.length buffer } in
+          let to_read = len - ofs in
+          if to_read <= current.len then begin
+            MBytes.blit current.buffer 0 res.buffer ofs to_read ;
+            res,
+            { current = { current with ofs = to_read ;
+                                       len = current.len - to_read } ;
+              pending ;
+              pending_rev ;
+              unread = stream.unread - len ;
+            }
+          end else begin
+            MBytes.blit current.buffer 0 res.buffer ofs current.len ;
+            loop (ofs + current.len) pending_rev pending
+          end in
+    loop stream.current.len stream.pending_rev stream.pending
diff --git a/vendors/tezos-modded/src/lib_stdlib/binary_stream.mli b/vendors/tezos-modded/src/lib_stdlib/binary_stream.mli
new file mode 100644
index 000000000..f70d4dbe4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/binary_stream.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+
+type buffer = {
+  buffer : MBytes.t ;
+  ofs : int ;
+  len : int ;
+}
+
+exception Need_more_data
+
+val is_empty: t -> bool
+val empty: t
+val of_buffer: buffer -> t
+val read: t -> int -> buffer * t
+val push: MBytes.t -> t -> t
diff --git a/vendors/tezos-modded/src/lib_stdlib/compare.ml b/vendors/tezos-modded/src/lib_stdlib/compare.ml
new file mode 100644
index 000000000..f34b04eaa
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/compare.ml
@@ -0,0 +1,135 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type S = sig
+  type t
+  val (=) : t -> t -> bool
+  val (<>) : t -> t -> bool
+  val (<) : t -> t -> bool
+  val (<=) : t -> t -> bool
+  val (>=) : t -> t -> bool
+  val (>) : t -> t -> bool
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val max : t -> t -> t
+  val min : t -> t -> t
+end
+
+module Make (P : COMPARABLE) = struct
+  include P
+  let compare = compare
+  let (=) a b = compare a b = 0
+  let (<>) a b = compare a b <> 0
+  let (<) a b = compare a b < 0
+  let (<=) a b = compare a b <= 0
+  let (>=) a b = compare a b >= 0
+  let (>) a b = compare a b > 0
+  let equal = (=)
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+end
+
+module List (P : COMPARABLE) = struct
+  type t = P.t list
+  let rec compare xs ys =
+    match xs, ys with
+    | [], [] -> 0
+    | [], _ -> -1
+    | _, [] -> 1
+    | x :: xs, y :: ys ->
+        let hd = P.compare x y in
+        if hd <> 0 then hd else compare xs ys
+  let (=) xs ys = compare xs ys = 0
+  let (<>) xs ys = compare xs ys <> 0
+  let (<) xs ys = compare xs ys < 0
+  let (<=) xs ys = compare xs ys <= 0
+  let (>=) xs ys = compare xs ys >= 0
+  let (>) xs ys = compare xs ys > 0
+  let equal = (=)
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+end
+
+module Option (P : COMPARABLE) = struct
+  type t = P.t option
+  let compare xs ys =
+    match xs, ys with
+    | None, None -> 0
+    | None, _ -> -1
+    | _, None -> 1
+    | Some x, Some y -> P.compare x y
+  let (=) xs ys = compare xs ys = 0
+  let (<>) xs ys = compare xs ys <> 0
+  let (<) xs ys = compare xs ys < 0
+  let (<=) xs ys = compare xs ys <= 0
+  let (>=) xs ys = compare xs ys >= 0
+  let (>) xs ys = compare xs ys > 0
+  let equal = (=)
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+end
+
+module Char = Make (Char)
+module Bool = Make (struct type t = bool let compare = Pervasives.compare end)
+module Int = Make (struct type t = int let compare = Pervasives.compare end)
+module Int32 = Make (Int32)
+module Int64 = Make (Int64)
+
+module MakeUnsigned (Int : S) (Z : sig val zero : Int.t end) = struct
+  type t = Int.t
+  let compare va vb =
+    Int.(if va >= Z.zero then if vb >= Z.zero then compare va vb else -1
+         else if vb >= Z.zero then 1 else compare va vb)
+  let (=) = ((=) : t -> t -> bool)
+  let (<>) = ((<>) : t -> t -> bool)
+  let (<) a b =
+    Int.(if Z.zero <= a then
+           (a < b || b < Z.zero)
+         else
+           (b < Z.zero && a < b))
+  let (<=) a b =
+    Int.(if Z.zero <= a then
+           (a <= b || b < Z.zero)
+         else
+           (b < Z.zero && a <= b))
+  let (>=) a b = (<=) b a
+  let (>) a b = (<) b a
+  let equal = (=)
+  let max x y = if x >= y then x else y
+  let min x y = if x <= y then x else y
+end
+
+module Uint32 = MakeUnsigned (Int32) (struct let zero = 0l end)
+module Uint64 = MakeUnsigned (Int64) (struct let zero = 0L end)
+
+module Float = Make (struct type t = float let compare = Pervasives.compare end)
+module String = Make (String)
+
+module Z = Make (Z)
diff --git a/vendors/tezos-modded/src/lib_stdlib/compare.mli b/vendors/tezos-modded/src/lib_stdlib/compare.mli
new file mode 100644
index 000000000..8a67a866e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/compare.mli
@@ -0,0 +1,59 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
+module type S = sig
+  type t
+  val (=) : t -> t -> bool
+  val (<>) : t -> t -> bool
+  val (<) : t -> t -> bool
+  val (<=) : t -> t -> bool
+  val (>=) : t -> t -> bool
+  val (>) : t -> t -> bool
+  val compare : t -> t -> int
+  val equal : t -> t -> bool
+  val max : t -> t -> t
+  val min : t -> t -> t
+end
+
+module Make (P : COMPARABLE) : S with type t := P.t
+
+module Char : S with type t = char
+module Bool : S with type t = bool
+module Int : S with type t = int
+module Int32 : S with type t = int32
+module Uint32 : S with type t = int32
+module Int64 : S with type t = int64
+module Uint64 : S with type t = int64
+module Float : S with type t = float
+module String : S with type t = string
+module Z : S with type t = Z.t
+
+module List (P : COMPARABLE) : S with type t = P.t list
+module Option (P : COMPARABLE) : S with type t = P.t option
diff --git a/vendors/tezos-modded/src/lib_stdlib/dune b/vendors/tezos-modded/src/lib_stdlib/dune
new file mode 100644
index 000000000..95449499a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/dune
@@ -0,0 +1,21 @@
+(library
+ (name tezos_stdlib)
+ (public_name tezos-stdlib)
+ (libraries ocplib-endian.bigstring
+            bigstring
+            cstruct
+            hex
+            re
+            zarith
+            lwt
+            lwt.log)
+ (flags (:standard -safe-string)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{dep:test-ocp-indent.sh} %{deps})))
+
+(install
+ (section libexec)
+ (files (test-ocp-indent.sh as test-ocp-indent.sh)))
diff --git a/vendors/tezos-modded/src/lib_stdlib/hashPtree.ml b/vendors/tezos-modded/src/lib_stdlib/hashPtree.ml
new file mode 100644
index 000000000..f85ac7382
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/hashPtree.ml
@@ -0,0 +1,1076 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Ptree_sig = struct
+  module type Value = sig
+
+    type t
+    val equal : t -> t -> bool
+    val hash : t -> int
+
+  end
+
+  type prefix_order =
+    | Equal
+    | Shorter
+    | Longer
+    | Different
+
+  module type Prefix = sig
+    type key    (* bit sequence *)
+    type prefix (* prefix of a bit sequence *)
+    type mask   (* integer length of a bit sequence *)
+
+    val equal_key : key -> key -> bool
+    val equal_mask : mask -> mask -> bool
+    val equal_prefix : prefix -> prefix -> bool
+
+    val hash_key : key -> int
+    val hash_mask : mask -> int
+    val hash_prefix : prefix -> int
+
+    val full_length_mask : mask
+
+    val strictly_shorter_mask : mask -> mask -> bool
+
+    val key_prefix : key -> prefix
+    (* Full lenght prefix *)
+    val prefix_key : prefix -> mask -> key
+    (* Some key matching the prefix with the given mask *)
+
+    val match_prefix : key:key -> prefix:prefix -> mask:mask -> bool
+    (* Does the prefix of length [mask] of [key] equals to [prefix] *)
+
+    val select_bit : prefix:prefix -> mask:mask -> bool
+    (* Get the bit of [prefix] at position [mask] assumes that [mask] is
+       less than the length of prefix *)
+
+    val common_mask : prefix -> prefix -> mask
+    (* The length of the common part of given prefixes *)
+
+    val apply_mask : prefix -> mask -> prefix
+    (* Cut the prefix to the given length *)
+
+    val compare_prefix : mask -> prefix -> mask -> prefix -> prefix_order
+    (* [compare_prefix m1 p1 m2 p2]:
+       let p1' (resp p2') be the sub-prefix of length m1 of p1 (resp m2 of p2)
+       The result is
+         Equal if p1' equal p2'
+         Shorter if p1' is a prefix of p2'
+         Longer if p2' is a prefix of p1'
+         Different if those not ordered
+    *)
+  end
+
+  module type S = sig
+
+    type key
+    type prefix
+    type mask
+    type value
+
+    type not_empty = TNot_empty
+    type empty     = TEmpty
+
+    type _ t = private
+      | Leaf : {
+          mutable id: int; (* Mutable to get a good sharing semantics *)
+          mask : mask;
+          key : key;
+          value : value;
+        } -> not_empty t
+      | Node : {
+          mutable id : int;
+          mask : mask;
+          prefix : prefix;
+          true_ : not_empty t;
+          false_ : not_empty t;
+        } -> not_empty t
+      | Empty : empty t
+
+    val leaf : key:key -> mask:mask -> value -> not_empty t
+    val node : prefix:prefix -> mask:mask -> true_:not_empty t -> false_:not_empty t -> not_empty t
+    val empty : empty t
+
+    val equal : not_empty t -> not_empty t -> bool
+
+    val fast_partial_equal : not_empty t -> not_empty t -> bool
+    (* if [fast_partial_equal x y] is true, then [equal x y] is true,
+       but if fast_partial_equal returns false, nothing can be
+       asserted. *)
+
+    val id : not_empty t -> int
+  end
+end
+
+module Shared_tree : sig
+
+  module Hash_consed_tree(P:Ptree_sig.Prefix)(V:Ptree_sig.Value) : Ptree_sig.S
+    with type value = V.t
+     and type key = P.key
+     and type prefix = P.prefix
+     and type mask = P.mask
+
+  module Simple_tree(P:Ptree_sig.Prefix)(V:sig type t val equal : t -> t -> bool  end) : Ptree_sig.S
+    with type value = V.t
+     and type key = P.key
+     and type prefix = P.prefix
+     and type mask = P.mask
+
+end = struct
+  open Ptree_sig
+
+(*
+  type int2 = { mutable i1 : int; mutable i2 : int }
+  let h2 = { i1 = 0; i2 = 0 }
+  let hash2int x1 x2 =
+    h2.i1 <- x1; h2.i2 <- x2;
+    Hashtbl.hash h2
+*)
+  type int3 = { mutable i1 : int; mutable i2 : int; mutable i3 : int }
+  let h3 = { i1 = 0; i2 = 0; i3 = 0 }
+  let hash3int x1 x2 x3 =
+    h3.i1 <- x1; h3.i2 <- x2; h3.i3 <- x3;
+    Hashtbl.hash h3
+
+  type int4 = { mutable i1 : int; mutable i2 : int; mutable i3 : int; mutable i4 : int }
+  let h4 = { i1 = 0; i2 = 0; i3 = 0; i4 = 0 }
+  let hash4int x1 x2 x3 x4 =
+    h4.i1 <- x1; h4.i2 <- x2; h4.i3 <- x3; h4.i4 <- x4;
+    Hashtbl.hash h4
+
+
+  module Hash_consed_tree(P:Prefix)(V:Value) : S
+    with type value = V.t
+     and type key = P.key
+     and type prefix = P.prefix
+     and type mask = P.mask
+  = struct
+
+    type key = P.key
+    type mask = P.mask
+    type prefix = P.prefix
+    type value = V.t
+
+    type not_empty = TNot_empty
+    type empty     = TEmpty
+
+    type _ t =
+      | Leaf : {
+          mutable id: int; (* Mutable to get a good sharing semantics *)
+          mask : mask;
+          key : key;
+          value : value;
+        } -> not_empty t
+      | Node : {
+          mutable id : int;
+          mask : mask;
+          prefix : prefix;
+          true_ : not_empty t;
+          false_ : not_empty t;
+        } -> not_empty t
+      | Empty : empty t
+
+    let id : not_empty t -> int = function
+      | Leaf { id ; _ } -> id
+      | Node { id ; _ } -> id
+
+    let set_id (n : not_empty t) id = match n with
+      | Leaf r -> r.id <- id
+      | Node r -> r.id <- id
+
+    (*let mask : not_empty t -> mask = function
+      | Leaf { mask ; _ } -> mask
+      | Node { mask ; _ } -> mask
+    *)
+    (* let prefix_table = WeakPrefixTbl.create 20 *)
+
+    module Tree :
+      Hashtbl.HashedType with type t = not_empty t
+    = struct
+
+      type nonrec t = not_empty t
+
+      let equal (t1 : t) (t2 : t) = match t1, t2 with
+        | Leaf _, Node _ | Node _, Leaf _-> false
+        | Leaf { key = p1; value = v1; mask = m1 ; _ },
+          Leaf { key = p2; value = v2; mask = m2 ; _ } ->
+            P.equal_key p1 p2 && P.equal_mask m1 m2 && V.equal v1 v2
+        | Node { prefix = p1; mask = m1; true_ = t1; false_ = f1 ; _ },
+          Node { prefix = p2; mask = m2; true_ = t2; false_ = f2 ; _ } ->
+            (* Assumes that only the head can be unshared: this means
+               that structural equality implies physical one on children *)
+            P.equal_prefix p1 p2 &&
+            P.equal_mask m1 m2 && t1 == t2 && f1 == f2
+
+      let hash : t -> int = function
+        | Leaf { key; value; mask ; _ } ->
+            hash3int (P.hash_key key) (V.hash value) (P.hash_mask mask)
+        | Node { mask; prefix; true_; false_ ; _ } ->
+            hash4int
+              (P.hash_mask mask) (P.hash_prefix prefix)
+              (id true_) (id false_)
+
+    end
+
+    module WeakTreeTbl = Weak.Make(Tree)
+
+    (* Or move that to a state ? *)
+    let weak_tree_tbl = WeakTreeTbl.create 10
+
+    let next =
+      let r = ref 0 in
+      fun () -> incr r; !r
+
+    let leaf ~key ~mask value =
+      let l = Leaf { id = 0; key; value; mask } in
+      match WeakTreeTbl.find_opt weak_tree_tbl l with
+      | None ->
+          set_id l (next ());
+          WeakTreeTbl.add weak_tree_tbl l;
+          l
+      | Some l -> l
+
+    let node ~prefix ~mask ~true_ ~false_ =
+      let l = Node { id = 0; mask; prefix; true_; false_ } in
+      match WeakTreeTbl.find_opt weak_tree_tbl l with
+      | None ->
+          set_id l (next ());
+          WeakTreeTbl.add weak_tree_tbl l;
+          l
+      | Some l -> l
+
+    let empty = Empty
+
+    let equal (x:not_empty t) (y:not_empty t) =
+      x == y
+
+    let fast_partial_equal = equal
+
+  end [@@inline]
+
+  module Simple_tree(P:Ptree_sig.Prefix)(V:sig type t val equal : t -> t -> bool end) : S
+    with type value = V.t
+     and type key = P.key
+     and type prefix = P.prefix
+     and type mask = P.mask
+  = struct
+
+    type key = P.key
+    type mask = P.mask
+    type prefix = P.prefix
+    type value = V.t
+
+    type not_empty = TNot_empty
+    type empty     = TEmpty
+
+    type _ t =
+      | Leaf : {
+          mutable id: int; (* Mutable to get a good sharing semantics *)
+          mask : mask;
+          key : key;
+          value : value;
+        } -> not_empty t
+      | Node : {
+          mutable id : int;
+          mask : mask;
+          prefix : prefix;
+          true_ : not_empty t;
+          false_ : not_empty t;
+        } -> not_empty t
+      | Empty : empty t
+
+    let id : not_empty t -> int = function
+      | Leaf { id ; _ } -> id
+      | Node { id ; _ } -> id
+
+    (*let set_id (n : not_empty t) id = match n with
+      | Leaf r -> r.id <- id
+      | Node r -> r.id <- id
+
+      let mask : not_empty t -> mask = function
+      | Leaf { mask ; _ } -> mask
+      | Node { mask ; _ } -> mask
+    *)
+    let leaf ~key ~mask value =
+      Leaf { id = 0; key; value; mask }
+
+    let node ~prefix ~mask ~true_ ~false_ =
+      Node { id = 0; mask; prefix; true_; false_ }
+
+    let empty = Empty
+
+    let rec equal_not_empty (x:not_empty t) (y:not_empty t) =
+      x == y ||
+      match x, y with
+      | Leaf l1, Leaf l2 ->
+          P.equal_key l1.key l2.key &&
+          V.equal l1.value l2.value
+      | Node n1, Node n2 ->
+          P.equal_prefix n1.prefix n2.prefix &&
+          P.equal_mask n1.mask n2.mask &&
+          equal_not_empty n1.true_ n2.true_ &&
+          equal_not_empty n1.false_ n2.false_
+      | Node _, Leaf _ | Leaf _, Node _ -> false
+
+    let equal : type a b. a t -> b t -> bool = fun x y ->
+      match x, y with
+      | Empty, Empty -> true
+      | Leaf _, Leaf _ ->
+          equal_not_empty x y
+      | Node _, Node _ ->
+          equal_not_empty x y
+      | _, _ ->
+          false
+
+    let fast_partial_equal (x:not_empty t) (y:not_empty t) =
+      x == y
+
+  end [@@inline]
+
+end
+
+module type Value = sig
+  type t
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
+
+module type Bits = sig
+  type t
+
+  val lnot : t -> t
+  val (land) : t -> t -> t
+  val (lxor) : t -> t -> t
+  val (lor) : t -> t -> t
+  val (lsr) : t -> int -> t
+  val (lsl) : t -> int -> t
+  val pred : t -> t
+
+  val less_than : t -> t -> bool
+
+  val highest_bit : t -> t
+  val equal : t -> t -> bool
+  val hash : t -> int
+  val zero : t
+  val one : t
+
+  val size : int
+end
+
+module type Size = sig
+  val size : int
+end
+
+module Bits(S:Size) = struct
+  type t = Z.t
+  let size = S.size
+  let higher_bit = Z.shift_left Z.one size
+  let mask = Z.pred higher_bit
+
+  let mark n = Z.logor higher_bit n
+  let unmark n = Z.logxor higher_bit n
+
+  let one = mark Z.one
+  let zero = higher_bit
+  let hash = Z.hash
+  let equal = Z.equal
+  let less_than = Z.lt
+
+  let highest_bit_unmarked n =
+    if Z.equal Z.zero n then
+      Z.zero
+    else
+      Z.(Z.one lsl (Pervasives.pred (numbits n)))
+
+  let highest_bit n = mark (highest_bit_unmarked (unmark n))
+
+  let lnot x = Z.logor (Z.lognot x) higher_bit
+  let (land) = Z.logand
+  let (lxor) a b = Z.logor (Z.logxor a b) higher_bit
+  let (lor) = Z.logor
+  let (lsr) a n =
+    Z.logor
+      (Z.shift_right_trunc (Z.logxor a higher_bit) n)
+      higher_bit
+  let (lsl) a n =
+    Z.logor
+      (Z.logand (Z.shift_left a n) mask)
+      higher_bit
+
+  let pred = Z.pred
+
+  let of_z n = mark n
+  let to_z n = unmark n
+end
+
+module BE_gen_prefix(Bits:Bits) : Ptree_sig.Prefix
+  with type key = Bits.t
+   and type prefix = Bits.t
+   and type mask = Bits.t
+= struct
+  type key = Bits.t
+  type mask = Bits.t (* Only a single bit set *)
+  type prefix = Bits.t
+
+  let equal_key = Bits.equal
+  let equal_mask = Bits.equal
+  let equal_prefix = Bits.equal
+
+  let hash_key x = Bits.hash x
+  let hash_mask x = Bits.hash x
+  let hash_prefix x = Bits.hash x
+
+  open Bits
+
+  let full_length_mask = Bits.one
+
+  let strictly_shorter_mask (m1:mask) m2 =
+    Bits.less_than m2 m1
+
+  let select_bit ~prefix ~mask =
+    not (Bits.equal (prefix land mask) Bits.zero)
+
+  let apply_mask prefix mask =
+    prefix land (lnot (pred mask))
+
+  let match_prefix ~key ~prefix ~mask =
+    equal_prefix (apply_mask key mask) prefix
+
+  let common_mask p0 p1 =
+    (Bits.highest_bit (* [@inlined] *)) (p0 lxor p1)
+
+  let key_prefix x = x
+  let prefix_key p _m = p
+
+  let smaller_set_mask m1 m2 =
+    (lnot (pred m1))
+    land
+    (lnot (pred m2))
+
+  let compare_prefix m1 p1 m2 p2 =
+    let min_mask = smaller_set_mask m1 m2 in
+    let applied_p1 = p1 land min_mask in
+    let applied_p2 = p2 land min_mask in
+    if applied_p1 = applied_p2 then
+      if m1 > m2 then Ptree_sig.Shorter
+      else if m1 < m2 then Ptree_sig.Longer
+      else Ptree_sig.Equal
+    else
+      Ptree_sig.Different
+end
+
+
+module LE_prefix : Ptree_sig.Prefix
+  with type key = int
+   and type prefix = int
+   and type mask = int
+= struct
+  type key = int
+  type mask = int (* Only a single bit set *)
+  type prefix = int
+
+  let equal_key = (==)
+  let equal_mask = (==)
+  let equal_prefix = (==)
+
+  let hash_key x = x
+  let hash_mask x = x
+  let hash_prefix x = x
+
+  let full_length_mask = (-1) lxor ((-1) lsr 1)
+
+  let strictly_shorter_mask (m1:mask) m2 =
+    m1 < m2
+
+  let select_bit ~prefix ~mask = (prefix land mask) != 0
+
+  let apply_mask prefix mask = prefix land (mask-1)
+  let match_prefix ~key ~prefix ~mask =
+    (apply_mask key mask) == prefix
+
+  let lowest_bit x = x land (-x)
+  let common_mask p0 p1 = lowest_bit (p0 lxor p1)
+
+  let key_prefix x = x
+  let prefix_key p _m = p
+
+  let smaller_set_mask m1 m2 = (m1-1) land (m2-1)
+
+  let compare_prefix m1 p1 m2 p2 =
+    let min_mask = smaller_set_mask m1 m2 in
+    let applied_p1 = p1 land min_mask in
+    let applied_p2 = p2 land min_mask in
+    if applied_p1 = applied_p2 then
+      if m1 < m2 then Ptree_sig.Shorter
+      else if m1 > m2 then Ptree_sig.Longer
+      else Ptree_sig.Equal
+    else
+      Ptree_sig.Different
+end
+
+module BE_prefix : Ptree_sig.Prefix
+  with type key = int
+   and type prefix = int
+   and type mask = int
+= struct
+  type key = int
+  type mask = int (* Only a single bit set *)
+  type prefix = int
+
+  let equal_key = (==)
+  let equal_mask = (==)
+  let equal_prefix = (==)
+
+  let hash_key x = x
+  let hash_mask x = x
+  let hash_prefix x = x
+
+  let full_length_mask = 1
+
+  let strictly_shorter_mask (m1:mask) m2 =
+    m1 > m2
+
+  let select_bit ~prefix ~mask = (prefix land mask) != 0
+
+  module Nativeint_infix = struct
+    let (lor) = Nativeint.logor
+    (*let (lsl) = Nativeint.shift_left*)
+    let (lsr) = Nativeint.shift_right_logical
+    (*let (asr) = Nativeint.shift_right*)
+    let (land) = Nativeint.logand
+    let (lnot) = Nativeint.lognot
+    let (lxor) = Nativeint.logxor
+    let (-) = Nativeint.sub
+  end
+
+  let apply_mask prefix mask =
+    let open Nativeint_infix in
+    let prefix = Nativeint.of_int prefix in
+    let mask = Nativeint.of_int mask in
+    Nativeint.to_int
+      (
+        prefix land
+        (lnot (mask - 1n))
+      )
+
+  let match_prefix ~key ~prefix ~mask =
+    (apply_mask key mask) == prefix
+
+  let highest_bit x =
+    Nativeint_infix.(
+      let x = x lor (x lsr 1) in
+      let x = x lor (x lsr 2) in
+      let x = x lor (x lsr 4) in
+      let x = x lor (x lsr 8) in
+      let x = x lor (x lsr 16) in
+      let x =
+        if Sys.word_size > 32 then
+          x lor (x lsr 32)
+        else
+          x
+      in
+      Nativeint.to_int (x - (x lsr 1))
+    )
+
+  let common_mask p0 p1 =
+    let open Nativeint_infix in
+    let p0 = Nativeint.of_int p0 in
+    let p1 = Nativeint.of_int p1 in
+    highest_bit (p0 lxor p1)
+
+  let key_prefix x = x
+  let prefix_key p _m = p
+
+  let smaller_set_mask m1 m2 =
+    let open Nativeint_infix in
+    (lnot (m1 - 1n))
+    land
+    (lnot (m2 - 1n))
+
+  let compare_prefix m1 p1 m2 p2 =
+    let open Nativeint_infix in
+    let m1 = Nativeint.of_int m1 in
+    let m2 = Nativeint.of_int m2 in
+    let p1 = Nativeint.of_int p1 in
+    let p2 = Nativeint.of_int p2 in
+    let min_mask = smaller_set_mask m1 m2 in
+    let applied_p1 = p1 land min_mask in
+    let applied_p2 = p2 land min_mask in
+    if applied_p1 = applied_p2 then
+      if m1 > m2 then Ptree_sig.Shorter
+      else if m1 < m2 then Ptree_sig.Longer
+      else Ptree_sig.Equal
+    else
+      Ptree_sig.Different
+end
+
+module Make(P:Ptree_sig.Prefix)(V:Value) = struct
+
+  module T = Shared_tree.Hash_consed_tree(P)(V)
+
+  type t = E : 'a T.t -> t [@@ocaml.unboxed]
+  type key = T.key
+  type value = T.value
+  type mask = T.mask
+(*
+  let (=) = `Do_not_use_polymorphic_equality
+  let (<=) = `Do_not_use_polymorphic_comparison
+  let (>=) = `Do_not_use_polymorphic_comparison
+  let (<) = `Do_not_use_polymorphic_comparison
+  let (>) = `Do_not_use_polymorphic_comparison
+  let compare = `Do_not_use_polymorphic_comparison
+   *)
+  let equal (E t1) (E t2) =
+    match t1, t2 with
+    | T.Empty, T.Empty -> true
+    | T.Empty, T.Leaf _ -> false
+    | T.Empty, T.Node _ -> false
+    | T.Leaf _, T.Empty -> false
+    | T.Node _, T.Empty -> false
+    | T.Node _, T.Node _ -> T.equal t1 t2
+    | T.Node _, T.Leaf _ -> T.equal t1 t2
+    | T.Leaf _, T.Node _ -> T.equal t1 t2
+    | T.Leaf _, T.Leaf _ -> T.equal t1 t2
+
+  let select_key_bit k m =
+    P.select_bit ~prefix:(P.key_prefix k) ~mask:m
+
+  let matching_key k1 k2 mask =
+    let p1 = P.apply_mask (P.key_prefix k1) mask in
+    let p2 = P.apply_mask (P.key_prefix k2) mask in
+    P.equal_prefix p1 p2
+
+  let rec mem : type k. key -> k T.t -> bool = fun k -> function
+    | T.Empty ->
+        false
+    | T.Leaf { key; mask ; _} ->
+        matching_key key k mask
+    | T.Node { prefix = _; mask; true_; false_ ; _ } ->
+        mem k
+          (if select_key_bit k mask then true_ else false_)
+
+  let rec mem_exact : type k. key -> k T.t -> bool = fun k -> function
+    | T.Empty ->
+        false
+    | T.Leaf { key; mask ; _ } ->
+        P.equal_key k key && P.equal_mask mask P.full_length_mask
+    | T.Node { prefix = _; mask; true_; false_ ; _ } ->
+        mem_exact k
+          (if select_key_bit k mask then true_ else false_)
+
+  let rec find_ne k (t: T.not_empty T.t) = match t with
+    | T.Leaf { key; value; mask ; _ } ->
+        if matching_key key k mask then
+          Some value
+        else
+          None
+    | T.Node { prefix = _; mask; true_; false_ ; _ } ->
+        find_ne k
+          (if select_key_bit k mask then true_ else false_)
+
+  let find : type k. key -> k T.t -> value option = fun k -> function
+    | T.Empty ->
+        None
+    | T.Leaf _ as t ->
+        find_ne k t
+    | T.Node _ as t ->
+        find_ne k t
+
+  let singleton ~key ~value ~mask =
+    T.leaf ~key value ~mask
+
+  let join ~mask p0 t0 p1 t1 =
+    (* assumes p0 <> p1 *)
+    let c_mask = P.common_mask p0 p1 in
+    let mask = if P.strictly_shorter_mask c_mask mask then c_mask else mask in
+    let prefix = P.apply_mask p1 mask in
+    let true_, false_ =
+      if P.select_bit ~prefix:p0 ~mask then
+        t0, t1
+      else
+        t1, t0
+    in
+    T.node ~prefix ~mask ~true_ ~false_
+
+  let rebuild_ne_branch node prefix mask ~node_true ~node_false ~true_ ~false_ =
+    if T.fast_partial_equal node_true true_ &&
+       T.fast_partial_equal node_false false_ then
+      node
+    else
+      T.node ~prefix ~mask ~true_ ~false_
+
+  let rec add_ne combine ~key ~value ?(mask=P.full_length_mask) t =
+    match t with
+    | T.Leaf leaf ->
+        if P.equal_key key leaf.key && P.equal_mask leaf.mask P.full_length_mask then
+          if value == leaf.value then
+            t
+          else
+            T.leaf ~key (combine value leaf.value) ~mask
+        else if
+          P.strictly_shorter_mask leaf.mask mask &&
+          P.match_prefix ~key ~prefix:(P.key_prefix leaf.key) ~mask:leaf.mask then
+          (* The previous leaf shadows the new one: no modification *)
+          t
+        else if
+          P.strictly_shorter_mask mask leaf.mask &&
+          P.match_prefix ~key:leaf.key ~prefix:(P.key_prefix key) ~mask then
+          (* The new leaf shadows the previous one: replace *)
+          T.leaf ~key (combine value leaf.value) ~mask
+        else
+          join ~mask
+            (P.key_prefix key) (T.leaf ~key value ~mask)
+            (P.key_prefix leaf.key) t
+    | T.Node node ->
+        if P.match_prefix ~key ~prefix:node.prefix ~mask:node.mask then
+          let true_, false_ =
+            if select_key_bit key node.mask then
+              add_ne combine ~key ~value ~mask node.true_, node.false_
+            else
+              node.true_, add_ne combine ~key ~value ~mask node.false_
+          in
+          rebuild_ne_branch t node.prefix node.mask
+            ~node_false:node.false_ ~node_true:node.true_
+            ~true_ ~false_
+        else
+          join ~mask
+            (P.key_prefix key) (T.leaf ~key value ~mask)
+            node.prefix t
+
+  let add : type k.
+    (value -> value -> value) -> key:key -> value:value ->
+    ?mask:P.mask -> k T.t ->
+    T.not_empty T.t = fun combine ~key ~value ?(mask=P.full_length_mask) ->
+    function
+    | T.Empty ->
+        singleton ~key ~value ~mask
+
+    (* Should be merged by matcher *)
+    | T.Leaf _ as t ->
+        add_ne combine ~key ~value ~mask t
+    | T.Node _ as t ->
+        add_ne combine ~key ~value ~mask t
+
+  let empty = E T.empty
+
+  let rebuild_branch
+      node prefix mask ~node_true ~node_false
+      ~true_:(E true_) ~false_:(E false_) =
+    match true_, false_ with
+    | T.Empty, T.Empty ->
+        empty
+    | T.Empty, t ->
+        E t
+    | t, T.Empty ->
+        E t
+    | T.Leaf _ as true_, (T.Leaf _ as false_) ->
+        E (rebuild_ne_branch node prefix mask ~node_true ~node_false ~true_ ~false_)
+    | T.Leaf _ as true_, (T.Node _ as false_) ->
+        E (rebuild_ne_branch node prefix mask ~node_true ~node_false ~true_ ~false_)
+    | T.Node _ as true_, (T.Leaf _ as false_) ->
+        E (rebuild_ne_branch node prefix mask ~node_true ~node_false ~true_ ~false_)
+    | T.Node _ as true_, (T.Node _ as false_) ->
+        E (rebuild_ne_branch node prefix mask ~node_true ~node_false ~true_ ~false_)
+
+  let rec remove_ne : key -> T.not_empty T.t -> t =
+    fun key t ->
+      match t with
+      | T.Leaf leaf ->
+          if matching_key leaf.key key leaf.mask then
+            E T.empty
+          else
+            E t
+      | T.Node node ->
+          if P.match_prefix ~key ~prefix:node.prefix ~mask:node.mask then
+            let true_, false_ =
+              if select_key_bit key node.mask then
+                remove_ne key node.true_, E node.false_
+              else
+                E node.true_, remove_ne key node.false_
+            in
+            rebuild_branch t node.prefix node.mask
+              ~node_true:node.true_ ~node_false:node.false_ ~true_ ~false_
+          else
+            E t
+
+  let remove key (E t) =
+    match t with
+    | T.Empty ->
+        empty
+    | T.Leaf _ as t ->
+        remove_ne key t
+    | T.Node _ as t ->
+        remove_ne key t
+
+  let rec remove_prefix_ne : key -> mask -> T.not_empty T.t -> t =
+    fun key mask t ->
+      match t with
+      | T.Leaf leaf ->
+          if matching_key key leaf.key mask then
+            E T.empty
+          else
+            E t
+      | T.Node node ->
+          match P.compare_prefix mask (P.key_prefix key) node.mask node.prefix with
+          | Different ->
+              E t
+          | Equal ->
+              E T.empty
+          | Shorter ->
+              E T.empty
+          | Longer ->
+              let true_, false_ =
+                if select_key_bit key node.mask then
+                  remove_prefix_ne key mask node.true_, E node.false_
+                else
+                  E node.true_, remove_prefix_ne key mask node.false_
+              in
+              rebuild_branch t node.prefix node.mask
+                ~node_true:node.true_ ~node_false:node.false_ ~true_ ~false_
+
+  let remove_prefix key mask (E t) =
+    match t with
+    | T.Empty ->
+        empty
+    | T.Leaf _ as t ->
+        remove_prefix_ne key mask t
+    | T.Node _ as t ->
+        remove_prefix_ne key mask t
+
+  let rec remove_ne_exact : key -> T.not_empty T.t -> t =
+    fun key t ->
+      match t with
+      | T.Leaf leaf ->
+          if P.equal_key leaf.key key && P.equal_mask leaf.mask P.full_length_mask then
+            E T.empty
+          else
+            E t
+      | T.Node node ->
+          if P.match_prefix ~key ~prefix:node.prefix ~mask:node.mask then
+            let true_, false_ =
+              if select_key_bit key node.mask then
+                remove_ne_exact key node.true_, E node.false_
+              else
+                E node.true_, remove_ne_exact key node.false_
+            in
+            rebuild_branch t node.prefix node.mask
+              ~node_true:node.true_ ~node_false:node.false_ ~true_ ~false_
+          else
+            E t
+
+  let remove_exact key (E t) =
+    match t with
+    | T.Empty ->
+        empty
+    | T.Leaf _ as t ->
+        remove_ne_exact key t
+    | T.Node _ as t ->
+        remove_ne_exact key t
+
+  let rec replace_subtree_ne ~key ~id value t =
+    match t with
+    | T.Leaf leaf ->
+        if leaf.id == id then
+          T.leaf ~key:leaf.key ~mask:leaf.mask value
+        else
+          t
+    | T.Node node ->
+        if node.id == id then
+          T.leaf ~key:(P.prefix_key node.prefix node.mask) ~mask:node.mask value
+        else
+        if P.match_prefix ~key ~prefix:node.prefix ~mask:node.mask then
+          let true_, false_ =
+            if select_key_bit key node.mask then
+              replace_subtree_ne ~key ~id value node.true_, node.false_
+            else
+              node.true_, replace_subtree_ne ~key ~id value node.false_
+          in
+          rebuild_ne_branch t node.prefix node.mask
+            ~node_true:node.true_ ~node_false:node.false_ ~true_ ~false_
+        else
+          t
+
+  let replace_subtree ~replaced:(E replaced) value t =
+    let replace_subtree_aux ~key ~id value (E t) =
+      match t with
+      | T.Empty ->
+          empty
+      | T.Leaf _ as t ->
+          E (replace_subtree_ne ~key ~id value t)
+      | T.Node _ as t ->
+          E (replace_subtree_ne ~key ~id value t)
+    in
+    match replaced with
+    | T.Empty ->
+        t
+    | T.Leaf leaf ->
+        replace_subtree_aux ~key:leaf.key ~id:leaf.id value t
+    | T.Node node ->
+        replace_subtree_aux
+          ~key:(P.prefix_key node.prefix node.mask)
+          ~id:node.id value t
+
+
+  let rec fold_ne : (key -> mask -> value -> 'a -> 'a) -> T.not_empty T.t -> 'a -> 'a =
+    fun f t acc ->
+      match t with
+      | T.Leaf {key; mask; value; _} ->
+          f key mask value acc
+      | T.Node node ->
+          let acc = fold_ne f node.false_ acc in
+          fold_ne f node.true_ acc
+
+  let fold f (E t) acc =
+    match t with
+    | T.Empty ->
+        acc
+    | T.Leaf _ as t ->
+        fold_ne f t acc
+    | T.Node _ as t ->
+        fold_ne f t acc
+
+  module T_id = struct
+    type t = T.not_empty T.t
+
+    let hash = T.id
+    let equal t1 t2 = T.id t1 == T.id t2
+  end
+  module Map_cache = Ephemeron.K1.Make(T_id)
+
+  module type Map_Reduce = sig
+    type result
+    val default : result
+    val map : t -> key -> T.value -> result
+    val reduce : t -> result -> result -> result
+  end
+  module Map_Reduce(M:Map_Reduce) = struct
+    let cache : M.result Map_cache.t = Map_cache.create 10
+
+    let rec map_reduce_ne t =
+      match Map_cache.find_opt cache t with
+      | Some v -> v
+      | None ->
+          let v =
+            match t with
+            | T.Leaf leaf ->
+                M.map (E t) leaf.key leaf.value
+            | T.Node node ->
+                let v_true = map_reduce_ne node.true_ in
+                let v_false = map_reduce_ne node.false_ in
+                M.reduce (E t) v_true v_false
+          in
+          Map_cache.add cache t v;
+          v
+
+    let run (E t) = match t with
+      | T.Empty ->
+          M.default
+      | T.Leaf _ as t ->
+          map_reduce_ne t
+      | T.Node _ as t ->
+          map_reduce_ne t
+
+    let rec filter_ne f t =
+      let result = map_reduce_ne t in
+      if f result then
+        E t
+      else
+        match t with
+        | T.Leaf _ ->
+            empty
+        | T.Node node ->
+            let true_ = filter_ne f node.true_ in
+            let false_ = filter_ne f node.false_ in
+            rebuild_branch t node.prefix node.mask
+              ~node_true:node.true_ ~node_false:node.false_ ~true_ ~false_
+
+    let filter f (E t) = match t with
+      | T.Empty ->
+          empty
+      | T.Leaf _ as t ->
+          filter_ne f t
+      | T.Node _ as t ->
+          filter_ne f t
+
+  end
+
+  (* Packing in the existential *)
+
+  let mem key (E t) =
+    mem key t
+
+  let mem_exact key (E t) =
+    mem_exact key t
+
+  let find key (E t) =
+    find key t
+
+  let singleton ~key ~value ~mask =
+    E (singleton ~key ~value ~mask)
+
+  let add combine ~key ~value ?mask (E t) =
+    E (add combine ~key ~value ?mask t)
+
+end [@@inline]
+
+module type S = sig
+  type key
+  type value
+  type mask
+  type t
+
+  val equal : t -> t -> bool
+
+  val empty : t
+  val singleton : key:key -> value:value -> mask:mask -> t
+  val add : (value -> value -> value) -> key:key -> value:value ->
+    ?mask:mask -> t -> t
+  val remove : key -> t -> t
+  val remove_exact : key -> t -> t
+  val remove_prefix : key -> mask -> t -> t
+  val mem : key -> t -> bool
+  val mem_exact : key -> t -> bool
+  val find : key -> t -> value option
+  val replace_subtree : replaced:t -> value -> t -> t
+  val fold : (key -> mask -> value -> 'a -> 'a) -> t -> 'a -> 'a
+
+  module type Map_Reduce = sig
+    type result
+    val default : result
+    val map : t -> key -> value -> result
+    val reduce : t -> result -> result -> result
+  end
+  module Map_Reduce(M:Map_Reduce) : sig
+    val run : t -> M.result
+    val filter : (M.result -> bool) -> t -> t
+  end
+
+end
+
+module Make_LE(V:Value) = Make(LE_prefix)(V)
+module Make_BE(V:Value) = Make(BE_prefix)(V)
+module Make_BE_gen(V:Value)(B:Bits) = Make(BE_gen_prefix(B))(V)
+module Make_BE_sized(V:Value)(S:Size) = Make(BE_gen_prefix(Bits(S)))(V)
diff --git a/vendors/tezos-modded/src/lib_stdlib/hashPtree.mli b/vendors/tezos-modded/src/lib_stdlib/hashPtree.mli
new file mode 100644
index 000000000..9ec085b88
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/hashPtree.mli
@@ -0,0 +1,145 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Hash Consed Patricia Trees *)
+
+module type Value = sig
+  type t
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
+
+module type Bits = sig
+  type t
+
+  val lnot : t -> t
+  val (land) : t -> t -> t
+  val (lxor) : t -> t -> t
+  val (lor) : t -> t -> t
+  val (lsr) : t -> int -> t
+  val (lsl) : t -> int -> t
+  val pred : t -> t
+
+  val less_than : t -> t -> bool
+
+  val highest_bit : t -> t
+  val equal : t -> t -> bool
+  val hash : t -> int
+  val zero : t
+  val one : t
+
+  val size : int
+end
+
+module type Size = sig
+  val size : int
+end
+
+module Bits(S:Size) : sig
+  include Bits
+  val of_z : Z.t -> t
+  val to_z : t -> Z.t
+end
+
+module type S = sig
+  type key
+  type value
+  type mask
+  type t
+
+  val equal : t -> t -> bool
+
+  val empty : t
+  val singleton : key:key -> value:value -> mask:mask -> t
+
+  (** [add combine ~key ~value ?mask t]
+      Add a new key in the tree. If mask is specified, then we consider the whole
+      subtree stemming from key.
+
+      Assumes that forall x, [combine x x = x]
+  *)
+  val add : (value -> value -> value) -> key:key -> value:value ->
+    ?mask:mask -> t -> t
+
+  (** [remove key t] Remove the entire subtree speficied by the mask associated with
+      key in the tree. Otherwise remove only the key *)
+  val remove : key -> t -> t
+
+  (** [remove_exact key t] Remove the largest subtree
+      stemming from key. Otherwise remove only the key *)
+  val remove_exact : key -> t -> t
+
+  val remove_prefix : key -> mask -> t -> t
+
+  (** [mem key t] return true if the entire subtree speficied by the mask associated with
+      key is in the tree *)
+  val mem : key -> t -> bool
+
+  (** [mem_exact key t] return true if the largest subtree stemming from key is in the tree *)
+  val mem_exact : key -> t -> bool
+
+  val find : key -> t -> value option
+
+  (** [let new_tree = replace_subtree ~replaced value tree]
+      If replaced is a subtree of tree (for instance provided
+      by Map_reduce.reduce)
+      let n and m be the smallest integers such that for all
+      keys part of replaced, n is smaller and n + 2^m is strictly larger.
+      Then new_tree is the map such that for each key, n <= key < n + 2^m,
+      [find key new_tree] is [Some value] *)
+  val replace_subtree : replaced:t -> value -> t -> t
+
+  val fold : (key -> mask -> value -> 'a -> 'a) -> t -> 'a -> 'a
+
+  module type Map_Reduce = sig
+    type result
+    val default : result
+    val map : t -> key -> value -> result
+    val reduce : t -> result -> result -> result
+  end
+  module Map_Reduce(M:Map_Reduce) : sig
+    (** run has a constant amortized complexity *)
+    val run : t -> M.result
+
+    (** [filter f t] assumes that the composition of [f] and [reduce]
+        is monotonic i.e.
+        for any [t], if [f (reduce t x y) = true] then [f x = true]
+        and [f y = true].
+
+        For efficiency reason, you should also ensure that
+        if [f (reduce t x y) = false] then either [f x = false] or
+        [f y = false].
+        It is not required for correctness, but is needed to get a
+        constant amortized complexity.
+    *)
+    val filter : (M.result -> bool) -> t -> t
+  end
+
+end
+
+module Make_LE(V:Value) : S with type key = int and type value = V.t and type mask = int
+module Make_BE(V:Value) : S with type key = int and type value = V.t and type mask = int
+module Make_BE_gen(V:Value)(B:Bits) : S with type key = B.t and type value = V.t and type mask = B.t
+module Make_BE_sized(V:Value)(S:Size) : S with type key = Bits(S).t and type value = V.t and type mask = Bits(S).t
diff --git a/vendors/tezos-modded/src/lib_stdlib/logging.ml b/vendors/tezos-modded/src/lib_stdlib/logging.ml
new file mode 100644
index 000000000..7f0a9bbc6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/logging.ml
@@ -0,0 +1,251 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type ('a, 'b) msgf =
+  (('a, Format.formatter, unit, 'b) format4 -> ?tags:Tag.set -> 'a) -> ?tags:Tag.set -> 'b
+
+type ('a, 'b) log = ('a, 'b) msgf -> 'b
+
+module type MESSAGE = sig
+  val name: string
+end
+
+type level = Lwt_log_core.level =
+  | Debug
+  (** Debugging message. They can be automatically removed by the
+      syntax extension. *)
+  | Info
+  (** Informational message. Suitable to be displayed when the
+      program is in verbose mode. *)
+  | Notice
+  (** Same as {!Info}, but is displayed by default. *)
+  | Warning
+  (** Something strange happend *)
+  | Error
+  (** An error message, which should not means the end of the
+      program. *)
+  | Fatal
+
+type log_section = ..
+
+type log_message = {
+  section : log_section ;
+  level : level ;
+  text : string option ;
+  tags : Tag.set ;
+}
+
+type tap_id = int
+let next_tap : int ref = ref 0
+
+type tap = {
+  id : tap_id ;
+  process : log_message -> unit ;
+}
+
+let taps : tap list ref = ref []
+
+let tap process = let id = !next_tap in
+  begin
+    next_tap := id + 1 ;
+    taps := { id ; process } :: !taps ;
+    id
+  end
+
+let untap x = taps := List.filter (fun tap -> tap.id <> x) !taps
+
+let call_taps v = List.iter (fun tap -> tap.process v) !taps
+
+module type SEMLOG = sig
+
+  type log_section += Section
+
+  module Tag = Tag
+
+  val debug: ('a, unit) log
+  val log_info: ('a, unit) log
+  val log_notice: ('a, unit) log
+  val warn: ('a, unit) log
+  val log_error: ('a, unit) log
+  val fatal_error: ('a, unit) log
+
+  val lwt_debug: ('a, unit Lwt.t) log
+  val lwt_log_info: ('a, unit Lwt.t) log
+  val lwt_log_notice: ('a, unit Lwt.t) log
+  val lwt_warn: ('a, unit Lwt.t) log
+  val lwt_log_error: ('a, unit Lwt.t) log
+  val lwt_fatal_error: ('a, unit Lwt.t) log
+
+  val event : string Tag.def
+  val exn : exn Tag.def
+
+end
+
+let sections = ref []
+
+let event = Tag.def ~doc:"String identifier for the class of event being logged" "event" Format.pp_print_text
+let exn = Tag.def ~doc:"Exception which was detected" "exception" (fun f e -> Format.pp_print_text f (Printexc.to_string e))
+
+module Make_semantic(S : MESSAGE) : SEMLOG = struct
+
+  include S
+
+  type log_section += Section
+
+  module Tag = Tag
+
+  let () = sections := S.name :: !sections
+  let section = Lwt_log_core.Section.make S.name
+
+
+  let log_f ~level =
+    if level < Lwt_log_core.Section.level section then
+      fun format ?(tags=Tag.empty) ->
+        Format.ikfprintf
+          (fun _ -> call_taps { section = Section ; level ; text = None ; tags }; Lwt.return_unit)
+          Format.std_formatter
+          format
+    else
+      fun format ?(tags=Tag.empty) ->
+        Format.kasprintf
+          (fun text ->
+             call_taps { section = Section ; level ; text = Some text ; tags };
+             Lwt_log_core.log ~section ~level text)
+          format
+
+  let ign_log_f ~level =
+    if level < Lwt_log_core.Section.level section then
+      fun format ?(tags=Tag.empty) ->
+        Format.ikfprintf
+          (fun _ -> call_taps { section = Section ; level ; text = None ; tags })
+          Format.std_formatter
+          format
+    else
+      fun format ?(tags=Tag.empty) ->
+        Format.kasprintf
+          (fun text ->
+             call_taps { section = Section ; level ; text = Some text ; tags };
+             Lwt_log_core.ign_log ~section ~level text)
+          format
+
+  let debug f = f (ign_log_f ~level:Lwt_log_core.Debug) ?tags:(Some Tag.empty)
+  let log_info f = f (ign_log_f ~level:Lwt_log_core.Info) ?tags:(Some Tag.empty)
+  let log_notice f = f (ign_log_f ~level:Lwt_log_core.Notice) ?tags:(Some Tag.empty)
+  let warn f = f (ign_log_f ~level:Lwt_log_core.Warning) ?tags:(Some Tag.empty)
+  let log_error f = f (ign_log_f ~level:Lwt_log_core.Error) ?tags:(Some Tag.empty)
+  let fatal_error f = f (ign_log_f ~level:Lwt_log_core.Fatal) ?tags:(Some Tag.empty)
+
+  let lwt_debug f = f (log_f ~level:Lwt_log_core.Debug) ?tags:(Some Tag.empty)
+  let lwt_log_info f = f (log_f ~level:Lwt_log_core.Info) ?tags:(Some Tag.empty)
+  let lwt_log_notice f = f (log_f ~level:Lwt_log_core.Notice) ?tags:(Some Tag.empty)
+  let lwt_warn f = f (log_f ~level:Lwt_log_core.Warning) ?tags:(Some Tag.empty)
+  let lwt_log_error f = f (log_f ~level:Lwt_log_core.Error) ?tags:(Some Tag.empty)
+  let lwt_fatal_error f = f (log_f ~level:Lwt_log_core.Fatal) ?tags:(Some Tag.empty)
+
+  let event = event
+  let exn = exn
+
+end
+
+module type LOG = sig
+
+  type log_section += Section
+
+  val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_info: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_notice: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val warn: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val fatal_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+
+  val lwt_debug: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_info: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_notice: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_warn: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_fatal_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+
+end
+
+let sections = ref []
+
+module Make_unregistered(S : MESSAGE) : LOG = struct
+
+  let section = Lwt_log_core.Section.make S.name
+  type log_section += Section
+
+  let log_f
+      ?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
+    if level < Lwt_log_core.Section.level section then
+      Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
+    else
+      Format.kasprintf
+        (fun msg ->
+           call_taps { section = Section ; level ; text = Some msg ; tags = Tag.empty };
+           Lwt_log_core.log ?exn ~section ?location ?logger ~level msg)
+        format
+
+  let ign_log_f
+      ?exn ?(section = Lwt_log_core.Section.main) ?location ?logger ~level format =
+    if level < Lwt_log_core.Section.level section then
+      Format.ikfprintf (fun _ -> ()) Format.std_formatter format
+    else
+      Format.kasprintf
+        (fun msg ->
+           call_taps { section = Section ; level ; text = Some msg ; tags = Tag.empty };
+           Lwt_log_core.ign_log ?exn ~section ?location ?logger ~level msg)
+        format
+
+  let debug fmt = ign_log_f ~section ~level:Lwt_log_core.Debug fmt
+  let log_info fmt = ign_log_f ~section ~level:Lwt_log_core.Info fmt
+  let log_notice fmt = ign_log_f ~section ~level:Lwt_log_core.Notice fmt
+  let warn fmt = ign_log_f ~section ~level:Lwt_log_core.Warning fmt
+  let log_error fmt = ign_log_f ~section ~level:Lwt_log_core.Error fmt
+  let fatal_error fmt = ign_log_f ~section ~level:Lwt_log_core.Fatal fmt
+
+  let lwt_debug fmt = log_f ~section ~level:Lwt_log_core.Debug fmt
+  let lwt_log_info fmt = log_f ~section ~level:Lwt_log_core.Info fmt
+  let lwt_log_notice fmt = log_f ~section ~level:Lwt_log_core.Notice fmt
+  let lwt_warn fmt = log_f ~section ~level:Lwt_log_core.Warning fmt
+  let lwt_log_error fmt = log_f ~section ~level:Lwt_log_core.Error fmt
+  let lwt_fatal_error fmt = log_f ~section ~level:Lwt_log_core.Fatal fmt
+
+end
+
+module Make(S : MESSAGE) : LOG = struct
+
+  let () = sections := S.name :: !sections
+  include Make_unregistered(S)
+
+end
+
+module Core = struct
+  include Make_semantic(struct let name = "core" end)
+
+  let worker = Tag.def ~doc:"Name of affected worker" "worker" Format.pp_print_text
+end
+
+type template = Lwt_log_core.template
+let default_template = "$(date) - $(section): $(message)"
diff --git a/vendors/tezos-modded/src/lib_stdlib/logging.mli b/vendors/tezos-modded/src/lib_stdlib/logging.mli
new file mode 100644
index 000000000..cd408464c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/logging.mli
@@ -0,0 +1,130 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type level = Lwt_log_core.level =
+  | Debug
+  (** Debugging message. They can be automatically removed by the
+      syntax extension. *)
+  | Info
+  (** Informational message. Suitable to be displayed when the
+      program is in verbose mode. *)
+  | Notice
+  (** Same as {!Info}, but is displayed by default. *)
+  | Warning
+  (** Something strange happend *)
+  | Error
+  (** An error message, which should not means the end of the
+      program. *)
+  | Fatal
+
+(** Unique tag for a logging module.
+    Match against, e.g. `Logging.Core.Section`.  *)
+type log_section = private ..
+
+type log_message = {
+  section : log_section ;
+  level : level ;
+  text : string option ;
+  tags : Tag.set ;
+}
+
+type tap_id
+
+(** Intercept events as they are logged.  All events will generate a call to
+    your tap function, but `text` will only be included for events that
+    actually print a message according to the active logging configuration.  *)
+val tap : (log_message -> unit) -> tap_id
+
+(** Remove a previously set tap by supplying its tap_id.  Does nothing if
+    the tap was removed already.  *)
+val untap : tap_id -> unit
+
+type ('a,'b) msgf = (('a, Format.formatter, unit, 'b) format4 -> ?tags:Tag.set -> 'a) -> ?tags:Tag.set -> 'b
+type ('a,'b) log = ('a,'b) msgf -> 'b
+
+module type MESSAGE = sig
+  val name: string
+end
+
+module type SEMLOG = sig
+
+  type log_section += Section
+
+  module Tag = Tag
+
+  val debug: ('a, unit) log
+  val log_info: ('a, unit) log
+  val log_notice: ('a, unit) log
+  val warn: ('a, unit) log
+  val log_error: ('a, unit) log
+  val fatal_error: ('a, unit) log
+
+  val lwt_debug: ('a, unit Lwt.t) log
+  val lwt_log_info: ('a, unit Lwt.t) log
+  val lwt_log_notice: ('a, unit Lwt.t) log
+  val lwt_warn: ('a, unit Lwt.t) log
+  val lwt_log_error: ('a, unit Lwt.t) log
+  val lwt_fatal_error: ('a, unit Lwt.t) log
+
+  val event : string Tag.def
+  val exn : exn Tag.def
+
+end
+
+module type LOG = sig
+
+  type log_section += Section
+
+  val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_info: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_notice: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val warn: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val fatal_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+
+  val lwt_debug: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_info: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_notice: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_warn: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_fatal_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+
+end
+
+module Core : sig
+  include SEMLOG
+
+  val worker : string Tag.def
+end
+
+module Make(S: MESSAGE) : LOG
+module Make_unregistered(S: MESSAGE) : LOG
+
+module Make_semantic(S: MESSAGE) : SEMLOG
+
+type template = Lwt_log.template
+val default_template : template
+
+val sections: string list ref
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.ml
new file mode 100644
index 000000000..91416b368
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.ml
@@ -0,0 +1,69 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+type t = {
+  cancelation: unit Lwt_condition.t ;
+  cancelation_complete: unit Lwt_condition.t ;
+  mutable cancel_hook: unit -> unit Lwt.t ;
+  mutable canceling: bool ;
+  mutable canceled: bool ;
+}
+
+let create () =
+  let cancelation = Lwt_condition.create () in
+  let cancelation_complete = Lwt_condition.create () in
+  { cancelation ; cancelation_complete ;
+    cancel_hook = (fun () -> Lwt.return_unit) ;
+    canceling = false ;
+    canceled = false ;
+  }
+
+let cancel st =
+  if st.canceled then
+    Lwt.return_unit
+  else if st.canceling then
+    Lwt_condition.wait st.cancelation_complete
+  else begin
+    st.canceling <- true ;
+    Lwt_condition.broadcast st.cancelation () ;
+    Lwt.finalize
+      st.cancel_hook
+      (fun () ->
+         st.canceled <- true ;
+         Lwt_condition.broadcast st.cancelation_complete () ;
+         Lwt.return_unit)
+  end
+
+let on_cancel st cb =
+  let hook = st.cancel_hook in
+  st.cancel_hook <- (fun () -> hook () >>= cb)
+
+let cancelation st =
+  if st.canceling then Lwt.return_unit
+  else Lwt_condition.wait st.cancelation
+
+let canceled st = st.canceling
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.mli
new file mode 100644
index 000000000..8c23d03ac
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_canceler.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** A [Canceler.t] is a three-states synchronization object with transitions
+    "waiting -> canceling -> canceled", starting in waiting state. A chain
+    of hooks can be attached to the canceler. Hooks are triggered when
+    switching to the canceling state. The canceler switches to canceled state
+    when the hooks have completed. *)
+
+type t
+
+(** [create t] returns a canceler in waiting state. *)
+val create : unit -> t
+
+(** If [t] is in wait state, [cancel t] triggers the cancelation process:
+    1. it switches to canceling state,
+    2. executes the hooks sequentially in separate Lwt threads,
+    3. waits for hooks execution to complete,
+    4. switches to cancel state.
+    If [t] is in canceled state, [cancel t] is determined immediately.
+    If [t] is in canceling state, [cancel t] is determined at the end of the
+    cancelation process. *)
+val cancel : t -> unit Lwt.t
+
+(** [cancelation t] is determined when [t] is in canceling or canceled state. *)
+val cancelation : t -> unit Lwt.t
+
+(** [on_cancel t hook] adds [hook] to the end of the current chain. *)
+val on_cancel : t -> (unit -> unit Lwt.t) -> unit
+
+(** [canceled t] is [true] iff [t] is canceled or canceling. *)
+val canceled : t -> bool
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.ml
new file mode 100644
index 000000000..f20c7a1f4
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.ml
@@ -0,0 +1,106 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+exception Closed
+
+type 'a t =
+  { mutable data : 'a option ;
+    mutable closed : bool ;
+    mutable put_waiter : (unit Lwt.t * unit Lwt.u) option ;
+  }
+
+let create () =
+  { data = None ;
+    closed = false ;
+    put_waiter = None ;
+  }
+
+let notify_put dropbox =
+  match dropbox.put_waiter with
+  | None -> ()
+  | Some (_waiter, wakener) ->
+      dropbox.put_waiter <- None ;
+      Lwt.wakeup_later wakener ()
+
+let put dropbox elt =
+  if dropbox.closed then
+    raise Closed
+  else begin
+    dropbox.data <- Some elt ;
+    notify_put dropbox
+  end
+
+let peek dropbox = dropbox.data
+
+let close dropbox =
+  if not dropbox.closed then begin
+    dropbox.closed <- true ;
+    notify_put dropbox ;
+  end
+
+let wait_put ~timeout dropbox =
+  match dropbox.put_waiter with
+  | Some (waiter, _wakener) ->
+      Lwt.choose [
+        timeout ;
+        Lwt.protected waiter
+      ]
+  | None ->
+      let waiter, wakener = Lwt.wait () in
+      dropbox.put_waiter <- Some (waiter, wakener) ;
+      Lwt.choose [
+        timeout ;
+        Lwt.protected waiter ;
+      ]
+
+let rec take dropbox =
+  match dropbox.data with
+  | Some elt ->
+      dropbox.data <- None ;
+      Lwt.return elt
+  | None ->
+      if dropbox.closed then
+        Lwt.fail Closed
+      else
+        wait_put ~timeout:(Lwt_utils.never_ending ()) dropbox >>= fun () ->
+        take dropbox
+
+let rec take_with_timeout timeout dropbox =
+  match dropbox.data with
+  | Some elt ->
+      Lwt.cancel timeout ;
+      dropbox.data <- None ;
+      Lwt.return_some elt
+  | None ->
+      if Lwt.is_sleeping timeout then
+        if dropbox.closed then
+          Lwt.fail Closed
+        else
+          wait_put ~timeout dropbox >>= fun () ->
+          take_with_timeout timeout dropbox
+      else
+        Lwt.return_none
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.mli
new file mode 100644
index 000000000..d11244055
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_dropbox.mli
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** A 'dropbox' with a single element. *)
+
+type 'a t
+(** Type of dropbox holding a value of type ['a] *)
+
+val create: unit -> 'a t
+(** Create an empty dropbox. *)
+
+val put: 'a t -> 'a -> unit
+(** Put an element inside the dropbox. If the dropbox was already
+    containing an element, the old element is replaced by the new one.
+    The function might return [Closed] if the dropbox has been closed
+    with [close]. *)
+
+val take: 'a t -> 'a Lwt.t
+(** Wait until the dropbox contains an element, then returns the elements.
+    The elements is removed from the dropbox. The function might return
+    [Closed] if the dropbox is empty and closed. *)
+
+val take_with_timeout: unit Lwt.t -> 'a t -> 'a option Lwt.t
+(** Like [take] except that it returns [None] after [timeout seconds]
+    if the dropbox is still empty. *)
+
+val peek: 'a t -> 'a option
+(** Read the current element of the dropbox without removing it. It
+    immediatly returns [None] if the dropbox is empty. *)
+
+exception Closed
+(** The exception returned when trying to access a 'closed' dropbox. *)
+
+val close: 'a t -> unit
+(** Close the dropox. It terminates all the waiting reader with the
+    exception [Closed]. All further read or write will also immediatly
+    fail with [Closed], except if the dropbox is not empty when
+    [close] is called. In that can, a single (and last) [take] will
+    succeed. *)
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.ml
new file mode 100644
index 000000000..7bac9ed2f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.ml
@@ -0,0 +1,103 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+type t =
+  { mutable pending_tasks : unit Lwt.u list ;
+    mutable pending_idle : (unit -> unit Lwt.t) list ;
+    mutable running_tasks : int ;
+    mutable running_idle : bool ;
+    mutable prevent_tasks : bool }
+
+let create () =
+  { pending_tasks = [] ;
+    pending_idle = [] ;
+    running_tasks = 0 ;
+    running_idle = false ;
+    prevent_tasks = false }
+
+let rec may_run_idle_tasks w =
+  if w.running_tasks = 0 && not w.running_idle then
+    match w.pending_idle with
+    | [] -> ()
+    | pending_idle ->
+        w.running_idle <- true ;
+        w.prevent_tasks <- false ;
+        w.pending_idle <- [] ;
+        Lwt.async (fun () ->
+            let pending_idle = List.rev pending_idle in
+            Lwt_list.iter_s (fun f -> f ()) pending_idle >>= fun () ->
+            w.running_idle <- false ;
+            let pending_tasks = List.rev w.pending_tasks in
+            w.pending_tasks <- [] ;
+            List.iter (fun u -> Lwt.wakeup u ()) pending_tasks ;
+            may_run_idle_tasks w ;
+            Lwt.return_unit)
+
+let wrap_error f =
+  Lwt.catch
+    (fun () -> f () >>= fun r -> Lwt.return (Ok r))
+    (fun exn -> Lwt.return (Error exn))
+
+let unwrap_error = function
+  | Ok r -> Lwt.return r
+  | Error exn -> Lwt.fail exn
+
+let wakeup_error u = function
+  | Ok r -> Lwt.wakeup u r
+  | Error exn -> Lwt.wakeup_exn u exn
+
+let rec task w f =
+  if w.running_idle || w.prevent_tasks then
+    let t, u = Lwt.task () in
+    w.pending_tasks <- u :: w.pending_tasks ;
+    t >>= fun () -> task w f
+  else begin
+    w.running_tasks <- w.running_tasks + 1 ;
+    wrap_error f >>= fun res ->
+    w.running_tasks <- w.running_tasks - 1 ;
+    may_run_idle_tasks w ;
+    unwrap_error res
+  end
+
+let when_idle w f =
+  let t, u = Lwt.task () in
+  let canceled = ref false in
+  Lwt.on_cancel t (fun () -> canceled := true) ;
+  let f () =
+    if !canceled then
+      Lwt.return_unit
+    else
+      wrap_error f >>= fun res ->
+      wakeup_error u res ;
+      Lwt.return_unit in
+  w.pending_idle <- f :: w.pending_idle ;
+  may_run_idle_tasks w ;
+  t
+
+let force_idle w f =
+  w.prevent_tasks <- true ;
+  when_idle w f
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.mli
new file mode 100644
index 000000000..c8e6fe48c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_idle_waiter.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+(** A lightweight scheduler to run tasks concurrently as well as
+    special callbacks that must be run in mutual exclusion with the
+    tasks (and each other). *)
+
+val create : unit -> t
+(** Creates a new task / idle callback scheduler *)
+
+val task : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Schedule a task to be run as soon as no idle callbacks is
+    running, or as soon as the next idle callback has been run if it
+    was scheduled by {!force_idle}. *)
+
+val when_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Runs a callback as soon as no task is running. Does not prevent
+    new tasks from being scheduled, the calling code should ensure
+    that some idle time will eventually come. Calling this function
+    from inside the callback will result in a dead lock. *)
+
+val force_idle : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+(** Runs a callback as soon as possible. Lets all current tasks
+    finish, but postpones all new tasks until the end of the
+    callback. Calling this function from inside the callback will
+    result in a dead lock. *)
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.ml
new file mode 100644
index 000000000..6b51645c6
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.ml
@@ -0,0 +1,233 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+type 'a t =
+  { queue : (int * 'a) Queue.t ;
+    mutable current_size : int ;
+    max_size : int ;
+    compute_size : ('a -> int) ;
+    mutable closed : bool ;
+    mutable push_waiter : (unit Lwt.t * unit Lwt.u) option ;
+    mutable pop_waiter : (unit Lwt.t * unit Lwt.u) option ;
+    empty: unit Lwt_condition.t ;
+  }
+
+let push_overhead = 4 * (Sys.word_size / 8)
+
+let create ?size () =
+  let max_size, compute_size =
+    match size with
+    | None -> max_int, (fun _ -> 0)
+    | Some (max_size, compute_size) -> max_size, compute_size in
+  { queue = Queue.create () ;
+    current_size = 0 ;
+    max_size ;
+    compute_size ;
+    closed = false ;
+    push_waiter = None ;
+    pop_waiter = None ;
+    empty = Lwt_condition.create () ;
+  }
+
+let notify_push q =
+  match q.push_waiter with
+  | None -> ()
+  | Some (_, w) ->
+      q.push_waiter <- None ;
+      Lwt.wakeup_later w ()
+
+let notify_pop q =
+  match q.pop_waiter with
+  | None -> ()
+  | Some (_, w) ->
+      q.pop_waiter <- None ;
+      Lwt.wakeup_later w ()
+
+let wait_push q =
+  match q.push_waiter with
+  | Some (t, _) -> Lwt.protected t
+  | None ->
+      let waiter, wakener = Lwt.wait () in
+      q.push_waiter <- Some (waiter, wakener) ;
+      Lwt.protected waiter
+
+let wait_pop q =
+  match q.pop_waiter with
+  | Some (t, _) -> Lwt.protected t
+  | None ->
+      let waiter, wakener = Lwt.wait () in
+      q.pop_waiter <- Some (waiter, wakener) ;
+      Lwt.protected waiter
+
+let length { queue ; _ } = Queue.length queue
+let is_empty { queue ; _ } = Queue.is_empty queue
+
+let rec empty q =
+  if is_empty q
+  then Lwt.return_unit
+  else (Lwt_condition.wait q.empty >>= fun () -> empty q)
+
+exception Closed
+
+let rec push ({ closed ; queue ; current_size ;
+                max_size ; compute_size ; _ } as q) elt =
+  let elt_size = compute_size elt in
+  if closed then
+    Lwt.fail Closed
+  else if current_size + elt_size < max_size || Queue.is_empty queue then begin
+    Queue.push (elt_size, elt) queue ;
+    q.current_size <- current_size + elt_size ;
+    notify_push q ;
+    Lwt.return_unit
+  end else
+    wait_pop q >>= fun () ->
+    push q elt
+
+let push_now ({ closed ; queue ; compute_size ;
+                current_size ; max_size ; _
+              } as q) elt =
+  if closed then raise Closed ;
+  let elt_size = compute_size elt in
+  (current_size + elt_size < max_size || Queue.is_empty queue)
+  && begin
+    Queue.push (elt_size, elt) queue ;
+    q.current_size <- current_size + elt_size ;
+    notify_push q ;
+    true
+  end
+
+exception Full
+
+let push_now_exn q elt =
+  if not (push_now q elt) then raise Full
+
+let safe_push_now q elt =
+  try push_now_exn q elt
+  with _ -> ()
+
+let rec pop ({ closed ; queue ; empty ; current_size ; _ } as q) =
+  if not (Queue.is_empty queue) then
+    let (elt_size, elt) = Queue.pop queue in
+    notify_pop q ;
+    q.current_size <- current_size - elt_size ;
+    (if Queue.length queue = 0 then Lwt_condition.signal empty ());
+    Lwt.return elt
+  else if closed then
+    Lwt.fail Closed
+  else
+    wait_push q >>= fun () ->
+    pop q
+
+let rec pop_with_timeout timeout q =
+  if not (Queue.is_empty q.queue) then begin
+    Lwt.cancel timeout ;
+    pop q >>= Lwt.return_some
+  end else if Lwt.is_sleeping timeout then
+    if q.closed then begin
+      Lwt.cancel timeout ;
+      Lwt.fail Closed
+    end else
+      let waiter = wait_push q in
+      Lwt.choose [
+        timeout ;
+        Lwt.protected waiter ;
+      ] >>= fun () ->
+      pop_with_timeout timeout q
+  else
+    Lwt.return_none
+
+let rec peek ({ closed ; queue ; _ } as q) =
+  if not (Queue.is_empty queue) then
+    let (_elt_size, elt) = Queue.peek queue in
+    Lwt.return elt
+  else if closed then
+    Lwt.fail Closed
+  else
+    wait_push q >>= fun () ->
+    peek q
+
+let peek_all { queue ; closed ; _ } =
+  if closed then
+    []
+  else
+    List.rev (Queue.fold (fun acc (_, e) -> e :: acc) [] queue)
+
+exception Empty
+
+let pop_now_exn ({ closed ; queue ; empty ; current_size ; _ } as q) =
+  if Queue.is_empty queue then
+    (if closed then raise Closed else raise Empty) ;
+  let (elt_size, elt) = Queue.pop queue in
+  (if Queue.length queue = 0 then Lwt_condition.signal empty ());
+  q.current_size <- current_size - elt_size ;
+  notify_pop q ;
+  elt
+
+let pop_now q =
+  match pop_now_exn q with
+  | exception Empty -> None
+  | elt -> Some elt
+
+let rec values_available q =
+  if is_empty q then
+    if q.closed then
+      raise Closed
+    else
+      wait_push q >>= fun () ->
+      values_available q
+  else
+    Lwt.return_unit
+
+let rec pop_all_loop q acc =
+  match pop_now_exn q with
+  | exception Empty -> List.rev acc
+  | e -> pop_all_loop q (e :: acc)
+
+let pop_all q =
+  pop q >>= fun e ->
+  Lwt.return (pop_all_loop q [e])
+
+let pop_all_now q =
+  pop_all_loop q []
+
+let close q =
+  if not q.closed then begin
+    q.closed <- true ;
+    notify_push q ;
+    notify_pop q ;
+  end
+
+let rec iter q ~f =
+  Lwt.catch begin fun () ->
+    pop q >>= fun elt ->
+    f elt >>= fun () ->
+    iter q ~f
+  end begin function
+    | Closed -> Lwt.return_unit
+    | exn -> Lwt.fail exn
+  end
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.mli
new file mode 100644
index 000000000..b9feaaade
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_pipe.mli
@@ -0,0 +1,127 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Data queues similar to the [Pipe] module in Jane Street's [Async]
+    library. They are implemented with [Queue]s, limited in size, and
+    use lwt primitives for concurrent access. *)
+
+type 'a t
+(** Type of queues holding values of type ['a]. *)
+
+val create : ?size:(int * ('a -> int)) -> unit -> 'a t
+(** [create ~size:(max_size, compute_size)] is an empty queue that can
+    hold max [size] bytes of data, using [compute_size] to compute the
+    size of a datum. If want to count allocated bytes precisely, you
+    need to add [push_overhead] to the result of[compute_size].
+    When no [size] argument is provided, the queue is unbounded. *)
+
+val push : 'a t -> 'a -> unit Lwt.t
+(** [push q v] is a thread that blocks while [q] contains more
+    than [size] elements, then adds [v] at the end of [q]. *)
+
+val pop : 'a t -> 'a Lwt.t
+(** [pop q] is a thread that blocks while [q] is empty, then
+    removes and returns the first element in [q]. *)
+
+val pop_with_timeout : unit Lwt.t -> 'a t -> 'a option Lwt.t
+(** [pop t q] is a thread that blocks while [q] is empty, then
+    removes and returns the first element [v] in [q] and
+    to return [Some v], unless no message could be popped
+    in [t] seconds, in which case it returns [None].
+    As concurrent readers are allowed, [None] does not
+    necessarily mean that no value has been pushed. *)
+
+val pop_all : 'a t -> 'a list Lwt.t
+(** [pop_all q] is a thread that blocks while [q] is empty, then
+    removes and returns all the element in [q] (in the order they
+    were inserted). *)
+
+val pop_all_now : 'a t -> 'a list
+(** [pop_all_now q] returns all the element in [q] (in the order they
+    were inserted), or [[]] if [q] is empty. *)
+
+val peek : 'a t -> 'a Lwt.t
+(** [peek] is like [pop] except it does not removes the first
+    element. *)
+
+val peek_all : 'a t -> 'a list
+(** [peek_all q] returns the elements in the [q] (oldest first),
+    or [[]] if empty. *)
+
+val values_available : 'a t -> unit Lwt.t
+(** [values_available] is like [peek] but it ignores the value
+    returned. *)
+
+val push_now : 'a t -> 'a -> bool
+(** [push_now q v] adds [v] at the ends of [q] immediately and returns
+    [false] if [q] is currently full, [true] otherwise. *)
+
+exception Full
+
+val push_now_exn : 'a t -> 'a -> unit
+(** [push_now q v] adds [v] at the ends of [q] immediately or
+    raise [Full] if [q] is currently full. *)
+
+val safe_push_now : 'a t -> 'a -> unit
+(** [safe_push_now q v] may adds [v] at the ends of [q]. It does
+    nothing if the queue is fulled or closed. *)
+
+val pop_now : 'a t -> 'a option
+(** [pop_now q] maybe removes and returns the first element in [q] if
+    [q] contains at least one element. *)
+
+exception Empty
+
+val pop_now_exn : 'a t -> 'a
+(** [pop_now_exn q] removes and returns the first element in [q] if
+    [q] contains at least one element, or raise [Empty] otherwise. *)
+
+val length : 'a t -> int
+(** [length q] is the number of elements in [q]. *)
+
+val is_empty : 'a t -> bool
+(** [is_empty q] is [true] if [q] is empty, [false] otherwise. *)
+
+val empty : 'a t -> unit Lwt.t
+(** [empty q] returns when [q] becomes empty. *)
+
+val iter : 'a t -> f:('a -> unit Lwt.t) -> unit Lwt.t
+(** [iter q ~f] pops all elements of [q] and applies [f] on them. *)
+
+exception Closed
+
+val close : 'a t -> unit
+(** [close q] the write end of [q]:
+
+    * Future write attempts will fail with [Closed].
+    * If there are reads blocked, they will unblock and fail with [Closed].
+    * Future read attempts will drain the data until there is no data left.
+
+    Thus, after a pipe has been closed, reads never block.
+    Close is idempotent.
+*)
+
+val push_overhead: int
+(** The allocated size in bytes when pushing in the queue. *)
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_utils.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_utils.ml
new file mode 100644
index 000000000..35a7d23da
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_utils.ml
@@ -0,0 +1,193 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module LC = Lwt_condition
+
+open Lwt.Infix
+open Logging.Core
+
+let may ~f = function
+  | None -> Lwt.return_unit
+  | Some x -> f x
+
+let never_ending () = fst (Lwt.wait ())
+
+type trigger =
+  | Absent
+  | Present
+  | Waiting of unit Lwt.t * unit Lwt.u
+
+let trigger () : (unit -> unit) * (unit -> unit Lwt.t) =
+  let state = ref Absent in
+  let trigger () =
+    match !state with
+    | Absent -> state := Present
+    | Present -> ()
+    | Waiting (_waiter, wakener) ->
+        state := Absent;
+        Lwt.wakeup wakener ()
+  in
+  let wait () =
+    match !state with
+    | Absent ->
+        let waiter, wakener = Lwt.wait () in
+        state := Waiting (waiter, wakener) ;
+        waiter
+    | Present ->
+        state := Absent;
+        Lwt.return_unit
+    | Waiting (waiter, _wakener)  ->
+        waiter
+  in
+  trigger, wait
+
+(* A worker launcher, takes a cancel callback to call upon *)
+let worker name ~run ~cancel =
+  let stop = LC.create () in
+  let fail e =
+    log_error Tag.DSL.(fun f ->
+        f "%s worker failed with %a"
+        -% t event "worker_failed"
+        -% s worker name
+        -% a exn e) ;
+    cancel ()
+  in
+  let waiter = LC.wait stop in
+  log_info Tag.DSL.(fun f ->
+      f "%s worker started"
+      -% t event "worker_started"
+      -% s worker name) ;
+  Lwt.async
+    (fun () ->
+       Lwt.catch run fail >>= fun () ->
+       LC.signal stop ();
+       Lwt.return_unit) ;
+  waiter >>= fun () ->
+  log_info Tag.DSL.(fun f ->
+      f "%s worker ended"
+      -% t event "worker_finished"
+      -% s worker name) ;
+  Lwt.return_unit
+
+
+let rec chop k l =
+  if k = 0 then l else begin
+    match l with
+    | _::t -> chop (k-1) t
+    | _ -> assert false
+  end
+let stable_sort cmp l =
+  let rec rev_merge l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> Lwt.return (List.rev_append l2 accu)
+    | l1, [] -> Lwt.return (List.rev_append l1 accu)
+    | h1::t1, h2::t2 ->
+        cmp h1 h2 >>= function
+        | x when x <= 0 -> rev_merge t1 l2 (h1::accu)
+        | _             -> rev_merge l1 t2 (h2::accu)
+  in
+  let rec rev_merge_rev l1 l2 accu =
+    match l1, l2 with
+    | [], l2 -> Lwt.return (List.rev_append l2 accu)
+    | l1, [] -> Lwt.return (List.rev_append l1 accu)
+    | h1::t1, h2::t2 ->
+        cmp h1 h2 >>= function
+        | x when x > 0 -> rev_merge_rev t1 l2 (h1::accu)
+        | _            -> rev_merge_rev l1 t2 (h2::accu)
+  in
+  let rec sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ -> begin
+        cmp x1 x2 >|= function
+        | x when x <= 0 -> [x1; x2]
+        | _             -> [x2; x1]
+      end
+    | 3, x1 :: x2 :: x3 :: _ -> begin
+        cmp x1 x2 >>= function
+        | x when x <= 0 -> begin
+            cmp x2 x3 >>= function
+            | x when x <= 0 -> Lwt.return [x1; x2; x3]
+            | _ -> cmp x1 x3 >|= function
+              | x when x <= 0 -> [x1; x3; x2]
+              | _ -> [x3; x1; x2]
+          end
+        | _ -> begin
+            cmp x1 x3 >>= function
+            | x when x <= 0 -> Lwt.return [x2; x1; x3]
+            | _ -> cmp x2 x3 >|= function
+              | x when x <= 0 -> [x2; x3; x1]
+              | _ -> [x3; x2; x1]
+          end
+      end
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let l2 = chop n1 l in
+        rev_sort n1 l >>= fun s1 ->
+        rev_sort n2 l2 >>= fun s2 ->
+        rev_merge_rev s1 s2 []
+  and rev_sort n l =
+    match n, l with
+    | 2, x1 :: x2 :: _ -> begin
+        cmp x1 x2 >|= function
+        | x when x > 0 -> [x1; x2]
+        | _ -> [x2; x1]
+      end
+    | 3, x1 :: x2 :: x3 :: _ -> begin
+        cmp x1 x2 >>= function
+        | x when x > 0 -> begin
+            cmp x2 x3 >>= function
+            | x when x > 0 -> Lwt.return [x1; x2; x3]
+            | _ ->
+                cmp x1 x3 >|= function
+                | x when x > 0 -> [x1; x3; x2]
+                | _ -> [x3; x1; x2]
+          end
+        | _ -> begin
+            cmp x1 x3 >>= function
+            | x when x > 0 -> Lwt.return [x2; x1; x3]
+            | _ ->
+                cmp x2 x3 >|= function
+                | x when x > 0 -> [x2; x3; x1]
+                | _ -> [x3; x2; x1]
+          end
+      end
+    | n, l ->
+        let n1 = n asr 1 in
+        let n2 = n - n1 in
+        let l2 = chop n1 l in
+        sort n1 l >>= fun s1 ->
+        sort n2 l2 >>= fun s2 ->
+        rev_merge s1 s2 []
+  in
+  let len = List.length l in
+  if len < 2 then Lwt.return l else sort len l
+
+let sort = stable_sort
+
+let unless cond f =
+  if cond then Lwt.return_unit else f ()
+
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_utils.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_utils.mli
new file mode 100644
index 000000000..437c7da2e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_utils.mli
@@ -0,0 +1,43 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 may: f:('a -> unit Lwt.t) -> 'a option -> unit Lwt.t
+
+val never_ending: unit -> 'a Lwt.t
+
+(** [worker name ~run ~cancel] runs worker [run], and logs worker
+    creation, ending or failure. [cancel] is called if worker fails. *)
+val worker:
+  string ->
+  run:(unit -> unit Lwt.t) ->
+  cancel:(unit -> unit Lwt.t) ->
+  unit Lwt.t
+
+val trigger: unit -> (unit -> unit) * (unit -> unit Lwt.t)
+
+val sort: ('a -> 'a -> int Lwt.t) -> 'a list -> 'a list Lwt.t
+
+val unless: bool -> (unit -> unit Lwt.t) -> unit Lwt.t
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.ml b/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.ml
new file mode 100644
index 000000000..ad594e923
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.ml
@@ -0,0 +1,75 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a inner_stopper = {
+  id: int ;
+  push: ('a option -> unit) ;
+  mutable active : bool;
+  input : 'a input;
+}
+
+and 'a input =
+  { mutable watchers : 'a inner_stopper list;
+    mutable cpt : int; }
+
+type stopper = unit -> unit
+
+let create_input () =
+  { watchers = [];
+    cpt = 0 }
+
+let shutdown_input input =
+  let { watchers ; _ } = input in
+  List.iter (fun w ->
+      w.active <- false ;
+      w.push None
+    ) watchers ;
+  input.cpt <- 0 ;
+  input.watchers <- []
+
+let create_fake_stream () =
+  let str, push = Lwt_stream.create () in
+  str, (fun () -> push None)
+
+let notify input info =
+  List.iter (fun w -> w.push (Some info)) input.watchers
+
+let shutdown_output output =
+  if output.active then begin
+    output.active <- false;
+    output.push None;
+    output.input.watchers <-
+      List.filter (fun w -> w.id <> output.id) output.input.watchers;
+  end
+
+let create_stream input =
+  input.cpt <- input.cpt + 1;
+  let id = input.cpt in
+  let stream, push = Lwt_stream.create () in
+  let output = { id; push; input; active = true } in
+  input.watchers <- output :: input.watchers;
+  stream, (fun () -> shutdown_output output)
+
+let shutdown f = f ()
diff --git a/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.mli b/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.mli
new file mode 100644
index 000000000..73c94e0df
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/lwt_watcher.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** This module implements a one-to-many publish/suscribe pattern.
+
+    Clients can register/unregister to an [input]. Events notified to the input
+    (through [notify]) are dispatched asynchronously to all registered clients
+    through an [Lwt_stream]. A client receives only events sent after
+    registration and before unregistration. *)
+
+type 'a input
+
+val create_input : unit -> 'a input
+
+(** [notify t v] publishes value v to the input t *)
+val notify : 'a input -> 'a -> unit
+
+type stopper
+
+(** [create_stream t] registers a new client which can read published
+    values via a stream. A [stopper] is used to shutdown the client. *)
+val create_stream : 'a input -> 'a Lwt_stream.t * stopper
+
+(** A fake stream never receives any value. *)
+val create_fake_stream : unit -> 'a Lwt_stream.t * stopper
+
+(** [shutdown s] unregisters the client associated to [s]. [None] is pushed
+    to the stream. *)
+val shutdown : stopper -> unit
+
+(** Shutdowns all the clients of this input *)
+val shutdown_input : 'a input -> unit
diff --git a/vendors/tezos-modded/src/lib_stdlib/mBytes.ml b/vendors/tezos-modded/src/lib_stdlib/mBytes.ml
new file mode 100644
index 000000000..70a8a382a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/mBytes.ml
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Bigstring
+
+include EndianBigstring.BigEndian
+module LE = EndianBigstring.LittleEndian
+
+let make sz c =
+  let buf = create sz in
+  fill buf c ;
+  buf
+
+let to_hex t =
+  Hex.of_cstruct (Cstruct.of_bigarray t)
+
+let of_hex hex =
+  Cstruct.to_bigarray (Hex.to_cstruct hex)
+
+let pp_hex ppf s =
+  let `Hex hex = to_hex s in
+  Format.pp_print_string ppf hex
+
+let cut ?(copy=false) sz bytes =
+  let length = length bytes in
+  if length <= sz then
+    [bytes] (* if the result fits in the given sz *)
+  else
+    let may_copy = if copy then Bigstring.copy else fun t -> t in
+    let nb_full = length / sz in (* nb of blocks of size sz *)
+    let sz_full = nb_full * sz in (* size of the full part *)
+    let acc = (* eventually init acc with a non-full block *)
+      if sz_full = length then []
+      else [may_copy (sub bytes sz_full (length - sz_full))]
+    in
+    let rec split_full_blocks curr_upper_limit acc =
+      let start = curr_upper_limit - sz in
+      assert (start >= 0);
+      (* copy the block [ start, curr_upper_limit [ of size sz *)
+      let acc = (may_copy (sub bytes start sz)) :: acc in
+      if start = 0 then acc else split_full_blocks start acc
+    in
+    split_full_blocks sz_full acc
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = Bigstring.compare
+  end)
diff --git a/vendors/tezos-modded/src/lib_stdlib/mBytes.mli b/vendors/tezos-modded/src/lib_stdlib/mBytes.mli
new file mode 100644
index 000000000..a96c7af13
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/mBytes.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Low-level byte array querying and manipulation.
+
+    Default layout for numeric operations is big-endian.
+    Little-endian operations in the LE submodule. **)
+
+include module type of Bigstring
+include Compare.S with type t := t
+
+include EndianBigstring.EndianBigstringSig
+module LE : EndianBigstring.EndianBigstringSig
+
+val make : int -> char -> t
+val of_hex : Hex.t -> t
+val to_hex : t -> Hex.t
+val pp_hex : Format.formatter -> t -> unit
+
+(** [cut ?copy size bytes] cut [bytes] the in a list of successive
+    chunks of length [size] at most.
+
+    If [copy] is false (default), the blocks of the list
+    can be garbage-collected only when all the blocks are
+    unreachable (because of the 'optimized' implementation of
+    [sub] used internally. *)
+val cut: ?copy:bool -> int  -> t -> t list
diff --git a/vendors/tezos-modded/src/lib_stdlib/option.ml b/vendors/tezos-modded/src/lib_stdlib/option.ml
new file mode 100644
index 000000000..e0e44d6f2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/option.ml
@@ -0,0 +1,68 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 map ~f = function
+  | None -> None
+  | Some x -> Some (f x)
+
+let apply ~f = function
+  | None -> None
+  | Some x -> f x
+
+let (>>=) x f = apply ~f x
+let (>>|) x f = map ~f x
+
+let iter ~f = function
+  | None -> ()
+  | Some x -> f x
+
+let unopt ~default = function
+  | None -> default
+  | Some x -> x
+
+let unopt_map ~f ~default = function
+  | None -> default
+  | Some x -> f x
+
+let unopt_exn err = function
+  | Some x -> x
+  | _ -> raise err
+
+let first_some a b = match a, b with
+  | None, None -> None
+  | None, Some v -> Some v
+  | Some v, _ -> Some v
+
+let try_with f =
+  try Some (f ()) with _ -> None
+
+let some x = Some x
+
+let pp ?(default="") data_pp ppf opt =
+  unopt_map
+    ~f:(fun i -> data_pp ppf i)
+    ~default:(Format.pp_print_string ppf default)
+    opt
diff --git a/vendors/tezos-modded/src/lib_stdlib/option.mli b/vendors/tezos-modded/src/lib_stdlib/option.mli
new file mode 100644
index 000000000..64d9ab4bf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/option.mli
@@ -0,0 +1,59 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2019 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** [Some (f x)] if input is [Some x], or [None] if it's [None] **)
+val map: f:('a -> 'b) -> 'a option -> 'b option
+
+(** [(f x)] if input is [Some x], or [None] if it's [None] **)
+val apply: f:('a -> 'b option) -> 'a option -> 'b option
+
+val (>>=) : 'a option -> ('a -> 'b option) -> 'b option
+val (>>|) : 'a option -> ('a -> 'b) -> 'b option
+
+(** Call [(f x)] if input is [Some x], noop if it's [None] **)
+val iter: f:('a -> unit) -> 'a option -> unit
+
+(** [x] if input is [Some x], default if it's [None] **)
+val unopt: default:'a -> 'a option -> 'a
+
+(** [unopt_map f d x] is [y] if [x] is [Some y], [d] if [x] is [None] **)
+val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b
+
+(** [unopt_exn exn x] is [y] if [x] is [Some y], or raises [exn] if [x] is [None] *)
+val unopt_exn : exn -> 'a option -> 'a
+
+(** First input of form [Some x], or [None] if none **)
+val first_some: 'a option -> 'a option -> 'a option
+
+(** [Some (f ())] if [f] does not raise, [None] otherwise *)
+val try_with : (unit -> 'a) -> 'a option
+
+(** Make an option of a value *)
+val some : 'a -> 'a option
+
+(** [pp ~default data_pp ppf x] pretty-print value [x] using [data_pp]
+    or [default] ([""] by default) string if there is no value. *)
+val pp: ?default:string ->(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
diff --git a/vendors/tezos-modded/src/lib_stdlib/registry.ml b/vendors/tezos-modded/src/lib_stdlib/registry.ml
new file mode 100644
index 000000000..c76d20912
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/registry.ml
@@ -0,0 +1,57 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type S = sig
+  type k
+  type v
+  val register: k -> v -> unit
+  val alter: k -> (v -> v) -> unit
+  val remove: k -> unit
+  val query: k -> v option
+  val iter_p: (k -> v -> unit Lwt.t) -> unit Lwt.t
+  val fold: (k -> v -> 'a -> 'a) -> 'a -> 'a
+end
+
+module Make (M: sig type v include Map.OrderedType end) : S
+  with type k = M.t
+   and type v = M.v =
+struct
+
+  module Reg = Map.Make(M)
+  type v = M.v
+  type k = Reg.key
+  let registry: v Reg.t ref = ref Reg.empty
+  let register k v = registry := Reg.add k v !registry
+  let alter k f =
+    match Reg.find_opt k !registry with
+    | None -> ()
+    | Some v -> registry := Reg.add k (f v) !registry
+  let remove k = registry := Reg.remove k !registry
+  let query k = Reg.find_opt k !registry
+  let iter_p f = Lwt.join (Reg.fold (fun k v acc -> (f k v) :: acc) !registry [])
+  let fold f a = Reg.fold f !registry a
+
+end
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/registry.mli b/vendors/tezos-modded/src/lib_stdlib/registry.mli
new file mode 100644
index 000000000..f8e0d89a1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/registry.mli
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** A simple imperative map *)
+
+module type S = sig
+  type k
+  type v
+  val register: k -> v -> unit
+  val alter: k -> (v -> v) -> unit
+  val remove: k -> unit
+  val query: k -> v option
+  val iter_p: (k -> v -> unit Lwt.t) -> unit Lwt.t
+  val fold: (k -> v -> 'a -> 'a) -> 'a -> 'a
+end
+
+module Make (M: sig type v include Map.OrderedType end) : S
+  with type k = M.t
+   and type v = M.v
diff --git a/vendors/tezos-modded/src/lib_stdlib/ring.ml b/vendors/tezos-modded/src/lib_stdlib/ring.ml
new file mode 100644
index 000000000..027b5c012
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/ring.ml
@@ -0,0 +1,153 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Ring = struct
+  type 'a raw =
+    | Empty of int
+    | Inited of {
+        data : 'a array ;
+        mutable pos : int ;
+      }
+
+  type 'a t = 'a raw ref
+
+  let create size =
+    if size <= 0 then
+      invalid_arg "Ring.create: size must be positive"
+    else
+      ref (Empty size)
+
+  let add r v =
+    match !r with
+    | Empty size ->
+        r := Inited { data = Array.make size v ; pos = 0 }
+    | Inited s ->
+        s.pos <-
+          if s.pos = 2 * Array.length s.data - 1 then
+            Array.length s.data
+          else
+            s.pos + 1 ;
+        s.data.(s.pos mod Array.length s.data) <- v
+
+  let add_and_return_erased r v =
+    let replaced = match !r with
+      | Empty _ -> None
+      | Inited s ->
+          if s.pos >= Array.length s.data - 1 then
+            Some (s.data.((s.pos + 1) mod Array.length s.data))
+          else
+            None in
+    add r v ; replaced
+
+  let clear r =
+    match !r with
+    | Empty _ -> ()
+    | Inited { data ; _ } ->
+        r := Empty (Array.length data)
+
+
+  let add_list r l = List.iter (add r) l
+
+  let last r =
+    match !r with
+    | Empty _ -> None
+    | Inited { data ; pos } -> Some data.(pos mod Array.length data)
+
+  let fold r ~init ~f =
+    match !r with
+    | Empty _ -> init
+    | Inited { data ; pos } ->
+        let size = Array.length data in
+        let acc = ref init in
+        for i = 0 to min pos (size - 1) do
+          acc := f !acc data.((pos - i) mod size)
+        done ;
+        !acc
+
+  let elements t =
+    fold t ~init:[] ~f:(fun acc elt -> elt :: acc)
+
+  exception Empty
+
+  let last_exn r =
+    match last r with
+    | None -> raise Empty
+    | Some d -> d
+end
+
+include Ring
+
+(** Ring Buffer Table *)
+module type TABLE = sig
+  type t
+  type v
+  val create : int -> t
+  val add : t -> v -> unit
+  val mem : t -> v -> bool
+  val remove : t -> v -> unit
+  val clear : t -> unit
+  val elements : t -> v list
+end
+
+
+(* fixed size set of Peers id. If the set exceed the maximal allowed capacity, the
+   element that was added first is removed when a new one is added *)
+module MakeTable (V: Hashtbl.HashedType) = struct
+  module Table = Hashtbl.Make(V)
+
+  type raw = {
+    size : int ;
+    ring : V.t Ring.t ;
+    table : unit Table.t ;
+  }
+  type t = raw ref
+  type v = V.t
+
+  let create size = ref {
+      size;
+      ring = Ring.create size;
+      table = Table.create size }
+
+  let add {contents = t } v =
+    Option.iter
+      (Ring.add_and_return_erased t.ring v)
+      ~f:(Table.remove t.table);
+    Table.add t.table v ()
+
+  let mem {contents = t} v = Table.mem t.table v
+
+  let remove {contents = t} v =
+    Table.remove t.table v
+
+  let clear ({contents = t} as tt) =
+    tt := { t with
+            ring = Ring.create t.size;
+            table = Table.create t.size
+          }
+
+  let elements {contents = t} =
+    Table.fold (fun k _ acc -> k::acc) t.table []
+
+end
diff --git a/vendors/tezos-modded/src/lib_stdlib/ring.mli b/vendors/tezos-modded/src/lib_stdlib/ring.mli
new file mode 100644
index 000000000..e19768594
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/ring.mli
@@ -0,0 +1,89 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Imperative Ring Buffer *)
+
+(** An imperative ring buffer: a mutable structure that holds at most
+    a fixed number of values of a same type. Values are never removed,
+    once the limit is reached, adding a value replaces the oldest one
+    in the ring buffer.  *)
+exception Empty
+
+type 'a t
+
+(** Allocates a ring buffer for a given number of values. *)
+val create : int -> 'a t
+
+(** Adds a value, dropping the oldest present one if full. *)
+val add : 'a t -> 'a -> unit
+
+(** Same as {!add}, but returns the dropped value if any. *)
+val add_and_return_erased : 'a t -> 'a -> 'a option
+
+(** Adds the values of a list, in order. *)
+val add_list : 'a t -> 'a list -> unit
+
+(** Removes all values in the ring buffer. *)
+val clear : 'a t -> unit
+
+(** Retrieves the most recent value, or [None] when empty. *)
+val last : 'a t -> 'a option
+
+(** Same as {!last}, but raises {!Empty} when empty. *)
+val last_exn : 'a t -> 'a
+
+(** Iterates over the elements, oldest to newest. *)
+val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
+
+(** Retrieves the elements as a list, oldest first.. *)
+val elements : 'a t -> 'a list
+
+(** Ring Buffer Table *)
+module type TABLE = sig
+  type t
+  type v
+
+  (** [create size] inizialize an empty ring *)
+  val create : int -> t
+
+  (** [add t v] add a value to the ring. If the ring already contains size elements,
+      the first element is removed and [v] is added. *)
+  val add : t -> v -> unit
+
+  (** [mem t v] check if v is in the ring. O(1) *)
+  val mem : t -> v -> bool
+
+  (** [remove t v] remove one element from the table *)
+  val remove : t -> v -> unit
+
+  (** [retest t] remore all bindings from the current ring *)
+  val clear : t -> unit
+
+  (** [elements t] return the list of elements currently in the ring *)
+  val elements : t -> v list
+
+end
+
+module MakeTable (V: Hashtbl.HashedType) : TABLE with type v = V.t
diff --git a/vendors/tezos-modded/src/lib_stdlib/tag.ml b/vendors/tezos-modded/src/lib_stdlib/tag.ml
new file mode 100644
index 000000000..3d0efacf2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tag.ml
@@ -0,0 +1,183 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type _ selector = ..
+
+module type DEF_ARG = sig
+  val name : string
+  type t
+  val doc : string
+  val pp : Format.formatter -> t -> unit
+end
+
+module type DEF = sig
+  include DEF_ARG
+
+  type id
+  val id: id
+  type _ selector += Me : t selector
+
+  val uid : int
+
+end
+
+module Def (X : DEF_ARG): DEF with type t = X.t = struct
+  include X
+
+  type id = Id
+  let id = Id
+  type _ selector += Me : t selector
+
+  let uid = Obj.(extension_id @@ extension_constructor @@ Me)
+
+end
+
+type 'a def = (module DEF with type t = 'a)
+
+let def (type a) ?(doc = "undocumented") name pp =
+  (module Def(struct let name = name type t = a let doc = doc let pp = pp end): DEF with type t = a)
+
+type (_,_) eq = Refl : ('a,'a) eq
+
+let maybe_eq : type a b. a def -> b def -> (a,b) eq option =
+  fun s t ->
+    let module S = (val s) in
+    let module T = (val t) in
+    match S.Me with
+    | T.Me -> Some Refl
+    | _ -> None
+
+let selector_of : type a. a def -> a selector = fun d -> let module D = (val d) in D.Me
+let name : type a. a def -> string = fun d -> let module D = (val d) in D.name
+let doc : type a. a def -> string = fun d -> let module D = (val d) in D.doc
+let printer : type a. a def -> Format.formatter -> a -> unit = fun d -> let module D = (val d) in D.pp
+let pp_def ppf d = Format.fprintf ppf "tag:%s" (name d)
+
+module Key = struct
+  type t = V : 'a def -> t
+  type s = S : 'a selector -> s
+  let compare (V k0) (V k1) = compare (S (selector_of k0)) (S (selector_of k1))
+end
+
+module TagSet = Map.Make(Key)
+
+type t = V : 'a def * 'a -> t
+type binding = t
+type set = binding TagSet.t
+
+let pp ppf (V (tag, v)) =
+  Format.fprintf ppf "@[<1>(%a@ @[%a@])@]" pp_def tag (printer tag) v
+
+let option_map f = function
+  | None -> None
+  | Some v -> Some (f v)
+
+let option_bind f = function
+  | None -> None
+  | Some v -> f v
+
+let reveal2 : type a b. a def -> b def -> b -> a option = fun t u v ->
+  match maybe_eq t u with
+  | None -> None
+  | Some Refl -> Some v
+
+let reveal : 'a. 'a def -> binding -> 'a option = fun tag -> function
+  | V (another, v) -> reveal2 tag another v
+
+let unveil : 'a. 'a def -> binding option -> 'a option = fun tag -> option_bind @@ reveal tag
+
+let conceal : 'a. 'a def -> 'a -> binding = fun tag v -> V (tag, v)
+
+let veil : 'a. 'a def -> 'a option -> binding option = fun tag -> option_map @@ conceal tag
+
+let empty = TagSet.empty
+let is_empty = TagSet.is_empty
+let mem tag = TagSet.mem (Key.V tag)
+let add tag v = TagSet.add (Key.V tag) (V (tag, v))
+let update tag f = TagSet.update (Key.V tag) (fun b -> veil tag @@ f @@ unveil tag b)
+let singleton tag v = TagSet.singleton (Key.V tag) (V (tag, v))
+let remove tag = TagSet.remove (Key.V tag)
+let rem = remove
+type merger = { merger : 'a. 'a def -> 'a option -> 'a option -> 'a option }
+let merge f = TagSet.merge @@ function
+  | Key.V tag -> fun a b -> veil tag @@ f.merger tag (unveil tag a) (unveil tag b)
+type unioner = { unioner : 'a . 'a def -> 'a -> 'a -> 'a }
+let union f = merge { merger = fun tag a b ->
+    match (a,b) with
+    | (Some aa, Some bb) -> Some (f.unioner tag aa bb)
+    | (Some _, None) -> a
+    | (None, _) -> b
+  }
+(* no compare and equal, compare especially makes little sense *)
+let iter f = TagSet.iter (fun _ -> f)
+let fold f = TagSet.fold (fun _ -> f)
+let for_all p = TagSet.for_all (fun _ -> p)
+let exists p = TagSet.exists (fun _ -> p)
+let filter p = TagSet.filter (fun _ -> p)
+let partition p = TagSet.partition (fun _ -> p)
+let cardinal = TagSet.cardinal
+let bindings s = List.map snd @@ TagSet.bindings s
+let min_binding s = snd @@ TagSet.min_binding s
+let min_binding_opt s = option_map snd @@ TagSet.min_binding_opt s
+let max_binding s = snd @@ TagSet.max_binding s
+let max_binding_opt s = option_map snd @@ TagSet.max_binding_opt s
+let choose s = snd @@ TagSet.choose s
+let choose_opt s = option_map snd @@ TagSet.choose_opt s
+let split tag s = (fun (l,m,r) -> (l,unveil tag m,r)) @@ TagSet.split (Key.V tag) s
+(* In order to match the usual interface for maps, `find` should be different from
+   `find_opt` but `Logs` has `find_opt` called `find` so we favor that. *)
+let find tag s = option_bind (reveal tag) @@ TagSet.find_opt (Key.V tag) s
+let find_opt tag s = option_bind (reveal tag) @@ TagSet.find_opt (Key.V tag) s
+(* This would usually be called `find` but `Logs` has it with this name.  We can't
+   have it at both named because `Logs` has `find_opt` as `find`. *)
+let get tag s = find_opt tag s |> function
+  | None -> invalid_arg (Format.asprintf "tag named %s not found in set" (name tag))
+  | Some v -> v
+let find_first p s = snd @@ TagSet.find_first p s
+let find_first_opt p s = option_map snd @@ TagSet.find_first_opt p s
+let find_last p s = snd @@ TagSet.find_last p s
+let find_last_opt p s = option_map snd @@ TagSet.find_last_opt p s
+let map = TagSet.map
+let mapi = TagSet.map
+let pp_set ppf s = Format.(
+    fprintf ppf "@[<1>{";
+    pp_print_list pp ppf (bindings s);
+    Format.fprintf ppf "}@]")
+
+module DSL = struct
+  type (_,_,_,_) arg = | A : ('x def * 'x) -> (('b -> 'x -> 'c) -> 'x -> 'd, 'b, 'c, 'd) arg
+                       | S : ('x def * 'x) -> ('x -> 'd, 'b, 'c, 'd) arg
+                       | T : ('x def * 'x) -> ('d, 'b, 'c, 'd) arg
+  let a tag v = A (tag,v)
+  let s tag v = S (tag,v)
+  let t tag v = T (tag,v)
+
+  let pp_of_def (type a) tag = let module Tg = (val tag : DEF with type t = a) in Tg.pp
+
+  let (-%): type a d. (?tags:set -> a) -> (a,Format.formatter,unit,d) arg -> (?tags:set -> d) = fun f -> function
+    | A (tag,v) -> (fun ?(tags=empty) -> f ~tags:(add tag v tags) (pp_of_def tag) v) [@warning "-16"]
+    | S (tag,v) -> (fun ?(tags=empty) -> f ~tags:(add tag v tags) v) [@warning "-16"]
+    | T (tag,v) -> (fun ?(tags=empty) -> f ~tags:(add tag v tags)) [@warning "-16"]
+end
diff --git a/vendors/tezos-modded/src/lib_stdlib/tag.mli b/vendors/tezos-modded/src/lib_stdlib/tag.mli
new file mode 100644
index 000000000..a35f0605f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tag.mli
@@ -0,0 +1,133 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tags and tag sets.  Tags are basically similar to a plain extensible
+    variant type, but wrapped with metadata that enables them to be printed
+    generically and combined into tag sets where each tag is either not
+    present or associated with a specific value.
+
+    They are primarily intended for use with the `Logging` module but it
+    would probably be reasonable to use them for other purposes. *)
+
+(** Type of tag definitions.  Analogous to a constructor of an extensible
+    variant type, but first-class. *)
+type _ def
+
+(** Define a new tag with a name, printer, and optional documentation string.
+    This is generative, not applicative, so tag definitions created with
+    identical names and printers at different times or places will be
+    different tags!  You probably do not want to define a tag in a local
+    scope unless you have something really tricky in mind.  Basically all
+    the caveats you would have if you wrote [type t +=] apply. *)
+val def : ?doc:string -> string -> (Format.formatter -> 'a -> unit) -> 'a def
+
+val name : 'a def -> string
+val doc : 'a def -> string
+val printer : 'a def -> (Format.formatter -> 'a -> unit)
+
+(** Print the name of a tag definition. *)
+val pp_def : Format.formatter -> 'a def -> unit
+
+(** A binding consisting of a tag and value.  If a `def` is a constructor
+    of an extensible variant type, a `t` is a value of that type. *)
+type t = V : 'a def * 'a -> t
+val pp : Format.formatter -> t -> unit
+
+module Key : sig
+  type t = V : 'a def -> t
+end
+
+(** Tag sets.  If `t` is an extensible variant type, `set` is a set of `t`s
+    no two of which have the same constructor.  Most ordinary set and map
+    operations familiar from the Ocaml standard library are provided.
+    `equal` and `compare` are purposely not provided as there is no
+    meaningful ordering on tags and their arguments may not even have a
+    meaningful notion of equality. *)
+type set
+
+val empty : set
+val is_empty : set -> bool
+val mem : 'a def -> set -> bool
+val add : 'a def -> 'a -> set -> set
+val update : 'a def -> ('a option -> 'a option) -> (set -> set)
+val singleton : 'a def -> 'a -> set
+val remove : 'a def -> set -> set
+val rem : 'a def -> set -> set
+type merger = { merger : 'a. 'a def -> 'a option -> 'a option -> 'a option }
+val merge : merger -> set -> set -> set
+type unioner = { unioner : 'a. 'a def -> 'a -> 'a -> 'a }
+val union : unioner -> set -> set -> set
+val iter : (t -> unit) -> set -> unit
+val fold : (t -> 'b -> 'b) -> (set -> 'b -> 'b)
+val for_all : (t -> bool) -> (set -> bool)
+val exists : (t -> bool) -> (set -> bool)
+val filter : (t -> bool) -> set -> set
+val partition : (t -> bool) -> set -> (set * set)
+val cardinal : set -> int
+val min_binding : set -> t
+val min_binding_opt : set -> t option
+val max_binding : set -> t
+val max_binding_opt : set -> t option
+val choose : set -> t
+val choose_opt : set -> t option
+val split : 'a def -> set -> set * 'a option * set
+val find_opt : 'a def -> set -> 'a option
+val find : 'a def -> set -> 'a option
+val get : 'a def -> set -> 'a
+val find_first : (Key.t -> bool) -> set -> t
+val find_first_opt : (Key.t -> bool) -> set -> t option
+val find_last : (Key.t -> bool) -> set -> t
+val find_last_opt : (Key.t -> bool) -> set -> t option
+val map : (t -> t) -> set -> set
+val mapi : (t -> t) -> set -> set
+val pp_set : Format.formatter -> set -> unit
+
+(** DSL for logging messages.  Opening this locally makes it easy to supply a number
+    of semantic tags for a log event while using their values in the human-readable
+    text.  For example:
+
+    {[
+      lwt_log_info Tag.DSL.(fun f ->
+          f "request for operations %a:%d from peer %a timed out."
+          -% t event "request_operations_timeout"
+          -% a Block_hash.Logging.tag bh
+          -% s operations_index_tag n
+          -% a P2p_peer.Id.Logging.tag pipeline.peer_id)
+    ]} *)
+module DSL : sig
+  type (_,_,_,_) arg
+
+  (** Use a semantic tag with a `%a` format, supplying the pretty printer from the tag. *)
+  val a : 'v def -> 'v -> (('b -> 'v -> 'c) -> 'v -> 'd, 'b, 'c, 'd) arg
+
+  (** Use a semantic tag with ordinary formats such as `%s`, `%d`, and `%f`. *)
+  val s : 'v def -> 'v -> ('v -> 'd, 'b, 'c, 'd) arg
+
+  (** Supply a semantic tag without formatting it. *)
+  val t : 'v def -> 'v -> ('d, 'b, 'c, 'd) arg
+
+  (** Perform the actual application of a tag to a format. *)
+  val (-%) : (?tags:set -> 'a) -> ('a,Format.formatter,unit,'d) arg -> (?tags:set -> 'd)
+end
diff --git a/vendors/tezos-modded/src/lib_stdlib/test-ocp-indent.sh b/vendors/tezos-modded/src/lib_stdlib/test-ocp-indent.sh
new file mode 100755
index 000000000..614bd3493
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/test-ocp-indent.sh
@@ -0,0 +1,44 @@
+#!/bin/bash
+
+type ocp-indent > /dev/null 2>&-
+if [ $? -ne 0 ]; then
+  echo "I require ocp-indent but it's not installed (opam install ocp-indent). Aborting."
+  exit 1
+fi
+
+tmp_dir="$(mktemp -d -t tezos_build.XXXXXXXXXX)"
+failed=no
+if [ "$1" = "fix" ]; then
+    fix=yes
+    shift 1
+fi
+
+files="$@"
+if [ -z "$files" ]; then
+files=` find \( -name _build -or \
+                -name .git -or \
+                -name _opam -or \
+                -wholename ./src/environment/v1.ml -or \
+                -name ocplib-json-typed -or \
+                -name registerer.ml \) -prune -or \
+                \( -name \*.ml -or -name \*.mli \) -print`
+fi
+
+for f in $files ; do
+  ff=$(basename $f)
+  ocp-indent $f > $tmp_dir/$ff
+  diff -U 3 $f $tmp_dir/$ff
+  if [ $? -ne 0 ]; then
+    if [ "$fix" = "yes" ]; then
+      echo "Fix indentation $f"
+      cp $tmp_dir/$ff $f
+    else
+      failed=yes
+    fi
+  fi
+  rm -f $tmp_dir/$ff $tmp_dir/$ff.diff
+done
+
+if [ $failed = "yes" ]; then
+    exit 2
+fi
diff --git a/vendors/tezos-modded/src/lib_stdlib/test/assert.ml b/vendors/tezos-modded/src/lib_stdlib/test/assert.ml
new file mode 100644
index 000000000..5930d3990
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/test/assert.ml
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fail expected given msg =
+  Format.kasprintf failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+let fail_msg fmt = Format.kasprintf (fail "" "") fmt
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (prn x) (prn y) msg
diff --git a/vendors/tezos-modded/src/lib_stdlib/test/dune b/vendors/tezos-modded/src/lib_stdlib/test/dune
new file mode 100644
index 000000000..7220ddaa0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/test/dune
@@ -0,0 +1,32 @@
+(executables
+ (names test_tzList
+        test_lwt_pipe)
+ (libraries tezos-stdlib
+            alcotest
+            lwt.unix)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_stdlib)))
+
+(alias
+ (name buildtest)
+ (deps test_tzList.exe
+       test_lwt_pipe.exe))
+
+(alias
+ (name runtest_tzList)
+ (action (run %{exe:test_tzList.exe})))
+
+(alias
+ (name runtest_lwt_pipe)
+ (action (run %{exe:test_lwt_pipe.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_tzList)
+       (alias runtest_lwt_pipe)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_stdlib/test/test_lwt_pipe.ml b/vendors/tezos-modded/src/lib_stdlib/test/test_lwt_pipe.ml
new file mode 100644
index 000000000..f1ab67b07
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/test/test_lwt_pipe.ml
@@ -0,0 +1,76 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+let rec producer queue = function
+  | 0 ->
+      Format.eprintf "Done producing." ;
+      Lwt.return_unit
+  | n ->
+      Lwt_pipe.push queue () >>= fun () ->
+      producer queue (pred n)
+
+let rec consumer queue = function
+  | 0 ->
+      Format.eprintf "Done consuming." ;
+      Lwt.return_unit
+  | n ->
+      Lwt_pipe.pop queue >>= fun _ ->
+      consumer queue (pred n)
+
+let rec gen acc f = function
+  | 0 -> acc
+  | n -> gen (f () :: acc) f (pred n)
+
+let run qsize nbp nbc p c =
+  let q = Lwt_pipe.create ~size:(qsize, fun () -> qsize) () in
+  let producers = gen [] (fun () -> producer q p) nbp in
+  let consumers = gen [] (fun () -> consumer q c) nbc in
+  Lwt.join producers <&> Lwt.join consumers
+
+let main () =
+  let qsize = ref 10 in
+  let nb_producers = ref 10 in
+  let nb_consumers = ref 10 in
+  let produced_per_producer = ref 10 in
+  let consumed_per_consumer = ref 10 in
+  let spec = Arg.[
+      "-qsize", Set_int qsize, "<int> Size of the pipe";
+      "-nc", Set_int nb_consumers, "<int> Number of consumers";
+      "-np", Set_int nb_producers, "<int> Number of producers";
+      "-n", Set_int consumed_per_consumer, "<int> Number of consumed items per consumers";
+      "-p", Set_int produced_per_producer, "<int> Number of produced items per producers";
+      "-v", Unit (fun () -> Lwt_log_core.(add_rule "*" Info)), " Log up to info msgs";
+      "-vv", Unit (fun () -> Lwt_log_core.(add_rule "*" Debug)), " Log up to debug msgs";
+    ]
+  in
+  let anon_fun _ = () in
+  let usage_msg = "Usage: %s <num_peers>.\nArguments are:" in
+  Arg.parse spec anon_fun usage_msg;
+  run !qsize !nb_producers
+    !nb_consumers !produced_per_producer !consumed_per_consumer
+
+let () = Lwt_main.run @@ main ()
diff --git a/vendors/tezos-modded/src/lib_stdlib/test/test_tzList.ml b/vendors/tezos-modded/src/lib_stdlib/test/test_tzList.ml
new file mode 100644
index 000000000..56169cdab
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/test/test_tzList.ml
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 rec permut = function
+  | [] -> [[]]
+  | x :: xs ->
+      let insert xs =
+        let rec loop acc left right =
+          match right with
+          | [] -> List.rev (x :: left) :: acc
+          | y :: ys ->
+              loop
+                ((List.rev_append left (x :: right)) :: acc)
+                (y :: left) ys in
+        loop [] [] xs in
+      List.concat (List.map insert (permut xs))
+
+let test_take_n _ =
+  ListLabels.iter (permut [1;2;3;4;5;6;7;8;9]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 1 xs) [9]
+  end ;
+  ListLabels.iter (permut [1;2;3;4;5;6;7;8;9]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 3 xs) [7;8;9]
+  end ;
+  let inv_compare x y = compare y x in
+  ListLabels.iter (permut [1;2;3;4;5;6;7;8;9]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare:inv_compare 3 xs) [3;2;1]
+  end ;
+  (* less elements than the bound. *)
+  ListLabels.iter (permut [1;2;3;4;5;6;7;8;9]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 12 xs) [1;2;3;4;5;6;7;8;9]
+  end ;
+  (* with duplicates. *)
+  ListLabels.iter (permut [1;2;3;3;4;5;5;5;6]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 3 xs) [5;5;6]
+  end ;
+  ListLabels.iter (permut [1;2;3;3;4;5;5;5;6]) ~f:begin fun xs ->
+    Assert.equal ~msg:__LOC__ (TzList.take_n ~compare 5 xs) [4;5;5;5;6]
+  end
+
+let tests = [
+  "take_n", `Quick, test_take_n ;
+]
+
+let () =
+  Alcotest.run "stdlib" [
+    "tzList", tests ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_stdlib/tezos-stdlib.opam b/vendors/tezos-modded/src/lib_stdlib/tezos-stdlib.opam
new file mode 100644
index 000000000..aed09afc0
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tezos-stdlib.opam
@@ -0,0 +1,25 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" & < "1.7" } ## Incompatible with lwt<4
+  "bigstring"
+  "hex"
+  "ocplib-endian"
+  "re"
+  "lwt" { < "4" }
+  "zarith"
+  "alcotest" { with-test }
+  "ocp-indent" { with-test & = "1.6.1" }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_stdlib/tzList.ml b/vendors/tezos-modded/src/lib_stdlib/tzList.ml
new file mode 100644
index 000000000..725f7a7d1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tzList.ml
@@ -0,0 +1,166 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 may_cons xs x = match x with None -> xs | Some x -> x :: xs
+
+let filter_map f l =
+  List.rev @@ List.fold_left (fun acc x -> may_cons acc (f x)) [] l
+
+let rev_sub l n =
+  if n < 0 then
+    invalid_arg "Utils.rev_sub: `n` must be non-negative.";
+  let rec append_rev_sub acc l = function
+    | 0 -> acc
+    | n ->
+        match l with
+        | [] -> acc
+        | hd :: tl -> append_rev_sub (hd :: acc) tl (n - 1) in
+  append_rev_sub [] l n
+
+let sub l n = rev_sub l n |> List.rev
+
+let hd_opt = function
+  | [] -> None
+  | h :: _ -> Some h
+
+let rec last_exn = function
+  | [] -> raise Not_found
+  | [x] -> x
+  | _ :: xs -> last_exn xs
+
+let merge_filter2
+    ?(finalize = List.rev) ?(compare = compare)
+    ?(f = Option.first_some)
+    l1 l2 =
+  let sort = List.sort compare in
+  let rec merge_aux acc = function
+    | [], [] -> finalize acc
+    | r1, [] -> finalize acc @ (filter_map (fun x1 -> f (Some x1) None) r1)
+    | [], r2 -> finalize acc @ (filter_map (fun x2 -> f None (Some x2)) r2)
+    | ((h1 :: t1) as r1), ((h2 :: t2) as r2) ->
+        if compare h1 h2 > 0 then
+          merge_aux (may_cons acc (f None (Some h2))) (r1, t2)
+        else if compare h1 h2 < 0 then
+          merge_aux (may_cons acc (f (Some h1) None)) (t1, r2)
+        else (* m1 = m2 *)
+          merge_aux (may_cons acc (f (Some h1) (Some h2))) (t1, t2)
+  in
+  merge_aux [] (sort l1, sort l2)
+
+let merge2 ?finalize ?compare ?(f = fun x1 _x1 -> x1) l1 l2 =
+  merge_filter2 ?finalize ?compare
+    ~f:(fun x1 x2 -> match x1, x2 with
+        | None, None -> assert false
+        | Some x1, None -> Some x1
+        | None, Some x2 -> Some x2
+        | Some x1, Some x2 -> Some (f x1 x2))
+    l1 l2
+
+let rec remove nb = function
+  | [] -> []
+  | l when nb <= 0 -> l
+  | _ :: tl -> remove (nb - 1) tl
+
+let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x
+
+let split_n n l =
+  let rec loop acc n = function
+    | [] -> l, []
+    | rem when n <= 0 -> List.rev acc, rem
+    | x :: xs -> loop (x :: acc) (pred n) xs in
+  loop [] n l
+
+let take_n_unsorted n l = fst (split_n n l)
+
+module Bounded(E: Set.OrderedType) : sig
+
+  type t
+  val create: int -> t
+  val insert: E.t -> t -> unit
+  val get: t -> E.t list
+
+end = struct
+
+  (* TODO one day replace the list by an heap array *)
+
+  type t = {
+    bound : int ;
+    mutable size : int ;
+    mutable data : E.t list ;
+  }
+
+  let create bound =
+    if bound <= 0 then invalid_arg "Utils.Bounded(_).create" ;
+    { bound ; size = 0 ; data = [] }
+
+  let rec push x = function
+    | [] -> [x]
+    | (y :: xs) as ys ->
+        if E.compare x y <= 0
+        then x :: ys
+        else y :: push x xs
+
+  let insert x t =
+    if t.size < t.bound then begin
+      t.size <- t.size + 1 ;
+      t.data <- push x t.data
+    end else begin
+      match t.data with
+      | [] -> assert false
+      | hd :: tl ->
+          if E.compare hd x < 0 then
+            t.data <- push x tl
+    end
+
+  let get { data ; _ } = data
+
+end
+
+let take_n_sorted (type a) compare n l =
+  let module B = Bounded(struct type t = a let compare = compare end) in
+  let t = B.create n in
+  List.iter (fun x -> B.insert x t) l ;
+  B.get t
+
+let take_n ?compare n l =
+  match compare with
+  | None -> take_n_unsorted n l
+  | Some compare -> take_n_sorted compare n l
+
+let select n l =
+  let rec loop n acc = function
+    | [] -> invalid_arg "Utils.select"
+    | x :: xs when n <= 0 -> x, List.rev_append acc xs
+    | x :: xs -> loop (pred n) (x :: acc) xs
+  in
+  loop n [] l
+
+let shift = function
+  | [] -> []
+  | hd :: tl -> tl@[hd]
+
+let rec product a b = match a with
+  | [] -> []
+  | hd :: tl -> (List.map (fun x -> (hd , x)) b) @ product tl b
diff --git a/vendors/tezos-modded/src/lib_stdlib/tzList.mli b/vendors/tezos-modded/src/lib_stdlib/tzList.mli
new file mode 100644
index 000000000..66290ca3b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tzList.mli
@@ -0,0 +1,89 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** [remove nb list] remove the first [nb] elements from the list [list]. *)
+val remove: int -> 'a list -> 'a list
+
+(** [repeat n x] is a list of [n] [x]'s **)
+val repeat: int -> 'a -> 'a list
+
+(** [shift (hd :: tl)] computes [tl @ [hd]] *)
+val shift : 'a list -> 'a list
+
+(** [product a b] computes the cartesian product of two lists [a] and [b]. *)
+val product : 'a list -> 'b list -> ('a * 'b) list
+
+(** [take_n n l] returns the [n] first elements of [l]. When [compare]
+    is provided, it returns the [n] greatest element of [l]. *)
+val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list
+
+val split_n: int -> 'a list -> 'a list * 'a list
+
+(** Bounded sequence: keep only the [n] greatest elements. *)
+module Bounded(E: Set.OrderedType) : sig
+  type t
+  val create: int -> t
+  val insert: E.t -> t -> unit
+  val get: t -> E.t list
+end
+
+(** [select n l] is ([n]th element of [l], [l] without that element) **)
+val select: int -> 'a list -> 'a * 'a list
+
+
+(** [filter_map f l] is [[y for x in l where (f x) = Some y]] **)
+val filter_map: ('a -> 'b option) -> 'a list -> 'b list
+
+(** [rev_sub l n] is [List.rev l] capped to max [n] elements *)
+val rev_sub : 'a list -> int -> 'a list
+
+(** [sub l n] is [l] capped to max [n] elements *)
+val sub: 'a list -> int -> 'a list
+
+(** Like [List.hd], but [Some hd] or [None] if empty **)
+val hd_opt: 'a list -> 'a option
+
+(** Last elt of list, or raise Not_found if empty **)
+val last_exn: 'a list -> 'a
+
+(** [merge_filter2 ~compare ~f l1 l2] merges two lists ordered by [compare]
+    and whose items can be merged with [f]. Item is discarded or kept whether
+    [f] returns [Some] or [None] *)
+val merge_filter2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a option -> 'a option -> 'a option) ->
+  'a list -> 'a list ->
+  'a list
+
+(** [merge2 ~compare ~f l1 l2] merges two lists ordered by [compare] and
+    whose items can be merged with [f] *)
+val merge2 :
+  ?finalize:('a list -> 'a list) ->
+  ?compare:('a -> 'a -> int) ->
+  ?f:('a -> 'a -> 'a) ->
+  'a list -> 'a list ->
+  'a list
+
diff --git a/vendors/tezos-modded/src/lib_stdlib/tzString.ml b/vendors/tezos-modded/src/lib_stdlib/tzString.ml
new file mode 100644
index 000000000..f3d006bf2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tzString.ml
@@ -0,0 +1,95 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Set = Set.Make (String)
+module Map = Map.Make (String)
+
+let split delim ?(dup = true) ?(limit = max_int) path =
+  let l = String.length path in
+  let rec do_slashes acc limit i =
+    if i >= l then
+      List.rev acc
+    else if String.get path i = delim then
+      if dup then
+        do_slashes acc limit (i + 1)
+      else
+        do_split acc limit (i + 1)
+    else
+      do_split acc limit i
+  and do_split acc limit i =
+    if limit <= 0 then
+      if i = l then
+        List.rev acc
+      else
+        List.rev (String.sub path i (l - i) :: acc)
+    else
+      do_component acc (pred limit) i i
+  and do_component acc limit i j =
+    if j >= l then
+      if i = j then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if String.get path j = delim then
+      do_slashes (String.sub path i (j - i) :: acc) limit j
+    else
+      do_component acc limit i (j + 1) in
+  if limit > 0 then
+    do_slashes [] limit 0
+  else
+    [ path ]
+
+let split_path path = split '/' path
+
+let has_prefix ~prefix s =
+  let x = String.length prefix in
+  let n = String.length s in
+  n >= x && String.sub s 0 x = prefix
+
+let remove_prefix ~prefix s =
+  let x = String.length prefix in
+  let n = String.length s in
+  if n >= x && String.sub s 0 x = prefix then
+    Some (String.sub s x (n - x))
+  else
+    None
+
+let common_prefix s1 s2 =
+  let last = min (String.length s1) (String.length s2) in
+  let rec loop i =
+    if last <= i then last
+    else if s1.[i] = s2.[i] then
+      loop (i+1)
+    else
+      i in
+  loop 0
+
+let mem_char s c =
+  String.index_opt s c <> None
+
+let fold_left f init s =
+  let acc = ref init in
+  String.iter (fun c -> acc := f !acc c) s ;
+  !acc
diff --git a/vendors/tezos-modded/src/lib_stdlib/tzString.mli b/vendors/tezos-modded/src/lib_stdlib/tzString.mli
new file mode 100644
index 000000000..949f3ac9a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/tzString.mli
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Set : Set.S with type elt = string
+module Map : Map.S with type key = string
+
+(** Splits a string on slashes, grouping multiple slashes, and
+    ignoring slashes at the beginning and end of string. *)
+val split_path: string -> string list
+
+(** Splits a string on a delimier character, grouping multiple
+    delimiters, and ignoring delimiters at the beginning and end of
+    string, if [limit] is passed, stops after [limit] split(s). *)
+val split: char -> ?dup:bool -> ?limit: int -> string -> string list
+
+(** [true] if input has prefix **)
+val has_prefix: prefix:string -> string -> bool
+
+(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
+val remove_prefix: prefix:string -> string -> string option
+
+(** Length of common prefix of input strings *)
+val common_prefix: string -> string -> int
+
+(** Test whether a string contains a given character *)
+val mem_char: string -> char -> bool
+
+(** Functional iteration over the characters of a string from first to last *)
+val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
diff --git a/vendors/tezos-modded/src/lib_stdlib/utils.ml b/vendors/tezos-modded/src/lib_stdlib/utils.ml
new file mode 100644
index 000000000..db9c56f41
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/utils.ml
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Infix = struct
+
+  let (<<) g f = fun a -> g (f a)
+
+  let (--) i j =
+    let rec loop acc j =
+      if j < i then acc else loop (j :: acc) (pred j) in
+    loop [] j
+
+end
+
+let nbsp = Re.(compile (str "\xC2\xA0"))
+let display_paragraph ppf description =
+  Format.fprintf ppf "@[%a@]"
+    (Format.pp_print_list ~pp_sep:Format.pp_print_newline
+       (fun ppf line ->
+          Format.pp_print_list ~pp_sep:Format.pp_print_space
+            (fun ppf w ->
+               (* replace   by real spaces... *)
+               Format.fprintf ppf "%s@ "
+                 (Re.replace ~all:true nbsp ~f:(fun _ -> " ") w))
+            ppf
+            (TzString.split ' ' line)))
+    (TzString.split ~dup:false '\n' description)
+
+let finalize f g = try let res = f () in g (); res with exn -> g (); raise exn
diff --git a/vendors/tezos-modded/src/lib_stdlib/utils.mli b/vendors/tezos-modded/src/lib_stdlib/utils.mli
new file mode 100644
index 000000000..b3a58ec3e
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/utils.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Infix : sig
+
+  (** Compose functions from right to left. *)
+  val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
+
+  (** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *)
+  val (--) : int -> int -> int list
+
+end
+
+(** Print a paragraph in a box **)
+val display_paragraph: Format.formatter -> string -> unit
+
+(** [finalize f g ] ensures g() called after f(), even if exception raised **)
+val finalize: (unit -> 'a) -> (unit -> unit) -> 'a
diff --git a/vendors/tezos-modded/src/lib_stdlib/weakRingTable.ml b/vendors/tezos-modded/src/lib_stdlib/weakRingTable.ml
new file mode 100644
index 000000000..cfeb0b917
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/weakRingTable.ml
@@ -0,0 +1,48 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Nomadic Labs, Inc. <contact@nomadic-labs.com>          *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make(M: Hashtbl.HashedType) = struct
+
+  module Table = Ephemeron.K1.Make(M)
+  module Ring = Ring.MakeTable(M)
+
+  type 'a t = {
+    table : 'a Table.t ;
+    ring : Ring.t ;
+  }
+
+  let create n = { table = Table.create n ; ring = Ring.create n }
+
+  let add { ring ; table } k v =
+    Ring.add ring k ;
+    Table.replace table k v
+
+  let find_opt { table ; _ } k =
+    Table.find_opt table k
+
+  let fold f { table ; _ } acc =
+    Table.fold f table acc
+
+end
diff --git a/vendors/tezos-modded/src/lib_stdlib/weakRingTable.mli b/vendors/tezos-modded/src/lib_stdlib/weakRingTable.mli
new file mode 100644
index 000000000..932603050
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib/weakRingTable.mli
@@ -0,0 +1,56 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Nomadic Labs, Inc. <contact@nomadic-labs.com>          *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Make (K: Hashtbl.HashedType): sig
+
+  (** A bounded table which optimistically cheats on the bound and sometimes
+      counts wrong.
+      Specifically, the table retains a bounded number of elements. It will also
+      retain more if given more than that, but it will always drop back to the
+      bound if the garbage collector intervenes.
+      In addition, repeated bindings on the same key use several slots when
+      counting the number of elements even though only the last binding is ever
+      accessible. *)
+  type 'a t
+
+  (** [create n] is a table with at most [n] elements except when it has more. *)
+  val create: int -> 'a t
+
+  (** [add t k v] adds a mapping from key [k] to value [v] in the table.
+      NOTE: when n values are bound to the same key, it may count as up to n
+      elements.
+      However, NOTE: when n values are bound to the same key, only the last
+      binding can be found with [find_opt] or traversed with [fold]. *)
+  val add: 'a t -> K.t -> 'a -> unit
+
+  (** [fold f t acc] folds over the bindings in [t] starting with [acc]. *)
+  val fold: (K.t -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+
+  (** [find_opt t k] is [Some v] if [k] is bound to [v] in [t] and [None]
+      otherwise. A key [k] is bound to a value [v] in [t] if [add t k v] has been
+      called and not too many other bindings have been added since then. *)
+  val find_opt: 'a t -> K.t -> 'a option
+
+end
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/dune b/vendors/tezos-modded/src/lib_stdlib_unix/dune
new file mode 100644
index 000000000..10ba0e087
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/dune
@@ -0,0 +1,15 @@
+(library
+ (name tezos_stdlib_unix)
+ (public_name tezos-stdlib-unix)
+ (flags (:standard -w -9-30
+                   -open Tezos_base__TzPervasives
+                   -safe-string))
+ (libraries tezos-base
+            lwt.unix
+            ipaddr.unix
+            str))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.ml b/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.ml
new file mode 100644
index 000000000..63f52d6a3
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.ml
@@ -0,0 +1,231 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+module Output = struct
+
+  type t =
+    | Null
+    | Stdout
+    | Stderr
+    | File of string
+    | Syslog of Lwt_log.syslog_facility
+
+  let to_string : t -> string = function
+    | Null -> "/dev/null"
+    | Stdout -> "stdout"
+    | Stderr -> "stderr"
+    | File fp -> fp
+    | Syslog `Auth -> "syslog:auth"
+    | Syslog `Authpriv -> "syslog:authpriv"
+    | Syslog `Cron -> "syslog:cron"
+    | Syslog `Daemon -> "syslog:daemon"
+    | Syslog `FTP -> "syslog:ftp"
+    | Syslog `Kernel -> "syslog:kernel"
+    | Syslog `Local0 -> "syslog:local0"
+    | Syslog `Local1 -> "syslog:local1"
+    | Syslog `Local2 -> "syslog:local2"
+    | Syslog `Local3 -> "syslog:local3"
+    | Syslog `Local4 -> "syslog:local4"
+    | Syslog `Local5 -> "syslog:local5"
+    | Syslog `Local6 -> "syslog:local6"
+    | Syslog `Local7 -> "syslog:local7"
+    | Syslog `LPR -> "syslog:lpr"
+    | Syslog `Mail -> "syslog:mail"
+    | Syslog `News -> "syslog:news"
+    | Syslog `Syslog -> "syslog:syslog"
+    | Syslog `User -> "syslog:user"
+    | Syslog `UUCP -> "syslog:uucp"
+    | Syslog `NTP -> "syslog:ntp"
+    | Syslog `Security -> "syslog:security"
+    | Syslog `Console -> "syslog:console"
+
+  let of_string : string -> t = function
+    | "/dev/null" | "null" -> Null
+    | "stdout" -> Stdout
+    | "stderr" -> Stderr
+    | "syslog:auth" -> Syslog `Auth
+    | "syslog:authpriv" -> Syslog `Authpriv
+    | "syslog:cron" -> Syslog `Cron
+    | "syslog:daemon" -> Syslog `Daemon
+    | "syslog:ftp" -> Syslog `FTP
+    | "syslog:kernel" -> Syslog `Kernel
+    | "syslog:local0" -> Syslog `Local0
+    | "syslog:local1" -> Syslog `Local1
+    | "syslog:local2" -> Syslog `Local2
+    | "syslog:local3" -> Syslog `Local3
+    | "syslog:local4" -> Syslog `Local4
+    | "syslog:local5" -> Syslog `Local5
+    | "syslog:local6" -> Syslog `Local6
+    | "syslog:local7" -> Syslog `Local7
+    | "syslog:lpr" -> Syslog `LPR
+    | "syslog:mail" -> Syslog `Mail
+    | "syslog:news" -> Syslog `News
+    | "syslog:syslog" -> Syslog `Syslog
+    | "syslog:user" -> Syslog `User
+    | "syslog:uucp" -> Syslog `UUCP
+    | "syslog:ntp" -> Syslog `NTP
+    | "syslog:security" -> Syslog `Security
+    | "syslog:console" -> Syslog `Console
+    (* | s when start_with "syslog:" FIXME error or warning. *)
+    | fp ->
+        (* TODO check absolute path *)
+        File fp
+
+  let encoding =
+    let open Data_encoding in
+    conv to_string of_string string
+
+  let of_string str =
+    try
+      Some (Data_encoding.Json.destruct encoding (`String str))
+    with _ -> None
+
+  let to_string output =
+    match Data_encoding.Json.construct encoding output with
+    | `String res -> res
+    | #Data_encoding.json -> assert false
+
+  let pp fmt output =
+    Format.fprintf fmt "%s" (to_string output)
+end
+
+type cfg = {
+  output : Output.t ;
+  default_level : Logging.level ;
+  rules : string option ;
+  template : Logging.template ;
+}
+
+let create_cfg
+    ?(output = Output.Stderr)
+    ?(default_level = Logging.Notice)
+    ?rules ?(template = Logging.default_template) () =
+  { output ; default_level ; rules ; template }
+
+let default_cfg = create_cfg ()
+
+let level_encoding =
+  let open Logging in
+  let open Data_encoding in
+  conv
+    (function
+      | Fatal -> "fatal"
+      | Error -> "error"
+      | Warning -> "warning"
+      | Notice -> "notice"
+      | Info -> "info"
+      | Debug -> "debug")
+    (function
+      | "error" -> Error
+      | "warn" -> Warning
+      | "notice" -> Notice
+      | "info" -> Info
+      | "debug" -> Debug
+      | "fatal" -> Fatal
+      | _ -> invalid_arg "Logging.level")
+    string
+
+let cfg_encoding =
+  let open Data_encoding in
+  conv
+    (fun {output ; default_level ; rules ; template } ->
+       (output, default_level, rules, template))
+    (fun (output, default_level, rules, template) ->
+       { output ; default_level ; rules ; template })
+    (obj4
+       (dft "output"
+          ~description: "Output for the logging function. Either 'stdout', \
+                         'stderr' or the name of a log file ."
+          Output.encoding default_cfg.output)
+       (dft "level"
+          ~description: "Verbosity level: one of 'fatal', 'error', 'warn',\
+                         'notice', 'info', 'debug'."
+          level_encoding default_cfg.default_level)
+       (opt "rules"
+          ~description: "Fine-grained logging instructions. Same format as \
+                         described in `tezos-node run --help`, DEBUG section. \
+                         In the example below, sections 'p2p' 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."
+          string)
+       (dft "template"
+          ~description: "Format for the log file, see \
+                         http://ocsigen.org/lwt/dev/api/Lwt_log_core#2_Logtemplates."
+          string default_cfg.template))
+
+let init ?(template = Logging.default_template) output =
+  let open Output in
+  begin
+    match output with
+    | Stderr ->
+        Lwt.return @@
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
+    | Stdout ->
+        Lwt.return @@
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout ()
+    | File file_name ->
+        Lwt_log.file ~file_name ~template ()
+    | Null ->
+        Lwt.return @@
+        Lwt_log.null
+    | Syslog facility ->
+        Lwt.return @@
+        Lwt_log.syslog ~template ~facility ()
+  end >>= fun logger ->
+  Lwt_log.default := logger ;
+  Lwt.return_unit
+
+let find_log_rules default =
+  match Sys.(getenv_opt "TEZOS_LOG", getenv_opt "LWT_LOG") with
+  | Some rules, None -> "environment variable TEZOS_LOG", Some rules
+  | None, Some rules -> "environment variable LWT_LOG", Some rules
+  | None, None -> "configuration file", default
+  | Some rules, Some _ ->
+      Format.eprintf
+        "@[<v 2>@{<warning>@{<title>Warning@}@} \
+         Both environment variables TEZOS_LOG and LWT_LOG \
+         defined, using TEZOS_LOG.@]@\n@." ;
+      "environment varible TEZOS_LOG", Some rules
+
+let init ?(cfg = default_cfg) () =
+  Lwt_log_core.add_rule "*" cfg.default_level ;
+  let origin, rules = find_log_rules cfg.rules in
+  begin match rules with
+    | None -> Lwt.return_unit
+    | Some rules ->
+        try
+          Lwt_log_core.load_rules rules ~fail_on_error:true ;
+          Lwt.return_unit
+        with _ ->
+          Printf.ksprintf Lwt.fail_with
+            "Incorrect log rules defined in %s" origin
+  end >>= fun () ->
+  init ~template:cfg.template cfg.output
+
+let close () =
+  Lwt_log.close !Lwt_log.default
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.mli b/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.mli
new file mode 100644
index 000000000..cbb29e017
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/logging_unix.mli
@@ -0,0 +1,59 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Output : sig
+  type t =
+    | Null
+    | Stdout
+    | Stderr
+    | File of string
+    | Syslog of Lwt_log.syslog_facility
+
+  val encoding : t Data_encoding.t
+  val of_string : string -> t option
+  val to_string : t -> string
+  val pp : Format.formatter -> t -> unit
+end
+
+type cfg = {
+  output : Output.t ;
+  default_level : Logging.level ;
+  rules : string option ;
+  template : Logging.template ;
+}
+
+val default_cfg : cfg
+
+val create_cfg :
+  ?output:Output.t ->
+  ?default_level:Logging.level ->
+  ?rules:string ->
+  ?template:Logging.template -> unit -> cfg
+
+val level_encoding : Logging.level Data_encoding.t
+val cfg_encoding : cfg Data_encoding.t
+
+val init: ?cfg:cfg -> unit -> unit Lwt.t
+val close: unit -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.ml b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.ml
new file mode 100644
index 000000000..bf785c121
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.ml
@@ -0,0 +1,74 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+let create_inner
+    lock_command
+    ?(close_on_exec=true)
+    ?(unlink_on_exit=false) fn =
+  protect begin fun () ->
+    Lwt_unix.openfile fn Unix.[O_CREAT ; O_WRONLY; O_TRUNC] 0o644 >>= fun fd ->
+    if close_on_exec then Lwt_unix.set_close_on_exec fd ;
+    Lwt_unix.lockf fd lock_command 0 >>= fun () ->
+    if unlink_on_exit then
+      Lwt_main.at_exit (fun () -> Lwt_unix.unlink fn) ;
+    let pid_str = string_of_int @@ Unix.getpid () in
+    Lwt_unix.write_string fd pid_str 0 (String.length pid_str) >>= fun _ ->
+    return_unit
+  end
+
+let create = create_inner Unix.F_TLOCK
+
+let blocking_create
+    ?timeout
+    ?(close_on_exec=true)
+    ?(unlink_on_exit=false) fn =
+  let create () =
+    create_inner Unix.F_LOCK ~close_on_exec ~unlink_on_exit fn in
+  match timeout with
+  | None -> create ()
+  | Some duration -> with_timeout (Lwt_unix.sleep duration) (fun _ -> create ())
+
+let is_locked fn =
+  if not @@ Sys.file_exists fn then return_false else
+    protect begin fun () ->
+      Lwt_unix.openfile fn [Unix.O_RDONLY] 0o644 >>= fun fd ->
+      Lwt.finalize (fun () ->
+          Lwt.try_bind
+            (fun () -> Lwt_unix.(lockf fd F_TEST 0))
+            (fun () -> return_false)
+            (fun _ -> return_true))
+        (fun () -> Lwt_unix.close fd)
+    end
+
+let get_pid fn =
+  let open Lwt_io in
+  protect begin fun () ->
+    with_file ~mode:Input fn begin fun ic ->
+      read ic >>= fun content ->
+      return (int_of_string content)
+    end
+  end
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.mli b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.mli
new file mode 100644
index 000000000..4e7692e49
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_lock_file.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+val create :
+  ?close_on_exec:bool ->
+  ?unlink_on_exit:bool ->
+  string -> unit tzresult Lwt.t
+
+val blocking_create :
+  ?timeout:float ->
+  ?close_on_exec:bool ->
+  ?unlink_on_exit:bool ->
+  string -> unit tzresult Lwt.t
+
+val is_locked : string -> bool tzresult Lwt.t
+val get_pid : string -> int tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.ml b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.ml
new file mode 100644
index 000000000..0fd6447cd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.ml
@@ -0,0 +1,417 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  register_error_kind
+    `Temporary
+    ~id:"unix_error"
+    ~title:"Unix error"
+    ~description:"An unhandled unix exception"
+    ~pp:Format.pp_print_string
+    Data_encoding.(obj1 (req "msg" string))
+    (function
+      | Exn (Unix.Unix_error (err, fn, _)) ->
+          Some ("Unix error in " ^ fn ^ ": " ^ Unix.error_message err)
+      | _ -> None)
+    (fun msg -> Exn (Failure msg))
+
+let read_bytes ?(pos = 0) ?len fd buf =
+  let len = match len with None -> Bytes.length buf - pos | Some l -> l in
+  let rec inner pos len =
+    if len = 0 then
+      Lwt.return_unit
+    else
+      Lwt_unix.read fd buf pos len >>= function
+      | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *)
+      | nb_read -> inner (pos + nb_read) (len - nb_read)
+  in
+  inner pos len
+
+let read_mbytes ?(pos=0) ?len fd buf =
+  let len = match len with None -> MBytes.length buf - pos | Some l -> l in
+  let rec inner pos len =
+    if len = 0 then
+      Lwt.return_unit
+    else
+      Lwt_bytes.read fd buf pos len >>= function
+      | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *)
+      | nb_read -> inner (pos + nb_read) (len - nb_read)
+  in
+  inner pos len
+
+let write_mbytes ?(pos=0) ?len descr buf =
+  let len = match len with None -> MBytes.length buf - pos | Some l -> l in
+  let rec inner pos len =
+    if len = 0 then
+      Lwt.return_unit
+    else
+      Lwt_bytes.write descr buf pos len >>= function
+      | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *)
+      | nb_written -> inner (pos + nb_written) (len - nb_written) in
+  inner pos len
+
+let write_bytes ?(pos=0) ?len descr buf =
+  let len = match len with None -> Bytes.length buf - pos | Some l -> l in
+  let rec inner pos len =
+    if len = 0 then
+      Lwt.return_unit
+    else
+      Lwt_unix.write descr buf pos len >>= function
+      | 0 -> Lwt.fail End_of_file (* other endpoint cleanly closed its connection *)
+      | nb_written -> inner (pos + nb_written) (len - nb_written) in
+  inner pos len
+
+let (>>=) = Lwt.bind
+
+let remove_dir dir =
+  let rec remove dir =
+    let files = Lwt_unix.files_of_directory dir in
+    Lwt_stream.iter_s
+      (fun file ->
+         if file = "." || file = ".." then
+           Lwt.return_unit
+         else begin
+           let file = Filename.concat dir file in
+           if Sys.is_directory file
+           then remove file
+           else Lwt_unix.unlink file
+         end)
+      files >>= fun () ->
+    Lwt_unix.rmdir dir in
+  if Sys.file_exists dir && Sys.is_directory dir then
+    remove dir
+  else
+    Lwt.return_unit
+
+let rec create_dir ?(perm = 0o755) dir =
+  Lwt_unix.file_exists dir >>= function
+  | false ->
+      create_dir (Filename.dirname dir) >>= fun () ->
+      Lwt_unix.mkdir dir perm
+  | true ->
+      Lwt_unix.stat dir >>= function
+      | { st_kind = S_DIR ; _ } -> Lwt.return_unit
+      | _ -> Pervasives.failwith "Not a directory"
+
+let create_file ?(perm = 0o644) name content =
+  Lwt_unix.openfile name Unix.([O_TRUNC; O_CREAT; O_WRONLY]) perm >>= fun fd ->
+  Lwt_unix.write_string fd content 0 (String.length content) >>= fun _ ->
+  Lwt_unix.close fd
+
+let read_file fn =
+  Lwt_io.with_file fn ~mode:Input begin fun ch ->
+    Lwt_io.read ch
+  end
+
+
+
+let safe_close fd =
+  Lwt.catch
+    (fun () -> Lwt_unix.close fd)
+    (fun _ -> Lwt.return_unit)
+
+
+
+let of_sockaddr = function
+  | Unix.ADDR_UNIX _ -> None
+  | Unix.ADDR_INET (addr, port) ->
+      match Ipaddr_unix.of_inet_addr addr with
+      | V4 addr -> Some (Ipaddr.v6_of_v4 addr, port)
+      | V6 addr -> Some (addr, port)
+
+let getaddrinfo ~passive ~node ~service =
+  let open Lwt_unix in
+  getaddrinfo node service
+    ( AI_SOCKTYPE SOCK_STREAM ::
+      (if passive then [AI_PASSIVE] else []) ) >>= fun addr ->
+  let points =
+    TzList.filter_map
+      (fun { ai_addr ; _ } -> of_sockaddr ai_addr)
+      addr in
+  Lwt.return points
+
+let getpass () =
+  let open Unix in
+  (* Turn echoing off and fail if we can't. *)
+  let tio = tcgetattr stdin in
+  let old_echo = tio.c_echo in
+  let old_echonl = tio.c_echonl in
+  tio.c_echo <- false ;
+  tio.c_echonl <- true ;
+  tcsetattr stdin TCSAFLUSH tio ;
+  (* Read the passwd. *)
+  let passwd = read_line () in
+  (* Restore terminal. *)
+  tio.c_echo <- old_echo ;
+  tio.c_echonl <- old_echonl ;
+  tcsetattr stdin TCSAFLUSH tio ;
+  passwd
+
+module Json = struct
+
+  let to_root = function
+    | `O ctns -> `O ctns
+    | `A ctns -> `A ctns
+    | `Null -> `O []
+    | oth -> `A [ oth ]
+
+  let write_file file json =
+    let json = to_root json in
+    protect begin fun () ->
+      Lwt_io.with_file ~mode:Output file begin fun chan ->
+        let str = Data_encoding.Json.to_string ~minify:false json in
+        Lwt_io.write chan str >>= fun _ ->
+        return_unit
+      end
+    end
+
+  let read_file file =
+    protect begin fun () ->
+      Lwt_io.with_file ~mode:Input file begin fun chan ->
+        Lwt_io.read chan >>= fun str ->
+        return (Ezjsonm.from_string str :> Data_encoding.json)
+      end
+    end
+
+end
+
+module Protocol = struct
+
+  let name = "TEZOS_PROTOCOL"
+
+  open Protocol
+
+  let (//) = Filename.concat
+
+  let to_file ~dir:dirname ?hash ?env_version modules =
+    let config_file =
+      Data_encoding.Json.construct
+        Meta.encoding
+        { hash ; expected_env_version = env_version ; modules } in
+    Json.write_file (dirname // name) config_file
+
+  let of_file ~dir:dirname =
+    Json.read_file (dirname // name) >>=? fun json ->
+    return (Data_encoding.Json.destruct Meta.encoding json)
+
+  let find_component dirname module_name =
+    let name_lowercase = String.uncapitalize_ascii module_name in
+    let implementation = dirname // name_lowercase ^ ".ml" in
+    let interface = implementation ^ "i" in
+    match Sys.file_exists implementation, Sys.file_exists interface with
+    | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation
+    | true, false ->
+        read_file implementation >|= fun implementation ->
+        { name = module_name; interface = None; implementation }
+    | _ ->
+        read_file interface >>= fun interface ->
+        read_file implementation >|= fun implementation ->
+        { name = module_name; interface = Some interface; implementation }
+
+  let read_dir dir =
+    of_file ~dir >>=? fun meta ->
+    Lwt_list.map_p (find_component dir) meta.modules >>= fun components ->
+    let expected_env =
+      match meta.expected_env_version with
+      | None -> V1
+      | Some v -> v in
+    return (meta.hash, { expected_env ; components })
+
+  open Lwt.Infix
+
+  let create_files dir units =
+    remove_dir dir >>= fun () ->
+    create_dir dir >>= fun () ->
+    Lwt_list.map_s
+      (fun { name ; interface ; implementation } ->
+         let name = String.lowercase_ascii name in
+         let ml = dir // (name ^ ".ml") in
+         let mli = dir // (name ^ ".mli") in
+         create_file ml implementation >>= fun () ->
+         match interface with
+         | None -> Lwt.return [ml]
+         | Some content ->
+             create_file mli content >>= fun () ->
+             Lwt.return [ mli ; ml ])
+      units >>= fun files ->
+    let files = List.concat files in
+    Lwt.return files
+
+  let write_dir dir ?hash (p: t) =
+    create_files dir p.components >>= fun _files ->
+    to_file
+      ~dir
+      ?hash
+      ~env_version:p.expected_env
+      (List.map (fun { name ; _ } -> String.capitalize_ascii name) p.components)
+
+end
+
+let with_tempdir name f =
+  let base_dir = Filename.temp_file name "" in
+  Lwt_unix.unlink base_dir >>= fun () ->
+  Lwt_unix.mkdir base_dir 0o700 >>= fun () ->
+  Lwt.finalize (fun () -> f base_dir) (fun () -> remove_dir base_dir)
+
+
+module Socket = struct
+
+  type addr =
+    | Unix of string
+    | Tcp of string * string * Unix.getaddrinfo_option list
+
+  let handle_litteral_ipv6 host =
+    (* To strip '[' and ']' when a litteral IPv6 is provided *)
+    match Ipaddr.of_string host with
+    | Error (`Msg _) -> host
+    | Ok ipaddr -> Ipaddr.to_string ipaddr
+
+  let connect ?(timeout=5.) = function
+    | Unix path ->
+        let addr = Lwt_unix.ADDR_UNIX path in
+        let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
+        Lwt_unix.connect sock addr >>= fun () ->
+        return sock
+    | Tcp (host, service, opts) ->
+        let host = handle_litteral_ipv6 host in
+        Lwt_unix.getaddrinfo host service opts >>= function
+        | [] ->
+            failwith "could not resolve host '%s'" host
+        | addrs ->
+            let rec try_connect acc = function
+              | [] ->
+                  Lwt.return
+                    (Error (failure "could not connect to '%s'" host :: List.rev acc))
+              | { Unix.ai_family; ai_socktype; ai_protocol; ai_addr } :: addrs ->
+                  let sock = Lwt_unix.socket ai_family ai_socktype ai_protocol in
+                  protect ~on_error:begin fun e ->
+                    Lwt_unix.close sock >>= fun () ->
+                    Lwt.return (Error e)
+                  end begin fun () ->
+                    with_timeout (Lwt_unix.sleep timeout) (fun _c ->
+                        Lwt_unix.connect sock ai_addr >>= fun () ->
+                        return sock)
+                  end >>= function
+                  | Ok sock -> return sock
+                  | Error e ->
+                      try_connect (e @ acc) addrs in
+            try_connect [] addrs
+
+  let bind ?(backlog = 10) = function
+    | Unix path ->
+        let addr = Lwt_unix.ADDR_UNIX path in
+        let sock = Lwt_unix.socket PF_UNIX SOCK_STREAM 0 in
+        Lwt_unix.bind sock addr >>= fun () ->
+        Lwt_unix.listen sock backlog ;
+        return [sock]
+    | Tcp (host, service, opts) ->
+        Lwt_unix.getaddrinfo
+          (handle_litteral_ipv6 host) service (AI_PASSIVE :: opts) >>= function
+        | [] -> failwith "could not resolve host '%s'" host
+        | addrs ->
+            let do_bind { Unix.ai_family; ai_socktype; ai_protocol; ai_addr } =
+              let sock = Lwt_unix.socket ai_family ai_socktype ai_protocol in
+              Lwt_unix.setsockopt sock SO_REUSEADDR true ;
+              Lwt_unix.bind sock ai_addr >>= fun () ->
+              Lwt_unix.listen sock backlog ;
+              return sock in
+            map_s do_bind addrs
+
+  type error +=
+    | Encoding_error
+    | Decoding_error
+
+  let () =
+    register_error_kind `Permanent
+      ~id: "signer.encoding_error"
+      ~title: "Encoding_error"
+      ~description: "Error while encoding a remote signer message"
+      ~pp: (fun ppf () ->
+          Format.fprintf ppf "Could not encode a remote signer message")
+      Data_encoding.empty
+      (function Encoding_error -> Some () | _ -> None)
+      (fun () -> Encoding_error) ;
+    register_error_kind `Permanent
+      ~id: "signer.decoding_error"
+      ~title: "Decoding_error"
+      ~description: "Error while decoding a remote signer message"
+      ~pp: (fun ppf () ->
+          Format.fprintf ppf "Could not decode a remote signer message")
+      Data_encoding.empty
+      (function Decoding_error -> Some () | _ -> None)
+      (fun () -> Decoding_error)
+
+  let message_len_size = 2
+
+  let send fd encoding message =
+    let encoded_message_len = Data_encoding.Binary.length encoding message in
+    fail_unless
+      (encoded_message_len < 1 lsl (message_len_size * 8))
+      Encoding_error >>=? fun () ->
+    (* len is the length of int16 plus the length of the message we want to send *)
+    let len = message_len_size + encoded_message_len in
+    let buf = MBytes.create len in
+    match Data_encoding.Binary.write
+            encoding message buf message_len_size encoded_message_len with
+    | None ->
+        fail Encoding_error
+    | Some last ->
+        fail_unless (last = len) Encoding_error >>=? fun () ->
+        (* we set the beginning of the buf with the length of what is next *)
+        MBytes.set_int16 buf 0 encoded_message_len ;
+        write_mbytes fd buf >>= fun () ->
+        return_unit
+
+  let recv fd encoding =
+    let header_buf = MBytes.create message_len_size in
+    read_mbytes ~len:message_len_size fd header_buf >>= fun () ->
+    let len = MBytes.get_uint16 header_buf 0 in
+    let buf = MBytes.create len in
+    read_mbytes ~len fd buf >>= fun () ->
+    match Data_encoding.Binary.read encoding buf 0 len with
+    | None ->
+        fail Decoding_error
+    | Some (read_len, message) ->
+        if read_len <> len then
+          fail Decoding_error
+        else
+          return message
+
+end
+
+
+let rec retry ?(log=(fun _ -> Lwt.return_unit)) ?(n=5) ?(sleep=1.) f =
+  f () >>= function
+  | Ok r -> Lwt.return (Ok r)
+  | (Error error) as x ->
+      if n > 0 then
+        begin
+          log error >>= fun () ->
+          Lwt_unix.sleep sleep >>= fun () ->
+          retry ~log ~n:(n-1) ~sleep f
+        end
+      else
+        Lwt.return x
+
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.mli b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.mli
new file mode 100644
index 000000000..98a3467bf
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/lwt_utils_unix.mli
@@ -0,0 +1,112 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Error_monad
+
+val read_bytes:
+  ?pos:int -> ?len:int -> Lwt_unix.file_descr -> bytes -> unit Lwt.t
+
+val read_mbytes:
+  ?pos:int -> ?len:int -> Lwt_unix.file_descr -> MBytes.t -> unit Lwt.t
+
+val write_bytes:
+  ?pos:int -> ?len:int -> Lwt_unix.file_descr -> bytes -> unit Lwt.t
+val write_mbytes:
+  ?pos:int -> ?len:int -> Lwt_unix.file_descr -> MBytes.t -> unit Lwt.t
+
+val remove_dir: string -> unit Lwt.t
+val create_dir: ?perm:int -> string -> unit Lwt.t
+val read_file: string -> string Lwt.t
+val create_file: ?perm:int -> string -> string -> unit Lwt.t
+
+val with_tempdir: string -> (string -> 'a Lwt.t) -> 'a Lwt.t
+
+val safe_close: Lwt_unix.file_descr -> unit Lwt.t
+
+val getaddrinfo:
+  passive:bool ->
+  node:string -> service:string ->
+  (Ipaddr.V6.t * int) list Lwt.t
+
+(** [getpass ()] reads a password from stdio while setting-up the
+    terminal to not display the password being typed. *)
+val getpass : unit -> string
+
+module Json : sig
+
+  (** Loads a JSON file in memory *)
+  val read_file : string -> Data_encoding.json tzresult Lwt.t
+
+  (** (Over)write a JSON file from in memory data *)
+  val write_file : string -> Data_encoding.json -> unit tzresult Lwt.t
+
+end
+
+module Protocol : sig
+
+  val read_dir: string -> (Protocol_hash.t option * Protocol.t) tzresult Lwt.t
+
+  val write_dir: string -> ?hash:Protocol_hash.t -> Protocol.t -> unit tzresult Lwt.t
+
+end
+
+module Socket : sig
+
+  type addr =
+    | Unix of string
+    | Tcp of string * string * Unix.getaddrinfo_option list
+
+  val connect:
+    ?timeout:float -> addr -> Lwt_unix.file_descr tzresult Lwt.t
+  (** [connect ?timeout addr] tries connecting to [addr] and returns
+      the resulting socket file descriptor on success. When using TCP,
+      [Unix.getaddrinfo] is used to resolve the hostname and service
+      (port). The different socket addresses returned by
+      [Unix.getaddrinfo] are tried sequentially, and the [?timeout]
+      argument (default: 5s) governs how long it waits to get a
+      connection. If a connection is not obtained in less than
+      [?timeout], the connection is canceled and and the next socket
+      address (if it exists) is tried. *)
+
+  val bind:
+    ?backlog:int -> addr -> Lwt_unix.file_descr list tzresult Lwt.t
+
+  type error +=
+    | Encoding_error
+    | Decoding_error
+
+  val send:
+    Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a -> unit tzresult Lwt.t
+  val recv:
+    Lwt_unix.file_descr -> 'a Data_encoding.t -> 'a tzresult Lwt.t
+
+end
+
+val retry:
+  ?log:('error -> unit Lwt.t) ->
+  ?n:int ->
+  ?sleep:float ->
+  (unit -> ('a, 'error) result Lwt.t) -> ('a, 'error) result Lwt.t
+
diff --git a/vendors/tezos-modded/src/lib_stdlib_unix/tezos-stdlib-unix.opam b/vendors/tezos-modded/src/lib_stdlib_unix/tezos-stdlib-unix.opam
new file mode 100644
index 000000000..62cf0ef2a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_stdlib_unix/tezos-stdlib-unix.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "lwt" { >= "3.0.0" }
+  "conf-libev"
+  "ipaddr" { >= "3.0.0" }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_storage/context.ml b/vendors/tezos-modded/src/lib_storage/context.ml
new file mode 100644
index 000000000..6db05a472
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/context.ml
@@ -0,0 +1,497 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Versioned (key x value) store (over Irmin) *)
+
+module IrminPath = Irmin.Path.String_list
+
+module MBytesContent = struct
+  type t = MBytes.t
+  let t =
+    Irmin.Type.(like cstruct)
+      (fun x -> Cstruct.to_bigarray x)
+      (fun x -> Cstruct.of_bigarray x)
+  let merge = Irmin.Merge.default Irmin.Type.(option t)
+  let pp ppf b = Format.pp_print_string ppf (MBytes.to_string b)
+  let of_string s = Ok (MBytes.of_string s)
+end
+
+module Metadata = struct
+  type t = unit
+  let t = Irmin.Type.unit
+  let default = ()
+  let merge = Irmin.Merge.default t
+end
+
+module IrminBlake2B : Irmin.Hash.S with type t = Context_hash.t = struct
+
+  type t = Context_hash.t
+
+  let digest_size = Context_hash.size
+
+  let to_raw t = Cstruct.of_bigarray (Context_hash.to_bytes t)
+  let of_raw t =
+    match Context_hash.of_bytes_opt (Cstruct.to_bigarray t) with
+    | Some t -> t
+    | None ->
+        let str = Cstruct.to_string t in
+        Format.kasprintf invalid_arg "%s (%d)" str (String.length str)
+
+  let t = Irmin.Type.like Irmin.Type.cstruct of_raw to_raw
+
+  let digest t x =
+    Context_hash.hash_bytes
+      [Cstruct.to_bigarray (Irmin.Type.encode_cstruct t x)]
+
+  let pp = Context_hash.pp
+
+  let of_string x =
+    match Context_hash.of_b58check_exn x with
+    | exception (Invalid_argument s) -> Error (`Msg s)
+    | h -> Ok h
+
+  let has_kind = function
+    | `SHA1 -> true
+    | _ -> false
+
+  let to_raw_int c =
+    Int64.to_int @@ MBytes.get_int64 (Context_hash.to_bytes c) 0
+
+end
+
+module GitStore =
+  Irmin_lmdb.Make
+    (Metadata)
+    (MBytesContent)
+    (Irmin.Path.String_list)
+    (Irmin.Branch.String)
+    (IrminBlake2B)
+
+type index = {
+  path: string ;
+  repo: GitStore.Repo.t ;
+  patch_context: context -> context Lwt.t ;
+}
+
+and context = {
+  index: index ;
+  parents: GitStore.Commit.t list ;
+  tree: GitStore.tree ;
+}
+type t = context
+
+(*-- Version Access and Update -----------------------------------------------*)
+
+let current_protocol_key = ["protocol"]
+let current_test_chain_key = ["test_chain"]
+
+let exists index key =
+  GitStore.Commit.of_hash index.repo key >>= function
+  | None -> Lwt.return_false
+  | Some _ -> Lwt.return_true
+
+let checkout index key =
+  GitStore.Commit.of_hash index.repo key >>= function
+  | None -> Lwt.return_none
+  | Some commit ->
+      GitStore.Commit.tree commit >>= fun tree ->
+      let ctxt = { index ; tree ; parents = [commit] } in
+      Lwt.return_some ctxt
+
+let checkout_exn index key =
+  checkout index key >>= function
+  | None -> Lwt.fail Not_found
+  | Some p -> Lwt.return p
+
+let raw_commit ~time ?(message = "") context =
+  let info =
+    Irmin.Info.v ~date:(Time.to_seconds time) ~author:"Tezos" message in
+  GitStore.Commit.v
+    context.index.repo ~info ~parents:context.parents context.tree
+
+module P = GitStore.Private
+
+(* --- FIXME(samoht): I am so sorry --- *)
+module Hack = struct
+
+  module StepMap = struct
+    module X = struct
+      type t = GitStore.step
+      let t = GitStore.step_t
+      let compare = Irmin.Type.compare t
+    end
+    include Map.Make(X)
+  end
+
+  module Contents = struct
+
+    type key = P.Contents.key
+    type contents = P.Contents.value
+
+    type t =
+      | Key      of key
+      | Contents of contents
+      | Both     of key * contents
+
+    let t =
+      let open Irmin.Type in
+      variant "Node.Contents" (fun key contents both -> function
+          | Key x       -> key x
+          | Contents x -> contents x
+          | Both (x, y) -> both (x, y))
+      |~ case1 "Key" P.Contents.Key.t (fun x -> Key x)
+      |~ case1 "Contents" P.Contents.Val.t (fun x -> Contents x)
+      |~ case1 "Both" (pair P.Contents.Key.t P.Contents.Val.t)
+        (fun (x, y) -> Both (x, y))
+      |> sealv
+
+    let hash = function
+      | Key k | Both (k, _) -> k
+      | Contents c -> P.Contents.Key.digest P.Contents.Val.t c
+
+  end
+
+  type key = P.Node.key
+
+  type value = [ `Node of node | `Contents of Contents.t * Metadata.t ]
+
+  and map = value StepMap.t
+
+  and node =
+    | Map  of map
+    | Key  of key
+    | Both of key * map
+
+  let value t =
+    let open Irmin.Type in
+    variant "Node.value" (fun node contents -> function
+        | `Node x     -> node x
+        | `Contents x -> contents x)
+    |~ case1 "Node" t (fun x -> `Node x)
+    |~ case1 "Contents" (pair Contents.t Metadata.t) (fun x -> `Contents x)
+    |> sealv
+
+  let map value =
+    let open Irmin.Type in
+    let to_map x =
+      List.fold_left (fun acc (k, v) -> StepMap.add k v acc) StepMap.empty x
+    in
+    let of_map m = StepMap.fold (fun k v acc -> (k, v) :: acc) m [] in
+    like (list (pair GitStore.step_t value)) to_map of_map
+
+  let node map =
+    let open Irmin.Type in
+    variant "Node.node" (fun map key both -> function
+        | Map x      -> map x
+        | Key y      -> key y
+        | Both (y,z) -> both (y, z))
+    |~ case1 "Map" map (fun x -> Map x)
+    |~ case1 "Key" P.Node.Key.t (fun x -> Key x)
+    |~ case1 "Both" (pair P.Node.Key.t map) (fun (x, y) -> Both (x, y))
+    |> sealv
+
+  let node_t = Irmin.Type.mu (fun n ->
+      let value = value n in
+      node (map value)
+    )
+
+  (* Mimick irmin-lmdb ordering *)
+  module Sort_key = struct
+
+    exception Result of int
+
+    let compare (x, vx) (y, vy) = match vx, vy with
+      | `Contents _, `Contents _ -> String.compare x y
+      | _  ->
+          let lenx = String.length x in
+          let leny = String.length y in
+          let i = ref 0 in
+          try
+            while !i < lenx && !i < leny do
+              match
+                Char.compare
+                  (String.unsafe_get x !i) (String.unsafe_get y !i)
+              with
+              | 0 -> incr i
+              | i -> raise (Result i)
+            done;
+            let get len k v i =
+              if i < len then String.unsafe_get k i
+              else if i = len then match v with
+                | `Node _     -> '/'
+                | `Contents _ -> '\000'
+              else '\000'
+            in
+            match Char.compare (get lenx x vx !i) (get leny y vy !i) with
+            | 0 -> Char.compare (get lenx x vx (!i + 1)) (get leny y vy (!i + 1))
+            | i -> i
+          with Result i ->
+            i
+
+  end
+
+  let sort_entries = List.fast_sort Sort_key.compare
+
+  let pp_hex ppf x =
+    let buf = IrminBlake2B.to_raw x in
+    let `Hex hex = Hex.of_cstruct buf in
+    Fmt.string ppf hex
+
+  module Entry = struct
+    type kind = [ `Node | `Contents of Metadata.t ]
+    type entry = { kind : kind; name : string; node : IrminBlake2B.t; }
+
+    let entry_t =
+      let open Irmin.Type in
+      record "Tree.entry"
+        (fun kind name node ->
+           let kind =
+             match kind with
+             | None -> `Node
+             | Some m -> `Contents m in
+           { kind ; name ; node } )
+      |+ field "kind" (option Metadata.t) (function
+          | { kind = `Node ; _ } -> None
+          | { kind = `Contents m ; _ } -> Some m)
+      |+ field "name" string (fun { name ; _ } -> name)
+      |+ field "node" IrminBlake2B.t (fun { node ; _ } -> node)
+      |> sealr
+
+    let of_entry e = e.name, match e.kind with
+      | `Node       -> `Node e.node
+      | `Contents m -> `Contents (e.node, m)
+
+    let to_entry (name, value) = match value with
+      | `Node node -> { name; kind = `Node; node }
+      | `Contents (node, m) -> { name; kind = `Contents m; node }
+
+    let t = Irmin.Type.like entry_t of_entry to_entry
+
+  end
+
+  let rec export_map map =
+    let alist =
+      StepMap.fold (fun step v acc ->
+          (step, hash_value v) :: acc
+        ) map []
+    in
+    let l = sort_entries alist in
+    P.Node.Val.v l
+
+  and hash_value = function
+    | `Contents (c, m) -> `Contents (Contents.hash c, m)
+    | `Node n          -> `Node (hash_node n)
+
+  and hash_node = function
+    | Both (k, _) | Key k -> k
+    | Map m ->
+        let v = export_map m in
+        let entries = P.Node.Val.list v in
+        (* This needs to match what is done in the backend... *)
+        let v = Irmin.Type.encode_cstruct (Irmin.Type.list Entry.t) entries in
+        IrminBlake2B.digest Irmin.Type.cstruct v
+
+  let cast: GitStore.node -> node = fun n ->
+    let buf = Irmin.Type.encode_cstruct GitStore.node_t n in
+    match Irmin.Type.decode_cstruct node_t buf with
+    | Error (`Msg e) -> Fmt.failwith "invalid cast\n%s" e
+    | Ok x -> x
+
+end
+
+let tree_hash: GitStore.tree -> GitStore.Tree.hash = function
+  | `Contents (c, m) -> `Contents (P.Contents.Key.digest P.Contents.Val.t c, m)
+  | `Node n          -> `Node (Hack.hash_node (Hack.cast n))
+
+let hash ~time ?(message = "") context =
+  let info =
+    Irmin.Info.v ~date:(Time.to_seconds time) ~author:"Tezos" message
+  in
+  let parents = List.map (fun c -> GitStore.Commit.hash c) context.parents in
+  let node = match tree_hash context.tree with
+    | `Contents _ -> assert false
+    | `Node node  -> node
+  in
+  let commit = P.Commit.Val.v ~parents ~node ~info in
+  let x = P.Commit.Key.digest P.Commit.Val.t commit in
+  (* FIXME: this doesn't have to be lwt *)
+  Lwt.return x
+
+let commit ~time ?message context =
+  raw_commit ~time ?message context >>= fun commit ->
+  let h = GitStore.Commit.hash commit in
+  Lwt.return h
+
+(*-- Generic Store Primitives ------------------------------------------------*)
+
+let data_key key = "data" :: key
+let undata_key = function
+  | "data" :: key -> key
+  | _ -> assert false
+
+type key = string list
+type value = MBytes.t
+
+let mem ctxt key =
+  GitStore.Tree.mem ctxt.tree (data_key key) >>= fun v ->
+  Lwt.return v
+
+let dir_mem ctxt key =
+  GitStore.Tree.mem_tree ctxt.tree (data_key key) >>= fun v ->
+  Lwt.return v
+
+let raw_get ctxt key =
+  GitStore.Tree.find ctxt.tree key
+let get t key = raw_get t (data_key key)
+
+let raw_set ctxt key data =
+  GitStore.Tree.add ctxt.tree key data >>= fun tree ->
+  Lwt.return { ctxt with tree }
+let set t key data = raw_set t (data_key key) data
+
+let raw_del ctxt key =
+  GitStore.Tree.remove ctxt.tree key >>= fun tree ->
+  Lwt.return { ctxt with tree }
+let del t key = raw_del t (data_key key)
+
+let remove_rec ctxt key =
+  GitStore.Tree.remove ctxt.tree (data_key key) >>= fun tree ->
+  Lwt.return { ctxt with tree }
+
+let copy ctxt ~from ~to_ =
+  GitStore.Tree.find_tree ctxt.tree (data_key from) >>= function
+  | None -> Lwt.return_none
+  | Some sub_tree ->
+      GitStore.Tree.add_tree ctxt.tree (data_key to_) sub_tree >>= fun tree ->
+      Lwt.return_some { ctxt with tree }
+
+let fold ctxt key ~init ~f =
+  GitStore.Tree.list ctxt.tree (data_key key) >>= fun keys ->
+  Lwt_list.fold_left_s
+    begin fun acc (name, kind) ->
+      let key =
+        match kind with
+        | `Contents -> `Key (key @ [name])
+        | `Node -> `Dir (key @ [name]) in
+      f key acc
+    end
+    init keys
+
+(*-- Predefined Fields -------------------------------------------------------*)
+
+let get_protocol v =
+  raw_get v current_protocol_key >>= function
+  | None -> assert false
+  | Some data -> Lwt.return (Protocol_hash.of_bytes_exn data)
+let set_protocol v key =
+  raw_set v current_protocol_key (Protocol_hash.to_bytes key)
+
+let get_test_chain v =
+  raw_get v current_test_chain_key >>= function
+  | None -> Lwt.fail (Failure "Unexpected error (Context.get_test_chain)")
+  | Some data ->
+      match Data_encoding.Binary.of_bytes Test_chain_status.encoding data with
+      | None -> Lwt.fail (Failure "Unexpected error (Context.get_test_chain)")
+      | Some r -> Lwt.return r
+
+let set_test_chain v id =
+  raw_set v current_test_chain_key
+    (Data_encoding.Binary.to_bytes_exn Test_chain_status.encoding id)
+let del_test_chain v  = raw_del v current_test_chain_key
+
+let fork_test_chain v ~protocol ~expiration =
+  set_test_chain v (Forking { protocol ; expiration })
+
+(*-- Initialisation ----------------------------------------------------------*)
+
+let init ?patch_context ?mapsize ?readonly root =
+  GitStore.Repo.v
+    (Irmin_lmdb.config ?mapsize ?readonly root) >>= fun repo ->
+  Lwt.return {
+    path = root ;
+    repo ;
+    patch_context =
+      match patch_context with
+      | None -> (fun ctxt -> Lwt.return ctxt)
+      | Some patch_context -> patch_context
+  }
+
+let get_branch chain_id = Format.asprintf "%a" Chain_id.pp chain_id
+
+
+let commit_genesis index ~chain_id ~time ~protocol =
+  let tree = GitStore.Tree.empty in
+  let ctxt = { index ; tree ; parents = [] } in
+  index.patch_context ctxt >>= fun ctxt ->
+  set_protocol ctxt protocol >>= fun ctxt ->
+  set_test_chain ctxt Not_running >>= fun ctxt ->
+  raw_commit ~time ~message:"Genesis" ctxt >>= fun commit ->
+  GitStore.Branch.set index.repo (get_branch chain_id) commit >>= fun () ->
+  Lwt.return (GitStore.Commit.hash commit)
+
+let compute_testchain_genesis forked_block =
+  let genesis = Block_hash.hash_bytes [Block_hash.to_bytes forked_block] in
+  let chain_id = Chain_id.of_block_hash genesis in
+  chain_id, genesis
+
+let commit_test_chain_genesis index forked_block time ctxt =
+  let chain_id, genesis = compute_testchain_genesis forked_block in
+  let branch = get_branch chain_id in
+  let message = Format.asprintf "Forking testchain: %s." branch in
+  raw_commit ~time ~message ctxt >>= fun commit ->
+  GitStore.Branch.set index.repo branch commit >>= fun () ->
+  return (chain_id, genesis, GitStore.Commit.hash commit)
+
+let reset_test_chain ctxt forked_block timestamp =
+  get_test_chain ctxt >>= function
+  | Not_running -> Lwt.return ctxt
+  | Running { expiration } ->
+      if Time.(expiration <= timestamp) then
+        set_test_chain ctxt Not_running
+      else
+        Lwt.return ctxt
+  | Forking { protocol ; expiration } ->
+      let chain_id, genesis = compute_testchain_genesis forked_block in
+      set_test_chain ctxt
+        (Running { chain_id ; genesis ;
+                   protocol ; expiration })
+
+let clear_test_chain index chain_id =
+  (* TODO remove commits... ??? *)
+  let branch = get_branch chain_id in
+  GitStore.Branch.remove index.repo branch
+
+let set_head index chain_id commit =
+  let branch = get_branch chain_id in
+  GitStore.Commit.of_hash index.repo commit >>= function
+  | None -> assert false
+  | Some commit ->
+      GitStore.Branch.set index.repo branch commit
+
+let set_master index commit =
+  GitStore.Commit.of_hash index.repo commit >>= function
+  | None -> assert false
+  | Some commit ->
+      GitStore.Branch.set index.repo GitStore.Branch.master commit
diff --git a/vendors/tezos-modded/src/lib_storage/context.mli b/vendors/tezos-modded/src/lib_storage/context.mli
new file mode 100644
index 000000000..309a0318a
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/context.mli
@@ -0,0 +1,104 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos - Versioned, block indexed (key x value) store *)
+
+(** A block-indexed (key x value) store directory.  *)
+type index
+
+(** A (key x value) store for a given block. *)
+type t
+type context = t
+
+(** Open or initialize a versioned store at a given path. *)
+val init:
+  ?patch_context:(context -> context Lwt.t) ->
+  ?mapsize:int64 ->
+  ?readonly:bool ->
+  string ->
+  index Lwt.t
+
+val commit_genesis:
+  index ->
+  chain_id:Chain_id.t ->
+  time:Time.t ->
+  protocol:Protocol_hash.t ->
+  Context_hash.t Lwt.t
+
+val commit_test_chain_genesis:
+  index -> Block_hash.t -> Time.t -> context ->
+  (Chain_id.t * Block_hash.t * Context_hash.t) tzresult Lwt.t
+
+(** {2 Generic interface} ****************************************************)
+
+type key = string list
+type value = MBytes.t
+
+val mem: context -> key -> bool Lwt.t
+val dir_mem: context -> key -> bool Lwt.t
+val get: context -> key -> value option Lwt.t
+val set: context -> key -> value -> t Lwt.t
+val del: context -> key -> t Lwt.t
+val remove_rec: context -> key -> t Lwt.t
+
+(** [copy] returns None if the [from] key is not bound *)
+val copy: context -> from:key -> to_:key -> context option Lwt.t
+
+val fold:
+  context -> key -> init:'a ->
+  f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+  'a Lwt.t
+
+(** {2 Accessing and Updating Versions} **************************************)
+
+val exists: index -> Context_hash.t -> bool Lwt.t
+val checkout: index -> Context_hash.t -> context option Lwt.t
+val checkout_exn: index -> Context_hash.t -> context Lwt.t
+val hash:   time:Time.t ->
+  ?message:string -> t -> Context_hash.t Lwt.t
+val commit:
+  time:Time.t ->
+  ?message:string ->
+  context ->
+  Context_hash.t Lwt.t
+val set_head: index -> Chain_id.t -> Context_hash.t -> unit Lwt.t
+val set_master: index -> Context_hash.t -> unit Lwt.t
+
+
+(** {2 Predefined Fields} ****************************************************)
+
+val get_protocol: context -> Protocol_hash.t Lwt.t
+val set_protocol: context -> Protocol_hash.t -> context Lwt.t
+
+val get_test_chain: context -> Test_chain_status.t Lwt.t
+val set_test_chain: context -> Test_chain_status.t -> context Lwt.t
+
+val del_test_chain: context -> context Lwt.t
+
+val reset_test_chain: context -> Block_hash.t -> Time.t -> context Lwt.t
+
+val fork_test_chain:
+  context -> protocol:Protocol_hash.t -> expiration:Time.t -> context Lwt.t
+val clear_test_chain: index -> Chain_id.t -> unit Lwt.t
diff --git a/vendors/tezos-modded/src/lib_storage/dune b/vendors/tezos-modded/src/lib_storage/dune
new file mode 100644
index 000000000..e0820c116
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/dune
@@ -0,0 +1,14 @@
+(library
+ (name tezos_storage)
+ (public_name tezos-storage)
+ (libraries tezos-base
+            lmdb
+            irmin-lmdb)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_storage/raw_store.ml b/vendors/tezos-modded/src/lib_storage/raw_store.ml
new file mode 100644
index 000000000..e45090d53
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/raw_store.ml
@@ -0,0 +1,309 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Rresult
+
+type t = {
+  dir : Lmdb.t ;
+  parent : (Lmdb.rw Lmdb.txn * Lmdb.db * Lmdb.rw Lmdb.cursor) Lwt.key ;
+}
+
+type key = string list
+type value = MBytes.t
+
+type error += Unknown of string list
+
+let () =
+  Error_monad.register_error_kind
+    `Permanent
+    ~id:"raw_store.unknown"
+    ~title:"Missing key in store"
+    ~description:"Missing key in store"
+    ~pp:(fun ppf keys ->
+        Format.fprintf ppf
+          "Missing key in store: %s"
+          (String.concat "/" keys))
+    Data_encoding.(obj1 (req "key" (list string)))
+    (function Unknown keys -> Some keys | _ -> None)
+    (fun keys -> Unknown keys)
+
+let concat = String.concat "/"
+let split = String.split_on_char '/'
+
+let lwt_fail_error err =
+  Lwt.fail_with (Lmdb.string_of_error err)
+
+let of_result = function
+  | Ok res -> Lwt.return res
+  | Error err -> lwt_fail_error err
+
+let (>>=?) v f =
+  match v with
+  | Error err -> lwt_fail_error err
+  | Ok v -> f v
+
+let init ?mapsize path =
+  if not (Sys.file_exists path) then Unix.mkdir path 0o755 ;
+  let sync_flag =
+    match Sys.getenv_opt "TEZOS_STORE_SYNC" with
+    | None -> []
+    | Some s ->
+        match String.lowercase_ascii s with
+        | "nosync" -> [ Lmdb.NoSync ]
+        | "nometasync" -> [ Lmdb.NoMetaSync ]
+        | _ ->
+            Printf.eprintf "Unrecognized TEZOS_SYNC option : %s\n\
+                            allowed: nosync nometasync" s;
+            []
+  in
+  match Lmdb.opendir ?mapsize ~flags:(sync_flag @ [NoTLS; NoMetaSync]) path 0o644 with
+  | Ok dir -> return { dir ; parent = Lwt.new_key () }
+  | Error err -> failwith "%a" Lmdb.pp_error err
+
+let close { dir } = Lmdb.closedir dir
+
+let known { dir ; parent } key =
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> Lmdb.mem txn db (concat key)
+    | None ->
+        Lmdb.with_ro_db dir ~f:begin fun txn db ->
+          Lmdb.mem txn db (concat key)
+        end
+  end |> of_result
+
+let read_opt { dir ; parent } key =
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> Lmdb.get txn db (concat key) >>| MBytes.copy
+    | None ->
+        Lmdb.with_ro_db dir ~f:begin fun txn db ->
+          Lmdb.get txn db (concat key) >>| MBytes.copy
+        end
+  end |> function
+  | Ok v -> Lwt.return_some v
+  | Error KeyNotFound -> Lwt.return_none
+  | Error err -> lwt_fail_error err
+
+let read { dir ; parent } key =
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> Lmdb.get txn db (concat key) >>| MBytes.copy
+    | None ->
+        Lmdb.with_ro_db dir ~f:begin fun txn db ->
+          Lmdb.get txn db (concat key) >>| MBytes.copy
+        end
+  end |> function
+  | Ok v -> return v
+  | Error _err -> fail (Unknown key)
+
+let read_exn { dir ; parent } key =
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> Lmdb.get txn db (concat key) >>| MBytes.copy
+    | None ->
+        Lmdb.with_ro_db dir ~f:begin fun txn db ->
+          Lmdb.get txn db (concat key) >>| MBytes.copy
+        end
+  end |> of_result
+
+let store { dir ; parent } k v =
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> Lmdb.put txn db (concat k) v
+    | None ->
+        Lmdb.with_rw_db dir ~f:begin fun txn db ->
+          Lmdb.put txn db (concat k) v
+        end
+  end |> of_result
+
+let remove { dir ; parent } k =
+  let remove txn db =
+    match Lmdb.del txn db (concat k) with
+    | Ok () -> Ok ()
+    | Error KeyNotFound -> Ok ()
+    | Error err -> Error err in
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) -> remove txn db
+    | None -> Lmdb.with_rw_db dir ~f:remove
+  end |> of_result
+
+let is_prefix s s' =
+  String.(length s <= length s' && compare s (sub s' 0 (length s)) = 0)
+
+let known_dir { dir ; parent } k =
+  let k = concat k in
+  let cursor_fun cursor =
+    Lmdb.cursor_at cursor k >>= fun () ->
+    Lmdb.cursor_get cursor >>| fun (first_k, _v) ->
+    (is_prefix k (MBytes.to_string first_k))
+  in
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) ->
+        Lmdb.with_cursor txn db ~f:cursor_fun
+    | None ->
+        Lmdb.with_ro_db dir ~f:begin fun txn db ->
+          Lmdb.with_cursor txn db ~f:cursor_fun
+        end
+  end |> of_result
+
+let remove_dir { dir ; parent } k =
+  let k = concat k in
+  let cursor_fun cursor =
+    Lmdb.cursor_at cursor k >>= fun () ->
+    Lmdb.cursor_iter cursor ~f:begin fun (kk, _v) ->
+      let kk_string = MBytes.to_string kk in
+      if is_prefix k kk_string then begin
+        Lmdb.cursor_del cursor
+      end
+      else Error KeyNotFound
+    end in
+  begin match Lwt.get parent with
+    | Some (txn, db, _cursor) ->
+        Lmdb.with_cursor txn db ~f:cursor_fun
+    | None ->
+        Lmdb.with_rw_db dir ~f:begin fun txn db ->
+          Lmdb.with_cursor txn db ~f:cursor_fun
+        end
+  end |> function
+  | Error KeyNotFound
+  | Ok () -> Lwt.return_unit
+  | Error err -> lwt_fail_error err
+
+let list_equal l1 l2 len =
+  if len < 0 || len > List.length l1 || len > List.length l2
+  then invalid_arg "list_compare: invalid len" ;
+  let rec inner l1 l2 len =
+    match len, l1, l2 with
+    | 0, _, _ -> true
+    | _, [], _
+    | _, _, [] -> false
+    | _, h1 :: t1, h2 :: t2 ->
+        if h1 <> h2 then false
+        else inner t1 t2 (pred len)
+  in
+  inner l1 l2 len
+
+let is_child ~parent ~child =
+  let plen = List.length parent in
+  let clen = List.length child in
+  clen > plen && list_equal parent child plen
+
+let list_sub l pos len =
+  if len < 0 || pos < 0 || pos + len > List.length l then
+    invalid_arg "list_sub" ;
+  let rec inner (acc, n) = function
+    | [] -> List.rev acc
+    | h :: t ->
+        if n = 0 then List.rev acc
+        else inner (h :: acc, pred n) t in
+  inner ([], len) l
+
+let with_rw_cursor_lwt ?nosync ?nometasync ?flags ?name { dir ; parent } ~f =
+  let local_parent =
+    match Lwt.get parent with
+    | None -> None
+    | Some (txn, _db, _cursor) -> Some txn in
+  Lmdb.create_rw_txn
+    ?nosync ?nometasync ?parent:local_parent dir >>=? fun txn ->
+  Lmdb.opendb ?flags ?name txn >>=? fun db ->
+  Lmdb.opencursor txn db >>=? fun cursor ->
+  Lwt.with_value parent (Some (txn, db, cursor)) begin fun () ->
+    Lwt.try_bind (fun () -> f cursor)
+      begin fun res ->
+        Lmdb.cursor_close cursor ;
+        Lmdb.commit_txn txn >>=? fun () ->
+        Lwt.return res
+      end
+      begin fun exn ->
+        Lmdb.cursor_close cursor ;
+        Lmdb.abort_txn txn ;
+        Lwt.fail exn
+      end
+  end
+
+let cursor_next_lwt cursor acc f =
+  match Lmdb.cursor_next cursor with
+  | Error KeyNotFound -> acc
+  | Error err -> lwt_fail_error err
+  | Ok () -> Lwt.bind acc f
+
+let cursor_at_lwt cursor k acc f =
+  match Lmdb.cursor_at cursor (concat k) with
+  | Error KeyNotFound -> acc
+  | Error err -> lwt_fail_error err
+  | Ok () -> Lwt.bind acc f
+
+(* assumption: store path segments have only characters different than
+   the separator '/', which immediately precedes '0' *)
+let zero_char_str = String.make 1 (Char.chr (Char.code '/' + 1))
+let next_key_after_subdirs = function
+  | [] -> [ zero_char_str ]
+  | (_ :: _) as path ->
+      List.sub path (List.length path - 1) @
+      [List.last_exn path ^ zero_char_str]
+
+let fold t k ~init ~f =
+  let base_len = List.length k in
+  let rec inner ht cursor acc =
+    Lmdb.cursor_get cursor >>=? fun (kk, _v) ->
+    let kk = MBytes.to_string kk in
+    let kk_split = split kk in
+    match is_child ~child:kk_split ~parent:k with
+    | false -> Lwt.return acc
+    | true ->
+        let cur_len = List.length kk_split in
+        if cur_len = succ base_len then begin
+          cursor_next_lwt cursor (f (`Key kk_split) acc) (inner ht cursor)
+        end
+        else begin
+          let dir = list_sub kk_split 0 (succ base_len) in
+          if Hashtbl.mem ht dir then
+            cursor_at_lwt cursor (next_key_after_subdirs dir)
+              (Lwt.return acc) (inner ht cursor)
+          else begin
+            Hashtbl.add ht dir () ;
+            cursor_next_lwt cursor (f (`Dir dir) acc) (inner ht cursor)
+          end
+        end in
+  with_rw_cursor_lwt t ~f:begin fun cursor ->
+    cursor_at_lwt cursor k
+      (Lwt.return init)
+      (fun acc ->
+         let ht = Hashtbl.create 31 in
+         inner ht cursor acc)
+  end
+
+let fold_keys t k ~init ~f =
+  with_rw_cursor_lwt t ~f:begin fun cursor ->
+    cursor_at_lwt cursor k
+      (Lwt.return init)
+      (let rec inner acc =
+         Lmdb.cursor_get cursor >>=? fun (kk, _v) ->
+         let kk = MBytes.to_string kk in
+         let kk_split = split kk in
+         match is_child ~child:kk_split ~parent:k with
+         | false -> Lwt.return acc
+         | true -> cursor_next_lwt cursor (f kk_split acc) inner
+       in inner)
+  end
+
+let keys t =
+  fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
diff --git a/vendors/tezos-modded/src/lib_storage/raw_store.mli b/vendors/tezos-modded/src/lib_storage/raw_store.mli
new file mode 100644
index 000000000..c203db89d
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/raw_store.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Store_sigs
+
+include STORE
+
+val init: ?mapsize:int64 -> string -> t tzresult Lwt.t
+val close : t -> unit
+
diff --git a/vendors/tezos-modded/src/lib_storage/store_helpers.ml b/vendors/tezos-modded/src/lib_storage/store_helpers.ml
new file mode 100644
index 000000000..9810d87f8
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/store_helpers.ml
@@ -0,0 +1,399 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Store_sigs
+
+module Make_value (V : ENCODED_VALUE) = struct
+  type t = V.t
+  let of_bytes b =
+    match Data_encoding.Binary.of_bytes V.encoding b with
+    | None -> generic_error "Cannot parse data" (* TODO personalize *)
+    | Some v -> ok v
+  let to_bytes v =
+    try Data_encoding.Binary.to_bytes_exn V.encoding v
+    with Data_encoding.Binary.Write_error error ->
+      Store_logging.log_error
+        "Exception while serializing value %a"
+        Data_encoding.Binary.pp_write_error error ;
+      MBytes.create 0
+end
+
+module Raw_value = struct
+  type t = MBytes.t
+  let of_bytes b = ok b
+  let to_bytes b = b
+end
+
+module Make_single_store (S : STORE) (N : NAME) (V : VALUE) = struct
+  type t = S.t
+  type value = V.t
+  let known t = S.known t N.name
+  let read t = S.read t N.name >>=? fun b -> Lwt.return (V.of_bytes b)
+  let read_opt t =
+    read t >|= function
+    | Error _ -> None
+    | Ok v -> Some v
+  let read_exn t =
+    read t >>= function
+    | Error _ -> Lwt.fail Not_found
+    | Ok v -> Lwt.return v
+  let store t v = S.store t N.name (V.to_bytes v)
+  let remove t = S.remove t N.name
+end
+
+let map_key f = function
+  |`Key k -> `Key (f k)
+  | `Dir k -> `Dir (f k)
+
+module Make_substore (S : STORE) (N : NAME)
+  : STORE with type t = S.t = struct
+  type t = S.t
+  type key = string list
+  type value = MBytes.t
+  let name_length = List.length N.name
+  let to_key k = N.name @ k
+  let of_key k = List.remove name_length k
+  let known t k = S.known t (to_key k)
+  let known_dir t k = S.known_dir t (to_key k)
+  let read t k = S.read t (to_key k)
+  let read_opt t k = S.read_opt t (to_key k)
+  let read_exn t k = S.read_exn t (to_key k)
+  let store t k v = S.store t (to_key k) v
+  let remove t k = S.remove t (to_key k)
+  let fold t k ~init ~f =
+    S.fold t (to_key k) ~init
+      ~f:(fun k acc -> f (map_key of_key k) acc)
+  let keys t k = S.keys t (to_key k) >|= fun keys -> List.map of_key keys
+  let fold_keys t k ~init ~f =
+    S.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)
+  let remove_dir t k = S.remove_dir t (to_key k)
+end
+
+module Make_indexed_substore (S : STORE) (I : INDEX) = struct
+
+  type t = S.t
+  type key = I.t
+
+  module Store = struct
+    type t = S.t * I.t
+    type key = string list
+    type value = MBytes.t
+    let to_key i k =
+      assert (List.length (I.to_path i []) = I.path_length) ;
+      I.to_path i k
+    let of_key k = List.remove I.path_length k
+    let known (t,i) k = S.known t (to_key i k)
+    let known_dir (t,i) k = S.known_dir t (to_key i k)
+    let read (t,i) k = S.read t (to_key i k)
+    let read_opt (t,i) k = S.read_opt t (to_key i k)
+    let read_exn (t,i) k = S.read_exn t (to_key i k)
+    let store (t,i) k v = S.store t (to_key i k) v
+    let remove (t,i) k = S.remove t (to_key i k)
+    let fold (t,i) k ~init ~f =
+      S.fold t (to_key i k) ~init
+        ~f:(fun k acc -> f (map_key of_key k) acc)
+    let keys (t,i) k = S.keys t (to_key i k) >|= fun keys -> List.map of_key keys
+    let fold_keys (t,i) k ~init ~f =
+      S.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)
+    let remove_dir (t,i) k = S.remove_dir t (to_key i k)
+  end
+
+  let remove_all t i = Store.remove_dir (t, i) []
+
+  let fold_indexes t ~init ~f =
+    let rec dig i path acc =
+      if i <= 0 then
+        match I.of_path path with
+        | None -> assert false
+        | Some path -> f path acc
+      else
+        S.fold t path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k -> dig (i-1) k acc
+          | `Key _ -> Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let indexes t =
+    fold_indexes t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))
+
+  let list t k = S.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
+  let resolve_index t prefix =
+    let rec loop i prefix = function
+      | [] when i = I.path_length -> begin
+          match I.of_path prefix with
+          | None -> assert false
+          | Some path -> Lwt.return [path]
+        end
+      | [] ->
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix -> loop (i+1) prefix []) prefixes
+          >|= List.flatten
+      | [d] when i = I.path_length - 1 ->
+          if (i >= I.path_length) then invalid_arg "IO.resolve" ;
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix ->
+                  match String.remove_prefix ~prefix:d (List.hd (List.rev prefix)) with
+                  | None -> Lwt.return_nil
+                  | Some _ -> loop (i+1) prefix [])
+            prefixes
+          >|= List.flatten
+      | "" :: ds ->
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix -> loop (i+1) prefix ds) prefixes
+          >|= List.flatten
+      | d :: ds ->
+          if (i >= I.path_length) then invalid_arg "IO.resolve" ;
+          S.known_dir t (prefix @ [d]) >>= function
+          | true -> loop (i+1) (prefix @ [d]) ds
+          | false -> Lwt.return_nil in
+    loop 0 [] prefix
+
+  module Make_set (N : NAME) = struct
+    type t = S.t
+    type elt = I.t
+    let inited = MBytes.of_string "inited"
+    let known s i = Store.known (s, i) N.name
+    let store s i = Store.store (s, i) N.name inited
+    let remove s i = Store.remove (s, i) N.name
+    let remove_all s =
+      fold_indexes s ~init:() ~f:(fun i () -> remove s i)
+    let fold s ~init ~f =
+      fold_indexes s ~init
+        ~f:(fun i acc ->
+            known s i >>= function
+            | true -> f i acc
+            | false -> Lwt.return acc)
+    let elements s =
+      fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+    let iter s ~f =
+      fold s ~init:() ~f:(fun p () -> f p)
+  end
+
+  module Make_buffered_set (N : NAME) (Set : Set.S with type elt = I.t) = struct
+    include Make_set (N)
+    module Set = Set
+    let read_all s =
+      fold s ~init:Set.empty ~f:(fun i set -> Lwt.return (Set.add i set))
+    let store_all s new_set =
+      read_all s >>= fun old_set ->
+      Lwt_list.iter_p (remove s)
+        Set.(elements (diff old_set new_set)) >>= fun () ->
+      Lwt_list.iter_p (store s) Set.(elements (diff new_set old_set))
+  end
+
+  module Make_map (N : NAME) (V : VALUE) = struct
+    type t = S.t
+    type key = I.t
+    type value = V.t
+    let known s i = Store.known (s,i) N.name
+    let read s i =
+      Store.read (s,i) N.name >>=? fun b -> Lwt.return (V.of_bytes b)
+    let read_opt s i =
+      read s i >>= function
+      | Error _ -> Lwt.return_none
+      | Ok v -> Lwt.return_some v
+    let read_exn s i =
+      read s i >>= function
+      | Error _ -> Lwt.fail Not_found
+      | Ok v -> Lwt.return v
+    let store s i v = Store.store (s,i) N.name (V.to_bytes v)
+    let remove s i = Store.remove (s,i) N.name
+    let remove_all s = fold_indexes s ~init:() ~f:(fun i () -> remove s i)
+    let fold s ~init ~f =
+      fold_indexes s ~init
+        ~f:(fun i acc ->
+            read_opt s i >>= function
+            | None -> Lwt.return acc
+            | Some v -> f i v acc)
+    let bindings s =
+      fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
+    let iter s ~f =
+      fold s ~init:() ~f:(fun p v () -> f p v)
+    let fold_keys s ~init ~f =
+      fold_indexes s ~init
+        ~f:(fun i acc ->
+            known s i >>= function
+            | false -> Lwt.return acc
+            | true -> f i acc)
+    let keys s =
+      fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+    let iter_keys s ~f =
+      fold_keys s ~init:() ~f:(fun p () -> f p)
+  end
+
+  module Make_buffered_map
+      (N : NAME) (V : VALUE)
+      (Map : Map.S with type key = I.t) = struct
+    include Make_map (N) (V)
+    module Map = Map
+    let read_all s =
+      fold s ~init:Map.empty ~f:(fun i v set -> Lwt.return (Map.add i v set))
+    let store_all s map =
+      remove_all s >>= fun () ->
+      Map.fold
+        (fun k v acc -> let res = store s k v in acc >>= fun () -> res)
+        map Lwt.return_unit
+  end
+
+end
+
+module Make_set (S : STORE) (I : INDEX) = struct
+  type t = S.t
+  type elt = I.t
+  let inited = MBytes.of_string "inited"
+  let known s i = S.known s (I.to_path i [])
+  let store s i = S.store s (I.to_path i []) inited
+  let remove s i = S.remove s (I.to_path i [])
+  let remove_all s = S.remove_dir s []
+
+  let fold s ~init ~f =
+    let rec dig i path acc =
+      if i <= 1 then
+        S.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir _ -> Lwt.return acc
+          | `Key file ->
+              match I.of_path file with
+              | None -> assert false
+              | Some p -> f p acc
+        end
+      else
+        S.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k ->
+              dig (i-1) k acc
+          | `Key _ ->
+              Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let elements s =
+    fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+  let iter s ~f =
+    fold s ~init:() ~f:(fun p () -> f p)
+end
+
+module Make_buffered_set
+    (S : STORE) (I : INDEX) (Set : Set.S with type elt = I.t) = struct
+  include Make_set (S) (I)
+  module Set = Set
+  let read_all s =
+    fold s ~init:Set.empty ~f:(fun i set -> Lwt.return (Set.add i set))
+  let store_all s new_set =
+    read_all s >>= fun old_set ->
+    Lwt_list.iter_p (remove s) Set.(elements (diff old_set new_set)) >>= fun () ->
+    Lwt_list.iter_p (store s) Set.(elements (diff new_set old_set))
+end
+
+module Make_map (S : STORE) (I : INDEX) (V : VALUE) = struct
+  type t = S.t
+  type key = I.t
+  type value = V.t
+  let known s i = S.known s (I.to_path i [])
+  let read s i =
+    S.read s (I.to_path i []) >>=? fun b -> Lwt.return (V.of_bytes b)
+  let read_opt s i =
+    read s i >>= function
+    | Error _ -> Lwt.return_none
+    | Ok v -> Lwt.return_some v
+  let read_exn s i =
+    read s i >>= function
+    | Error _ -> Lwt.fail Not_found
+    | Ok v -> Lwt.return v
+  let store s i v = S.store s (I.to_path i []) (V.to_bytes v)
+  let remove s i = S.remove s (I.to_path i [])
+  let remove_all s = S.remove_dir s []
+  let fold s ~init ~f =
+    let rec dig i path acc =
+      if i <= 1 then
+        S.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir _ -> Lwt.return acc
+          | `Key file ->
+              S.read_opt s file >>= function
+              | None -> Lwt.return acc
+              | Some b ->
+                  match V.of_bytes b with
+                  | Error _ ->
+                      (* Silently ignore unparsable data *)
+                      Lwt.return acc
+                  | Ok v ->
+                      match I.of_path file with
+                      | None -> assert false
+                      | Some path -> f path v acc
+        end
+      else
+        S.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k -> dig (i-1) k acc
+          | `Key _ -> Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let bindings s =
+    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
+  let iter s ~f =
+    fold s ~init:() ~f:(fun p v () -> f p v)
+  let fold_keys s ~init ~f =
+    S.fold s [] ~init
+      ~f:(fun p acc ->
+          match p with
+          | `Dir _ -> Lwt.return acc
+          | `Key p ->
+              match I.of_path p with
+              | None -> assert false
+              | Some path -> f path acc)
+  let keys s =
+    fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+  let iter_keys s ~f =
+    fold_keys s ~init:() ~f:(fun p () -> f p)
+end
+
+module Make_buffered_map
+    (S : STORE) (I : INDEX) (V : VALUE)
+    (Map : Map.S with type key = I.t) = struct
+  include Make_map (S) (I) (V)
+  module Map = Map
+  let read_all s =
+    fold s ~init:Map.empty ~f:(fun i v set -> Lwt.return (Map.add i v set))
+  let store_all s map =
+    remove_all s >>= fun () ->
+    Map.fold
+      (fun k v acc -> let res = store s k v in acc >>= fun () -> res)
+      map Lwt.return_unit
+end
+
+module Integer_index = struct
+  type t = int
+  let path_length = 1
+  let to_path x l = string_of_int x :: l
+  let of_path = function
+    | [x] -> begin try Some (int_of_string x) with _ -> None end
+    | _ -> None
+end
diff --git a/vendors/tezos-modded/src/lib_storage/store_helpers.mli b/vendors/tezos-modded/src/lib_storage/store_helpers.mli
new file mode 100644
index 000000000..127f8ebe1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/store_helpers.mli
@@ -0,0 +1,65 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Store_sigs
+
+module Make_value (V : ENCODED_VALUE) : VALUE with type t = V.t
+
+module Raw_value : VALUE with type t = MBytes.t
+
+module Make_single_store (S : STORE) (N : NAME) (V : VALUE)
+  : SINGLE_STORE with type t = S.t
+                  and type value = V.t
+
+module Make_substore (S : STORE) (N : NAME)
+  : STORE with type t = S.t
+
+module Make_set (S : STORE) (I : INDEX)
+  : SET_STORE with type t = S.t and type elt = I.t
+
+module Make_buffered_set
+    (S : STORE) (I : INDEX) (Set : Set.S with type elt = I.t)
+  : BUFFERED_SET_STORE with type t = S.t
+                        and type elt = I.t
+                        and module Set = Set
+
+module Make_map
+    (S : STORE) (I : INDEX) (V : VALUE)
+  : MAP_STORE with type t = S.t
+               and type key = I.t
+               and type value = V.t
+
+module Make_buffered_map
+    (S : STORE) (I : INDEX) (V : VALUE) (Map : Map.S with type key = I.t)
+  : BUFFERED_MAP_STORE with type t = S.t
+                        and type key = I.t
+                        and type value = V.t
+                        and module Map = Map
+
+module Make_indexed_substore (S : STORE) (I : INDEX)
+  : INDEXED_STORE with type t = S.t
+                   and type key = I.t
+
+module Integer_index : INDEX with type t = int
diff --git a/vendors/tezos-modded/src/lib_storage/store_logging.ml b/vendors/tezos-modded/src/lib_storage/store_logging.ml
new file mode 100644
index 000000000..f79df4b52
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/store_logging.ml
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make(struct let name = "db" end)
diff --git a/vendors/tezos-modded/src/lib_storage/store_logging.mli b/vendors/tezos-modded/src/lib_storage/store_logging.mli
new file mode 100644
index 000000000..ede719e2c
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/store_logging.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.LOG
diff --git a/vendors/tezos-modded/src/lib_storage/store_sigs.ml b/vendors/tezos-modded/src/lib_storage/store_sigs.ml
new file mode 100644
index 000000000..1263cdee1
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/store_sigs.ml
@@ -0,0 +1,165 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type NAME = sig
+  val name : string list
+end
+
+module type VALUE = sig
+  type t
+  val of_bytes: MBytes.t -> t tzresult
+  val to_bytes: t -> MBytes.t
+end
+
+module type ENCODED_VALUE = sig
+  type t
+  val encoding: t Data_encoding.t
+end
+
+module type INDEX = sig
+  type t
+  val path_length: int
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+end
+
+module type SINGLE_STORE = sig
+  type t
+  type value
+  val known: t -> bool Lwt.t
+  val read: t -> value tzresult Lwt.t
+  val read_opt: t -> value option Lwt.t
+  val read_exn: t -> value Lwt.t
+  val store: t -> value -> unit Lwt.t
+  val remove: t -> unit Lwt.t
+end
+
+module type STORE = sig
+
+  type t
+  type key = string list
+  type value = MBytes.t
+
+  val known: t -> key -> bool Lwt.t
+  val read: t -> key -> value tzresult Lwt.t
+  val read_opt: t -> key -> value option Lwt.t
+  val read_exn: t -> key -> value Lwt.t
+  val store: t -> key -> value -> unit Lwt.t
+  val remove: t -> key -> unit Lwt.t
+
+  val known_dir: t -> key -> bool Lwt.t
+  val remove_dir: t -> key -> unit Lwt.t
+
+  val fold:
+    t -> key -> init:'a ->
+    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+    'a Lwt.t
+
+  val keys: t -> key -> key list Lwt.t
+  val fold_keys: t -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+end
+
+module type SET_STORE = sig
+  type t
+  type elt
+  val known: t -> elt -> bool Lwt.t
+  val store: t -> elt -> unit Lwt.t
+  val remove: t -> elt -> unit Lwt.t
+  val elements: t -> elt list Lwt.t
+  val remove_all: t -> unit Lwt.t
+  val iter: t -> f:(elt -> unit Lwt.t) -> unit Lwt.t
+  val fold: t -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+end
+
+module type BUFFERED_SET_STORE = sig
+  include SET_STORE
+  module Set : Set.S with type elt = elt
+  val read_all: t -> Set.t Lwt.t
+  val store_all: t -> Set.t -> unit Lwt.t
+end
+
+module type MAP_STORE = sig
+  type t
+  type key
+  type value
+  val known: t -> key -> bool Lwt.t
+  val read: t -> key -> value tzresult Lwt.t
+  val read_opt: t -> key -> value option Lwt.t
+  val read_exn: t -> key -> value Lwt.t
+  val store: t -> key -> value -> unit Lwt.t
+  val remove: t -> key -> unit Lwt.t
+  val keys: t -> key list Lwt.t
+  val bindings: t -> (key * value) list Lwt.t
+  val remove_all: t -> unit Lwt.t
+  val iter: t -> f:(key -> value -> unit Lwt.t) -> unit Lwt.t
+  val iter_keys: t -> f:(key -> unit Lwt.t) -> unit Lwt.t
+  val fold: t -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  val fold_keys: t -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+end
+
+module type BUFFERED_MAP_STORE = sig
+  include MAP_STORE
+  module Map : Map.S with type key = key
+  val read_all: t -> value Map.t Lwt.t
+  val store_all: t -> value Map.t -> unit Lwt.t
+end
+
+module type INDEXED_STORE = sig
+
+  type t
+  type key
+
+  module Store : STORE with type t = t * key
+
+  val remove_all: t -> key -> unit Lwt.t
+
+  val fold_indexes: t -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  val indexes: t -> key list Lwt.t
+
+  val resolve_index: t -> string list -> key list Lwt.t
+
+  module Make_set (N : NAME)
+    : SET_STORE with type t = t
+                 and type elt = key
+
+  module Make_buffered_set (N : NAME) (Set : Set.S with type elt = key)
+    : BUFFERED_SET_STORE with type t = t
+                          and type elt = key
+                          and module Set = Set
+
+  module Make_map (N : NAME) (V : VALUE)
+    : MAP_STORE with type t = t
+                 and type key = key
+                 and type value = V.t
+
+  module Make_buffered_map
+      (N : NAME) (V : VALUE) (Map : Map.S with type key = key)
+    : BUFFERED_MAP_STORE with type t = t
+                          and type key = key
+                          and type value = V.t
+                          and module Map = Map
+
+end
diff --git a/vendors/tezos-modded/src/lib_storage/test/assert.ml b/vendors/tezos-modded/src/lib_storage/test/assert.ml
new file mode 100644
index 000000000..4bf79a8a2
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/test/assert.ml
@@ -0,0 +1,79 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fail expected given msg =
+  Format.kasprintf Pervasives.failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+let fail_msg fmt = Format.kasprintf (fail "" "") fmt
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (prn x) (prn y) msg
+
+let equal_string ?msg s1 s2 =
+  equal ?msg ~prn:(fun s -> s) s1 s2
+
+let equal_string_option ?msg o1 o2 =
+  let prn = function
+    | None -> "None"
+    | Some s -> s in
+  equal ?msg ~prn o1 o2
+
+let is_none ?(msg="") x =
+  if x <> None then fail "None" "Some _" msg
+
+let make_equal_list eq prn ?(msg="") x y =
+  let rec iter i x y =
+    match x, y with
+    | hd_x :: tl_x, hd_y :: tl_y ->
+        if eq hd_x hd_y then
+          iter (succ i) tl_x tl_y
+        else
+          let fm = Printf.sprintf "%s (at index %d)" msg i in
+          fail (prn hd_x) (prn hd_y) fm
+    | _ :: _, [] | [], _ :: _ ->
+        let fm = Printf.sprintf "%s (lists of different sizes)" msg in
+        fail_msg "%s" fm
+    | [], [] ->
+        () in
+  iter 0 x y
+
+let equal_string_list ?msg l1 l2 =
+  make_equal_list ?msg (=) (fun x -> x) l1 l2
+
+let equal_string_list_list ?msg l1 l2 =
+  let pr_persist l =
+    let res =
+      String.concat ";" (List.map (fun s -> Printf.sprintf "%S" s) l) in
+    Printf.sprintf "[%s]" res in
+  make_equal_list ?msg (=) pr_persist l1 l2
+
+let equal_key_dir_list ?msg l1 l2 =
+  make_equal_list ?msg (=)
+    (function
+      | `Key k -> "Key " ^ String.concat "/" k
+      | `Dir k -> "Dir " ^ String.concat "/" k)
+    l1 l2
diff --git a/vendors/tezos-modded/src/lib_storage/test/dune b/vendors/tezos-modded/src/lib_storage/test/dune
new file mode 100644
index 000000000..67282a3fe
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/test/dune
@@ -0,0 +1,24 @@
+(executables
+ (names test)
+ (libraries tezos-base
+            tezos-storage
+            tezos-stdlib-unix
+            alcotest-lwt)
+ (flags (:standard -w -9-32
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_storage
+                   -open Tezos_stdlib_unix)))
+
+(alias
+ (name buildtest)
+ (deps test.exe))
+
+(alias
+ (name runtest)
+ (action (chdir %{workspace_root} (run %{exe:test.exe}))))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_storage/test/test.ml b/vendors/tezos-modded/src/lib_storage/test/test.ml
new file mode 100644
index 000000000..21a383a58
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/test/test.ml
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Alcotest.run "tezos-storage" [
+    "context", Test_context.tests ;
+    "raw_store", Test_raw_store.tests ;
+  ]
diff --git a/vendors/tezos-modded/src/lib_storage/test/test_context.ml b/vendors/tezos-modded/src/lib_storage/test/test_context.ml
new file mode 100644
index 000000000..224b70afe
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/test/test_context.ml
@@ -0,0 +1,243 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Context
+
+let (>>=) = Lwt.bind
+let (>|=) = Lwt.(>|=)
+let (//) = Filename.concat
+
+(** Basic blocks *)
+
+let genesis_block =
+  Block_hash.of_b58check_exn
+    "BLockGenesisGenesisGenesisGenesisGenesisGeneskvg68z"
+
+let genesis_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let genesis_time =
+  Time.of_seconds 0L
+
+let chain_id = Chain_id.of_block_hash genesis_block
+
+(** Context creation *)
+
+let commit = commit ~time:Time.epoch ~message:""
+
+let block2 =
+  Block_hash.of_hex_exn
+    (`Hex "2222222222222222222222222222222222222222222222222222222222222222")
+
+let create_block2 idx genesis_commit =
+  checkout idx genesis_commit >>= function
+  | None ->
+      Assert.fail_msg "checkout genesis_block"
+  | Some ctxt ->
+      set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
+      set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
+      set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt ->
+      commit ctxt
+
+let block3a =
+  Block_hash.of_hex_exn
+    (`Hex "3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a3a")
+
+let create_block3a idx block2_commit =
+  checkout idx block2_commit >>= function
+  | None  ->
+      Assert.fail_msg "checkout block2"
+  | Some ctxt ->
+      del ctxt ["a"; "b"] >>= fun ctxt ->
+      set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt ->
+      commit ctxt
+
+let block3b =
+  Block_hash.of_hex_exn
+    (`Hex "3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b3b")
+
+let block3c =
+  Block_hash.of_hex_exn
+    (`Hex "3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c3c")
+
+let create_block3b idx block2_commit =
+  checkout idx block2_commit >>= function
+  | None ->
+      Assert.fail_msg "checkout block3b"
+  | Some ctxt ->
+      del ctxt ["a"; "c"] >>= fun ctxt ->
+      set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt ->
+      commit ctxt
+
+type t = {
+  idx: Context.index ;
+  genesis: Context_hash.t ;
+  block2: Context_hash.t ;
+  block3a: Context_hash.t ;
+  block3b: Context_hash.t ;
+}
+
+let wrap_context_init f _ () =
+  Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
+    let root = base_dir // "context" in
+    Context.init ~mapsize:4_096_000L root >>= fun idx ->
+    Context.commit_genesis idx
+      ~chain_id
+      ~time:genesis_time
+      ~protocol:genesis_protocol >>= fun genesis ->
+    create_block2 idx genesis >>= fun block2 ->
+    create_block3a idx block2 >>= fun block3a ->
+    create_block3b idx block2  >>= fun block3b ->
+    f { idx; genesis; block2 ; block3a; block3b } >>= fun result ->
+    Lwt.return result
+  end
+
+(** Simple test *)
+
+let c = function
+  | None -> None
+  | Some s -> Some (MBytes.to_string s)
+
+let test_simple { idx ; block2 } =
+  checkout idx block2 >>= function
+  | None ->
+      Assert.fail_msg "checkout block2"
+  | Some ctxt ->
+      get ctxt ["version"] >>= fun version ->
+      Assert.equal_string_option ~msg:__LOC__ (c version) (Some "0.0") ;
+      get ctxt ["a";"b"] >>= fun novembre ->
+      Assert.equal_string_option (Some "Novembre") (c novembre) ;
+      get ctxt ["a";"c"] >>= fun juin ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
+      Lwt.return_unit
+
+let test_continuation { idx ; block3a } =
+  checkout idx block3a >>= function
+  | None  ->
+      Assert.fail_msg "checkout block3a"
+  | Some ctxt ->
+      get ctxt ["version"] >>= fun version ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
+      get ctxt ["a";"b"] >>= fun novembre ->
+      Assert.is_none ~msg:__LOC__ (c novembre) ;
+      get ctxt ["a";"c"] >>= fun juin ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
+      get ctxt ["a";"d"] >>= fun mars ->
+      Assert.equal_string_option ~msg:__LOC__  (Some "Mars") (c mars) ;
+      Lwt.return_unit
+
+let test_fork { idx ; block3b } =
+  checkout idx block3b >>= function
+  | None  ->
+      Assert.fail_msg "checkout block3b"
+  | Some ctxt ->
+      get ctxt ["version"] >>= fun version ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ;
+      get ctxt ["a";"b"] >>= fun novembre ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+      get ctxt ["a";"c"] >>= fun juin ->
+      Assert.is_none ~msg:__LOC__ (c juin) ;
+      get ctxt ["a";"d"] >>= fun mars ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ;
+      Lwt.return_unit
+
+let test_replay { idx ; genesis }  =
+  checkout idx genesis >>= function
+  | None  ->
+      Assert.fail_msg "checkout genesis_block"
+  | Some ctxt0 ->
+      set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 ->
+      set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 ->
+      set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 ->
+      set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a ->
+      set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b ->
+      set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a ->
+      get ctxt4a ["a";"b"] >>= fun novembre ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+      get ctxt5a ["a";"b"] >>= fun november ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "November") (c november) ;
+      get ctxt5a ["a";"d"] >>= fun july ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "July") (c july) ;
+      get ctxt4b ["a";"b"] >>= fun novembre ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ;
+      get ctxt4b ["a";"d"] >>= fun juillet ->
+      Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ;
+      Lwt.return_unit
+
+let fold_keys s k ~init ~f =
+  let rec loop k acc =
+    fold s k ~init:acc
+      ~f:(fun file acc ->
+          match file with
+          | `Key k -> f k acc
+          | `Dir k -> loop k acc) in
+  loop k init
+let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
+
+let test_fold { idx ; genesis } =
+  checkout idx genesis >>= function
+  | None ->
+      Assert.fail_msg "checkout genesis_block"
+  | Some ctxt ->
+      set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
+      set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
+      set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt ->
+      set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt ->
+      set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt ->
+      keys ctxt [] >>= fun l ->
+      Assert.equal_string_list_list ~msg:__LOC__
+        [["a";"b"];
+         ["a";"c"];
+         ["a";"d";"e"];
+         ["f"];
+         ["g";"h"]] (List.sort compare l) ;
+      keys ctxt ["a"] >>= fun l ->
+      Assert.equal_string_list_list
+        ~msg:__LOC__ [["a";"b"]; ["a";"c"]; ["a";"d";"e"]]
+        (List.sort compare l) ;
+      keys ctxt ["f"] >>= fun l ->
+      Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+      keys ctxt ["g"] >>= fun l ->
+      Assert.equal_string_list_list ~msg:__LOC__ [["g";"h"]] l ;
+      keys ctxt ["i"] >>= fun l ->
+      Assert.equal_string_list_list ~msg:__LOC__ [] l ;
+      Lwt.return_unit
+
+(******************************************************************************)
+
+let tests : (string * (t -> unit Lwt.t)) list = [
+  "simple", test_simple ;
+  "continuation", test_continuation ;
+  "fork", test_fork ;
+  "replay", test_replay ;
+  "fold", test_fold ;
+]
+
+
+let tests =
+  List.map
+    (fun (s, f) -> Alcotest_lwt.test_case s `Quick (wrap_context_init f))
+    tests
diff --git a/vendors/tezos-modded/src/lib_storage/test/test_raw_store.ml b/vendors/tezos-modded/src/lib_storage/test/test_raw_store.ml
new file mode 100644
index 000000000..408cbdf6b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/test/test_raw_store.ml
@@ -0,0 +1,86 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Raw_store
+
+let (>>=) = Lwt.bind
+let (>|=) = Lwt.(>|=)
+let (//) = Filename.concat
+
+let wrap_store_init f _ () =
+  Lwt_utils_unix.with_tempdir "tezos_test_" begin fun base_dir ->
+    let root = base_dir // "store" in
+    init ~mapsize:4_096_000L root >>= function
+    | Error _ -> Assert.fail_msg "wrap_store_init"
+    | Ok store -> f store
+  end
+
+let entries s k = fold s k ~init:[] ~f:(fun e acc -> Lwt.return (e :: acc)) >|= List.rev
+
+let test_fold st =
+  store st ["a"; "b"] (MBytes.of_string "Novembre") >>= fun _ ->
+  store st ["a"; "c"] (MBytes.of_string "Juin") >>= fun _ ->
+  store st ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun _ ->
+  store st ["f";] (MBytes.of_string "Avril") >>= fun _ ->
+  (* The code of '.' is just below the one of '/' ! *)
+  store st ["g";".12";"a"] (MBytes.of_string "Mai") >>= fun _ ->
+  store st ["g";".12";"b"] (MBytes.of_string "Février") >>= fun _ ->
+  store st ["g";"123";"456"] (MBytes.of_string "Mars") >>= fun _ ->
+  store st ["g";"1230"] (MBytes.of_string "Janvier") >>= fun _ ->
+
+  entries st [] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [`Dir ["a"]; `Key ["f"]; `Dir ["g"]] l ;
+
+  entries st ["0"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [] l ;
+
+  entries st ["0"; "1"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [] l ;
+
+  entries st ["a"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [`Key ["a"; "b"]; `Key ["a"; "c"]; `Dir ["a"; "d"]] l ;
+
+  entries st ["a"; "d"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [`Key ["a"; "d"; "e"]] l ;
+
+  entries st ["f"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [] l ;
+
+  entries st ["f"; "z"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [] l ;
+
+  entries st ["g"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [`Dir ["g";".12"]; `Dir ["g";"123"]; `Key ["g";"1230"]] l ;
+
+  entries st ["g";"123"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [`Key ["g";"123";"456"]] l ;
+
+  entries st ["z"] >>= fun l ->
+  Assert.equal_key_dir_list ~msg:__LOC__ [] l ;
+
+  Lwt.return_unit
+
+let tests =
+  [Alcotest_lwt.test_case "fold" `Quick (wrap_store_init test_fold)]
diff --git a/vendors/tezos-modded/src/lib_storage/tezos-storage.opam b/vendors/tezos-modded/src/lib_storage/tezos-storage.opam
new file mode 100644
index 000000000..4b7ee9007
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_storage/tezos-storage.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "lmdb"
+  "irmin-lmdb"
+  "tezos-stdlib-unix" { with-test }
+  "alcotest-lwt" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/lib_validation/block_validation.ml b/vendors/tezos-modded/src/lib_validation/block_validation.ml
new file mode 100644
index 000000000..7c2f5a3cd
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_validation/block_validation.ml
@@ -0,0 +1,282 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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 Block_validator_errors
+
+type result = {
+  validation_result: Tezos_protocol_environment_shell.validation_result ;
+  block_metadata: MBytes.t ;
+  ops_metadata: MBytes.t list list ;
+  context_hash: Context_hash.t ;
+}
+
+let may_patch_protocol
+    ~level
+    (validation_result : Tezos_protocol_environment_shell.validation_result) =
+  match Block_header.get_forced_protocol_upgrade ~level with
+  | None ->
+      return validation_result
+  | Some hash ->
+      Context.set_protocol validation_result.context hash >>= fun context ->
+      return { validation_result with context }
+
+module Make(Proto : Registered_protocol.T) = struct
+
+  let check_block_header
+      ~(predecessor_block_header : Block_header.t)
+      hash (block_header: Block_header.t) =
+    let validation_passes = List.length Proto.validation_passes in
+    fail_unless
+      (Int32.succ predecessor_block_header.shell.level = block_header.shell.level)
+      (invalid_block hash @@
+       Invalid_level { expected = Int32.succ predecessor_block_header.shell.level ;
+                       found = block_header.shell.level }) >>=? fun () ->
+    fail_unless
+      Time.(predecessor_block_header.shell.timestamp < block_header.shell.timestamp)
+      (invalid_block hash Non_increasing_timestamp) >>=? fun () ->
+    fail_unless
+      Fitness.(predecessor_block_header.shell.fitness < block_header.shell.fitness)
+      (invalid_block hash Non_increasing_fitness) >>=? fun () ->
+    fail_unless
+      (block_header.shell.validation_passes = validation_passes)
+      (invalid_block hash
+         (Unexpected_number_of_validation_passes block_header.shell.validation_passes)
+      ) >>=? fun () ->
+    return_unit
+
+  let parse_block_header block_hash (block_header : Block_header.t) =
+    match
+      Data_encoding.Binary.of_bytes
+        Proto.block_header_data_encoding
+        block_header.protocol_data with
+    | None ->
+        fail (invalid_block block_hash Cannot_parse_block_header)
+    | Some protocol_data ->
+        return ({ shell = block_header.shell ; protocol_data } : Proto.block_header)
+
+  let check_operation_quota block_hash operations =
+    let invalid_block = invalid_block block_hash in
+    iteri2_p
+      begin fun i ops quota ->
+        fail_unless
+          (Option.unopt_map ~default:true
+             ~f:(fun max -> List.length ops <= max)
+             quota.Tezos_protocol_environment_shell.max_op)
+          (let max = Option.unopt ~default:~-1 quota.max_op in
+           invalid_block
+             (Too_many_operations
+                { pass = i + 1 ; found = List.length ops ; max })) >>=? fun () ->
+        iter_p
+          begin fun op ->
+            let size = Data_encoding.Binary.length Operation.encoding op in
+            fail_unless
+              (size <= Proto.max_operation_data_length)
+              (invalid_block
+                 (Oversized_operation
+                    { operation = Operation.hash op ;
+                      size ; max = Proto.max_operation_data_length }))
+          end
+          ops >>=? fun () ->
+        return_unit
+      end
+      operations Proto.validation_passes
+
+  let parse_operations block_hash operations =
+    let invalid_block = invalid_block block_hash in
+    mapi_s
+      begin fun pass ->
+        map_s begin fun op ->
+          let op_hash = Operation.hash op in
+          match
+            Data_encoding.Binary.of_bytes
+              Proto.operation_data_encoding
+              op.Operation.proto with
+          | None ->
+              fail (invalid_block (Cannot_parse_operation op_hash))
+          | Some protocol_data ->
+              let op = { Proto.shell = op.shell ; protocol_data } in
+              let allowed_pass = Proto.acceptable_passes op in
+              fail_unless (List.mem pass allowed_pass)
+                (invalid_block
+                   (Unallowed_pass { operation = op_hash ;
+                                     pass ; allowed_pass } )) >>=? fun () ->
+              return op
+        end
+      end
+      operations
+
+  let apply
+      chain_id
+      ~max_operations_ttl
+      ~(predecessor_block_header : Block_header.t)
+      ~predecessor_context
+      ~(block_header : Block_header.t)
+      operations =
+    let block_hash = Block_header.hash block_header in
+    let invalid_block = invalid_block block_hash in
+    let pred_hash = Block_header.hash predecessor_block_header in
+    check_block_header
+      ~predecessor_block_header
+      block_hash block_header >>=? fun () ->
+    parse_block_header block_hash block_header >>=? fun block_header ->
+    check_operation_quota block_hash operations >>=? fun () ->
+    Context.reset_test_chain
+      predecessor_context pred_hash block_header.shell.timestamp >>= fun context ->
+    parse_operations block_hash operations >>=? fun operations ->
+    (* TODO wrap 'proto_error' into 'block_error' *)
+    Proto.begin_application
+      ~chain_id
+      ~predecessor_context:context
+      ~predecessor_timestamp:predecessor_block_header.shell.timestamp
+      ~predecessor_fitness:predecessor_block_header.shell.fitness
+      block_header >>=? fun state ->
+    fold_left_s
+      (fun (state, acc) ops ->
+         fold_left_s
+           (fun (state, acc) op ->
+              Proto.apply_operation state op >>=? fun (state, op_metadata) ->
+              return (state, op_metadata :: acc))
+           (state, []) ops >>=? fun (state, ops_metadata) ->
+         return (state, List.rev ops_metadata :: acc))
+      (state, []) operations >>=? fun (state, ops_metadata) ->
+    let ops_metadata = List.rev ops_metadata in
+    Proto.finalize_block state >>=? fun (validation_result, block_data) ->
+    may_patch_protocol
+      ~level:block_header.shell.level validation_result >>=? fun validation_result ->
+    Context.get_protocol validation_result.context >>= fun new_protocol ->
+    let expected_proto_level =
+      if Protocol_hash.equal new_protocol Proto.hash then
+        predecessor_block_header.shell.proto_level
+      else
+        (predecessor_block_header.shell.proto_level + 1) mod 256 in
+    fail_when (block_header.shell.proto_level <> expected_proto_level)
+      (invalid_block
+         (Invalid_proto_level {
+             found = block_header.shell.proto_level ;
+             expected = expected_proto_level ;
+           })) >>=? fun () ->
+    fail_when
+      Fitness.(validation_result.fitness <> block_header.shell.fitness)
+      (invalid_block
+         (Invalid_fitness {
+             expected = block_header.shell.fitness ;
+             found = validation_result.fitness ;
+           })) >>=? fun () ->
+    begin
+      if Protocol_hash.equal new_protocol Proto.hash then
+        return validation_result
+      else
+        match Registered_protocol.get new_protocol with
+        | None ->
+            fail (Unavailable_protocol { block = block_hash ;
+                                         protocol = new_protocol })
+        | Some (module NewProto) ->
+            NewProto.init validation_result.context block_header.shell
+    end >>=? fun validation_result ->
+    let max_operations_ttl =
+      max 0
+        (min
+           ((max_operations_ttl)+1)
+           validation_result.max_operations_ttl) in
+    let validation_result =
+      { validation_result with max_operations_ttl } in
+    let block_metadata =
+      Data_encoding.Binary.to_bytes_exn
+        Proto.block_header_metadata_encoding block_data in
+    let ops_metadata =
+      List.map
+        (List.map
+           (Data_encoding.Binary.to_bytes_exn
+              Proto.operation_receipt_encoding))
+        ops_metadata in
+    Context.commit
+      ~time:block_header.shell.timestamp
+      ?message:validation_result.message
+      validation_result.context >>= fun context_hash ->
+    return ({ validation_result ; block_metadata ;
+              ops_metadata ; context_hash })
+
+end
+
+let assert_no_duplicate_operations block_hash live_operations operations =
+  fold_left_s
+    begin fold_left_s
+        begin fun live_operations op ->
+          let oph = Operation.hash op in
+          fail_when (Operation_hash.Set.mem oph live_operations)
+            (invalid_block block_hash @@ Replayed_operation oph) >>=? fun () ->
+          return (Operation_hash.Set.add oph live_operations)
+        end
+    end
+    live_operations operations >>=? fun _ ->
+  return_unit
+
+let assert_operation_liveness block_hash live_blocks operations =
+  iter_s
+    begin iter_s
+        begin fun op ->
+          fail_unless
+            (Block_hash.Set.mem op.Operation.shell.branch live_blocks)
+            (invalid_block block_hash @@
+             Outdated_operation { operation = Operation.hash op ;
+                                  originating_block = op.shell.branch })
+        end
+    end
+    operations
+
+let check_liveness ~live_blocks ~live_operations block_hash operations =
+  assert_no_duplicate_operations
+    block_hash live_operations operations >>=? fun () ->
+  assert_operation_liveness block_hash live_blocks operations >>=? fun () ->
+  return_unit
+
+let apply
+    chain_id
+    ~max_operations_ttl
+    ~(predecessor_block_header : Block_header.t)
+    ~predecessor_context
+    ~(block_header : Block_header.t)
+    operations =
+  let block_hash = Block_header.hash block_header in
+  Context.get_protocol predecessor_context >>= fun pred_protocol_hash ->
+  begin
+    match Registered_protocol.get pred_protocol_hash with
+    | None ->
+        fail (Unavailable_protocol { block = block_hash ;
+                                     protocol = pred_protocol_hash })
+    | Some p -> return p
+  end >>=? fun (module Proto) ->
+  let module Block_validation = Make(Proto) in
+  Block_validation.apply
+    chain_id
+    ~max_operations_ttl
+    ~predecessor_block_header
+    ~predecessor_context
+    ~block_header
+    operations >>= function
+  | Error (Exn (Unix.Unix_error (errno, fn, msg)) :: _) ->
+      fail (System_error { errno ; fn ; msg })
+  | (Ok _ | Error _) as res -> Lwt.return res
diff --git a/vendors/tezos-modded/src/lib_validation/block_validation.mli b/vendors/tezos-modded/src/lib_validation/block_validation.mli
new file mode 100644
index 000000000..d3d71544f
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_validation/block_validation.mli
@@ -0,0 +1,52 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.com>                    *)
+(*                                                                           *)
+(* 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 may_patch_protocol:
+  level:Int32.t ->
+  Tezos_protocol_environment_shell.validation_result ->
+  Tezos_protocol_environment_shell.validation_result tzresult Lwt.t
+
+val check_liveness:
+  live_blocks:Block_hash.Set.t ->
+  live_operations:Operation_hash.Set.t ->
+  Block_hash.t ->
+  Operation.t list list ->
+  unit tzresult Lwt.t
+
+type result = {
+  validation_result: Tezos_protocol_environment_shell.validation_result ;
+  block_metadata: MBytes.t ;
+  ops_metadata: MBytes.t list list ;
+  context_hash: Context_hash.t ;
+}
+
+val apply:
+  Chain_id.t ->
+  max_operations_ttl:int ->
+  predecessor_block_header:Block_header.t ->
+  predecessor_context:Context.t ->
+  block_header:Block_header.t ->
+  Operation.t list list -> result tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/lib_validation/dune b/vendors/tezos-modded/src/lib_validation/dune
new file mode 100644
index 000000000..318cb2cff
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_validation/dune
@@ -0,0 +1,18 @@
+(library
+ (name tezos_validation)
+ (public_name tezos-validation)
+ (libraries tezos-base
+	    tezos-storage
+	    tezos-shell-services
+	    tezos-protocol-updater)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+		   -open Tezos_storage
+		   -open Tezos_shell_services
+		   -open Tezos_protocol_updater)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/lib_validation/tezos-validation.opam b/vendors/tezos-modded/src/lib_validation/tezos-validation.opam
new file mode 100644
index 000000000..331c8782b
--- /dev/null
+++ b/vendors/tezos-modded/src/lib_validation/tezos-validation.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-storage"
+  "tezos-shell-services"
+  "tezos-protocol-updater"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_accuser/dune b/vendors/tezos-modded/src/proto_alpha/bin_accuser/dune
new file mode 100644
index 000000000..314ffcb21
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_accuser/dune
@@ -0,0 +1,18 @@
+(executable
+ (name main_accuser_alpha)
+ (public_name tezos-accuser-alpha)
+ (libraries tezos-client-base-unix
+            tezos-client-commands
+            tezos-baking-alpha-commands)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_baking_alpha_commands
+                   -open Tezos_client_base_unix)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_accuser/main_accuser_alpha.ml b/vendors/tezos-modded/src/proto_alpha/bin_accuser/main_accuser_alpha.ml
new file mode 100644
index 000000000..a6825e360
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_accuser/main_accuser_alpha.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Client_commands.register Proto_alpha.hash @@ fun _network ->
+  List.map (Clic.map_command (new Proto_alpha.wrap_full)) @@
+  Delegate_commands.accuser_commands ()
+
+let select_commands _ _ =
+  return
+    (List.map
+       (Clic.map_command (new Proto_alpha.wrap_full))
+       (Delegate_commands.accuser_commands ()))
+
+let () = Client_main_run.run select_commands
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_accuser/tezos-accuser-alpha.opam b/vendors/tezos-modded/src/proto_alpha/bin_accuser/tezos-accuser-alpha.opam
new file mode 100644
index 000000000..014b413f2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_accuser/tezos-accuser-alpha.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-alpha"
+  "tezos-client-commands"
+  "tezos-baking-alpha-commands"
+  "tezos-client-base-unix"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_baker/dune b/vendors/tezos-modded/src/proto_alpha/bin_baker/dune
new file mode 100644
index 000000000..ddf9ce2bb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_baker/dune
@@ -0,0 +1,18 @@
+(executable
+ (name main_baker_alpha)
+ (public_name tezos-baker-alpha)
+ (libraries tezos-client-base-unix
+            tezos-client-commands
+            tezos-baking-alpha-commands)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_baking_alpha_commands
+                   -open Tezos_client_base_unix)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_baker/main_baker_alpha.ml b/vendors/tezos-modded/src/proto_alpha/bin_baker/main_baker_alpha.ml
new file mode 100644
index 000000000..65dd4c0a9
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_baker/main_baker_alpha.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Client_commands.register Proto_alpha.hash @@ fun _network ->
+  List.map (Clic.map_command (new Proto_alpha.wrap_full)) @@
+  Delegate_commands.delegate_commands ()
+
+let select_commands _ _ =
+  return
+    (List.map
+       (Clic.map_command (new Proto_alpha.wrap_full))
+       (Delegate_commands.baker_commands ()))
+
+let () = Client_main_run.run select_commands
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_baker/tezos-baker-alpha.opam b/vendors/tezos-modded/src/proto_alpha/bin_baker/tezos-baker-alpha.opam
new file mode 100644
index 000000000..014b413f2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_baker/tezos-baker-alpha.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-alpha"
+  "tezos-client-commands"
+  "tezos-baking-alpha-commands"
+  "tezos-client-base-unix"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_endorser/dune b/vendors/tezos-modded/src/proto_alpha/bin_endorser/dune
new file mode 100644
index 000000000..d7fb791d2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_endorser/dune
@@ -0,0 +1,18 @@
+(executable
+ (name main_endorser_alpha)
+ (public_name tezos-endorser-alpha)
+ (libraries tezos-client-base-unix
+            tezos-client-commands
+            tezos-baking-alpha-commands)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_baking_alpha_commands
+                   -open Tezos_client_base_unix)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_endorser/main_endorser_alpha.ml b/vendors/tezos-modded/src/proto_alpha/bin_endorser/main_endorser_alpha.ml
new file mode 100644
index 000000000..5eb567df4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_endorser/main_endorser_alpha.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Client_commands.register Proto_alpha.hash @@ fun _network ->
+  List.map (Clic.map_command (new Proto_alpha.wrap_full)) @@
+  Delegate_commands.delegate_commands ()
+
+let select_commands _ _ =
+  return
+    (List.map
+       (Clic.map_command (new Proto_alpha.wrap_full))
+       (Delegate_commands.endorser_commands ()))
+
+let () = Client_main_run.run select_commands
diff --git a/vendors/tezos-modded/src/proto_alpha/bin_endorser/tezos-endorser-alpha.opam b/vendors/tezos-modded/src/proto_alpha/bin_endorser/tezos-endorser-alpha.opam
new file mode 100644
index 000000000..014b413f2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/bin_endorser/tezos-endorser-alpha.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-client-alpha"
+  "tezos-client-commands"
+  "tezos-baking-alpha-commands"
+  "tezos-client-base-unix"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.ml
new file mode 100644
index 000000000..852df864f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.ml
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Contracts = Client_proto_contracts
+
+module Context = Client_proto_context
+
+module Programs = Client_proto_programs
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.mli
new file mode 100644
index 000000000..ed6107509
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/alpha.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Contracts : module type of Client_proto_contracts
+
+module Context : module type of Client_proto_context
+
+module Programs : module type of Client_proto_programs
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.ml
new file mode 100644
index 000000000..57e7ab6d1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.ml
@@ -0,0 +1,388 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Clic
+
+type error += Bad_tez_arg of string * string (* Arg_name * value *)
+type error += Bad_max_priority of string
+type error += Bad_minimal_fees of string
+type error += Bad_max_waiting_time of string
+type error += Bad_endorsement_delay of string
+type error += Bad_preserved_levels of string
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"badTezArg"
+    ~title:"Bad Tez Arg"
+    ~description:("Invalid \xEA\x9C\xA9 notation in parameter.")
+    ~pp:(fun ppf (arg_name, literal) ->
+        Format.fprintf ppf
+          "Invalid \xEA\x9C\xA9 notation in parameter %s: '%s'"
+          arg_name literal)
+    Data_encoding.(obj2
+                     (req "parameter" string)
+                     (req "literal" string))
+    (function Bad_tez_arg (parameter, literal) -> Some (parameter, literal) | _ -> None)
+    (fun (parameter, literal) -> Bad_tez_arg (parameter, literal)) ;
+  register_error_kind
+    `Permanent
+    ~id:"badMaxPriorityArg"
+    ~title:"Bad -max-priority arg"
+    ~description:("invalid priority in -max-priority")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "invalid priority '%s' in -max-priority" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_max_priority parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_max_priority parameter) ;
+  register_error_kind
+    `Permanent
+    ~id:"badMinimalFeesArg"
+    ~title:"Bad -minimal-fees arg"
+    ~description:("invalid fee threshold in -fee-threshold")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "invalid minimal fees '%s'" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_minimal_fees parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_minimal_fees parameter) ;
+  register_error_kind
+    `Permanent
+    ~id:"badMaxWaitingTimeArg"
+    ~title:"Bad -max-waiting-time arg"
+    ~description:("invalid duration in -max-waiting-time")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "Bad argument value for -max-waiting-time. Expected an integer, but given '%s'" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_max_waiting_time parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_max_waiting_time parameter) ;
+  register_error_kind
+    `Permanent
+    ~id:"badEndorsementDelayArg"
+    ~title:"Bad -endorsement-delay arg"
+    ~description:("invalid duration in -endorsement-delay")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_endorsement_delay parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_endorsement_delay parameter) ;
+  register_error_kind
+    `Permanent
+    ~id:"badPreservedLevelsArg"
+    ~title:"Bad -preserved-levels arg"
+    ~description:("invalid number of levels in -preserved-levels")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "Bad argument value for -preserved_levels. Expected a positive integer, but given '%s'" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_preserved_levels parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_preserved_levels parameter)
+
+
+let tez_sym =
+  "\xEA\x9C\xA9"
+
+let string_parameter =
+  parameter (fun _ x -> return x)
+
+let init_arg =
+  default_arg
+    ~long:"init"
+    ~placeholder:"data"
+    ~doc:"initial value of the contract's storage"
+    ~default:"Unit"
+    string_parameter
+
+let arg_arg =
+  arg
+    ~long:"arg"
+    ~placeholder:"data"
+    ~doc:"argument passed to the contract's script, if needed"
+    string_parameter
+
+let delegate_arg =
+  Client_keys.Public_key_hash.source_arg
+    ~long:"delegate"
+    ~placeholder:"address"
+    ~doc:"delegate of the contract\n\
+          Must be a known address."
+    ()
+
+let source_arg =
+  arg
+    ~long:"source"
+    ~placeholder:"address"
+    ~doc:"source of the deposits to be paid\n\
+          Must be a known address."
+    string_parameter
+
+let spendable_switch =
+  switch
+    ~long:"spendable"
+    ~doc:"allow the manager to spend the contract's tokens"
+    ()
+
+let force_switch =
+  switch
+    ~long:"force"
+    ~short:'f'
+    ~doc:"disables the node's injection checks\n\
+          Force the injection of branch-invalid operation or force \
+         \ the injection of block without a fitness greater than the \
+         \ current head."
+    ()
+
+let minimal_timestamp_switch =
+  switch
+    ~long:"minimal-timestamp"
+    ~doc:"Use the minimal timestamp instead of the current date \
+          as timestamp of the baked block."
+    ()
+
+let delegatable_switch =
+  switch
+    ~long:"delegatable"
+    ~doc:"allow future delegate change"
+    ()
+
+let tez_format =
+  "Text format: `DDDDDDD.DDDDDD`.\n\
+   Tez and mutez and separated by a period sign. Trailing and pending \
+   zeroes are allowed."
+
+let tez_parameter param =
+  parameter
+    (fun _ s ->
+       match Tez.of_string s with
+       | Some tez -> return tez
+       | None -> fail (Bad_tez_arg (param, s)))
+
+let tez_arg ~default ~parameter ~doc =
+  default_arg ~long:parameter ~placeholder:"amount" ~doc ~default
+    (tez_parameter ("--" ^ parameter))
+
+let tez_param ~name ~desc next =
+  Clic.param
+    ~name
+    ~desc:(desc ^ " in \xEA\x9C\xA9\n" ^ tez_format)
+    (tez_parameter name)
+    next
+
+let fee_arg =
+  arg
+    ~long:"fee"
+    ~placeholder:"amount"
+    ~doc:"fee in \xEA\x9C\xA9 to pay to the baker"
+    (tez_parameter ("--fee"))
+
+let gas_limit_arg =
+  arg
+    ~long:"gas-limit"
+    ~short:'G'
+    ~placeholder:"amount"
+    ~doc:"Set the gas limit of the transaction instead \
+          of letting the client decide based on a simulation"
+    (parameter (fun _ s ->
+         try
+           let v = Z.of_string s in
+           assert Compare.Z.(v >= Z.zero) ;
+           return v
+         with _ -> failwith "invalid gas limit (must be a positive number)"))
+
+let storage_limit_arg =
+  arg
+    ~long:"storage-limit"
+    ~short:'S'
+    ~placeholder:"amount"
+    ~doc:"Set the storage limit of the transaction instead \
+          of letting the client decide based on a simulation"
+    (parameter (fun _ s ->
+         try
+           let v = Z.of_string s in
+           assert Compare.Z.(v >= Z.zero) ;
+           return v
+         with _ -> failwith "invalid storage limit (must be a positive number of bytes)"))
+
+let counter_arg =
+  arg
+    ~long:"counter"
+    ~short:'C'
+    ~placeholder:"counter"
+    ~doc:"Set the counter to be used by the transaction"
+    (parameter (fun _ s ->
+         try
+           let v = Z.of_string s in
+           assert Compare.Z.(v >= Z.zero) ;
+           return v
+         with _ -> failwith "invalid counter (must be a positive number of bytes)"))
+
+let max_priority_arg =
+  arg
+    ~long:"max-priority"
+    ~placeholder:"slot"
+    ~doc:"maximum allowed baking slot"
+    (parameter (fun _ s ->
+         try return (int_of_string s)
+         with _ -> fail (Bad_max_priority s)))
+
+
+let default_minimal_fees = match Tez.of_mutez 100L with None -> assert false | Some t -> t
+let default_minimal_nanotez_per_gas_unit = Z.of_int 100
+let default_minimal_nanotez_per_byte = Z.of_int 1000
+
+let minimal_fees_arg =
+  default_arg
+    ~long:"minimal-fees"
+    ~placeholder:"amount"
+    ~doc:"exclude operations with fees lower than this threshold (in tez)"
+    ~default:(Tez.to_string default_minimal_fees)
+    (parameter (fun _ s ->
+         match Tez.of_string s with
+         | Some t -> return t
+         | None -> fail (Bad_minimal_fees s)))
+
+let minimal_nanotez_per_gas_unit_arg =
+  default_arg
+    ~long:"minimal-nanotez-per-gas-unit"
+    ~placeholder:"amount"
+    ~doc:"exclude operations with fees per gas lower than this threshold (in nanotez)"
+    ~default:(Z.to_string default_minimal_nanotez_per_gas_unit)
+    (parameter (fun _ s ->
+         try return (Z.of_string s)
+         with _ -> fail (Bad_minimal_fees s)))
+
+let minimal_nanotez_per_byte_arg =
+  default_arg
+    ~long:"minimal-nanotez-per-byte"
+    ~placeholder:"amount"
+    ~default:(Z.to_string default_minimal_nanotez_per_byte)
+    ~doc:"exclude operations with fees per byte lower than this threshold (in tez)"
+    (parameter (fun _ s ->
+         try return (Z.of_string s)
+         with _ -> fail (Bad_minimal_fees s)))
+
+let force_low_fee_arg =
+  switch
+    ~long:"force-low-fee"
+    ~doc:"Don't check that the fee is lower than the estimated default value"
+    ()
+
+let fee_cap_arg =
+  default_arg
+    ~long:"fee-cap"
+    ~placeholder:"amount"
+    ~default:"1.0"
+    ~doc:"Set the fee cap"
+    (parameter (fun _ s ->
+         match Tez.of_string s with
+         | Some t -> return t
+         | None -> failwith "Bad fee cap"))
+
+let burn_cap_arg =
+  default_arg
+    ~long:"burn-cap"
+    ~placeholder:"amount"
+    ~default:"0"
+    ~doc:"Set the burn cap"
+    (parameter (fun _ s ->
+         match Tez.of_string s with
+         | Some t -> return t
+         | None -> failwith "Bad burn cap"))
+
+let no_waiting_for_endorsements_arg =
+  switch
+    ~long:"no-waiting-for-late-endorsements"
+    ~doc:"Disable waiting for late endorsements"
+    ()
+
+let await_endorsements_arg =
+  switch
+    ~long:"await-late-endorsements"
+    ~doc:"Await late endorsements when baking a block"
+    ()
+
+let endorsement_delay_arg =
+  default_arg
+    ~long:"endorsement-delay"
+    ~placeholder:"seconds"
+    ~doc:"delay before endorsing blocks\n\
+          Delay between notifications of new blocks from the node and \
+          production of endorsements for these blocks."
+    ~default:"5"
+    (parameter (fun _ s ->
+         try
+           let i = int_of_string s in
+           fail_when (i < 0) (Bad_endorsement_delay s) >>=? fun () ->
+           return (int_of_string s)
+         with _ -> fail (Bad_endorsement_delay s)))
+
+let preserved_levels_arg =
+  default_arg
+    ~long:"preserved-levels"
+    ~placeholder:"threshold"
+    ~doc:"Number of effective levels kept in the accuser's memory"
+    ~default:"200"
+    (parameter (fun _ s ->
+         try
+           let preserved_cycles = int_of_string s in
+           if preserved_cycles < 0 then
+             fail (Bad_preserved_levels s)
+           else
+             return preserved_cycles
+         with _ -> fail (Bad_preserved_levels s)))
+
+let no_print_source_flag =
+  switch
+    ~long:"no-print-source"
+    ~short:'q'
+    ~doc:"don't print the source code\n\
+          If an error is encountered, the client will print the \
+          contract's source code by default.\n\
+          This option disables this behaviour."
+    ()
+
+let no_confirmation =
+  switch
+    ~long:"no-confirmation"
+    ~doc:"don't print wait for the operation to be confirmed."
+    ()
+
+module Daemon = struct
+  let baking_switch =
+    switch
+      ~long:"baking"
+      ~short:'B'
+      ~doc:"run the baking daemon" ()
+  let endorsement_switch =
+    switch
+      ~long:"endorsement"
+      ~short:'E'
+      ~doc:"run the endorsement daemon" ()
+  let denunciation_switch =
+    switch
+      ~long:"denunciation"
+      ~short:'D'
+      ~doc:"run the denunciation daemon" ()
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.mli
new file mode 100644
index 000000000..e23c3bf07
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_args.mli
@@ -0,0 +1,76 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val tez_sym: string
+
+val init_arg: (string, Proto_alpha.full) Clic.arg
+val fee_arg: (Tez.t option, Proto_alpha.full) Clic.arg
+val counter_arg: (Z.t option, Proto_alpha.full) Clic.arg
+val gas_limit_arg: (Z.t option, Proto_alpha.full) Clic.arg
+val storage_limit_arg: (Z.t option, Proto_alpha.full) Clic.arg
+val arg_arg: (string option, Proto_alpha.full) Clic.arg
+val source_arg: (string option, Proto_alpha.full) Clic.arg
+
+val delegate_arg: (Signature.Public_key_hash.t option, Proto_alpha.full) Clic.arg
+val delegatable_switch: (bool, Proto_alpha.full) Clic.arg
+val spendable_switch: (bool, Proto_alpha.full) Clic.arg
+val max_priority_arg: (int option, Proto_alpha.full) Clic.arg
+val minimal_fees_arg: (Tez.tez, Proto_alpha.full) Clic.arg
+val minimal_nanotez_per_gas_unit_arg: (Z.t, Proto_alpha.full) Clic.arg
+val minimal_nanotez_per_byte_arg: (Z.t, Proto_alpha.full) Clic.arg
+val force_low_fee_arg: (bool, Proto_alpha.full) Clic.arg
+val fee_cap_arg: (Tez.t, Proto_alpha.full) Clic.arg
+val burn_cap_arg: (Tez.t, Proto_alpha.full) Clic.arg
+val no_waiting_for_endorsements_arg: (bool, Proto_alpha.full) Clic.arg
+val await_endorsements_arg: (bool, Proto_alpha.full) Clic.arg
+val force_switch: (bool, Proto_alpha.full) Clic.arg
+val minimal_timestamp_switch: (bool, Proto_alpha.full) Clic.arg
+val endorsement_delay_arg: (int, Proto_alpha.full) Clic.arg
+val preserved_levels_arg: (int, Proto_alpha.full) Clic.arg
+
+val no_print_source_flag: (bool, Proto_alpha.full) Clic.arg
+val no_confirmation: (bool, Proto_alpha.full) Clic.arg
+
+val tez_arg :
+  default:string ->
+  parameter:string ->
+  doc:string ->
+  (Tez.t, Proto_alpha.full) Clic.arg
+val tez_param :
+  name:string ->
+  desc:string ->
+  ('a, full) Clic.params ->
+  (Tez.t -> 'a, full) Clic.params
+
+module Daemon : sig
+  val baking_switch: (bool, Proto_alpha.full) Clic.arg
+  val endorsement_switch: (bool, Proto_alpha.full) Clic.arg
+  val denunciation_switch: (bool, Proto_alpha.full) Clic.arg
+end
+
+val string_parameter : (string, full) Clic.parameter
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.ml
new file mode 100644
index 000000000..8bb80ad30
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.ml
@@ -0,0 +1,547 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+open Client_proto_contracts
+open Client_keys
+
+let get_balance (rpc : #Proto_alpha.rpc_context) ~chain ~block contract =
+  Alpha_services.Contract.balance rpc (chain, block) contract
+
+let get_storage (rpc : #Proto_alpha.rpc_context) ~chain ~block contract =
+  Alpha_services.Contract.storage_opt rpc (chain, block) contract
+
+let get_big_map_value (rpc : #Proto_alpha.rpc_context) ~chain ~block contract key =
+  Alpha_services.Contract.big_map_get_opt rpc (chain, block) contract key
+
+let get_script (rpc : #Proto_alpha.rpc_context) ~chain ~block contract =
+  Alpha_services.Contract.script_opt rpc (chain, block) contract
+
+let parse_expression arg =
+  Lwt.return
+    (Micheline_parser.no_parsing_error
+       (Michelson_v1_parser.parse_expression arg))
+
+let transfer (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ~destination ?arg
+    ~amount ?fee ?gas_limit ?storage_limit ?counter
+    ~fee_parameter
+    () =
+  begin match arg with
+    | Some arg ->
+        parse_expression arg >>=? fun { expanded = arg } ->
+        return_some arg
+    | None -> return_none
+  end >>=? fun parameters ->
+  let parameters = Option.map ~f:Script.lazy_expr parameters in
+  let contents = Transaction { amount ; parameters ; destination } in
+  Injection.inject_manager_operation
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ?fee ?gas_limit ?storage_limit ?counter
+    ~src_pk ~src_sk
+    ~fee_parameter
+    contents >>=? fun (_oph, _op, result as res) ->
+  Lwt.return
+    (Injection.originated_contracts (Single_result result)) >>=? fun contracts ->
+  return (res, contracts)
+
+let reveal cctxt
+    ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ?fee
+    ~fee_parameter
+    () =
+  let compute_fee, fee =
+    match fee with
+    | None -> true, Tez.zero
+    | Some fee -> false, fee in
+  Alpha_services.Contract.counter
+    cctxt (chain, block) source >>=? fun pcounter ->
+  let counter = Z.succ pcounter in
+  Alpha_services.Contract.manager_key
+    cctxt (chain, block) source >>=? fun (_, key) ->
+  match key with
+  | Some _ ->
+      failwith "The manager key was previously revealed."
+  | None -> begin
+      let contents =
+        Single
+          (Manager_operation { source ; fee ; counter ;
+                               gas_limit = Z.of_int ~- 1 ; storage_limit = Z.zero ;
+                               operation = Reveal src_pk }) in
+      Injection.inject_operation cctxt ~chain ~block ?confirmations
+        ?dry_run ?branch ~src_sk
+        ~compute_fee
+        ~fee_parameter
+        contents >>=? fun (oph, op, result) ->
+      match Apply_results.pack_contents_list op result with
+      | Apply_results.Single_and_result
+          (Manager_operation _ as op, result) ->
+          return (oph, op, result)
+    end
+
+let originate
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ?fee
+    ?gas_limit ?storage_limit
+    ~fee_parameter
+    contents =
+  Injection.inject_manager_operation
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ?fee ?gas_limit ?storage_limit
+    ~src_pk ~src_sk
+    ~fee_parameter
+    contents >>=? fun (_oph, _op, result as res) ->
+  Lwt.return
+    (Injection.originated_contracts (Single_result result)) >>=? function
+  | [ contract ] -> return (res, contract)
+  | contracts ->
+      failwith
+        "The origination introduced %d contracts instead of one."
+        (List.length contracts)
+
+let originate_account
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ~manager_pkh
+    ?(delegatable = false) ?delegate ~balance ?fee
+    ~fee_parameter
+    () =
+  let origination =
+    Origination { manager = manager_pkh ;
+                  delegate ;
+                  script = None ;
+                  spendable = true ;
+                  delegatable ;
+                  credit = balance ;
+                  preorigination = None } in
+  originate
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ?fee
+    ~fee_parameter
+    origination
+
+let delegate_contract cctxt
+    ~chain ~block ?branch ?confirmations
+    ?dry_run
+    ~source ~src_pk ~src_sk
+    ?fee
+    ~fee_parameter
+    delegate_opt =
+  let operation = Delegation delegate_opt in
+  Injection.inject_manager_operation
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ?fee ~storage_limit:Z.zero
+    ~src_pk ~src_sk
+    ~fee_parameter
+    operation >>=? fun res ->
+  return res
+
+let list_contract_labels
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block =
+  Alpha_services.Contract.list cctxt (chain, block) >>=? fun contracts ->
+  map_s (fun h ->
+      begin match Contract.is_implicit h with
+        | Some m -> begin
+            Public_key_hash.rev_find cctxt m >>=? function
+            | None -> return ""
+            | Some nm ->
+                RawContractAlias.find_opt cctxt nm >>=? function
+                | None -> return (" (known as " ^ nm ^ ")")
+                | Some _ -> return (" (known as key:" ^ nm ^ ")")
+          end
+        | None -> begin
+            RawContractAlias.rev_find cctxt h >>=? function
+            | None -> return ""
+            | Some nm ->  return (" (known as " ^ nm ^ ")")
+          end
+      end >>=? fun nm ->
+      let kind = match Contract.is_implicit h with
+        | Some _ -> " (implicit)"
+        | None -> "" in
+      let h_b58 = Contract.to_b58check h in
+      return (nm, h_b58, kind))
+    contracts
+
+let message_added_contract (cctxt : #Proto_alpha.full) name =
+  cctxt#message "Contract memorized as %s." name
+
+let get_manager
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block source =
+  Client_proto_contracts.get_manager
+    cctxt ~chain ~block source >>=? fun src_pkh ->
+  Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
+  return (src_name, src_pkh, src_pk, src_sk)
+
+let set_delegate
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?fee contract ~src_pk ~manager_sk
+    ~fee_parameter
+    opt_delegate =
+  delegate_contract
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ~source:contract ~src_pk ~src_sk:manager_sk ?fee
+    ~fee_parameter
+    opt_delegate
+
+let register_as_delegate
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?fee ~manager_sk
+    ~fee_parameter
+    src_pk =
+  let source = Signature.Public_key.hash src_pk in
+  delegate_contract
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ~source:(Contract.implicit_contract source) ~src_pk ~src_sk:manager_sk ?fee
+    ~fee_parameter
+    (Some source)
+
+let source_to_keys (wallet : #Proto_alpha.full) ~chain ~block source =
+  get_manager
+    wallet ~chain ~block
+    source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
+  return (src_pk, src_sk)
+
+let save_contract ~force cctxt alias_name contract =
+  RawContractAlias.add ~force cctxt alias_name contract >>=? fun () ->
+  message_added_contract cctxt alias_name >>= fun () ->
+  return_unit
+
+let originate_contract
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations
+    ?dry_run
+    ?branch
+    ?fee
+    ?gas_limit
+    ?storage_limit
+    ~delegate
+    ?(delegatable=true)
+    ?(spendable=false)
+    ~initial_storage
+    ~manager
+    ~balance
+    ~source
+    ~src_pk
+    ~src_sk
+    ~code
+    ~fee_parameter
+    () =
+  Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result ->
+  Lwt.return (Micheline_parser.no_parsing_error result) >>=?
+  fun { Michelson_v1_parser.expanded = storage } ->
+  let code = Script.lazy_expr code and storage = Script.lazy_expr storage in
+  let origination =
+    Origination { manager ;
+                  delegate ;
+                  script = Some { code ; storage } ;
+                  spendable ;
+                  delegatable ;
+                  credit = balance ;
+                  preorigination = None } in
+  originate cctxt ~chain ~block ?confirmations
+    ?dry_run
+    ?branch ~source ~src_pk ~src_sk ?fee ?gas_limit ?storage_limit
+    ~fee_parameter
+    origination
+
+type activation_key =
+  { pkh : Ed25519.Public_key_hash.t ;
+    amount : Tez.t ;
+    activation_code : Blinded_public_key_hash.activation_code ;
+    mnemonic : string list ;
+    password : string ;
+    email : string ;
+  }
+
+let raw_activation_key_encoding =
+  let open Data_encoding in
+  obj6
+    (req "pkh" Ed25519.Public_key_hash.encoding)
+    (req "amount" Tez.encoding)
+    (req "activation_code" Blinded_public_key_hash.activation_code_encoding)
+    (req "mnemonic" (list string))
+    (req "password" string)
+    (req "email" string)
+
+let activation_key_encoding =
+  (* Hack: allow compatibility with older encoding *)
+  let open Data_encoding in
+  conv
+    (fun { pkh ; amount ; activation_code ; mnemonic ; password ; email } ->
+       ( pkh, amount, activation_code, mnemonic, password, email ))
+    (fun ( pkh, amount, activation_code, mnemonic, password, email ) ->
+       { pkh ; amount ; activation_code ; mnemonic ; password ; email }) @@
+  splitted
+    ~binary:raw_activation_key_encoding
+    ~json:
+      (union [
+          case
+            ~title:"Activation"
+            Json_only
+            raw_activation_key_encoding
+            (fun x -> Some x)
+            (fun x -> x) ;
+          case
+            ~title:"Deprecated_activation"
+            Json_only
+            (obj6
+               (req "pkh" Ed25519.Public_key_hash.encoding)
+               (req "amount" Tez.encoding)
+               (req "secret" Blinded_public_key_hash.activation_code_encoding)
+               (req "mnemonic" (list string))
+               (req "password" string)
+               (req "email" string))
+            (fun _ -> None)
+            (fun x -> x) ;
+        ])
+
+let read_key key =
+  match Bip39.of_words key.mnemonic with
+  | None ->
+      failwith ""
+  | Some t ->
+      (* TODO: unicode normalization (NFKD)... *)
+      let passphrase = MBytes.(concat "" [of_string key.email ; of_string key.password]) in
+      let sk = Bip39.to_seed ~passphrase t in
+      let sk = MBytes.sub sk 0 32 in
+      let sk : Signature.Secret_key.t =
+        Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in
+      let pk = Signature.Secret_key.to_public_key sk in
+      let pkh = Signature.Public_key.hash pk in
+      return (pkh, pk, sk)
+
+let inject_activate_operation
+    cctxt ~chain ~block ?confirmations
+    ?dry_run
+    alias pkh activation_code =
+  let contents =
+    Single ( Activate_account { id = pkh ; activation_code } ) in
+  Injection.inject_operation
+    cctxt ?confirmations
+    ?dry_run
+    ~chain ~block
+    ~fee_parameter:Injection.dummy_fee_parameter
+    contents >>=? fun (oph, op, result) ->
+  begin
+    match confirmations with
+    | None ->
+        return_unit
+    | Some _confirmations ->
+        Alpha_services.Contract.balance
+          cctxt (`Main, `Head 0)
+          (Contract.implicit_contract (Ed25519 pkh)) >>=? fun balance ->
+        cctxt#message "Account %s (%a) activated with %s%a."
+          alias
+          Ed25519.Public_key_hash.pp pkh
+          Client_proto_args.tez_sym
+          Tez.pp balance >>= fun () ->
+        return_unit
+  end >>=? fun () ->
+  match Apply_results.pack_contents_list op result with
+  | Apply_results.Single_and_result
+      (Activate_account _ as op, result) ->
+      return (oph, op, result)
+
+let activate_account
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations
+    ?dry_run
+    ?(encrypted = false) ?force
+    key name =
+  read_key key >>=? fun (pkh, pk, sk) ->
+  fail_unless (Signature.Public_key_hash.equal pkh (Ed25519 key.pkh))
+    (failure "@[<v 2>Inconsistent activation key:@ \
+              Computed pkh: %a@ \
+              Embedded pkh: %a @]"
+       Signature.Public_key_hash.pp pkh
+       Ed25519.Public_key_hash.pp key.pkh) >>=? fun () ->
+  let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
+  begin
+    if encrypted then
+      Tezos_signer_backends.Encrypted.encrypt cctxt sk
+    else
+      return (Tezos_signer_backends.Unencrypted.make_sk sk)
+  end >>=? fun sk_uri ->
+  Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () ->
+  inject_activate_operation cctxt
+    ~chain ~block ?confirmations
+    ?dry_run
+    name key.pkh key.activation_code
+
+let activate_existing_account
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations
+    ?dry_run
+    alias activation_code =
+  Client_keys.alias_keys cctxt alias >>=? function
+  | Some (Ed25519 pkh, _, _) ->
+      inject_activate_operation
+        cctxt ~chain ~block ?confirmations
+        ?dry_run
+        alias pkh activation_code
+  | Some _ -> failwith "Only Ed25519 accounts can be activated"
+  | None -> failwith "Unknown account"
+
+type period_info = {
+  current_period_kind : Voting_period.kind ;
+  position : Int32.t ;
+  remaining : Int32.t ;
+  current_proposal : Protocol_hash.t option ;
+}
+
+type ballots_info = {
+  current_quorum : Int32.t ;
+  participation : Int32.t ;
+  supermajority : Int32.t ;
+  ballots : Vote.ballots ;
+}
+
+(* Should be moved to src/proto_alpha/lib_protocol/src/vote_storage.ml *)
+let ballot_list_encoding =
+  Data_encoding.(list (obj2
+                         (req "delegate" Signature.Public_key_hash.encoding)
+                         (req "ballot" Vote.ballot_encoding)))
+
+let get_ballots_info
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block =
+  (* Get the next level, not the current *)
+  let cb = (chain, block) in
+  Alpha_services.Voting.ballots          cctxt cb >>=? fun ballots ->
+  Alpha_services.Voting.current_quorum   cctxt cb >>=? fun current_quorum ->
+  Alpha_services.Voting.listings         cctxt cb >>=? fun listings ->
+  let max_participation =
+    List.fold_left (fun acc (_, w) -> Int32.add w acc) 0l listings in
+  let all_votes = Int32.(add (add ballots.yay ballots.nay) ballots.pass) in
+  let participation = Int32.(div (mul all_votes 100_00l) max_participation) in
+  let supermajority = Int32.(div (mul 8l (add ballots.yay ballots.nay)) 10l) in
+  return { current_quorum ;
+           participation ;
+           supermajority ;
+           ballots }
+
+let get_period_info
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block =
+  (* Get the next level, not the current *)
+  let cb = (chain, block) in
+  Alpha_services.Helpers.current_level cctxt ~offset:1l cb >>=? fun level ->
+  Alpha_services.Constants.all cctxt cb >>=? fun constants ->
+  Alpha_services.Voting.current_proposal cctxt cb >>=? fun current_proposal ->
+  let position = level.voting_period_position in
+  let remaining =
+    Int32.(sub constants.parametric.blocks_per_voting_period position) in
+  Alpha_services.Voting.current_period_kind cctxt cb >>=? fun current_period_kind ->
+  return { current_period_kind ;
+           position ;
+           remaining ;
+           current_proposal }
+
+let get_proposals
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block =
+  let cb = (chain, block) in
+  Alpha_services.Voting.proposals cctxt cb
+
+let submit_proposals
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations ~src_sk source proposals =
+  (* We need the next level, not the current *)
+  Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) >>=? fun (level : Level.t) ->
+  let period = level.voting_period in
+  let contents = Single ( Proposals { source ; period ; proposals } ) in
+  Injection.inject_operation cctxt ~chain ~block ?confirmations
+    ~fee_parameter:Injection.dummy_fee_parameter
+    ~src_sk contents
+
+let submit_ballot
+    (cctxt : #Proto_alpha.full)
+    ~chain ~block ?confirmations ~src_sk source proposal ballot =
+  (* The user must provide the proposal explicitly to make himself sure
+     for what he is voting. *)
+  Alpha_services.Helpers.current_level cctxt ~offset:1l (chain, block) >>=? fun (level : Level.t) ->
+  let period = level.voting_period in
+  let contents = Single ( Ballot { source ; period ; proposal ; ballot } ) in
+  Injection.inject_operation cctxt ~chain ~block ?confirmations
+    ~fee_parameter:Injection.dummy_fee_parameter
+    ~src_sk contents
+
+let pp_operation formatter (a : Alpha_block_services.operation) =
+  match a.receipt, a.protocol_data with
+  | Apply_results.Operation_metadata omd, Operation_data od -> (
+      match Apply_results.kind_equal_list od.contents omd.contents
+      with
+      | Some Apply_results.Eq ->
+          Operation_result.pp_operation_result formatter
+            (od.contents, omd.contents)
+      | None -> Pervasives.failwith "Unexpected result.")
+  | _ -> Pervasives.failwith "Unexpected result."
+
+let get_operation_from_block
+    (cctxt : #Client_context.full)
+    ~chain
+    predecessors
+    operation_hash =
+  Client_confirmations.lookup_operation_in_previous_blocks
+    cctxt
+    ~chain
+    ~predecessors
+    operation_hash
+  >>=? function
+  | None -> return_none
+  | Some (block, i, j) ->
+      cctxt#message "Operation found in block: %a (pass: %d, offset: %d)"
+        Block_hash.pp block i j >>= fun () ->
+      Proto_alpha.Alpha_block_services.Operations.operation cctxt
+        ~block:(`Hash (block, 0)) i j >>=? fun op' -> return_some op'
+
+let display_receipt_for_operation
+    (cctxt : #Proto_alpha.full)
+    ~chain
+    ?(predecessors = 10)
+    operation_hash =
+  get_operation_from_block cctxt ~chain predecessors operation_hash
+  >>=? function
+  | None ->
+      failwith "Couldn't find operation"
+  | Some op ->
+      cctxt#message "%a" pp_operation op >>= fun () ->
+      return_unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.mli
new file mode 100644
index 000000000..a5cc310d9
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_context.mli
@@ -0,0 +1,281 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val list_contract_labels:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  (string * string * string) list tzresult Lwt.t
+
+val get_storage:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  Script.expr option tzresult Lwt.t
+
+val get_big_map_value:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  (Script.expr * Script.expr) ->
+  Script.expr option tzresult Lwt.t
+
+val get_script:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  Script.t option tzresult Lwt.t
+
+val get_manager:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  (string * public_key_hash *
+   public_key * Client_keys.sk_uri) tzresult Lwt.t
+
+val get_balance:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  Tez.t tzresult Lwt.t
+
+val set_delegate:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?fee:Tez.tez ->
+  Contract.t ->
+  src_pk:public_key ->
+  manager_sk:Client_keys.sk_uri ->
+  fee_parameter:Injection.fee_parameter ->
+  public_key_hash option ->
+  Kind.delegation Kind.manager Injection.result tzresult Lwt.t
+
+val register_as_delegate:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?fee:Tez.tez ->
+  manager_sk:Client_keys.sk_uri ->
+  fee_parameter:Injection.fee_parameter ->
+  public_key ->
+  Kind.delegation Kind.manager Injection.result tzresult Lwt.t
+
+val source_to_keys:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  (public_key * Client_keys.sk_uri) tzresult Lwt.t
+
+val originate_account :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?branch:int ->
+  source:Contract.t ->
+  src_pk:public_key ->
+  src_sk:Client_keys.sk_uri ->
+  manager_pkh:public_key_hash ->
+  ?delegatable:bool ->
+  ?delegate:public_key_hash ->
+  balance:Tez.tez ->
+  ?fee:Tez.tez ->
+  fee_parameter:Injection.fee_parameter ->
+  unit -> (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t
+
+val save_contract :
+  force:bool ->
+  #Proto_alpha.full ->
+  string ->
+  Contract.t ->
+  unit tzresult Lwt.t
+
+val originate_contract:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?branch:int ->
+  ?fee:Tez.t ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  delegate:public_key_hash option ->
+  ?delegatable:bool ->
+  ?spendable:bool ->
+  initial_storage:string ->
+  manager:public_key_hash ->
+  balance:Tez.t ->
+  source:Contract.t ->
+  src_pk:public_key ->
+  src_sk:Client_keys.sk_uri ->
+  code:Script.expr ->
+  fee_parameter:Injection.fee_parameter ->
+  unit -> (Kind.origination Kind.manager Injection.result * Contract.t) tzresult Lwt.t
+
+val transfer :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?branch:int ->
+  source:Contract.t ->
+  src_pk:public_key ->
+  src_sk:Client_keys.sk_uri ->
+  destination:Contract.t ->
+  ?arg:string ->
+  amount:Tez.t ->
+  ?fee:Tez.t ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  ?counter:Z.t ->
+  fee_parameter:Injection.fee_parameter ->
+  unit ->
+  (Kind.transaction Kind.manager Injection.result * Contract.t list) tzresult Lwt.t
+
+val reveal :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?branch:int ->
+  source:Contract.t ->
+  src_pk:public_key ->
+  src_sk:Client_keys.sk_uri ->
+  ?fee:Tez.t ->
+  fee_parameter:Injection.fee_parameter ->
+  unit -> Kind.reveal Kind.manager Injection.result tzresult Lwt.t
+
+type activation_key =
+  { pkh : Ed25519.Public_key_hash.t ;
+    amount : Tez.t ;
+    activation_code : Blinded_public_key_hash.activation_code ;
+    mnemonic : string list ;
+    password : string ;
+    email : string ;
+  }
+
+val activation_key_encoding: activation_key Data_encoding.t
+
+val activate_account:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?encrypted:bool ->
+  ?force:bool ->
+  activation_key ->
+  string ->
+  Kind.activate_account Injection.result tzresult Lwt.t
+
+val activate_existing_account:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  string ->
+  Blinded_public_key_hash.activation_code ->
+  Kind.activate_account Injection.result tzresult Lwt.t
+
+type period_info = {
+  current_period_kind : Voting_period.kind ;
+  position : Int32.t ;
+  remaining : Int32.t ;
+  current_proposal : Protocol_hash.t option ;
+}
+
+type ballots_info = {
+  current_quorum : Int32.t ;
+  participation : Int32.t ;
+  supermajority : Int32.t ;
+  ballots : Vote.ballots ;
+}
+
+val get_period_info :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  period_info tzresult Lwt.t
+
+val get_ballots_info :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ballots_info tzresult Lwt.t
+
+val get_proposals :
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Int32.t Alpha_environment.Protocol_hash.Map.t tzresult Lwt.t
+
+val submit_proposals:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  src_sk:Client_keys.sk_uri ->
+  public_key_hash ->
+  Protocol_hash.t list ->
+  Kind.proposals Injection.result_list tzresult Lwt.t
+
+val submit_ballot:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  src_sk:Client_keys.sk_uri ->
+  public_key_hash ->
+  Protocol_hash.t ->
+  Proto_alpha.Alpha_context.Vote.ballot ->
+  Kind.ballot Injection.result_list tzresult Lwt.t
+
+(** lookup an operation in [predecessors] previous blocks, and print the
+    receipt if found *)
+val display_receipt_for_operation:
+  #Proto_alpha.full ->
+  chain:Block_services.chain ->
+  ?predecessors:int ->
+  Operation_list_hash.elt ->
+  unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.ml
new file mode 100644
index 000000000..9a2396026
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.ml
@@ -0,0 +1,160 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+module ContractEntity = struct
+  type t = Contract.t
+  let encoding = Contract.encoding
+  let of_source s =
+    match Contract.of_b58check s with
+    | Error _ as err ->
+        Lwt.return (Alpha_environment.wrap_error err)
+        |> trace (failure "bad contract notation")
+    | Ok s -> return s
+  let to_source s = return (Contract.to_b58check s)
+  let name = "contract"
+end
+
+module RawContractAlias = Client_aliases.Alias (ContractEntity)
+
+module ContractAlias = struct
+
+  let find cctxt s =
+    RawContractAlias.find_opt cctxt s >>=? function
+    | Some v -> return (s, v)
+    | None ->
+        Client_keys.Public_key_hash.find_opt cctxt s >>=? function
+        | Some v ->
+            return (s, Contract.implicit_contract v)
+        | None ->
+            failwith "no contract or key named %s" s
+
+  let find_key cctxt name =
+    Client_keys.Public_key_hash.find cctxt name >>=? fun v ->
+    return (name, Contract.implicit_contract v)
+
+  let rev_find cctxt c =
+    match Contract.is_implicit c with
+    | Some hash -> begin
+        Client_keys.Public_key_hash.rev_find cctxt hash >>=? function
+        | Some name -> return_some ("key:" ^ name)
+        | None -> return_none
+      end
+    | None -> RawContractAlias.rev_find cctxt c
+
+  let get_contract cctxt s =
+    match String.split ~limit:1 ':' s with
+    | [ "key" ; key ]->
+        find_key cctxt key
+    | _ -> find cctxt s
+
+  let autocomplete cctxt =
+    Client_keys.Public_key_hash.autocomplete cctxt >>=? fun keys ->
+    RawContractAlias.autocomplete cctxt >>=? fun contracts ->
+    return (List.map ((^) "key:") keys @ contracts)
+
+  let alias_param ?(name = "name") ?(desc = "existing contract alias") next =
+    let desc =
+      desc ^ "\n"
+      ^ "Can be a contract alias or a key alias (autodetected in order).\n\
+         Use 'key:name' to force the later." in
+    Clic.(
+      param ~name ~desc
+        (parameter ~autocomplete:autocomplete
+           (fun cctxt p -> get_contract cctxt p))
+        next)
+
+  let destination_param ?(name = "dst") ?(desc = "destination contract") next =
+    let desc =
+      desc ^ "\n"
+      ^ "Can be an alias, a key, or a literal (autodetected in order).\n\
+         Use 'text:literal', 'alias:name', 'key:name' to force." in
+    Clic.(
+      param ~name ~desc
+        (parameter
+           ~autocomplete:(fun cctxt ->
+               autocomplete cctxt >>=? fun list1 ->
+               Client_keys.Public_key_hash.autocomplete cctxt >>=? fun list2 ->
+               return (list1 @ list2))
+           (fun cctxt s ->
+              begin
+                match String.split ~limit:1 ':' s with
+                | [ "alias" ; alias ]->
+                    find cctxt alias
+                | [ "key" ; text ] ->
+                    Client_keys.Public_key_hash.find cctxt text >>=? fun v ->
+                    return (s, Contract.implicit_contract v)
+                | _ ->
+                    find cctxt s >>= function
+                    | Ok v -> return v
+                    | Error k_errs ->
+                        ContractEntity.of_source s >>= function
+                        | Ok v -> return (s, v)
+                        | Error c_errs ->
+                            Lwt.return (Error (k_errs @ c_errs))
+              end)))
+      next
+
+  let name cctxt contract =
+    rev_find cctxt contract >>=? function
+    | None -> return (Contract.to_b58check contract)
+    | Some name -> return name
+
+end
+
+let list_contracts cctxt =
+  RawContractAlias.load cctxt >>=? fun raw_contracts ->
+  Lwt_list.map_s
+    (fun (n, v) -> Lwt.return ("", n, v))
+    raw_contracts >>= fun contracts ->
+  Client_keys.Public_key_hash.load cctxt >>=? fun keys ->
+  (* List accounts (implicit contracts of identities) *)
+  map_s (fun (n, v) ->
+      RawContractAlias.mem cctxt n >>=? fun mem ->
+      let p = if mem then "key:" else "" in
+      let v' = Contract.implicit_contract v in
+      return (p, n, v'))
+    keys >>=? fun accounts ->
+  return (contracts @ accounts)
+
+let get_manager cctxt ~chain ~block source =
+  match Contract.is_implicit source with
+  | Some hash -> return hash
+  | None -> Alpha_services.Contract.manager cctxt (chain, block) source
+
+let get_delegate cctxt ~chain ~block source =
+  Alpha_services.Contract.delegate_opt cctxt (chain, block) source
+
+let may_check_key sourcePubKey sourcePubKeyHash =
+  match sourcePubKey with
+  | Some sourcePubKey ->
+      fail_unless
+        (Ed25519.Public_key_hash.equal
+           (Ed25519.Public_key.hash sourcePubKey) sourcePubKeyHash)
+        (failure "Invalid public key in `client_proto_endorsement`")
+  | None ->
+      return_unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.mli
new file mode 100644
index 000000000..b39c30cba
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_contracts.mli
@@ -0,0 +1,72 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Clic
+
+module RawContractAlias :
+  Client_aliases.Alias with type t = Contract.t
+
+module ContractAlias : sig
+  val get_contract:
+    #Client_context.wallet ->
+    string -> (string * Contract.t) tzresult Lwt.t
+  val alias_param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'wallet)) params ->
+    (Lwt_io.file_name * Contract.t -> 'a, 'wallet) params
+  val destination_param:
+    ?name:string ->
+    ?desc:string ->
+    ('a, (#Client_context.wallet as 'wallet)) params ->
+    (Lwt_io.file_name * Contract.t -> 'a, 'wallet) params
+  val rev_find:
+    #Client_context.wallet ->
+    Contract.t -> string option tzresult Lwt.t
+  val name:
+    #Client_context.wallet ->
+    Contract.t -> string tzresult Lwt.t
+  val autocomplete: #Client_context.wallet -> string list tzresult Lwt.t
+end
+
+val list_contracts:
+  #Client_context.wallet ->
+  (string * string * RawContractAlias.t) list tzresult Lwt.t
+
+val get_manager:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  public_key_hash tzresult Lwt.t
+
+val get_delegate:
+  #Proto_alpha.rpc_context ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  Contract.t ->
+  public_key_hash option tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.ml
new file mode 100644
index 000000000..f0f8f16a1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.ml
@@ -0,0 +1,176 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+
+open Michelson_v1_printer
+
+module Program = Client_aliases.Alias (struct
+    type t = Michelson_v1_parser.parsed Micheline_parser.parsing_result
+    let encoding =
+      Data_encoding.conv
+        (fun ({ Michelson_v1_parser.source }, _) -> source)
+        (fun source -> Michelson_v1_parser.parse_toplevel source)
+        Data_encoding.string
+    let of_source source =
+      return (Michelson_v1_parser.parse_toplevel source)
+    let to_source ({ Michelson_v1_parser.source }, _) = return source
+    let name = "script"
+  end)
+
+let print_errors (cctxt : #Client_context.printer) errs ~show_source ~parsed =
+  cctxt#warning "%a"
+    (Michelson_v1_error_reporter.report_errors
+       ~details:false
+       ~show_source
+       ~parsed) errs >>= fun () ->
+  cctxt#error "error running script" >>= fun () ->
+  return_unit
+
+let print_big_map_diff ppf = function
+  | None -> ()
+  | Some diff ->
+      Format.fprintf ppf
+        "@[<v 2>map diff:@,%a@]@,"
+        (Format.pp_print_list
+           ~pp_sep:Format.pp_print_space
+           (fun ppf Contract.{ diff_key ; diff_value ; _ } ->
+              Format.fprintf ppf "%s %a%a"
+                (match diff_value with
+                 | None -> "-"
+                 | Some _ -> "+")
+                print_expr diff_key
+                (fun ppf -> function
+                   | None -> ()
+                   | Some x -> Format.fprintf ppf "-> %a" print_expr x)
+                diff_value))
+        diff
+
+let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = function
+  | Ok (storage, operations, maybe_diff) ->
+      cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>emitted operations@,%a@]@,@[%a@]@]@."
+        print_expr storage
+        (Format.pp_print_list Operation_result.pp_internal_operation) operations
+        print_big_map_diff maybe_diff >>= fun () ->
+      return_unit
+  | Error errs ->
+      print_errors cctxt errs ~show_source ~parsed
+
+let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed =
+  function
+  | Ok (storage, operations, trace, maybe_big_map_diff) ->
+      cctxt#message
+        "@[<v 0>@[<v 2>storage@,%a@]@,\
+         @[<v 2>emitted operations@,%a@]@,%a@[<v 2>@[<v 2>trace@,%a@]@]@."
+        print_expr storage
+        (Format.pp_print_list Operation_result.pp_internal_operation) operations
+        print_big_map_diff maybe_big_map_diff
+        print_execution_trace trace >>= fun () ->
+      return_unit
+  | Error errs ->
+      print_errors cctxt errs ~show_source ~parsed
+
+let run
+    (cctxt : #Proto_alpha.rpc_context)
+    ?(chain = `Main)
+    block
+    ?(amount = Tez.fifty_cents)
+    ~(program : Michelson_v1_parser.parsed)
+    ~(storage : Michelson_v1_parser.parsed)
+    ~(input : Michelson_v1_parser.parsed)
+    () =
+  Alpha_services.Helpers.Scripts.run_code cctxt
+    (chain, block)
+    program.expanded (storage.expanded, input.expanded, amount)
+
+let trace
+    (cctxt : #Proto_alpha.rpc_context)
+    ?(chain = `Main)
+    block
+    ?(amount = Tez.fifty_cents)
+    ~(program : Michelson_v1_parser.parsed)
+    ~(storage : Michelson_v1_parser.parsed)
+    ~(input : Michelson_v1_parser.parsed)
+    () =
+  Alpha_services.Helpers.Scripts.trace_code cctxt
+    (chain, block)
+    program.expanded (storage.expanded, input.expanded, amount)
+
+let typecheck_data
+    cctxt
+    ?(chain = `Main)
+    block
+    ?gas
+    ~(data : Michelson_v1_parser.parsed)
+    ~(ty : Michelson_v1_parser.parsed)
+    () =
+  Alpha_services.Helpers.Scripts.typecheck_data
+    cctxt (chain, block)
+    (data.expanded, ty.expanded, gas)
+
+let typecheck_program
+    cctxt
+    ?(chain = `Main)
+    block
+    ?gas
+    (program : Michelson_v1_parser.parsed) =
+  Alpha_services.Helpers.Scripts.typecheck_code cctxt (chain, block) (program.expanded, gas)
+
+let print_typecheck_result
+    ~emacs ~show_types ~print_source_on_error
+    program res (cctxt : #Client_context.printer) =
+  if emacs then
+    let type_map, errs, _gas = match res with
+      | Ok (type_map, gas) -> (type_map, [], Some gas)
+      | Error (Alpha_environment.Ecoproto_error
+                 (Script_tc_errors.Ill_typed_contract (_, type_map ))
+               :: _ as errs) ->
+          (type_map, errs, None)
+      | Error errs ->
+          ([], errs, None) in
+    cctxt#message
+      "(@[<v 0>(types . %a)@ (errors . %a)@])"
+      Michelson_v1_emacs.print_type_map (program, type_map)
+      Michelson_v1_emacs.report_errors (program, errs) >>= fun () ->
+    return_unit
+  else
+    match res with
+    | Ok (type_map, gas) ->
+        let program = Michelson_v1_printer.inject_types type_map program in
+        cctxt#message "@[<v 0>Well typed@,Gas remaining: %a@]"
+          Gas.pp gas >>= fun () ->
+        if show_types then
+          cctxt#message "%a" Micheline_printer.print_expr program >>= fun () ->
+          return_unit
+        else return_unit
+    | Error errs ->
+        cctxt#warning "%a"
+          (Michelson_v1_error_reporter.report_errors
+             ~details: show_types
+             ~show_source:print_source_on_error
+             ~parsed:program) errs >>= fun () ->
+        cctxt#error "ill-typed script"
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.mli
new file mode 100644
index 000000000..03bd80896
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/client_proto_programs.mli
@@ -0,0 +1,103 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+
+module Program : Client_aliases.Alias
+  with type t = Michelson_v1_parser.parsed Micheline_parser.parsing_result
+
+val run :
+  #Proto_alpha.rpc_context ->
+  ?chain:Shell_services.chain ->
+  Shell_services.block ->
+  ?amount:Tez.t ->
+  program:Michelson_v1_parser.parsed ->
+  storage:Michelson_v1_parser.parsed ->
+  input:Michelson_v1_parser.parsed ->
+  unit ->
+  (Script.expr *
+   packed_internal_operation list *
+   Contract.big_map_diff option) tzresult Lwt.t
+
+val trace :
+  #Proto_alpha.rpc_context ->
+  ?chain:Shell_services.chain ->
+  Shell_services.block ->
+  ?amount:Tez.t ->
+  program:Michelson_v1_parser.parsed ->
+  storage:Michelson_v1_parser.parsed ->
+  input:Michelson_v1_parser.parsed ->
+  unit ->
+  (Script.expr *
+   packed_internal_operation list *
+   Script_interpreter.execution_trace *
+   Contract.big_map_diff option) tzresult Lwt.t
+
+val print_run_result :
+  #Client_context.printer ->
+  show_source:bool ->
+  parsed:Michelson_v1_parser.parsed ->
+  (Script_repr.expr *
+   packed_internal_operation list *
+   Contract.big_map_diff option) tzresult -> unit tzresult Lwt.t
+
+val print_trace_result :
+  #Client_context.printer ->
+  show_source:bool ->
+  parsed:Michelson_v1_parser.parsed ->
+  (Script_repr.expr *
+   packed_internal_operation list *
+   Script_interpreter.execution_trace *
+   Contract.big_map_diff option)
+    tzresult -> unit tzresult Lwt.t
+
+val typecheck_data :
+  #Proto_alpha.rpc_context ->
+  ?chain:Shell_services.chain ->
+  Shell_services.block ->
+  ?gas:Z.t ->
+  data:Michelson_v1_parser.parsed ->
+  ty:Michelson_v1_parser.parsed ->
+  unit ->
+  Gas.t tzresult Lwt.t
+
+val typecheck_program :
+  #Proto_alpha.rpc_context ->
+  ?chain:Shell_services.chain ->
+  Shell_services.block ->
+  ?gas:Z.t ->
+  Michelson_v1_parser.parsed ->
+  (Script_tc_errors.type_map * Gas.t) tzresult Lwt.t
+
+val print_typecheck_result :
+  emacs:bool ->
+  show_types:bool ->
+  print_source_on_error:bool ->
+  Michelson_v1_parser.parsed ->
+  (Script_tc_errors.type_map * Gas.t) tzresult ->
+  #Client_context.printer ->
+  unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/dune b/vendors/tezos-modded/src/proto_alpha/lib_client/dune
new file mode 100644
index 000000000..98216b9b8
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/dune
@@ -0,0 +1,25 @@
+(library
+ (name tezos_client_alpha)
+ (public_name tezos-client-alpha)
+ (libraries tezos-base
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-rpc
+            tezos-storage
+            tezos-signer-backends
+            bip39)
+ (library_flags (:standard -linkall))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_storage
+                   -open Tezos_rpc)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/injection.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/injection.ml
new file mode 100644
index 000000000..a832fb01f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/injection.ml
@@ -0,0 +1,657 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Apply_results
+
+let get_branch (rpc_config: #Proto_alpha.full)
+    ~chain ~(block : Block_services.block) branch =
+  let branch = Option.unopt ~default:0 branch in (* TODO export parameter *)
+  begin
+    match block with
+    | `Head n -> return (`Head (n+branch))
+    | `Hash (h,n) -> return (`Hash (h,n+branch))
+    | `Genesis -> return `Genesis
+    | `Level i -> return (`Level i)
+  end >>=? fun block ->
+  Shell_services.Blocks.hash rpc_config ~chain ~block () >>=? fun hash ->
+  Shell_services.Chain.chain_id rpc_config ~chain () >>=? fun chain_id ->
+  return (chain_id, hash)
+
+type 'kind preapply_result =
+  Operation_hash.t * 'kind operation * 'kind operation_metadata
+
+type 'kind result_list =
+  Operation_hash.t * 'kind contents_list * 'kind contents_result_list
+
+type 'kind result =
+  Operation_hash.t * 'kind contents * 'kind contents_result
+
+let get_manager_operation_gas_and_fee contents =
+  let open Operation in
+  let l = to_list (Contents_list contents) in
+  List.fold_left
+    (fun acc -> function
+       | Contents (Manager_operation { fee ; gas_limit ; _ }) -> begin
+           match acc with
+           | Error _ as e -> e
+           | Ok (total_fee, total_gas) ->
+               match Tez.(total_fee +? fee) with
+               | Ok total_fee -> Ok (total_fee, (Z.add total_gas gas_limit))
+               | Error _ as e -> e
+         end
+       | _ -> acc)
+    (Ok (Tez.zero, Z.zero))
+    l
+
+type fee_parameter = {
+  minimal_fees: Tez.t ;
+  minimal_nanotez_per_byte: Z.t ;
+  minimal_nanotez_per_gas_unit: Z.t ;
+  force_low_fee: bool ;
+  fee_cap: Tez.t ;
+  burn_cap: Tez.t ;
+}
+
+let dummy_fee_parameter = {
+  minimal_fees = Tez.zero ;
+  minimal_nanotez_per_byte = Z.zero ;
+  minimal_nanotez_per_gas_unit = Z.zero ;
+  force_low_fee = false ;
+  fee_cap = Tez.one ;
+  burn_cap = Tez.zero ;
+}
+
+let check_fees
+  : type t. #Proto_alpha.full -> fee_parameter -> t contents_list -> int -> unit Lwt.t
+  = fun cctxt config op size ->
+    match get_manager_operation_gas_and_fee op with
+    | Error _ -> assert false (* FIXME *)
+    | Ok (fee, gas) ->
+        if Tez.compare fee config.fee_cap > 0 then
+          cctxt#error "The proposed fee (%s%a) are higher than the configured fee cap (%s%a).@\n\
+                      \ Use `--fee-cap %a` to emit this operation anyway."
+            Client_proto_args.tez_sym Tez.pp fee
+            Client_proto_args.tez_sym Tez.pp config.fee_cap
+            Tez.pp fee >>= fun () ->
+          exit 1
+        else begin (* *)
+          let fees_in_nanotez =
+            Z.mul (Z.of_int64 (Tez.to_mutez fee)) (Z.of_int 1000) in
+          let minimal_fees_in_nanotez =
+            Z.mul (Z.of_int64 (Tez.to_mutez config.minimal_fees)) (Z.of_int 1000) in
+          let minimal_fees_for_gas_in_nanotez =
+            Z.mul config.minimal_nanotez_per_gas_unit gas in
+          let minimal_fees_for_size_in_nanotez =
+            Z.mul config.minimal_nanotez_per_byte (Z.of_int size) in
+          let estimated_fees_in_nanotez =
+            Z.add
+              minimal_fees_in_nanotez
+              (Z.add minimal_fees_for_gas_in_nanotez minimal_fees_for_size_in_nanotez) in
+          let estimated_fees =
+            match Tez.of_mutez (Z.to_int64 (Z.div (Z.add (Z.of_int 999) estimated_fees_in_nanotez) (Z.of_int 1000))) with
+            | None -> assert false
+            | Some fee -> fee in
+          if not config.force_low_fee &&
+             Z.compare fees_in_nanotez estimated_fees_in_nanotez < 0 then begin
+            cctxt#error "The proposed fee (%s%a) are lower than the fee that baker \
+                         expect by default (%s%a).@\n\
+                        \ Use `--force-low-fee` to emit this operation anyway."
+              Client_proto_args.tez_sym Tez.pp fee
+              Client_proto_args.tez_sym Tez.pp estimated_fees >>= fun () ->
+            exit 1
+          end else
+            Lwt.return_unit
+        end
+
+let preapply (type t)
+    (cctxt: #Proto_alpha.full) ~chain ~block
+    ?fee_parameter
+    ?branch ?src_sk (contents : t contents_list) =
+  get_branch cctxt ~chain ~block branch >>=? fun (chain_id, branch) ->
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.unsigned_encoding
+      ({ branch }, Contents_list contents) in
+  begin
+    match src_sk with
+    | None -> return_none
+    | Some src_sk ->
+        begin match contents with
+          | Single (Endorsement _) ->
+              Client_keys.sign cctxt
+                ~watermark:Signature.(Endorsement chain_id) src_sk bytes
+          | _ ->
+              Client_keys.sign cctxt
+                ~watermark:Signature.Generic_operation src_sk bytes
+        end >>=? fun signature ->
+        return_some signature
+  end >>=? fun signature ->
+  let op : _ Operation.t =
+    { shell = { branch } ;
+      protocol_data = { contents ; signature } } in
+  let oph = Operation.hash op in
+  let size = MBytes.length bytes + Signature.size in
+  begin
+    match fee_parameter with
+    | Some fee_parameter ->
+        check_fees cctxt fee_parameter contents size
+    | None -> Lwt.return_unit
+  end >>= fun () ->
+  Alpha_block_services.Helpers.Preapply.operations
+    cctxt ~chain ~block [Operation.pack op] >>=? function
+  | [(Operation_data op', Operation_metadata result)] -> begin
+      match Operation.equal
+              op { shell = { branch } ; protocol_data = op' },
+            Apply_results.kind_equal_list contents result.contents with
+      | Some Operation.Eq, Some Apply_results.Eq ->
+          return ((oph, op, result) : t preapply_result)
+      | _ -> failwith "Unexpected result"
+    end
+  | _ -> failwith "Unexpected result"
+
+let simulate (type t)
+    (cctxt: #Proto_alpha.full) ~chain ~block
+    ?branch (contents : t contents_list) =
+  get_branch cctxt ~chain ~block branch >>=? fun (_chain_id, branch) ->
+  let op : _ Operation.t =
+    { shell = { branch } ;
+      protocol_data = { contents ; signature = None } } in
+  let oph = Operation.hash op in
+  Alpha_services.Helpers.Scripts.run_operation
+    cctxt (chain, block) (Operation.pack op) >>=? function
+  | (Operation_data op', Operation_metadata result) -> begin
+      match Operation.equal
+              op { shell = { branch } ; protocol_data = op' },
+            Apply_results.kind_equal_list contents result.contents with
+      | Some Operation.Eq, Some Apply_results.Eq ->
+          return ((oph, op, result) : t preapply_result)
+      | _ -> failwith "Unexpected result"
+    end
+  | _ -> failwith "Unexpected result"
+
+let estimated_gas_single
+    (type kind)
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let consumed_gas (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { consumed_gas }) -> Ok consumed_gas
+    | Applied (Origination_result { consumed_gas }) -> Ok consumed_gas
+    | Applied (Reveal_result { consumed_gas }) -> Ok consumed_gas
+    | Applied (Delegation_result { consumed_gas }) -> Ok consumed_gas
+    | Skipped _ -> assert false
+    | Backtracked (_, None) -> Ok Z.zero (* there must be another error for this to happen *)
+    | Backtracked (_, Some errs) -> Alpha_environment.wrap_error (Error errs)
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
+  List.fold_left
+    (fun acc (Internal_operation_result (_, r)) ->
+       acc >>? fun acc ->
+       consumed_gas r >>? fun gas ->
+       Ok (Z.add acc gas))
+    (consumed_gas operation_result) internal_operation_results
+
+let rec estimated_gas :
+  type kind. kind Kind.manager contents_result_list -> _ =
+  function
+  | Single_result res -> estimated_gas_single res
+  | Cons_result (res, rest) ->
+      estimated_gas_single res >>? fun gas1 ->
+      estimated_gas rest >>? fun gas2 ->
+      Ok (Z.add gas1 gas2)
+
+let estimated_storage_single
+    (type kind)
+    origination_size
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let storage_size_diff (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { paid_storage_size_diff ; allocated_destination_contract }) ->
+        if allocated_destination_contract then
+          Ok (Z.add paid_storage_size_diff origination_size)
+        else
+          Ok paid_storage_size_diff
+    | Applied (Origination_result { paid_storage_size_diff }) ->
+        Ok (Z.add paid_storage_size_diff origination_size)
+    | Applied (Reveal_result _)-> Ok Z.zero
+    | Applied (Delegation_result _) -> Ok Z.zero
+    | Skipped _ -> assert false
+    | Backtracked (_, None) -> Ok Z.zero (* there must be another error for this to happen *)
+    | Backtracked (_, Some errs) -> Alpha_environment.wrap_error (Error errs)
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
+  List.fold_left
+    (fun acc (Internal_operation_result (_, r)) ->
+       acc >>? fun acc ->
+       storage_size_diff r >>? fun storage ->
+       Ok (Z.add acc storage))
+    (storage_size_diff operation_result) internal_operation_results
+
+let estimated_storage origination_size res =
+  let rec estimated_storage :
+    type kind. kind contents_result_list -> _ =
+    function
+    | Single_result (Manager_operation_result _ as res) -> estimated_storage_single origination_size res
+    | Single_result _ -> Ok Z.zero
+    | Cons_result (res, rest) ->
+        estimated_storage_single origination_size res >>? fun storage1 ->
+        estimated_storage rest >>? fun storage2 ->
+        Ok (Z.add storage1 storage2) in
+  estimated_storage res >>? fun diff ->
+  Ok (Z.max Z.zero diff)
+
+let originated_contracts_single
+    (type kind)
+    (Manager_operation_result { operation_result ;
+                                internal_operation_results }
+     : kind Kind.manager contents_result) =
+  let originated_contracts (type kind) (result : kind manager_operation_result) =
+    match result with
+    | Applied (Transaction_result { originated_contracts }) -> Ok originated_contracts
+    | Applied (Origination_result { originated_contracts }) -> Ok originated_contracts
+    | Applied (Reveal_result _) -> Ok []
+    | Applied (Delegation_result _) -> Ok []
+    | Skipped _ -> assert false
+    | Backtracked (_, None) -> Ok [] (* there must be another error for this to happen *)
+    | Backtracked (_, Some errs) -> Alpha_environment.wrap_error (Error errs)
+    | Failed (_, errs) -> Alpha_environment.wrap_error (Error errs) in
+  List.fold_left
+    (fun acc (Internal_operation_result (_, r)) ->
+       acc >>? fun acc ->
+       originated_contracts r >>? fun contracts ->
+       Ok (List.rev_append contracts acc))
+    (originated_contracts operation_result >|? List.rev)
+    internal_operation_results
+
+let rec originated_contracts :
+  type kind. kind contents_result_list -> _ =
+  function
+  | Single_result (Manager_operation_result _ as res) ->
+      originated_contracts_single res >|? List.rev
+  | Single_result _ -> Ok []
+  | Cons_result (res, rest) ->
+      originated_contracts_single res >>? fun contracts1 ->
+      originated_contracts rest >>? fun contracts2 ->
+      Ok (List.rev_append contracts1 contracts2)
+
+let detect_script_failure :
+  type kind. kind operation_metadata -> _ =
+  let rec detect_script_failure :
+    type kind. kind contents_result_list -> _ =
+    let detect_script_failure_single
+        (type kind)
+        (Manager_operation_result { operation_result ;
+                                    internal_operation_results }
+         : kind Kind.manager contents_result) =
+      let detect_script_failure (type kind) (result : kind manager_operation_result) =
+        match result with
+        | Applied _ -> Ok ()
+        | Skipped _ -> assert false
+        | Backtracked (_, None) -> (* there must be another error for this to happen *)
+            Ok ()
+        | Backtracked (_, Some errs) ->
+            record_trace
+              (failure "The transfer simulation failed.")
+              (Alpha_environment.wrap_error (Error errs))
+        | Failed (_, errs) ->
+            record_trace
+              (failure "The transfer simulation failed.")
+              (Alpha_environment.wrap_error (Error errs)) in
+      List.fold_left
+        (fun acc (Internal_operation_result (_, r)) ->
+           acc >>? fun () ->
+           detect_script_failure r)
+        (detect_script_failure operation_result)
+        internal_operation_results in
+    function
+    | Single_result (Manager_operation_result _ as res) ->
+        detect_script_failure_single res
+    | Single_result _ ->
+        Ok ()
+    | Cons_result (res, rest) ->
+        detect_script_failure_single res >>? fun () ->
+        detect_script_failure rest in
+  fun { contents } -> detect_script_failure contents
+
+let may_patch_limits
+    (type kind) (cctxt : #Proto_alpha.full)
+    ~fee_parameter
+    ~chain ~block ?branch ?(compute_fee = false)
+    (contents: kind contents_list) : kind contents_list tzresult Lwt.t =
+  Alpha_services.Constants.all cctxt
+    (chain, block) >>=? fun { parametric = {
+      hard_gas_limit_per_operation = gas_limit ;
+      hard_storage_limit_per_operation = storage_limit ;
+      origination_size ;
+      cost_per_byte ;
+    } } ->
+  let may_need_patching_single
+    : type kind. kind contents -> kind contents option = function
+    | Manager_operation c
+      when compute_fee || c.gas_limit < Z.zero || gas_limit <= c.gas_limit
+           || c.storage_limit < Z.zero || storage_limit <= c.storage_limit ->
+        let gas_limit =
+          if c.gas_limit < Z.zero || gas_limit <= c.gas_limit then
+            gas_limit
+          else
+            c.gas_limit in
+        let storage_limit =
+          if c.storage_limit < Z.zero || storage_limit <= c.storage_limit then
+            storage_limit
+          else
+            c.storage_limit in
+        Some (Manager_operation { c with gas_limit ; storage_limit })
+    | _ -> None in
+  let rec may_need_patching
+    : type kind. kind contents_list -> kind contents_list option =
+    function
+    | Single (Manager_operation _ as c) -> begin
+        match may_need_patching_single c with
+        | None -> None
+        | Some op -> Some (Single op)
+      end
+    | Single _ -> None
+    | Cons (Manager_operation _ as c, rest) -> begin
+        match may_need_patching_single c, may_need_patching rest with
+        | None, None -> None
+        | Some c, None -> Some (Cons (c, rest))
+        | None, Some rest -> Some (Cons (c, rest))
+        | Some c, Some rest -> Some (Cons (c, rest))
+      end in
+
+  let rec patch_fee :
+    type kind. bool -> kind contents -> kind contents = fun first -> function
+    | Manager_operation c as op ->
+        let gas_limit = c.gas_limit in
+        let size =
+          if first then
+            Data_encoding.Binary.fixed_length_exn
+              Tezos_base.Operation.shell_header_encoding +
+            Data_encoding.Binary.length
+              Operation.contents_encoding
+              (Contents op) +
+            Signature.size
+          else
+            Data_encoding.Binary.length
+              Operation.contents_encoding
+              (Contents op)
+        in
+        let minimal_fees_in_nanotez =
+          Z.mul (Z.of_int64 (Tez.to_mutez fee_parameter.minimal_fees)) (Z.of_int 1000) in
+        let minimal_fees_for_gas_in_nanotez =
+          Z.mul fee_parameter.minimal_nanotez_per_gas_unit gas_limit in
+        let minimal_fees_for_size_in_nanotez =
+          Z.mul fee_parameter.minimal_nanotez_per_byte (Z.of_int size) in
+        let fees_in_nanotez =
+          Z.add minimal_fees_in_nanotez @@
+          Z.add minimal_fees_for_gas_in_nanotez minimal_fees_for_size_in_nanotez in
+        begin match Tez.of_mutez (Z.to_int64 (Z.div (Z.add (Z.of_int 999) fees_in_nanotez) (Z.of_int 1000))) with
+          | None -> assert false
+          | Some fee ->
+              if fee <= c.fee then
+                op
+              else
+                patch_fee first (Manager_operation { c with fee })
+        end
+    | c -> c in
+
+  let patch :
+    type kind. bool -> kind contents * kind contents_result -> kind contents tzresult Lwt.t = fun first -> function
+    | Manager_operation c, (Manager_operation_result _ as result) ->
+        begin
+          if c.gas_limit < Z.zero || gas_limit <= c.gas_limit then
+            Lwt.return (estimated_gas_single result) >>=? fun gas ->
+            begin
+              if Z.equal gas Z.zero then
+                cctxt#message "Estimated gas: none" >>= fun () ->
+                return Z.zero
+              else
+                cctxt#message
+                  "Estimated gas: %s units (will add 100 for safety)"
+                  (Z.to_string gas) >>= fun () ->
+                return (Z.min (Z.add gas (Z.of_int 100)) gas_limit)
+            end
+          else return c.gas_limit
+        end >>=? fun gas_limit ->
+        begin
+          if c.storage_limit < Z.zero || storage_limit <= c.storage_limit then
+            Lwt.return (estimated_storage_single (Z.of_int origination_size) result) >>=? fun storage ->
+            begin
+              if Z.equal storage Z.zero then
+                cctxt#message "Estimated storage: no bytes added" >>= fun () ->
+                return Z.zero
+              else
+                cctxt#message
+                  "Estimated storage: %s bytes added (will add 20 for safety)"
+                  (Z.to_string storage) >>= fun () ->
+                return (Z.min (Z.add storage (Z.of_int 20)) storage_limit)
+            end
+          else return c.storage_limit
+        end >>=? fun storage_limit ->
+        let c = Manager_operation { c with gas_limit ; storage_limit } in
+        if compute_fee then
+          return (patch_fee first c)
+        else
+          return c
+    | (c, _) -> return c in
+  let rec patch_list :
+    type kind. bool -> kind contents_and_result_list -> kind contents_list tzresult Lwt.t =
+    fun first -> function
+      | Single_and_result
+          ((Manager_operation _ as op), (Manager_operation_result _ as res)) ->
+          patch first (op, res) >>=? fun op -> return (Single op)
+      | Single_and_result (op, _) -> return (Single op)
+      | Cons_and_result ((Manager_operation _ as op),
+                         (Manager_operation_result _ as res), rest) -> begin
+          patch first (op, res) >>=? fun op ->
+          patch_list false rest >>=? fun rest ->
+          return (Cons (op, rest))
+        end in
+  match may_need_patching contents with
+  | Some contents ->
+      simulate cctxt ~chain ~block ?branch contents >>=? fun (_, _, result) ->
+      begin match detect_script_failure result with
+        | Ok () -> return_unit
+        | Error _ ->
+            cctxt#message
+              "@[<v 2>This simulation failed:@,%a@]"
+              Operation_result.pp_operation_result
+              (contents, result.contents) >>= fun () ->
+            return_unit
+      end >>=? fun () ->
+      begin
+        Lwt.return (estimated_storage (Z.of_int origination_size) result.contents) >>=? fun storage ->
+        Lwt.return (Alpha_environment.wrap_error Tez.(cost_per_byte *? Z.to_int64 storage)) >>=? fun burn ->
+        if Tez.(burn > fee_parameter.burn_cap) then
+          cctxt#error "The operation will burn %s%a which is higher than the configured burn cap (%s%a).@\n\
+                      \ Use `--burn-cap %a` to emit this operation."
+            Client_proto_args.tez_sym Tez.pp burn
+            Client_proto_args.tez_sym Tez.pp fee_parameter.burn_cap
+            Tez.pp burn >>= fun () ->
+          exit 1
+        else
+          return_unit
+      end >>=? fun () ->
+      let res = pack_contents_list contents result.contents in
+      patch_list true res
+  | None -> return contents
+
+let inject_operation
+    (type kind) cctxt ~chain ~block
+    ?confirmations
+    ?(dry_run = false)
+    ?branch ?src_sk
+    ~fee_parameter
+    ?compute_fee
+    (contents: kind contents_list)  =
+  Client_confirmations.wait_for_bootstrapped cctxt >>=? fun () ->
+  may_patch_limits
+    cctxt ~chain ~block ?branch
+    ~fee_parameter
+    ?compute_fee
+    contents >>=? fun contents ->
+  preapply cctxt ~chain ~block ~fee_parameter
+    ?branch ?src_sk contents >>=? fun (_oph, op, result) ->
+  begin match detect_script_failure result with
+    | Ok () -> return_unit
+    | Error _ as res ->
+        cctxt#message
+          "@[<v 2>This simulation failed:@,%a@]"
+          Operation_result.pp_operation_result
+          (op.protocol_data.contents, result.contents) >>= fun () ->
+        Lwt.return res
+  end >>=? fun () ->
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.encoding (Operation.pack op) in
+  if dry_run then
+    let oph = Operation_hash.hash_bytes [bytes] in
+    cctxt#message
+      "@[<v 0>Operation: 0x%a@,\
+       Operation hash is '%a'@]"
+      MBytes.pp_hex bytes
+      Operation_hash.pp oph >>= fun () ->
+    cctxt#message
+      "@[<v 2>Simulation result:@,%a@]"
+      Operation_result.pp_operation_result
+      (op.protocol_data.contents, result.contents) >>= fun () ->
+    return (oph, op.protocol_data.contents, result.contents)
+  else
+    Shell_services.Injection.operation cctxt ~chain bytes >>=? fun oph ->
+    cctxt#message "Operation successfully injected in the node." >>= fun () ->
+    cctxt#message "Operation hash is '%a'" Operation_hash.pp oph >>= fun () ->
+    begin
+      match confirmations with
+      | None ->
+          cctxt#message "@[<v 0>NOT waiting for the operation to be included.@,\
+                         Use command@,\
+                        \  tezos-client wait for %a to be included --confirmations 30 --branch %a@,\
+                         and/or an external block explorer to make sure that it has been included.@]"
+            Operation_hash.pp oph Block_hash.pp op.shell.branch >>= fun () ->
+          return result
+      | Some confirmations ->
+          cctxt#message "Waiting for the operation to be included..." >>= fun () ->
+          Client_confirmations.wait_for_operation_inclusion
+            ~branch:op.shell.branch ~confirmations cctxt ~chain oph >>=? fun (h, i , j) ->
+          Alpha_block_services.Operations.operation
+            cctxt ~block:(`Hash (h, 0)) i j >>=? fun op' ->
+          match op'.receipt with
+          | No_operation_metadata ->
+              failwith "Internal error: unexpected receipt."
+          | Operation_metadata receipt ->
+              match Apply_results.kind_equal_list contents receipt.contents
+              with
+              | Some Apply_results.Eq ->
+                  return (receipt : kind operation_metadata)
+              | None -> failwith "Internal error: unexpected receipt."
+    end >>=? fun result ->
+    cctxt#message
+      "@[<v 2>This sequence of operations was run:@,%a@]"
+      Operation_result.pp_operation_result
+      (op.protocol_data.contents, result.contents) >>= fun () ->
+    Lwt.return (originated_contracts result.contents) >>=? fun contracts ->
+    Lwt_list.iter_s
+      (fun c ->
+         cctxt#message
+           "New contract %a originated."
+           Contract.pp c)
+      contracts >>= fun () ->
+    begin match confirmations with
+      | None -> Lwt.return_unit
+      | Some number ->
+          if number >= 30 then
+            cctxt#message
+              "The operation was included in a block %d blocks ago."
+              number
+          else
+            cctxt#message
+              "@[<v 0>The operation has only been included %d blocks ago.@,\
+               We recommend to wait more.@,\
+               Use command@,\
+              \  tezos-client wait for %a to be included --confirmations 30 \
+               --branch %a@,\
+               and/or an external block explorer.@]"
+              number Operation_hash.pp oph Block_hash.pp op.shell.branch
+    end >>= fun () ->
+    return (oph, op.protocol_data.contents, result.contents)
+
+
+let inject_manager_operation
+    cctxt ~chain ~block ?branch ?confirmations ?dry_run
+    ~source ~src_pk ~src_sk ?fee ?(gas_limit = Z.minus_one) ?(storage_limit = (Z.of_int (-1))) ?counter ~fee_parameter
+    (type kind) (operation : kind manager_operation)
+  : (Operation_hash.t * kind Kind.manager contents *  kind Kind.manager contents_result) tzresult Lwt.t =
+  begin
+    match counter with
+    | None ->
+        Alpha_services.Contract.counter
+          cctxt (chain, block) source >>=? fun pcounter ->
+        let counter = Z.succ pcounter in
+        return counter
+    | Some counter ->
+        return counter
+  end >>=? fun counter ->
+  Alpha_services.Contract.manager_key
+    cctxt (chain, block) source >>=? fun (_, key) ->
+  let is_reveal : type kind. kind manager_operation -> bool = function
+    | Reveal _ -> true
+    | _ -> false in
+  let compute_fee, fee =
+    match fee with
+    | None -> true, Tez.zero
+    | Some fee -> false, fee in
+  match key with
+  | None when not (is_reveal operation) -> begin
+      let contents =
+        Cons
+          (Manager_operation { source ; fee = Tez.zero ; counter ;
+                               gas_limit = Z.of_int 10_000 ; storage_limit = Z.zero ;
+                               operation = Reveal src_pk },
+           Single (Manager_operation { source ; fee ; counter = Z.succ counter ;
+                                       gas_limit ; storage_limit ; operation })) in
+      inject_operation cctxt ~chain ~block ?confirmations ?dry_run
+        ~fee_parameter
+        ~compute_fee
+        ?branch ~src_sk contents >>=? fun (oph, op, result) ->
+      match pack_contents_list op result with
+      | Cons_and_result (_, _, Single_and_result (op, result)) ->
+          return (oph, op, result)
+      | Single_and_result (Manager_operation _, _) -> .
+      | _ -> assert false (* Grrr... *)
+    end
+  | _ ->
+      let contents =
+        Single (Manager_operation { source ; fee ; counter ;
+                                    gas_limit ; storage_limit ; operation }) in
+      inject_operation cctxt ~chain ~block ?confirmations ?dry_run
+        ~compute_fee ~fee_parameter ?branch ~src_sk contents >>=? fun (oph, op, result) ->
+      match pack_contents_list op result with
+      | Single_and_result (Manager_operation _ as op, result) ->
+          return (oph, op, result)
+      | _ -> assert false (* Grrr... *)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/injection.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/injection.mli
new file mode 100644
index 000000000..977072a3c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/injection.mli
@@ -0,0 +1,92 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Apply_results
+
+type 'kind preapply_result =
+  Operation_hash.t * 'kind operation * 'kind operation_metadata
+
+type fee_parameter = {
+  minimal_fees: Tez.t ;
+  minimal_nanotez_per_byte: Z.t ;
+  minimal_nanotez_per_gas_unit: Z.t ;
+  force_low_fee: bool ;
+  fee_cap: Tez.t ;
+  burn_cap: Tez.t ;
+}
+
+val dummy_fee_parameter: fee_parameter
+
+val preapply:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?fee_parameter:fee_parameter ->
+  ?branch:int ->
+  ?src_sk:Client_keys.sk_uri ->
+  'kind contents_list ->
+  'kind preapply_result tzresult Lwt.t
+
+type 'kind result_list =
+  Operation_hash.t * 'kind contents_list * 'kind contents_result_list
+
+val inject_operation:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  ?branch:int ->
+  ?src_sk:Client_keys.sk_uri ->
+  fee_parameter:fee_parameter ->
+  ?compute_fee:bool ->
+  'kind contents_list ->
+  'kind result_list tzresult Lwt.t
+
+type 'kind result =
+  Operation_hash.t * 'kind contents * 'kind contents_result
+
+val inject_manager_operation:
+  #Proto_alpha.full ->
+  chain:Shell_services.chain ->
+  block:Shell_services.block ->
+  ?branch:int ->
+  ?confirmations:int ->
+  ?dry_run:bool ->
+  source:Contract.t ->
+  src_pk:Signature.public_key ->
+  src_sk:Client_keys.sk_uri ->
+  ?fee:Tez.t ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  ?counter:Z.t ->
+  fee_parameter:fee_parameter ->
+  'kind manager_operation ->
+  'kind Kind.manager result tzresult Lwt.t
+
+val originated_contracts:
+  'kind contents_result_list -> Contract.t list tzresult
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.ml
new file mode 100644
index 000000000..0649e4ef2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.ml
@@ -0,0 +1,188 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Tezos_micheline
+open Micheline
+
+let print_expr ppf expr =
+  let print_annot ppf = function
+    | [] -> ()
+    | annots -> Format.fprintf ppf " %s" (String.concat " " annots) in
+  let rec print_expr ppf = function
+    | Int (_, value) -> Format.fprintf ppf "%s" (Z.to_string value)
+    | String (_, value) -> Micheline_printer.print_string ppf value
+    | Bytes (_, value) -> Format.fprintf ppf "0x%a" MBytes.pp_hex value
+    | Seq (_, items) ->
+        Format.fprintf ppf "(seq %a)"
+          (Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr)
+          items
+    | Prim (_, name, [], []) ->
+        Format.fprintf ppf "%s" name
+    | Prim (_, name, items, annot) ->
+        Format.fprintf ppf "(%s%a%s%a)"
+          name
+          print_annot annot
+          (if items = [] then "" else " ")
+          (Format.pp_print_list ~pp_sep:Format.pp_print_space print_expr) items in
+  let root = root (Michelson_v1_primitives.strings_of_prims expr) in
+  Format.fprintf ppf "@[<h>%a@]" print_expr root
+
+let print_var_annots ppf =
+  List.iter (Format.fprintf ppf "%s ")
+
+let print_annot_expr ppf (expr, annot) =
+  Format.fprintf ppf "(%a%a)"
+    print_var_annots annot
+    print_expr expr
+
+open Micheline_parser
+open Script_tc_errors
+
+let print_type_map ppf (parsed, type_map) =
+  let rec print_expr_types ppf = function
+    | Seq (loc, [])
+    | Prim (loc, _, [], _)
+    | Int (loc, _)
+    | Bytes (loc, _)
+    | String (loc, _) ->
+        print_item ppf loc
+    | Seq (loc, items)
+    | Prim (loc, _, items, _) ->
+        print_item ppf loc ;
+        List.iter (print_expr_types ppf) items
+  and print_stack ppf items =
+    Format.fprintf ppf "(%a)"
+      (Format.pp_print_list ~pp_sep:Format.pp_print_space print_annot_expr)
+      items
+  and print_item ppf loc = try
+      let { start = { point = s } ; stop = { point = e } }, locs =
+        List.assoc loc parsed.Michelson_v1_parser.expansion_table in
+      let locs = List.sort compare locs in
+      let (bef, aft) = List.assoc (List.hd locs) type_map in
+      Format.fprintf ppf "(@[<h>%d %d %a %a@])@,"
+        s e
+        print_stack bef
+        print_stack aft
+    with Not_found -> () in
+  Format.fprintf ppf "(@[<v 0>%a@])"
+    print_expr_types (root parsed.unexpanded)
+
+let first_error_location errs =
+  let rec find = function
+    | [] -> 0
+    | (Inconsistent_type_annotations (loc, _, _)
+      | Unexpected_annotation loc
+      | Ill_formed_type (_, _, loc)
+      | Invalid_arity (loc, _, _, _)
+      | Invalid_namespace (loc, _, _, _)
+      | Invalid_primitive (loc, _, _)
+      | Invalid_kind (loc, _, _)
+      | Fail_not_in_tail_position loc
+      | Undefined_binop (loc, _, _, _)
+      | Undefined_unop (loc, _, _)
+      | Bad_return (loc, _, _)
+      | Bad_stack (loc, _, _, _)
+      | Unmatched_branches (loc, _, _)
+      | Invalid_constant (loc, _, _)
+      | Invalid_contract (loc, _)
+      | Comparable_type_expected (loc, _)
+      | Michelson_v1_primitives.Invalid_primitive_name (_, loc)) :: _ -> loc
+    | _ :: rest -> find rest in
+  find errs
+
+let report_errors ppf (parsed, errs) =
+  let eco, out =
+    List.fold_left
+      (fun (eco, out) -> function
+         | Alpha_environment.Ecoproto_error err -> (err :: eco, out)
+         | err -> (eco, err :: out))
+      ([], []) errs in
+  let eco, out = List.rev eco, List.rev out in
+  Format.fprintf ppf "(@[<v 0>%a@,%a@])"
+    (fun ppf errs ->
+       let find_location loc =
+         let oloc = List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in
+         fst (List.assoc oloc parsed.expansion_table) in
+       match errs with
+       | top :: errs ->
+           let errs, loc =
+             List.map
+               (fun e -> Alpha_environment.Ecoproto_error e)
+               (top :: errs),
+             match top with
+             | Ill_typed_contract (expr, _)
+             | Ill_typed_data (_, expr, _) ->
+                 if expr = parsed.expanded then
+                   find_location
+                     (first_error_location
+                        (top :: errs))
+                 else find_location 0
+             | Michelson_v1_primitives.Invalid_primitive_name (expr, loc) ->
+                 if Micheline.strip_locations (Michelson_v1_macros.unexpand_rec (Micheline.root expr)) =
+                    parsed.Michelson_v1_parser.unexpanded then
+                   find_location loc
+                 else
+                   find_location 0
+             | _ -> find_location 0
+           in
+           let message =
+             Format.asprintf "%a"
+               (Michelson_v1_error_reporter.report_errors
+                  ~details:false ~show_source:false ~parsed)
+               errs in
+           let { start = { point = s } ; stop = { point = e } } = loc in
+           Format.fprintf ppf "(%d %d %S)" (s + 1) (e + 1) message
+       | [] -> ())
+    eco
+    (Format.pp_print_list
+       (fun ppf err ->
+          let find_location loc =
+            let oloc = List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in
+            fst (List.assoc oloc parsed.expansion_table) in
+          let loc =
+            match err with
+            | Invalid_utf8_sequence (point, _)
+            | Unexpected_character (point, _)
+            | Undefined_escape_sequence (point, _)
+            | Missing_break_after_number point ->
+                { start = point ; stop = point }
+            | Unterminated_string loc
+            | Unterminated_integer loc
+            | Unterminated_comment loc
+            | Odd_lengthed_bytes loc
+            | Unclosed { loc }
+            | Unexpected { loc }
+            | Extra { loc } -> loc
+            | Misaligned node -> location node
+            | _ -> find_location 0 in
+          let message =
+            Format.asprintf "%a"
+              (Michelson_v1_error_reporter.report_errors
+                 ~details:false ~show_source:false ~parsed)
+              [ err ] in
+          let { start = { point = s } ; stop = { point = e } } = loc in
+          Format.fprintf ppf "(%d %d %S)" (s + 1) (e + 1) message))
+    out
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.mli
new file mode 100644
index 000000000..7b50fc345
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_emacs.mli
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val print_expr :
+  Format.formatter ->
+  Script.expr ->
+  unit
+val print_type_map :
+  Format.formatter ->
+  Michelson_v1_parser.parsed * Script_tc_errors.type_map ->
+  unit
+val report_errors :
+  Format.formatter ->
+  Michelson_v1_parser.parsed * Error_monad.error list ->
+  unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
new file mode 100644
index 000000000..7d60787e6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
@@ -0,0 +1,484 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+open Script_tc_errors
+open Script_interpreter
+open Michelson_v1_printer
+
+let print_ty ppf ty =
+  Michelson_v1_printer.print_expr_unwrapped ppf ty
+
+let print_var_annot ppf annot =
+  List.iter (Format.fprintf ppf "@ %s") annot
+
+let print_stack_ty ?(depth = max_int) ppf s =
+  let rec loop depth ppf = function
+    | [] -> ()
+    | _ when depth <= 0 ->
+        Format.fprintf ppf "..."
+    | [last, annot] ->
+        Format.fprintf ppf "%a%a"
+          print_ty last
+          print_var_annot annot
+    | (last, annot) :: rest ->
+        Format.fprintf ppf "%a%a@ :@ %a"
+          print_ty last
+          print_var_annot annot
+          (loop (depth - 1)) rest in
+  match s with
+  | [] ->
+      Format.fprintf ppf "[]"
+  | sty ->
+      Format.fprintf ppf "@[<hov 2>[ %a ]@]" (loop depth) sty
+
+let rec print_enumeration ppf = function
+  | [ single ] ->
+      Format.fprintf ppf "%a"
+        Format.pp_print_text single
+  | [ prev ; last ] ->
+      Format.fprintf ppf "%a@ or@ %a"
+        Format.pp_print_text prev Format.pp_print_text last
+  | first :: rest ->
+      Format.fprintf ppf "%a,@ %a"
+        Format.pp_print_text first print_enumeration rest
+  | [] -> assert false
+
+let collect_error_locations errs =
+  let rec collect acc = function
+    | Alpha_environment.Ecoproto_error
+        (Ill_formed_type (_, _, _)
+        | Runtime_contract_error (_, _)
+        | Michelson_v1_primitives.Invalid_primitive_name (_, _)
+        | Ill_typed_data (_, _, _)
+        | Ill_typed_contract (_, _)) :: _
+    | [] -> acc
+    | Alpha_environment.Ecoproto_error
+        (Invalid_arity (loc, _, _, _)
+        | Inconsistent_type_annotations (loc, _, _)
+        | Unexpected_annotation loc
+        | Ungrouped_annotations loc
+        | Type_too_large (loc, _, _)
+        | Invalid_namespace (loc, _, _, _)
+        | Invalid_primitive (loc, _, _)
+        | Invalid_kind (loc, _, _)
+        | Duplicate_field (loc, _)
+        | Unexpected_big_map loc
+        | Unexpected_operation loc
+        | Fail_not_in_tail_position loc
+        | Undefined_binop (loc, _, _, _)
+        | Undefined_unop (loc, _, _)
+        | Bad_return (loc, _, _)
+        | Bad_stack (loc, _, _, _)
+        | Unmatched_branches (loc, _, _)
+        | Self_in_lambda loc
+        | Invalid_constant (loc, _, _)
+        | Invalid_contract (loc, _)
+        | Comparable_type_expected (loc, _)
+        | Overflow (loc, _)
+        | Reject (loc, _, _)) :: rest ->
+        collect (loc :: acc) rest
+    | _ :: rest -> collect acc rest in
+  collect [] errs
+
+let report_errors ~details ~show_source ?parsed ppf errs =
+  let rec print_trace locations errs =
+    let print_loc ppf loc =
+      match locations loc with
+      | None ->
+          Format.fprintf ppf "At (unshown) location %d, " loc
+      | Some loc ->
+          Format.fprintf ppf "%s,@ "
+            (String.capitalize_ascii
+               (Format.asprintf "%a" Micheline_parser.print_location loc))  in
+    let parsed_locations parsed loc = try
+        let oloc = List.assoc loc parsed.Michelson_v1_parser.unexpansion_table in
+        let ploc, _ = List.assoc oloc parsed.expansion_table in
+        Some ploc
+      with Not_found -> None in
+    let print_source ppf (parsed, _hilights (* TODO *)) =
+      let lines =
+        String.split_on_char '\n' parsed.Michelson_v1_parser.source in
+      let cols =
+        String.length (string_of_int (List.length lines)) in
+      Format.fprintf ppf "@[<v 0>%a@]"
+        (Format.pp_print_list
+           (fun ppf (i, l) ->
+              Format.fprintf ppf "%0*d: %s" cols i l))
+        (List.mapi (fun i l -> (i + 1, l)) lines) in
+    match errs with
+    | [] -> ()
+    | Alpha_environment.Ecoproto_error (Michelson_v1_primitives.Invalid_primitive_name (expr, loc)) :: rest ->
+        let parsed =
+          match parsed with
+          | Some parsed ->
+              if Micheline.strip_locations (Michelson_v1_macros.unexpand_rec (Micheline.root expr)) =
+                 parsed.Michelson_v1_parser.unexpanded then
+                parsed
+              else
+                Michelson_v1_printer.unparse_invalid expr
+          | None -> Michelson_v1_printer.unparse_invalid expr in
+        let hilights = loc :: collect_error_locations rest in
+        if show_source then
+          Format.fprintf ppf
+            "@[<hov 0>@[<hov 2>Invalid primitive:@ %a@]@]"
+            print_source (parsed, hilights)
+        else
+          Format.fprintf ppf "Invalid primitive." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error (Ill_typed_data (name, expr, ty)) :: rest ->
+        let parsed =
+          match parsed with
+          | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> parsed
+          | Some _ | None -> Michelson_v1_printer.unparse_expression expr in
+        let hilights = collect_error_locations rest in
+        Format.fprintf ppf
+          "@[<hov 0>@[<hov 2>Ill typed %adata:@ %a@]@ \
+           @[<hov 2>is not an expression of type@ %a@]@]"
+          (fun ppf -> function
+             | None -> ()
+             | Some s -> Format.fprintf ppf "%s " s)
+          name
+          print_source (parsed, hilights)
+          print_ty ty ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error (Ill_formed_type (_, expr, loc)) :: rest ->
+        let parsed =
+          match parsed with
+          | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> parsed
+          | Some _ | None -> Michelson_v1_printer.unparse_expression expr in
+        let hilights = loc :: collect_error_locations errs in
+        if show_source then
+          Format.fprintf ppf
+            "@[<v 2>%aill formed type:@ %a@]"
+            print_loc loc print_source (parsed, hilights)
+        else
+          Format.fprintf ppf
+            "Ill formed type." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error (Ill_typed_contract (expr, type_map)) :: rest ->
+        let parsed =
+          match parsed with
+          | Some parsed when not details && expr = parsed.Michelson_v1_parser.expanded -> parsed
+          | Some _ | None -> Michelson_v1_printer.unparse_toplevel ~type_map expr in
+        let hilights = collect_error_locations rest in
+        if show_source then
+          Format.fprintf ppf
+            "@[<v 0>Ill typed contract:@,  %a@]"
+            print_source (parsed, hilights)
+        else
+          Format.fprintf ppf "Ill typed contract.";
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error Apply.Gas_quota_exceeded_init_deserialize :: rest ->
+        Format.fprintf ppf
+          "@[<v 0>Not enough gas to deserialize the operation.@,\
+           Injecting such a transaction could have you banned from mempools.@]" ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Cannot_serialize_error :: rest ->
+        Format.fprintf ppf
+          "Error too big to serialize within the provided gas bounds." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Cannot_serialize_storage :: rest ->
+        Format.fprintf ppf
+          "Cannot serialize the resulting storage value within the provided gas bounds." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error (Missing_field prim) :: rest ->
+        Format.fprintf ppf "@[<v 0>Missing contract field: %s@]"
+          (Michelson_v1_primitives.string_of_prim prim) ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error (Duplicate_field (loc, prim)) :: rest ->
+        Format.fprintf ppf "@[<v 0>%aduplicate contract field: %s@]"
+          print_loc loc
+          (Michelson_v1_primitives.string_of_prim prim) ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error (Unexpected_big_map loc) :: rest ->
+        Format.fprintf ppf "%abig_map type only allowed on the left of the toplevel storage pair"
+          print_loc loc ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error (Unexpected_operation loc) :: rest ->
+        Format.fprintf ppf "%aoperation type forbidden in parameter, storage and constants"
+          print_loc loc ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error (Runtime_contract_error (contract, expr)) :: rest ->
+        let parsed =
+          match parsed with
+          | Some parsed when expr = parsed.Michelson_v1_parser.expanded -> parsed
+          | Some _ | None -> Michelson_v1_printer.unparse_toplevel expr in
+        let hilights = collect_error_locations rest in
+        Format.fprintf ppf
+          "@[<v 2>Runtime error in contract %a:@ %a@]"
+          Contract.pp contract
+          print_source (parsed, hilights) ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace (parsed_locations parsed) rest
+    | Alpha_environment.Ecoproto_error (Apply.Internal_operation_replay op) :: rest ->
+        Format.fprintf ppf
+          "@[<v 2>Internal operation replay attempt:@,%a@]"
+          Operation_result.pp_internal_operation op ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Gas.Gas_limit_too_high :: rest ->
+        Format.fprintf ppf
+          "Gas limit for the operation is out of the protocol hard bounds." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Gas.Block_quota_exceeded :: rest ->
+        Format.fprintf ppf
+          "Gas limit for the block exceeded during typechecking or execution." ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Gas.Operation_quota_exceeded :: rest ->
+        Format.fprintf ppf
+          "@[<v 0>Gas limit exceeded during typechecking or execution.@,Try again with a higher gas limit.@]" ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | Alpha_environment.Ecoproto_error Fees.Operation_quota_exceeded :: rest ->
+        Format.fprintf ppf
+          "@[<v 0>Storage limit exceeded during typechecking or execution.@,Try again with a higher storage limit.@]" ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | [ Alpha_environment.Ecoproto_error (Script_interpreter.Bad_contract_parameter c) ] ->
+        Format.fprintf ppf
+          "@[<v 0>Account %a is not a smart contract, it does not take arguments.@,\
+           The `-arg' flag should not be used when transferring to an account.@]"
+          Contract.pp c
+    | Alpha_environment.Ecoproto_error err :: rest ->
+        begin match err with
+          | Script_interpreter.Bad_contract_parameter c ->
+              Format.fprintf ppf
+                "Invalid argument passed to contract %a."
+                Contract.pp c
+          | Invalid_arity (loc, name, exp, got) ->
+              Format.fprintf ppf
+                "%aprimitive %s expects %d arguments but is given %d."
+                print_loc loc (Michelson_v1_primitives.string_of_prim name) exp got
+          | Invalid_namespace (loc, name, exp, got) ->
+              let human_namespace = function
+                | Instr_namespace -> ("an", "instruction")
+                | Type_namespace -> ("a", "type name")
+                | Constant_namespace -> ("a", "constant constructor")
+                | Keyword_namespace -> ("a", "keyword") in
+              Format.fprintf ppf
+                "@[%aunexpected %s %s, only %s %s can be used here."
+                print_loc loc
+                (snd (human_namespace got))
+                (Michelson_v1_primitives.string_of_prim name)
+                (fst (human_namespace exp)) (snd (human_namespace exp))
+          | Invalid_primitive (loc, exp, got) ->
+              Format.fprintf ppf
+                "@[%ainvalid primitive %s, only %a can be used here."
+                print_loc loc
+                (Michelson_v1_primitives.string_of_prim got)
+                print_enumeration
+                (List.map Michelson_v1_primitives.string_of_prim exp)
+          | Invalid_kind (loc, exp, got) ->
+              let human_kind = function
+                | Seq_kind -> ("a", "sequence")
+                | Prim_kind -> ("a", "primitive")
+                | Int_kind -> ("an", "int")
+                | String_kind -> ("a", "string")
+                | Bytes_kind -> ("a", "byte sequence") in
+              Format.fprintf ppf
+                "@[%aunexpected %s, only@ %a@ can be used here."
+                print_loc loc
+                (snd (human_kind got))
+                print_enumeration
+                (List.map (fun k -> let (a, n) = human_kind k in a ^ " " ^ n) exp)
+          | Duplicate_map_keys (_, expr) ->
+              Format.fprintf ppf
+                "@[<v 2>Map literals cannot contain duplicate keys, \
+                 however a duplicate key was found:@ \
+                 @[%a@]"
+                print_expr expr
+          | Unordered_map_keys (_, expr) ->
+              Format.fprintf ppf
+                "@[<v 2>Keys in a map literal must be in strictly ascending order, \
+                 but they were unordered in literal:@ \
+                 @[%a@]"
+                print_expr expr
+          | Duplicate_set_values (_, expr) ->
+              Format.fprintf ppf
+                "@[<v 2>Set literals cannot contain duplicate values, \
+                 however a duplicate value was found:@ \
+                 @[%a@]"
+                print_expr expr
+          | Unordered_set_values (_, expr) ->
+              Format.fprintf ppf
+                "@[<v 2>Values in a set literal must be in strictly ascending order, \
+                 but they were unordered in literal:@ \
+                 @[%a@]"
+                print_expr expr
+          | Fail_not_in_tail_position loc ->
+              Format.fprintf ppf
+                "%aThe FAIL instruction must appear in a tail position."
+                print_loc loc
+          | Undefined_binop (loc, name, tya, tyb) ->
+              Format.fprintf ppf
+                "@[<hov 0>@[<hov 2>%aoperator %s is undefined between@ %a@]@ \
+                 @[<hov 2>and@ %a.@]@]"
+                print_loc loc
+                (Michelson_v1_primitives.string_of_prim name)
+                print_ty tya
+                print_ty tyb
+          | Undefined_unop (loc, name, ty) ->
+              Format.fprintf ppf
+                "@[<hov 0>@[<hov 2>%aoperator %s is undefined on@ %a@]@]"
+                print_loc loc
+                (Michelson_v1_primitives.string_of_prim name)
+                print_ty ty
+          | Bad_return (loc, got, exp) ->
+              Format.fprintf ppf
+                "@[<v 2>%awrong stack type at end of body:@,\
+                 - @[<v 0>expected return stack type:@ %a,@]@,\
+                 - @[<v 0>actual stack type:@ %a.@]@]"
+                print_loc loc
+                (fun ppf -> print_stack_ty ppf) [exp, []]
+                (fun ppf -> print_stack_ty ppf) got
+          | Bad_stack (loc, name, depth, sty) ->
+              Format.fprintf ppf
+                "@[<hov 2>%awrong stack type for instruction %s:@ %a.@]"
+                print_loc loc
+                (Michelson_v1_primitives.string_of_prim name)
+                (print_stack_ty ~depth) sty
+          | Unmatched_branches (loc, sta, stb) ->
+              Format.fprintf ppf
+                "@[<v 2>%atwo branches don't end with the same stack type:@,\
+                 - @[<hov>first stack type:@ %a,@]@,\
+                 - @[<hov>other stack type:@ %a.@]@]"
+                print_loc loc
+                (fun ppf -> print_stack_ty ppf) sta
+                (fun ppf -> print_stack_ty ppf) stb
+          | Inconsistent_annotations (annot1, annot2) ->
+              Format.fprintf ppf
+                "@[<v 2>The two annotations do not match:@,\
+                 - @[<v>%s@]@,\
+                 - @[<v>%s@]@]"
+                annot1
+                annot2
+          | Inconsistent_field_annotations (annot1, annot2) ->
+              Format.fprintf ppf
+                "@[<v 2>The field access annotation does not match:@,\
+                 - @[<v>%s@]@,\
+                 - @[<v>%s@]@]"
+                annot1
+                annot2
+          | Inconsistent_type_annotations (loc, ty1, ty2) ->
+              Format.fprintf ppf
+                "@[<v 2>%athe two types contain incompatible annotations:@,\
+                 - @[<hov>%a@]@,\
+                 - @[<hov>%a@]@]"
+                print_loc loc
+                print_ty ty1
+                print_ty ty2
+          | Unexpected_annotation loc ->
+              Format.fprintf ppf
+                "@[<v 2>%aunexpected annotation."
+                print_loc loc
+          | Ungrouped_annotations loc ->
+              Format.fprintf ppf
+                "@[<v 2>%aAnnotations of the same kind must be grouped."
+                print_loc loc
+          | Type_too_large (loc, size, maximum_size) ->
+              Format.fprintf ppf
+                "@[<v 2>%atype size (%d) exceeded maximum type size (%d)."
+                print_loc loc
+                size maximum_size
+          | Self_in_lambda loc ->
+              Format.fprintf ppf
+                "%aThe SELF instruction cannot appear in a lambda."
+                print_loc loc
+          | Bad_stack_length ->
+              Format.fprintf ppf
+                "Bad stack length."
+          | Bad_stack_item lvl ->
+              Format.fprintf ppf
+                "Bad stack item %d."
+                lvl
+          | Invalid_constant (loc, got, exp) ->
+              Format.fprintf ppf
+                "@[<hov 0>@[<hov 2>%avalue@ %a@]@ \
+                 @[<hov 2>is invalid for type@ %a.@]@]"
+                print_loc loc
+                print_expr got
+                print_ty exp
+          | Invalid_contract (loc, contract) ->
+              Format.fprintf ppf
+                "%ainvalid contract %a."
+                print_loc loc Contract.pp contract
+          | Comparable_type_expected (loc, ty) ->
+              Format.fprintf ppf "%acomparable type expected."
+                print_loc loc ;
+              Format.fprintf ppf "@[<hov 0>@[<hov 2>Type@ %a@]@ is not comparable.@]"
+                print_ty ty
+          | Inconsistent_types (tya, tyb) ->
+              Format.fprintf ppf
+                "@[<hov 0>@[<hov 2>Type@ %a@]@ \
+                 @[<hov 2>is not compatible with type@ %a.@]@]"
+                print_ty tya
+                print_ty tyb
+          | Reject (loc, v, trace) ->
+              Format.fprintf ppf
+                "%ascript reached FAILWITH instruction@ \
+                 @[<hov 2>with@ %a@]%a"
+                print_loc loc print_expr v
+                (fun ppf -> function
+                   | None -> ()
+                   | Some trace ->
+                       Format.fprintf ppf "@,@[<v 2>trace@,%a@]"
+                         print_execution_trace trace)
+                trace
+          | Overflow (loc, trace) ->
+              Format.fprintf ppf "%aunexpected arithmetic overflow%a"
+                print_loc loc
+                (fun ppf -> function
+                   | None -> ()
+                   | Some trace ->
+                       Format.fprintf ppf "@,@[<v 2>trace@,%a@]"
+                         print_execution_trace trace)
+                trace
+          | err -> Format.fprintf ppf "%a" Alpha_environment.Error_monad.pp err
+        end ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest
+    | err :: rest ->
+        Format.fprintf ppf "%a" Error_monad.pp err ;
+        if rest <> [] then Format.fprintf ppf "@," ;
+        print_trace locations rest in
+  Format.fprintf ppf "@[<v 0>" ;
+  print_trace (fun _ -> None) errs ;
+  Format.fprintf ppf "@]"
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli
new file mode 100644
index 000000000..b9bc527bd
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_error_reporter.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 report_errors :
+  details: bool ->
+  show_source: bool ->
+  ?parsed: Michelson_v1_parser.parsed ->
+  Format.formatter ->
+  Error_monad.error list ->
+  unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.ml
new file mode 100644
index 000000000..478ab4de0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.ml
@@ -0,0 +1,1177 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Tezos_micheline
+open Micheline
+
+module IntMap = Map.Make (Compare.Int)
+
+type 'l node = ('l, string) Micheline.node
+
+type error += Unexpected_macro_annotation of string
+type error += Sequence_expected of string
+type error += Invalid_arity of string * int * int
+
+let rec check_letters str i j f =
+  i > j || f (String.get str i) && check_letters str (i + 1) j f
+
+let expand_caddadr original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len > 3
+      && String.get str 0 = 'C'
+      && String.get str (len - 1) = 'R'
+      && check_letters str 1 (len - 2)
+           (function 'A' | 'D' -> true | _ -> false) then
+        begin match args with
+          | [] -> ok ()
+          | _ :: _ -> error (Invalid_arity (str, List.length args, 0))
+        end >>? fun () ->
+        let rec parse i annot acc =
+          if i = 0 then
+            Seq (loc, acc)
+          else
+            let annot = if i = len - 2 then annot else [] in
+            match String.get str i with
+            | 'A' -> parse (i - 1) [] (Prim (loc, "CAR", [], annot) :: acc)
+            | 'D' -> parse (i - 1) [] (Prim (loc, "CDR", [], annot) :: acc)
+            | _ -> assert false in
+        ok (Some (parse (len - 2) annot []))
+      else
+        ok None
+  | _ -> ok None
+
+let extract_first_annot annot char =
+  let rec extract_first_annot others = function
+    | [] -> None, List.rev others
+    | a :: rest ->
+        try
+          if a.[0] = char
+          then Some a, List.rev_append others rest
+          else extract_first_annot (a :: others) rest
+        with Invalid_argument _ -> extract_first_annot (a :: others) rest
+  in
+  extract_first_annot [] annot
+
+let extract_first_field_annot annot = extract_first_annot annot '%'
+let extract_first_var_annot annot = extract_first_annot annot '@'
+
+let extract_field_annots annot =
+  List.partition (fun a ->
+      match a.[0] with
+      | '%' -> true
+      | _ -> false
+      | exception Invalid_argument _ -> false
+    ) annot
+
+let expand_set_caddadr original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len >= 7
+      && String.sub str 0 5 = "SET_C"
+      && String.get str (len - 1) = 'R'
+      && check_letters str 5 (len - 2)
+           (function 'A' | 'D' -> true | _ -> false) then
+        begin match args with
+          | [] -> ok ()
+          | _ :: _ -> error (Invalid_arity (str, List.length args, 0))
+        end >>? fun () ->
+        begin match extract_field_annots annot with
+          | [], annot -> ok (None, annot)
+          | [f], annot -> ok (Some f, annot)
+          | _, _ -> error (Unexpected_macro_annotation str)
+        end >>? fun (field_annot, annot) ->
+        let rec parse i acc =
+          if i = 4 then
+            acc
+          else
+            let annot = if i = 5 then annot else [] in
+            match String.get str i with
+            | 'A' ->
+                let acc =
+                  Seq (loc,
+                       [ Prim (loc, "DUP", [], []) ;
+                         Prim (loc, "DIP",
+                               [ Seq (loc,
+                                      [ Prim (loc, "CAR", [], [ "@%%" ]) ;
+                                        acc ]) ], []) ;
+                         Prim (loc, "CDR", [], [ "@%%" ]) ;
+                         Prim (loc, "SWAP", [], []) ;
+                         Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in
+                parse (i - 1) acc
+            | 'D' ->
+                let acc =
+                  Seq (loc,
+                       [ Prim (loc, "DUP", [], []) ;
+                         Prim (loc, "DIP",
+                               [ Seq (loc,
+                                      [ Prim (loc, "CDR", [], [ "@%%" ]) ;
+                                        acc ]) ], []) ;
+                         Prim (loc, "CAR", [], [ "@%%" ]) ;
+                         Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in
+                parse (i - 1) acc
+            | _ -> assert false in
+        match String.get str (len - 2) with
+        | 'A' ->
+            let access_check = match field_annot with
+              | None -> []
+              | Some f -> [ Prim (loc, "DUP", [], []) ;
+                            Prim (loc, "CAR", [], [ f ]) ;
+                            Prim (loc, "DROP", [], []) ;
+                          ] in
+            let encoding = [ Prim (loc, "CDR", [], [ "@%%" ]) ;
+                             Prim (loc, "SWAP", [], []) ] in
+            let pair = [ Prim (loc, "PAIR", [],
+                               [ Option.unopt field_annot ~default:"%" ; "%@" ]) ] in
+            let init = Seq (loc, access_check @ encoding @ pair) in
+            ok (Some (parse (len - 3) init))
+        | 'D' ->
+            let access_check = match field_annot with
+              | None -> []
+              | Some f -> [ Prim (loc, "DUP", [], []) ;
+                            Prim (loc, "CDR", [], [ f ]) ;
+                            Prim (loc, "DROP", [], []) ;
+                          ] in
+            let encoding = [ Prim (loc, "CAR", [], [ "@%%" ]) ] in
+            let pair = [ Prim (loc, "PAIR", [],
+                               [ "%@" ; Option.unopt field_annot ~default:"%" ]) ] in
+            let init = Seq (loc, access_check @ encoding @ pair) in
+            ok (Some (parse (len - 3) init))
+        | _ -> assert false
+      else
+        ok None
+  | _ -> ok None
+
+let expand_map_caddadr original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len >= 7
+      && String.sub str 0 5 = "MAP_C"
+      && String.get str (len - 1) = 'R'
+      && check_letters str 5 (len - 2)
+           (function 'A' | 'D' -> true | _ -> false) then
+        begin match args with
+          | [ Seq _ as code ] -> ok code
+          | [ _ ] -> error (Sequence_expected str)
+          | [] | _ :: _ :: _ -> error (Invalid_arity (str, List.length args, 1))
+        end >>? fun code ->
+        begin match extract_field_annots annot with
+          | [], annot -> ok (None, annot)
+          | [f], annot -> ok (Some f, annot)
+          | _, _ -> error (Unexpected_macro_annotation str)
+        end >>? fun (field_annot, annot) ->
+        let rec parse i acc =
+          if i = 4 then
+            acc
+          else
+            let annot = if i = 5 then annot else [] in
+            match String.get str i with
+            | 'A' ->
+                let acc =
+                  Seq (loc,
+                       [ Prim (loc, "DUP", [], []) ;
+                         Prim (loc, "DIP",
+                               [ Seq (loc,
+                                      [ Prim (loc, "CAR", [], [ "@%%" ]) ;
+                                        acc ]) ], []) ;
+                         Prim (loc, "CDR", [], [ "@%%" ]) ;
+                         Prim (loc, "SWAP", [], []) ;
+                         Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in
+                parse (i - 1) acc
+            | 'D' ->
+                let acc =
+                  Seq (loc,
+                       [ Prim (loc, "DUP", [], []) ;
+                         Prim (loc, "DIP",
+                               [ Seq (loc,
+                                      [ Prim (loc, "CDR", [], [ "@%%" ]) ;
+                                        acc ]) ], []) ;
+                         Prim (loc, "CAR", [], [ "@%%" ]) ;
+                         Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in
+                parse (i - 1) acc
+            | _ -> assert false in
+        let cr_annot = match field_annot with
+          | None -> []
+          | Some f -> [ "@" ^ String.sub f 1 (String.length f - 1) ] in
+        match String.get str (len - 2) with
+        | 'A' ->
+            let init =
+              Seq (loc,
+                   [ Prim (loc, "DUP", [], []) ;
+                     Prim (loc, "CDR", [], [ "@%%" ]) ;
+                     Prim (loc, "DIP",
+                           [ Seq (loc, [ Prim (loc, "CAR", [], cr_annot) ; code ]) ], []) ;
+                     Prim (loc, "SWAP", [], []) ;
+                     Prim (loc, "PAIR", [],
+                           [ Option.unopt field_annot ~default:"%" ; "%@"]) ]) in
+            ok (Some (parse (len - 3) init))
+        | 'D' ->
+            let init =
+              Seq (loc,
+                   [ Prim (loc, "DUP", [], []) ;
+                     Prim (loc, "CDR", [], cr_annot) ;
+                     code ;
+                     Prim (loc, "SWAP", [], []) ;
+                     Prim (loc, "CAR", [], [ "@%%" ]) ;
+                     Prim (loc, "PAIR", [],
+                           [ "%@" ; Option.unopt field_annot ~default:"%" ]) ]) in
+            ok (Some (parse (len - 3) init))
+        | _ -> assert false
+      else
+        ok None
+  | _ -> ok None
+
+exception Not_a_roman
+
+let decimal_of_roman roman =
+  (* http://rosettacode.org/wiki/Roman_numerals/Decode#OCaml *)
+  let arabic = ref 0 in
+  let lastval = ref 0 in
+  for i = (String.length roman) - 1 downto 0 do
+    let n =
+      match roman.[i] with
+      | 'M' -> 1000
+      | 'D' -> 500
+      | 'C' -> 100
+      | 'L' -> 50
+      | 'X' -> 10
+      | 'V' -> 5
+      | 'I' -> 1
+      | _ -> raise_notrace Not_a_roman
+    in
+    if Compare.Int.(n < !lastval)
+    then arabic := !arabic - n
+    else arabic := !arabic + n;
+    lastval := n
+  done;
+  !arabic
+
+let expand_dxiiivp original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len > 3
+      && String.get str 0 = 'D'
+      && String.get str (len - 1) = 'P' then
+        try
+          let depth = decimal_of_roman (String.sub str 1 (len - 2)) in
+          let rec make i acc =
+            if i = 0 then
+              acc
+            else
+              make (i - 1)
+                (Seq (loc, [ Prim (loc, "DIP", [ acc ], annot) ])) in
+          match args with
+          | [ Seq (_, _) as arg ] -> ok @@ Some (make depth arg)
+          | [ _ ] -> error (Sequence_expected str)
+          | [] | _ :: _ :: _ -> error (Invalid_arity (str, List.length args, 1))
+        with Not_a_roman -> ok None
+      else ok None
+  | _ -> ok None
+
+exception Not_a_pair
+
+let rec dip ~loc depth instr =
+  if depth <= 0
+  then instr
+  else dip ~loc (depth - 1) (Prim (loc, "DIP", [ Seq (loc, [ instr ]) ], []))
+
+type pair_item =
+  | A
+  | I
+  | P of int * pair_item * pair_item
+
+let parse_pair_substr str ~len start =
+  let rec parse ?left i =
+    if i = len - 1 then
+      raise_notrace Not_a_pair
+    else if String.get str i = 'P' then
+      let next_i, l = parse ~left:true (i + 1) in
+      let next_i, r = parse ~left:false next_i in
+      next_i, P (i, l, r)
+    else if String.get str i = 'A' && left = Some true then
+      i + 1, A
+    else if String.get str i = 'I' && left <> Some true then
+      i + 1, I
+    else
+      raise_notrace Not_a_pair in
+  let last, ast = parse start in
+  if last <> len - 1 then
+    raise_notrace Not_a_pair
+  else
+    ast
+
+let unparse_pair_item ast =
+  let rec unparse ast acc = match ast with
+    | P (_, l, r) -> unparse r (unparse l ("P" :: acc))
+    | A -> "A" :: acc
+    | I -> "I" :: acc in
+  List.rev ("R" :: unparse ast []) |> String.concat ""
+
+let pappaiir_annots_pos ast annot =
+  let rec find_annots_pos p_pos ast annots acc =
+    match ast, annots with
+    | _, [] -> annots, acc
+    | P (i, left, right), _ ->
+        let annots, acc = find_annots_pos i left annots acc in
+        find_annots_pos i right annots acc
+    | A, a :: annots ->
+        let pos = match IntMap.find_opt p_pos acc with
+          | None -> [ a ], []
+          | Some (_, cdr) -> [ a ], cdr in
+        annots, IntMap.add p_pos pos acc
+    | I, a :: annots ->
+        let pos = match IntMap.find_opt p_pos acc with
+          | None -> [], [ a ]
+          | Some (car, _) -> car, [ a ] in
+        annots, IntMap.add p_pos pos acc in
+  snd (find_annots_pos 0 ast annot IntMap.empty)
+
+let expand_pappaiir original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len > 4
+      && String.get str 0 = 'P'
+      && String.get str (len - 1) = 'R'
+      && check_letters str 1 (len - 2)
+           (function 'P' | 'A' | 'I' -> true | _ -> false) then
+        try
+          let field_annots, annot = extract_field_annots annot in
+          let ast = parse_pair_substr str ~len 0 in
+          let field_annots_pos = pappaiir_annots_pos ast field_annots in
+          let rec parse p (depth, acc) =
+            match p with
+            | P (i, left, right) ->
+                let annot =
+                  match i, IntMap.find_opt i field_annots_pos with
+                  | 0, None -> annot
+                  | _, None -> []
+                  | 0, Some ([], cdr_annot) -> "%" :: cdr_annot @ annot
+                  | _, Some ([], cdr_annot) -> "%" :: cdr_annot
+                  | 0, Some (car_annot, cdr_annot) -> car_annot @ cdr_annot @ annot
+                  | _, Some (car_annot, cdr_annot) -> car_annot @ cdr_annot
+                in
+                let acc = dip ~loc depth (Prim (loc, "PAIR", [], annot)) :: acc in
+                (depth, acc)
+                |> parse left
+                |> parse right
+            | A | I -> (depth + 1, acc)
+          in
+          let _, expanded = parse ast (0, []) in
+          begin match args with
+            | [] -> ok ()
+            | _ :: _ -> error (Invalid_arity (str, List.length args, 0))
+          end >>? fun () ->
+          ok (Some (Seq (loc, expanded)))
+        with Not_a_pair -> ok None
+      else
+        ok None
+  | _ -> ok None
+
+let expand_unpappaiir original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len >= 6
+      && String.sub str 0 3 = "UNP"
+      && String.get str (len - 1) = 'R'
+      && check_letters str 3 (len - 2)
+           (function 'P' | 'A' | 'I' -> true | _ -> false) then
+        try
+          let unpair car_annot cdr_annot =
+            Seq (loc, [ Prim (loc, "DUP", [], []) ;
+                        Prim (loc, "CAR", [], car_annot) ;
+                        dip ~loc 1 (Prim (loc, "CDR", [], cdr_annot)) ;
+                      ]) in
+          let ast = parse_pair_substr str ~len 2 in
+          let annots_pos = pappaiir_annots_pos ast annot in
+          let rec parse p (depth, acc) =
+            match p with
+            | P (i, left, right) ->
+                let car_annot, cdr_annot =
+                  match IntMap.find_opt i annots_pos with
+                  | None -> [], []
+                  | Some (car_annot, cdr_annot) -> car_annot, cdr_annot in
+                let acc = dip ~loc depth (unpair car_annot cdr_annot) :: acc in
+                (depth, acc)
+                |> parse left
+                |> parse right
+            | A | I -> (depth + 1, acc) in
+          let _, rev_expanded = parse ast (0, []) in
+          let expanded = Seq (loc, List.rev rev_expanded) in
+          begin match args with
+            | [] -> ok ()
+            | _ :: _ -> error (Invalid_arity (str, List.length args, 0))
+          end >>? fun () ->
+          ok (Some expanded)
+        with Not_a_pair -> ok None
+      else
+        ok None
+  | _ -> ok None
+
+exception Not_a_dup
+
+let expand_duuuuup original =
+  match original with
+  | Prim (loc, str, args, annot) ->
+      let len = String.length str in
+      if len > 3
+      && String.get str 0 = 'D'
+      && String.get str (len - 1) = 'P'
+      && check_letters str 1 (len - 2) ((=) 'U') then
+        begin match args with
+          | [] -> ok ()
+          | _ :: _ -> error (Invalid_arity (str, List.length args, 0))
+        end >>? fun () ->
+        try
+          let rec parse i acc =
+            if i = 1 then acc
+            else if String.get str i = 'U' then
+              parse (i - 1)
+                (Seq (loc, [ Prim (loc, "DIP", [ acc ], []) ;
+                             Prim (loc, "SWAP", [], []) ]))
+            else
+              raise_notrace Not_a_dup in
+          ok (Some (parse (len - 2) (Seq (loc, [ Prim (loc, "DUP", [], annot) ]))))
+        with Not_a_dup -> ok None
+      else
+        ok None
+  | _ -> ok None
+
+let expand_compare original =
+  let cmp loc is annot =
+    let is =
+      match List.rev_map (fun i -> Prim (loc, i, [], [])) is with
+      | Prim (loc, i, args, _) :: r -> List.rev (Prim (loc, i, args, annot) :: r)
+      | is -> List.rev is
+    in
+    ok (Some (Seq (loc, is))) in
+  let ifcmp loc is l r annot =
+    let is =
+      List.map (fun i -> Prim (loc, i, [], [])) is @
+      [ Prim (loc, "IF", [ l ; r ], annot) ] in
+    ok (Some (Seq (loc, is))) in
+  match original with
+  | Prim (loc, "CMPEQ", [], annot) ->
+      cmp loc [ "COMPARE" ; "EQ" ] annot
+  | Prim (loc, "CMPNEQ", [], annot) ->
+      cmp loc [ "COMPARE" ; "NEQ" ] annot
+  | Prim (loc, "CMPLT", [], annot) ->
+      cmp loc [ "COMPARE" ; "LT" ] annot
+  | Prim (loc, "CMPGT", [], annot) ->
+      cmp loc [ "COMPARE" ; "GT" ] annot
+  | Prim (loc, "CMPLE", [], annot) ->
+      cmp loc [ "COMPARE" ; "LE" ] annot
+  | Prim (loc, "CMPGE", [], annot) ->
+      cmp loc [ "COMPARE" ; "GE" ] annot
+  | Prim (_, ("CMPEQ" |  "CMPNEQ" |  "CMPLT"
+             |  "CMPGT" |  "CMPLE" | "CMPGE" as str), args, []) ->
+      error (Invalid_arity (str, List.length args, 0))
+  | Prim (loc, "IFCMPEQ", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "EQ" ] l r annot
+  | Prim (loc, "IFCMPNEQ", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "NEQ" ] l r annot
+  | Prim (loc, "IFCMPLT", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "LT" ] l r annot
+  | Prim (loc, "IFCMPGT", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "GT" ] l r annot
+  | Prim (loc, "IFCMPLE", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "LE" ] l r annot
+  | Prim (loc, "IFCMPGE", [ l ; r ], annot) ->
+      ifcmp loc [ "COMPARE" ; "GE" ] l r annot
+  | Prim (loc, "IFEQ", [ l ; r ], annot) ->
+      ifcmp loc [ "EQ" ] l r annot
+  | Prim (loc, "IFNEQ", [ l ; r ], annot) ->
+      ifcmp loc [ "NEQ" ] l r annot
+  | Prim (loc, "IFLT", [ l ; r ], annot) ->
+      ifcmp loc [ "LT" ] l r annot
+  | Prim (loc, "IFGT", [ l ; r ], annot) ->
+      ifcmp loc [ "GT" ] l r annot
+  | Prim (loc, "IFLE", [ l ; r ], annot) ->
+      ifcmp loc [ "LE" ] l r annot
+  | Prim (loc, "IFGE", [ l ; r ], annot) ->
+      ifcmp loc [ "GE" ] l r annot
+  | Prim (_, ("IFCMPEQ" | "IFCMPNEQ" | "IFCMPLT"
+             | "IFCMPGT" | "IFCMPLE" | "IFCMPGE"
+             | "IFEQ" | "IFNEQ" | "IFLT"
+             | "IFGT" | "IFLE" | "IFGE" as str), args, []) ->
+      error (Invalid_arity (str, List.length args, 2))
+  | Prim (_, ("IFCMPEQ" | "IFCMPNEQ" | "IFCMPLT"
+             | "IFCMPGT" | "IFCMPLE" | "IFCMPGE"
+             | "IFEQ" | "IFNEQ" | "IFLT"
+             | "IFGT" | "IFLE" | "IFGE" as str), [], _ :: _) ->
+      error (Unexpected_macro_annotation str)
+  | _ -> ok None
+
+let expand_asserts original =
+  let may_rename loc = function
+    | [] -> Seq (loc, [])
+    | annot -> Seq (loc, [ Prim (loc, "RENAME", [], annot) ])
+  in
+  let fail_false ?(annot=[]) loc =
+    [may_rename loc annot; Seq (loc, [ Prim (loc, "FAIL", [], []) ])]
+  in
+  let fail_true ?(annot=[]) loc =
+    [Seq (loc, [ Prim (loc, "FAIL", [], []) ]); may_rename loc annot]
+  in
+  match original with
+  | Prim (loc, "ASSERT", [], []) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, []) ]))
+  | Prim (loc, "ASSERT_NONE", [], []) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, []) ]))
+  | Prim (loc, "ASSERT_SOME", [], annot) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true ~annot loc, []) ]))
+  | Prim (loc, "ASSERT_LEFT", [], annot) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false ~annot loc, []) ]))
+  | Prim (loc, "ASSERT_RIGHT", [], annot) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true ~annot loc, []) ]))
+  | Prim (_, ("ASSERT" | "ASSERT_NONE" | "ASSERT_SOME"
+             | "ASSERT_LEFT" | "ASSERT_RIGHT" as str), args, []) ->
+      error (Invalid_arity (str, List.length args, 0))
+  | Prim (_, ( "ASSERT" | "ASSERT_NONE" as str), [], _ :: _) ->
+      error (Unexpected_macro_annotation str)
+  | Prim (loc, s, args, annot)
+    when String.(length s >  7 && equal (sub s 0 7) "ASSERT_") ->
+      begin match args with
+        | [] -> ok ()
+        | _ :: _ -> error (Invalid_arity (s, List.length args, 0))
+      end >>? fun () ->
+      begin match annot with
+        | _ :: _ -> (error (Unexpected_macro_annotation s))
+        | [] -> ok ()
+      end >>? fun () ->
+      begin
+        let remaining = String.(sub s 7 (length s - 7)) in
+        let remaining_prim = Prim (loc, remaining, [], []) in
+        match remaining with
+        | "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" ->
+            ok @@ Some (Seq (loc, [ remaining_prim ;
+                                    Prim (loc, "IF", fail_false loc, []) ]))
+        | _ ->
+            begin
+              expand_compare remaining_prim >|? function
+              | None -> None
+              | Some seq ->
+                  Some (Seq (loc, [ seq ;
+                                    Prim (loc, "IF", fail_false loc, []) ]))
+            end
+      end
+  | _ -> ok None
+
+
+let expand_if_some = function
+  | Prim (loc, "IF_SOME", [ right ; left ], annot) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", [ left ; right ], annot) ]))
+  | Prim (_, "IF_SOME", args, _annot) ->
+      error (Invalid_arity ("IF_SOME", List.length args, 2))
+  | _ -> ok @@ None
+
+let expand_if_right = function
+  | Prim (loc, "IF_RIGHT", [ right ; left ], annot) ->
+      ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", [ left ; right ], annot) ]))
+  | Prim (_, "IF_RIGHT", args, _annot) ->
+      error (Invalid_arity ("IF_RIGHT", List.length args, 2))
+  | _ -> ok @@ None
+
+let expand_fail = function
+  | Prim (loc, "FAIL", [], []) ->
+      ok @@ Some (Seq (loc, [
+          Prim (loc, "UNIT", [], []) ;
+          Prim (loc, "FAILWITH", [], []) ;
+        ]))
+  | _ -> ok @@ None
+
+let expand original =
+  let rec try_expansions = function
+    | [] -> ok @@ original
+    | expander :: expanders ->
+        expander original >>? function
+        | None -> try_expansions expanders
+        | Some rewritten -> ok rewritten in
+  try_expansions
+    [ expand_caddadr ;
+      expand_set_caddadr ;
+      expand_map_caddadr ;
+      expand_dxiiivp ;
+      (* expand_paaiair ; *)
+      expand_pappaiir ;
+      (* expand_unpaaiair ; *)
+      expand_unpappaiir ;
+      expand_duuuuup ;
+      expand_compare ;
+      expand_asserts ;
+      expand_if_some ;
+      expand_if_right ;
+      expand_fail ;
+    ]
+
+let expand_rec expr =
+  let rec error_map (expanded, errors) f = function
+    | [] -> (List.rev expanded, List.rev errors)
+    | hd :: tl ->
+        let (new_expanded, new_errors) = f hd in
+        error_map
+          (new_expanded :: expanded, List.rev_append new_errors errors)
+          f tl in
+  let error_map = error_map ([], []) in
+  let rec expand_rec expr =
+    match expand expr with
+    | Ok expanded ->
+        begin
+          match expanded with
+          | Seq (loc, items) ->
+              let items, errors = error_map expand_rec items in
+              (Seq (loc, items), errors)
+          | Prim (loc, name, args, annot) ->
+              let args, errors = error_map expand_rec args in
+              (Prim (loc, name, args, annot), errors)
+          | Int _ | String _ | Bytes _ as atom -> (atom, []) end
+    | Error errors -> (expr, errors) in
+  expand_rec expr
+
+let unexpand_caddadr expanded =
+  let rec rsteps acc = function
+    | [] -> Some acc
+    | Prim (_, "CAR" , [], []) :: rest ->
+        rsteps ("A" :: acc) rest
+    | Prim (_, "CDR" , [], []) :: rest ->
+        rsteps ("D" :: acc) rest
+    | _ -> None in
+  match expanded with
+  | Seq (loc, (Prim (_, "CAR" , [], []) :: _ as nodes))
+  | Seq (loc, (Prim (_, "CDR" , [], []) :: _ as nodes)) ->
+      begin match rsteps [] nodes with
+        | Some steps ->
+            let name = String.concat "" ("C" :: List.rev ("R" :: steps)) in
+            Some (Prim (loc, name, [], []))
+        | None -> None
+      end
+  | _ -> None
+
+let unexpand_set_caddadr expanded =
+  let rec steps acc annots = function
+    | Seq (loc,
+           [ Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], _) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "A" :: acc, annots)
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CAR", [], [ field_annot ]) ;
+             Prim (_, "DROP", [], []) ;
+             Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "A" :: acc, field_annot :: annots)
+    | Seq (loc,
+           [ Prim (_, "CAR", [], _) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "D" :: acc, annots)
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CDR", [], [ field_annot ]) ;
+             Prim (_, "DROP", [], []) ;
+             Prim (_, "CAR", [], _) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "D" :: acc, field_annot :: annots)
+    | Seq (_,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CAR", [], _) ;
+                            sub ]) ], []) ;
+             Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "PAIR", [], pair_annots) ]) ->
+        let _, pair_annots = extract_field_annots pair_annots in
+        steps ("A" :: acc) (List.rev_append pair_annots annots) sub
+    | Seq (_,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CDR", [], _) ;
+                            sub ]) ], []) ;
+             Prim (_, "CAR", [], _) ;
+             Prim (_, "PAIR", [], pair_annots) ]) ->
+        let _, pair_annots = extract_field_annots pair_annots in
+        steps ("D" :: acc) (List.rev_append pair_annots annots) sub
+    | _ -> None in
+  match steps [] [] expanded with
+  | Some (loc, steps, annots) ->
+      let name = String.concat "" ("SET_C" :: List.rev ("R" :: steps)) in
+      Some (Prim (loc, name, [], List.rev annots))
+  | None -> None
+
+let unexpand_map_caddadr expanded =
+  let rec steps acc annots = function
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CAR", [], []) ;
+                            code ]) ], []) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "A" :: acc, annots, code)
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CAR", [], [ field_annot ]) ;
+                            code ]) ], []) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "A" :: acc, field_annot :: annots, code)
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CDR", [], []) ;
+             code ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "CAR", [], _) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "D" :: acc, annots, code)
+    | Seq (loc,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "CDR", [], [ field_annot ]) ;
+             code ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "CAR", [], _) ;
+             Prim (_, "PAIR", [], _) ]) ->
+        Some (loc, "D" :: acc, field_annot :: annots, code)
+    | Seq (_,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CAR", [], _) ;
+                            sub ]) ], []) ;
+             Prim (_, "CDR", [], _) ;
+             Prim (_, "SWAP", [], []) ;
+             Prim (_, "PAIR", [], pair_annots) ]) ->
+        let _, pair_annots = extract_field_annots pair_annots in
+        steps ("A" :: acc) (List.rev_append pair_annots annots) sub
+    | Seq (_,
+           [ Prim (_, "DUP", [], []) ;
+             Prim (_, "DIP",
+                   [ Seq (_,
+                          [ Prim (_, "CDR", [], []) ;
+                            sub ]) ], []) ;
+             Prim (_, "CAR", [], []) ;
+             Prim (_, "PAIR", [], pair_annots) ]) ->
+        let _, pair_annots = extract_field_annots pair_annots in
+        steps ("D" :: acc) (List.rev_append pair_annots annots) sub
+    | _ -> None in
+  match steps [] [] expanded with
+  | Some (loc, steps, annots, code) ->
+      let name = String.concat "" ("MAP_C" :: List.rev ("R" :: steps)) in
+      Some (Prim (loc, name, [ code ], List.rev annots))
+  | None -> None
+
+let roman_of_decimal decimal =
+  (* http://rosettacode.org/wiki/Roman_numerals/Encode#OCaml *)
+  let digit x y z = function
+    | 1 -> [ x ]
+    | 2 -> [ x ; x ]
+    | 3 -> [ x ; x ; x ]
+    | 4 -> [ x ; y ]
+    | 5 -> [ y ]
+    | 6 -> [ y ; x ]
+    | 7 -> [ y ; x ; x ]
+    | 8 -> [ y ; x ; x ; x ]
+    | 9 -> [ x ; z ]
+    | _ -> assert false in
+  let rec to_roman x =
+    if x = 0 then []
+    else if x < 0 then
+      invalid_arg "Negative roman numeral"
+    else if x >= 1000 then
+      "M" :: to_roman (x - 1000)
+    else if x >= 100 then
+      digit "C" "D" "M" (x / 100) @ to_roman (x mod 100)
+    else if x >= 10 then
+      digit "X" "L" "C" (x / 10) @ to_roman (x mod 10)
+    else
+      digit "I" "V" "X" x in
+  String.concat "" (to_roman decimal)
+
+let dxiiivp_roman_of_decimal decimal =
+  let roman = roman_of_decimal decimal in
+  if String.length roman = 1 then
+    (* too short for D*P, fall back to IIIII... *)
+    String.concat "" (List.init decimal (fun _ -> "I"))
+  else
+    roman
+
+let unexpand_dxiiivp expanded =
+  match expanded with
+  | Seq (loc,
+         [ Prim (_, "DIP",
+                 [ Seq (_, [ Prim (_, "DIP", [ _ ], []) ]) as sub ],
+                 []) ]) ->
+      let rec count acc = function
+        | Seq (_, [ Prim (_, "DIP", [ sub ], []) ]) -> count (acc + 1) sub
+        | sub -> (acc, sub) in
+      let depth, sub = count 1 sub in
+      let name = "D" ^ dxiiivp_roman_of_decimal depth ^ "P" in
+      Some (Prim (loc, name, [ sub ], []))
+  | _ -> None
+
+let unexpand_duuuuup expanded =
+  let rec help expanded =
+    match expanded with
+    | Seq (loc, [ Prim (_, "DUP", [], []) ]) -> Some (loc, 1)
+    | Seq (_, [ Prim (_, "DIP", [expanded'], []);
+                Prim (_, "SWAP", [], []) ]) ->
+        begin
+          match help expanded' with
+          | None -> None
+          | Some (loc, n) -> Some (loc, n + 1)
+        end
+    | _ -> None
+  in let rec dupn = function
+      | 0 -> "P"
+      | n -> "U" ^ (dupn (n - 1)) in
+  match help expanded with
+  | None -> None
+  | Some (loc, n) -> Some (Prim (loc, "D" ^ (dupn n), [], []))
+
+let rec normalize_pair_item ?(right=false) = function
+  | P (i, a, b) -> P (i, normalize_pair_item a, normalize_pair_item ~right:true b)
+  | A when right -> I
+  | A -> A
+  | I -> I
+
+let unexpand_pappaiir expanded =
+  match expanded with
+  | Seq (_,  [ Prim (_, "PAIR", [], []) ]) -> Some expanded
+  | Seq (loc, (_ :: _ as nodes)) ->
+      let rec exec stack nodes = match nodes, stack with
+        | [], _ -> stack
+        | Prim (_, "DIP", [ Seq (_, sub) ], []) :: rest, a :: rstack ->
+            exec (a :: exec rstack sub) rest
+        | Prim (_, "DIP", [ Seq (_, sub) ], []) :: rest, [] ->
+            exec (A :: exec [] sub) rest
+        | Prim (_, "PAIR", [], []) :: rest, a :: b :: rstack ->
+            exec (P (0, a, b) :: rstack) rest
+        | Prim (_, "PAIR", [], []) :: rest, [ a ]  ->
+            exec [ P (0, a, I) ] rest
+        | Prim (_, "PAIR", [], []) :: rest, []  ->
+            exec [ P (0, A, I) ] rest
+        | _ -> raise_notrace Not_a_pair in
+      begin match exec [] nodes with
+        | [] -> None
+        | res :: _ ->
+            let res = normalize_pair_item res in
+            let name = unparse_pair_item res in
+            Some (Prim (loc, name, [], []))
+        | exception Not_a_pair -> None
+      end
+  | _ -> None
+
+let unexpand_unpappaiir expanded =
+  match expanded with
+  | Seq (loc, (_ :: _ as nodes)) ->
+      let rec exec stack nodes = match nodes, stack with
+        | [], _ -> stack
+        | Prim (_, "DIP", [ Seq (_, sub) ], []) :: rest, a :: rstack ->
+            exec (a :: exec rstack sub) rest
+        | Prim (_, "DIP", [ Seq (_, sub) ], []) :: rest, [] ->
+            exec (A :: exec [] sub) rest
+        | Seq (_, [ Prim (_, "DUP", [], []) ;
+                    Prim (_, "CAR", [], []) ;
+                    Prim (_, "DIP",
+                          [ Seq (_, [ Prim (_, "CDR", [], []) ]) ],
+                          []) ]) :: rest,
+          a :: b :: rstack ->
+            exec (P (0, a, b) :: rstack) rest
+        | Seq (_, [ Prim (_, "DUP", [], []) ;
+                    Prim (_, "CAR", [], []) ;
+                    Prim (_, "DIP",
+                          [ Seq (_, [ Prim (_, "CDR", [], []) ]) ],
+                          []) ]) :: rest,
+          [ a ]  ->
+            exec [ P (0, a, I) ] rest
+        | Seq (_, [ Prim (_, "DUP", [], []) ;
+                    Prim (_, "CAR", [], []) ;
+                    Prim (_, "DIP",
+                          [ Seq (_, [ Prim (_, "CDR", [], []) ]) ],
+                          []) ]) :: rest,
+          []  ->
+            exec [ P (0, A, I) ] rest
+        | _ -> raise_notrace Not_a_pair in
+      begin match exec [] (List.rev nodes) with
+        | [] -> None
+        | res :: _ ->
+            let res = normalize_pair_item res in
+            let name = "UN" ^ unparse_pair_item res in
+            Some (Prim (loc, name, [], []))
+        | exception Not_a_pair -> None
+      end
+  | _ -> None
+
+
+let unexpand_compare expanded =
+  match expanded with
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "EQ", [], annot) ]) ->
+      Some (Prim (loc, "CMPEQ", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "NEQ", [], annot) ]) ->
+      Some (Prim (loc, "CMPNEQ", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "LT", [], annot) ]) ->
+      Some (Prim (loc, "CMPLT", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "GT", [], annot) ]) ->
+      Some (Prim (loc, "CMPGT", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "LE", [], annot) ]) ->
+      Some (Prim (loc, "CMPLE", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "GE", [], annot) ]) ->
+      Some (Prim (loc, "CMPGE", [], annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "EQ", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPEQ", args, annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "NEQ", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPNEQ", args, annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "LT", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPLT", args, annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "GT", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPGT", args, annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "LE", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPLE", args, annot))
+  | Seq (loc, [ Prim (_, "COMPARE", [], _) ;
+                Prim (_, "GE", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFCMPGE", args, annot))
+  | Seq (loc, [ Prim (_, "EQ", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFEQ", args, annot))
+  | Seq (loc, [ Prim (_, "NEQ", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFNEQ", args, annot))
+  | Seq (loc, [ Prim (_, "LT", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFLT", args, annot))
+  | Seq (loc, [ Prim (_, "GT", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFGT", args, annot))
+  | Seq (loc, [ Prim (_, "LE", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFLE", args, annot))
+  | Seq (loc, [ Prim (_, "GE", [], _) ;
+                Prim (_, "IF", args, annot) ]) ->
+      Some (Prim (loc, "IFGE", args, annot))
+  | _ -> None
+
+let unexpand_asserts expanded =
+  match expanded with
+  | Seq (loc, [ Prim (_, "IF", [ Seq (_, []) ;
+                                 Seq (_, [
+                                     Seq (_, [
+                                         Prim (_, "UNIT", [], []) ;
+                                         Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT", [], []))
+  | Seq (loc, [ Seq (_, [ Prim(_, "COMPARE", [], []) ; Prim (_, comparison, [], []) ]) ;
+                Prim (_, "IF", [ Seq (_, []) ;
+                                 Seq (_, [
+                                     Seq (_, [
+                                         Prim (_, "UNIT", [], []) ;
+                                         Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_CMP" ^ comparison, [], []))
+  | Seq (loc, [ Prim (_, comparison, [], []) ;
+                Prim (_, "IF", [ Seq (_, []) ;
+                                 Seq (_, [
+                                     Seq (_, [
+                                         Prim (_, "UNIT", [], []) ;
+                                         Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_" ^ comparison, [], []))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Prim (_, "RENAME", [], annot) ]) ;
+                                      Seq (_, [
+                                          Seq (_, [
+                                              Prim (_, "UNIT", [], []) ;
+                                              Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_NONE", [], annot))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, []) ;
+                                      Seq (_, [
+                                          Seq (_, [
+                                              Prim (_, "UNIT", [], []) ;
+                                              Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_NONE", [], []))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
+                                                          Prim (_, "FAILWITH", [], []) ]) ]) ;
+                                      Seq (_, [])],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_SOME", [], []))
+  | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
+                                                          Prim (_, "FAILWITH", [], []) ]) ]) ;
+                                      Seq (_, [ Prim (_, "RENAME", [], annot) ])],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_SOME", [], annot))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, []) ;
+                                      Seq (_, [
+                                          Seq (_, [
+                                              Prim (_, "UNIT", [], []) ;
+                                              Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_LEFT", [], []))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Prim (_, "RENAME", [], annot) ]) ;
+                                      Seq (_, [
+                                          Seq (_, [
+                                              Prim (_, "UNIT", [], []) ;
+                                              Prim (_, "FAILWITH", [], []) ]) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_LEFT", [], annot))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
+                                                          Prim (_, "FAILWITH", [], []) ]) ]) ;
+                                      Seq (_, []) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_RIGHT", [], []))
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
+                                                          Prim (_, "FAILWITH", [], []) ]) ]) ;
+                                      Seq (_, [ Prim (_, "RENAME", [], annot) ]) ],
+                      []) ]) ->
+      Some (Prim (loc, "ASSERT_RIGHT", [], annot))
+  | _ -> None
+
+
+let unexpand_if_some = function
+  | Seq (loc, [ Prim (_, "IF_NONE", [ left ; right ], annot) ]) ->
+      Some (Prim (loc, "IF_SOME", [ right ; left ], annot))
+  | _ -> None
+
+let unexpand_if_right = function
+  | Seq (loc, [ Prim (_, "IF_LEFT", [ left ; right ], annot) ]) ->
+      Some (Prim (loc, "IF_RIGHT", [ right ; left ], annot))
+  | _ -> None
+
+let unexpand_fail = function
+  | Seq (loc, [
+      Prim (_, "UNIT", [], []) ;
+      Prim (_, "FAILWITH", [], []) ;
+    ]) ->
+      Some (Prim (loc, "FAIL", [], []))
+  | _ -> None
+
+let unexpand original =
+  let try_unexpansions unexpanders =
+    match
+      List.fold_left
+        (fun acc f ->
+           match acc with
+           | None -> f original
+           | Some rewritten -> Some rewritten)
+        None unexpanders with
+    | None -> original
+    | Some rewritten -> rewritten in
+  try_unexpansions
+    [ unexpand_asserts ;
+      unexpand_caddadr ;
+      unexpand_set_caddadr ;
+      unexpand_map_caddadr ;
+      unexpand_dxiiivp ;
+      unexpand_pappaiir ;
+      unexpand_unpappaiir ;
+      unexpand_duuuuup ;
+      unexpand_compare ;
+      unexpand_if_some ;
+      unexpand_if_right ;
+      unexpand_fail ]
+
+let rec unexpand_rec expr =
+  match unexpand expr with
+  | Seq (loc, items) ->
+      Seq (loc, List.map unexpand_rec items)
+  | Prim (loc, name, args, annot) ->
+      Prim (loc, name, List.map unexpand_rec args, annot)
+  | Int _ | String _ | Bytes _ as atom -> atom
+
+let () =
+  let open Data_encoding in
+  let open Proto_alpha in
+  register_error_kind
+    `Permanent
+    ~id:"michelson.macros.unexpected_annotation"
+    ~title:"Unexpected annotation"
+    ~description:"A macro had an annotation, but no annotation was permitted on this macro."
+    ~pp:(fun ppf ->
+        Format.fprintf ppf
+          "Unexpected annotation on macro %s.")
+    (obj1
+       (req "macro_name" string))
+    (function
+      | Unexpected_macro_annotation str -> Some str
+      | _ -> None)
+    (fun s -> Unexpected_macro_annotation s) ;
+  register_error_kind
+    `Permanent
+    ~id:"michelson.macros.sequence_expected"
+    ~title:"Macro expects a sequence"
+    ~description:"An macro expects a sequence, but a sequence was not provided"
+    ~pp:(fun ppf name ->
+        Format.fprintf ppf
+          "Macro %s expects a sequence, but did not receive one." name)
+    (obj1
+       (req "macro_name" string))
+    (function
+      | Sequence_expected name -> Some name
+      | _ -> None)
+    (fun name -> Sequence_expected name) ;
+  register_error_kind
+    `Permanent
+    ~id:"michelson.macros.bas_arity"
+    ~title:"Wrong number of arguments to macro"
+    ~description:"A wrong number of arguments was provided to a macro"
+    ~pp:(fun ppf (name, got, exp) ->
+        Format.fprintf ppf
+          "Macro %s expects %d arguments, was given %d." name got exp)
+    (obj3
+       (req "macro_name" string)
+       (req "given_number_of_arguments" uint16)
+       (req "expected_number_of_arguments" uint16))
+    (function
+      | Invalid_arity (name, got, exp) -> Some (name, got, exp)
+      | _ -> None)
+    (fun (name, got, exp) -> Invalid_arity (name, got, exp))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.mli
new file mode 100644
index 000000000..4a614cbc0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_macros.mli
@@ -0,0 +1,62 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Tezos_micheline
+
+type 'l node = ('l, string) Micheline.node
+
+type error += Unexpected_macro_annotation of string
+type error += Sequence_expected of string
+type error += Invalid_arity of string * int * int
+
+val expand : 'l node -> 'l node tzresult
+val expand_rec : 'l node -> 'l node * error list
+
+val expand_caddadr : 'l node -> 'l node option tzresult
+val expand_set_caddadr : 'l node -> 'l node option tzresult
+val expand_map_caddadr : 'l node -> 'l node option tzresult
+val expand_dxiiivp : 'l node -> 'l node option tzresult
+val expand_pappaiir : 'l node -> 'l node option tzresult
+val expand_duuuuup : 'l node -> 'l node option tzresult
+val expand_compare : 'l node -> 'l node option tzresult
+val expand_asserts : 'l node -> 'l node option tzresult
+val expand_unpappaiir : 'l node -> 'l node option tzresult
+val expand_if_some : 'l node -> 'l node option tzresult
+val expand_if_right : 'l node -> 'l node option tzresult
+
+val unexpand : 'l node -> 'l node
+val unexpand_rec : 'l node -> 'l node
+
+val unexpand_caddadr : 'l node -> 'l node option
+val unexpand_set_caddadr : 'l node -> 'l node option
+val unexpand_map_caddadr : 'l node -> 'l node option
+val unexpand_dxiiivp : 'l node -> 'l node option
+val unexpand_pappaiir : 'l node -> 'l node option
+val unexpand_duuuuup : 'l node -> 'l node option
+val unexpand_compare : 'l node -> 'l node option
+val unexpand_asserts : 'l node -> 'l node option
+val unexpand_unpappaiir : 'l node -> 'l node option
+val unexpand_if_some : 'l node -> 'l node option
+val unexpand_if_right : 'l node -> 'l node option
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.ml
new file mode 100644
index 000000000..7e4d8fcf1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.ml
@@ -0,0 +1,91 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Tezos_micheline
+open Micheline_parser
+open Micheline
+
+type parsed =
+  { source : string ;
+    unexpanded : string canonical ;
+    expanded : Michelson_v1_primitives.prim canonical ;
+    expansion_table : (int * (Micheline_parser.location * int list)) list ;
+    unexpansion_table : (int * int) list }
+
+(* Unexpanded toplevel expression should be a sequence *)
+let expand_all source ast errors =
+  let unexpanded, loc_table =
+    extract_locations ast in
+  let expanded, expansion_errors =
+    Michelson_v1_macros.expand_rec (root unexpanded) in
+  let expanded, unexpansion_table =
+    extract_locations expanded in
+  let expansion_table =
+    let sorted =
+      List.sort (fun (_, a) (_, b) -> compare a b) unexpansion_table in
+    let grouped =
+      let rec group = function
+        | acc, [] -> acc
+        | [], (u, e) :: r ->
+            group ([ (e, [ u ]) ], r)
+        | ((pe, us) :: racc as acc), (u, e) :: r ->
+            if e = pe then
+              group (((e, u :: us) :: racc), r)
+            else
+              group (((e, [ u ]) :: acc), r) in
+      group ([], sorted) in
+    List.map2
+      (fun (l, ploc) (l', elocs) ->
+         assert (l = l') ;
+         (l, (ploc, elocs)))
+      (List.sort compare loc_table)
+      (List.sort compare grouped) in
+  match Alpha_environment.wrap_error (Michelson_v1_primitives.prims_of_strings expanded) with
+  | Ok expanded ->
+      { source ; unexpanded ; expanded ;
+        expansion_table ; unexpansion_table },
+      errors @ expansion_errors
+  | Error errs ->
+      { source ; unexpanded ;
+        expanded = Micheline.strip_locations (Seq ((), [])) ;
+        expansion_table ; unexpansion_table },
+      errors @ expansion_errors @ errs
+
+let parse_toplevel ?check source =
+  let tokens, lexing_errors = Micheline_parser.tokenize source in
+  let asts, parsing_errors = Micheline_parser.parse_toplevel ?check tokens in
+  let ast =
+    let start = min_point asts and stop = max_point asts in
+    Seq ({ start ; stop }, asts) in
+  expand_all source ast (lexing_errors @ parsing_errors)
+
+let parse_expression ?check source =
+  let tokens, lexing_errors = Micheline_parser.tokenize source in
+  let ast, parsing_errors = Micheline_parser.parse_expression ?check tokens in
+  expand_all source ast (lexing_errors @ parsing_errors)
+
+let expand_all ~source ~original =
+  expand_all source original []
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.mli
new file mode 100644
index 000000000..6185a4fa4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_parser.mli
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+open Tezos_micheline
+
+(** The result of parsing and expanding a Michelson V1 script or data. *)
+type parsed =
+  {
+    source : string ;
+    (** The original source code. *)
+    unexpanded : string Micheline.canonical ;
+    (** Original expression with macros. *)
+    expanded : Script.expr ;
+    (** Expression with macros fully expanded. *)
+    expansion_table :
+      (int * (Micheline_parser.location * int list)) list ;
+    (** Associates unexpanded nodes to their parsing locations and
+        the nodes expanded from it in the expanded expression. *)
+    unexpansion_table : (int * int) list ;
+    (** Associates an expanded node to its source in the unexpanded
+        expression. *)
+  }
+
+val parse_toplevel : ?check:bool -> string -> parsed Micheline_parser.parsing_result
+val parse_expression : ?check:bool -> string -> parsed Micheline_parser.parsing_result
+val expand_all : source:string -> original:Micheline_parser.node -> parsed Micheline_parser.parsing_result
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.ml
new file mode 100644
index 000000000..e4a5aa810
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.ml
@@ -0,0 +1,156 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+open Micheline
+open Micheline_printer
+
+let anon = { comment = None }
+
+let print_expr ppf expr =
+  expr
+  |> Michelson_v1_primitives.strings_of_prims
+  |> Micheline.inject_locations (fun _ -> anon)
+  |> print_expr ppf
+
+let print_expr_unwrapped ppf expr =
+  expr
+  |> Michelson_v1_primitives.strings_of_prims
+  |> Micheline.inject_locations (fun _ -> anon)
+  |> print_expr_unwrapped ppf
+
+let print_var_annots ppf =
+  List.iter (Format.fprintf ppf "%s ")
+
+let print_annot_expr_unwrapped ppf (expr, annot) =
+  Format.fprintf ppf "%a%a"
+    print_var_annots annot
+    print_expr_unwrapped expr
+
+let print_stack ppf = function
+  | [] -> Format.fprintf ppf "[]"
+  | more ->
+      Format.fprintf ppf "@[<hov 0>[ %a ]@]"
+        (Format.pp_print_list
+           ~pp_sep: (fun ppf () -> Format.fprintf ppf "@ : ")
+           print_annot_expr_unwrapped)
+        more
+
+let print_execution_trace ppf trace =
+  Format.pp_print_list
+    (fun ppf (loc, gas, stack) ->
+       Format.fprintf ppf
+         "- @[<v 0>location: %d (remaining gas: %a)@,\
+          [ @[<v 0>%a ]@]@]"
+         loc Gas.pp gas
+         (Format.pp_print_list
+            (fun ppf (e, annot) ->
+               Format.fprintf ppf
+                 "@[<v 0>%a  \t%s@]"
+                 print_expr e
+                 (match annot with None -> "" | Some a -> a)
+            ))
+         stack)
+    ppf
+    trace
+
+let inject_types type_map parsed =
+  let rec inject_expr = function
+    | Seq (loc, items) ->
+        Seq (inject_loc `before loc, List.map inject_expr items)
+    | Prim (loc, name, items, annot) ->
+        Prim (inject_loc `after loc, name, List.map inject_expr items, annot)
+    | Int (loc, value) ->
+        Int (inject_loc `after loc, value)
+    | String (loc, value) ->
+        String (inject_loc `after loc, value)
+    | Bytes (loc, value) ->
+        Bytes (inject_loc `after loc, value)
+  and inject_loc which loc = try
+      let stack =
+        let locs =
+          List.assoc loc parsed.Michelson_v1_parser.expansion_table
+          |> snd
+          |> List.sort compare in
+        let (bef, aft) =
+          List.assoc (List.hd locs) type_map in
+        match which with
+        | `before -> bef
+        | `after -> aft in
+      { comment = Some (Format.asprintf "%a" print_stack stack) }
+    with Not_found -> { comment = None } in
+  inject_expr (root parsed.unexpanded)
+
+let unparse ?type_map parse expanded =
+  let source =
+    match type_map with
+    | Some type_map ->
+        let unexpanded, unexpansion_table =
+          expanded
+          |> Michelson_v1_primitives.strings_of_prims
+          |> root |> Michelson_v1_macros.unexpand_rec |> Micheline.extract_locations in
+        let rec inject_expr = function
+          | Seq (loc, items) ->
+              Seq (inject_loc `before loc, List.map inject_expr items)
+          | Prim (loc, name, items, annot) ->
+              Prim (inject_loc `after loc, name, List.map inject_expr items, annot)
+          | Int (loc, value) ->
+              Int (inject_loc `after loc, value)
+          | String (loc, value) ->
+              String (inject_loc `after loc, value)
+          | Bytes (loc, value) ->
+              Bytes (inject_loc `after loc, value)
+        and inject_loc which loc = try
+            let stack =
+              let (bef, aft) =
+                List.assoc (List.assoc loc unexpansion_table) type_map in
+              match which with
+              | `before -> bef
+              | `after -> aft in
+            { comment = Some (Format.asprintf "%a" print_stack stack) }
+          with Not_found -> { comment = None } in
+        unexpanded |> root |> inject_expr
+        |> Format.asprintf "%a" Micheline_printer.print_expr
+    | None ->
+        expanded |> Michelson_v1_primitives.strings_of_prims
+        |> root |> Michelson_v1_macros.unexpand_rec |> Micheline.strip_locations
+        |> Micheline_printer.printable (fun n -> n)
+        |> Format.asprintf "%a" Micheline_printer.print_expr in
+  match parse source with
+  | res, [] -> res
+  | _, _ :: _ -> Pervasives.failwith "Michelson_v1_printer.unparse"
+
+let unparse_toplevel ?type_map = unparse ?type_map Michelson_v1_parser.parse_toplevel
+let unparse_expression = unparse Michelson_v1_parser.parse_expression
+
+let unparse_invalid expanded =
+  let source =
+    expanded
+    |> root |> Michelson_v1_macros.unexpand_rec |> Micheline.strip_locations
+    |> Micheline_printer.printable (fun n -> n)
+    |> Format.asprintf "%a" Micheline_printer.print_expr_unwrapped in
+  fst (Michelson_v1_parser.parse_toplevel source)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.mli
new file mode 100644
index 000000000..9e1f03a42
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/michelson_v1_printer.mli
@@ -0,0 +1,56 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+
+val print_expr :
+  Format.formatter -> Script_repr.expr -> unit
+
+val print_expr_unwrapped :
+  Format.formatter -> Script_repr.expr -> unit
+
+val print_execution_trace:
+  Format.formatter ->
+  (Script.location * Gas.t * (Script.expr * string option) list) list -> unit
+
+(** Insert the type map returned by the typechecker as comments in a
+    printable Micheline AST. *)
+val inject_types :
+  Script_tc_errors.type_map ->
+  Michelson_v1_parser.parsed ->
+  Micheline_printer.node
+
+(** Unexpand the macros and produce the result of parsing an
+    intermediate pretty printed source. Useful when working with
+    contracts extracted from the blockchain and not local files. *)
+val unparse_toplevel : ?type_map: Script_tc_errors.type_map -> Script.expr -> Michelson_v1_parser.parsed
+val unparse_expression : Script.expr -> Michelson_v1_parser.parsed
+
+(** Unexpand the macros and produce the result of parsing an
+    intermediate pretty printed source. Works on generic trees,for
+    programs that fail to be converted to a specific script version. *)
+val unparse_invalid : string Micheline.canonical -> Michelson_v1_parser.parsed
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.ml
new file mode 100644
index 000000000..7607422ae
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.ml
@@ -0,0 +1,426 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Apply_results
+
+let pp_manager_operation_content
+    (type kind) source internal pp_result
+    ppf (operation, result : kind manager_operation * _) =
+  Format.fprintf ppf "@[<v 0>" ;
+  begin match operation with
+    | Transaction { destination ; amount ; parameters } ->
+        Format.fprintf ppf
+          "@[<v 2>%s:@,\
+           Amount: %s%a@,\
+           From: %a@,\
+           To: %a"
+          (if internal then "Internal transaction" else "Transaction")
+          Client_proto_args.tez_sym
+          Tez.pp amount
+          Contract.pp source
+          Contract.pp destination ;
+        begin match parameters with
+          | None -> ()
+          | Some expr ->
+              let expr =
+                Option.unopt_exn
+                  (Failure "ill-serialized argument")
+                  (Data_encoding.force_decode expr) in
+              Format.fprintf ppf
+                "@,Parameter: @[<v 0>%a@]"
+                Michelson_v1_printer.print_expr expr
+        end ;
+        pp_result ppf result ;
+        Format.fprintf ppf "@]" ;
+    | Origination { manager ; delegate ; credit ; spendable ; delegatable ; script } ->
+        Format.fprintf ppf "@[<v 2>%s:@,\
+                            From: %a@,\
+                            For: %a@,\
+                            Credit: %s%a"
+          (if internal then "Internal origination" else "Origination")
+          Contract.pp source
+          Signature.Public_key_hash.pp manager
+          Client_proto_args.tez_sym
+          Tez.pp credit ;
+        begin match script with
+          | None -> Format.fprintf ppf "@,No script (accepts all transactions)"
+          | Some { code ; storage } ->
+              let code =
+                Option.unopt_exn
+                  (Failure "ill-serialized code")
+                  (Data_encoding.force_decode code)
+              and storage =
+                Option.unopt_exn
+                  (Failure "ill-serialized storage")
+                  (Data_encoding.force_decode storage) in
+              let { Michelson_v1_parser.source } =
+                Michelson_v1_printer.unparse_toplevel code in
+              Format.fprintf ppf
+                "@,@[<hv 2>Script:@ @[<h>%a@]\
+                 @,@[<hv 2>Initial storage:@ %a@]"
+                Format.pp_print_text source
+                Michelson_v1_printer.print_expr storage
+        end ;
+        begin match delegate with
+          | None -> Format.fprintf ppf "@,No delegate for this contract"
+          | Some delegate -> Format.fprintf ppf "@,Delegate: %a" Signature.Public_key_hash.pp delegate
+        end ;
+        if spendable then Format.fprintf ppf "@,Spendable by the manager" ;
+        if delegatable then Format.fprintf ppf "@,Delegate can be changed by the manager" ;
+        pp_result ppf result ;
+        Format.fprintf ppf "@]" ;
+    | Reveal key ->
+        Format.fprintf ppf
+          "@[<v 2>%s of manager public key:@,\
+           Contract: %a@,\
+           Key: %a%a@]"
+          (if internal then "Internal revelation" else "Revelation")
+          Contract.pp source
+          Signature.Public_key.pp key
+          pp_result result
+    | Delegation None ->
+        Format.fprintf ppf
+          "@[<v 2>%s:@,\
+           Contract: %a@,\
+           To: nobody%a@]"
+          (if internal then "Internal Delegation" else "Delegation")
+          Contract.pp source
+          pp_result result
+    | Delegation (Some delegate) ->
+        Format.fprintf ppf
+          "@[<v 2>%s:@,\
+           Contract: %a@,\
+           To: %a%a@]"
+          (if internal then "Internal Delegation" else "Delegation")
+          Contract.pp source
+          Signature.Public_key_hash.pp delegate
+          pp_result result
+  end ;
+  Format.fprintf ppf "@]"
+
+let pp_balance_updates ppf = function
+  | [] -> ()
+  | balance_updates ->
+      let open Delegate in
+      let balance_updates =
+        List.map (fun (balance, update) ->
+            let balance = match balance with
+              | Contract c ->
+                  Format.asprintf "%a" Contract.pp c
+              | Rewards (pkh, l) ->
+                  Format.asprintf "rewards(%a,%a)"
+                    Signature.Public_key_hash.pp pkh Cycle.pp l
+              | Fees (pkh, l) ->
+                  Format.asprintf "fees(%a,%a)"
+                    Signature.Public_key_hash.pp pkh Cycle.pp l
+              | Deposits (pkh, l) ->
+                  Format.asprintf "deposits(%a,%a)"
+                    Signature.Public_key_hash.pp pkh Cycle.pp l in
+            (balance, update)) balance_updates in
+      let column_size =
+        List.fold_left
+          (fun acc (balance, _) -> Compare.Int.max acc (String.length balance))
+          0 balance_updates in
+      let pp_update ppf = function
+        | Credited amount -> Format.fprintf ppf "+%s%a" Client_proto_args.tez_sym Tez.pp amount
+        | Debited amount -> Format.fprintf ppf "-%s%a" Client_proto_args.tez_sym Tez.pp amount in
+      let pp_one ppf (balance, update) =
+        let to_fill = column_size + 3 - String.length balance in
+        let filler = String.make to_fill '.' in
+        Format.fprintf ppf "%s %s %a" balance filler pp_update update in
+      Format.fprintf ppf "@[<v 0>%a@]"
+        (Format.pp_print_list pp_one) balance_updates
+
+let pp_manager_operation_contents_and_result ppf
+    (Manager_operation { source ; fee ; operation ; counter ; gas_limit ; storage_limit },
+     Manager_operation_result { balance_updates ; operation_result ;
+                                internal_operation_results }) =
+  let pp_transaction_result
+      (Transaction_result { balance_updates ; consumed_gas ;
+                            storage ;
+                            originated_contracts ;
+                            storage_size ; paid_storage_size_diff }) =
+    begin match originated_contracts with
+      | [] -> ()
+      | contracts ->
+          Format.fprintf ppf "@,@[<v 2>Originated contracts:@,%a@]"
+            (Format.pp_print_list Contract.pp) contracts
+    end ;
+    begin match storage with
+      | None -> ()
+      | Some expr ->
+          Format.fprintf ppf "@,@[<hv 2>Updated storage:@ %a@]"
+            Michelson_v1_printer.print_expr expr
+    end ;
+    begin if storage_size <> Z.zero then
+        Format.fprintf ppf
+          "@,Storage size: %s bytes"
+          (Z.to_string storage_size)
+    end ;
+    begin if paid_storage_size_diff <> Z.zero then
+        Format.fprintf ppf
+          "@,Paid storage size diff: %s bytes"
+          (Z.to_string paid_storage_size_diff)
+    end ;
+    Format.fprintf ppf
+      "@,Consumed gas: %s"
+      (Z.to_string consumed_gas) ;
+    begin match balance_updates with
+      | [] -> ()
+      | balance_updates ->
+          Format.fprintf ppf
+            "@,Balance updates:@,  %a"
+            pp_balance_updates balance_updates
+    end in
+  let pp_origination_result
+      (Origination_result { balance_updates ; consumed_gas ;
+                            originated_contracts ;
+                            storage_size ; paid_storage_size_diff }) =
+    begin match originated_contracts with
+      | [] -> ()
+      | contracts ->
+          Format.fprintf ppf "@,@[<v 2>Originated contracts:@,%a@]"
+            (Format.pp_print_list Contract.pp) contracts
+    end ;
+    begin if storage_size <> Z.zero then
+        Format.fprintf ppf
+          "@,Storage size: %s bytes"
+          (Z.to_string storage_size)
+    end ;
+    begin if paid_storage_size_diff <> Z.zero then
+        Format.fprintf ppf
+          "@,Paid storage size diff: %s bytes"
+          (Z.to_string paid_storage_size_diff)
+    end ;
+    Format.fprintf ppf
+      "@,Consumed gas: %s"
+      (Z.to_string consumed_gas) ;
+    begin match balance_updates with
+      | [] -> ()
+      | balance_updates ->
+          Format.fprintf ppf
+            "@,Balance updates:@,  %a"
+            pp_balance_updates balance_updates
+    end in
+  let pp_result (type kind) ppf (result : kind manager_operation_result) =
+    Format.fprintf ppf "@," ;
+    match result with
+    | Skipped _ ->
+        Format.fprintf ppf
+          "This operation was skipped"
+    | Failed (_, _errs) ->
+        Format.fprintf ppf
+          "This operation FAILED."
+    | Applied (Reveal_result { consumed_gas }) ->
+        Format.fprintf ppf
+          "This revelation was successfully applied" ;
+        Format.fprintf ppf
+          "@,Consumed gas: %s"
+          (Z.to_string consumed_gas)
+    | Backtracked (Reveal_result _, _) ->
+        Format.fprintf ppf
+          "@[<v 0>This revelation was BACKTRACKED, \
+           its expected effects were NOT applied.@]" ;
+    | Applied (Delegation_result { consumed_gas })->
+        Format.fprintf ppf
+          "This delegation was successfully applied" ;
+        Format.fprintf ppf
+          "@,Consumed gas: %s"
+          (Z.to_string consumed_gas)
+    | Backtracked (Delegation_result _, _) ->
+        Format.fprintf ppf
+          "@[<v 0>This delegation was BACKTRACKED, \
+           its expected effects were NOT applied.@]" ;
+    | Applied (Transaction_result _ as tx) ->
+        Format.fprintf ppf
+          "This transaction was successfully applied" ;
+        pp_transaction_result tx
+    | Backtracked (Transaction_result _ as tx, _errs) ->
+        Format.fprintf ppf
+          "@[<v 0>This transaction was BACKTRACKED, \
+           its expected effects (as follow) were NOT applied.@]" ;
+        pp_transaction_result tx
+    | Applied (Origination_result _ as op) ->
+        Format.fprintf ppf
+          "This origination was successfully applied" ;
+        pp_origination_result op
+    | Backtracked (Origination_result _ as op, _errs) ->
+        Format.fprintf ppf
+          "@[<v 0>This origination was BACKTRACKED, \
+           its expected effects (as follow) were NOT applied.@]" ;
+        pp_origination_result op in
+  Format.fprintf ppf
+    "@[<v 0>@[<v 2>Manager signed operations:@,\
+     From: %a@,\
+     Fee to the baker: %s%a@,\
+     Expected counter: %s@,\
+     Gas limit: %s@,\
+     Storage limit: %s bytes"
+    Contract.pp source
+    Client_proto_args.tez_sym
+    Tez.pp fee
+    (Z.to_string counter)
+    (Z.to_string gas_limit)
+    (Z.to_string storage_limit) ;
+  begin match balance_updates with
+    | [] -> ()
+    | balance_updates ->
+        Format.fprintf ppf
+          "@,Balance updates:@,  %a"
+          pp_balance_updates balance_updates
+  end ;
+  Format.fprintf ppf
+    "@,%a"
+    (pp_manager_operation_content source false pp_result)
+    (operation, operation_result) ;
+  begin
+    match internal_operation_results with
+    | [] -> ()
+    | _ :: _ ->
+        Format.fprintf ppf
+          "@,@[<v 2>Internal operations:@ %a@]"
+          (Format.pp_print_list
+             (fun ppf (Internal_operation_result (op, res)) ->
+                pp_manager_operation_content op.source false pp_result
+                  ppf (op.operation, res)))
+          internal_operation_results
+  end ;
+  Format.fprintf ppf "@]"
+
+let rec pp_contents_and_result_list :
+  type kind. Format.formatter -> kind contents_and_result_list -> unit =
+  fun ppf -> function
+    | Single_and_result
+        (Seed_nonce_revelation { level ; nonce },
+         Seed_nonce_revelation_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Seed nonce revelation:@,\
+           Level: %a@,\
+           Nonce (hash): %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Raw_level.pp level
+          Nonce_hash.pp (Nonce.hash nonce)
+          pp_balance_updates bus
+    | Single_and_result
+        (Double_baking_evidence { bh1 ; bh2 },
+         Double_baking_evidence_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Double baking evidence:@,\
+           Exhibit A: %a@,\
+           Exhibit B: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Block_hash.pp (Block_header.hash bh1)
+          Block_hash.pp (Block_header.hash bh2)
+          pp_balance_updates bus
+    | Single_and_result
+        (Double_endorsement_evidence { op1 ; op2 },
+         Double_endorsement_evidence_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Double endorsement evidence:@,\
+           Exhibit A: %a@,\
+           Exhibit B: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Operation_hash.pp (Operation.hash op1)
+          Operation_hash.pp (Operation.hash op2)
+          pp_balance_updates bus
+    | Single_and_result
+        (Activate_account { id ; _ },
+         Activate_account_result bus) ->
+        Format.fprintf ppf
+          "@[<v 2>Genesis account activation:@,\
+           Account: %a@,\
+           Balance updates:@,\
+          \  %a@]"
+          Ed25519.Public_key_hash.pp id
+          pp_balance_updates bus
+    | Single_and_result
+        (Endorsement { level },
+         Endorsement_result { balance_updates ; delegate ; slots }) ->
+        Format.fprintf ppf
+          "@[<v 2>Endorsement:@,\
+           Level: %a@,\
+           Balance updates:%a@,\
+           Delegate: %a@,\
+           Slots: %a@]"
+          Raw_level.pp level
+          pp_balance_updates balance_updates
+          Signature.Public_key_hash.pp delegate
+          (Format.pp_print_list
+             ~pp_sep:Format.pp_print_space
+             Format.pp_print_int)
+          slots
+    | Single_and_result
+        (Proposals { source ; period ; proposals },
+         Proposals_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Proposals:@,\
+           From: %a@,\
+           Period: %a@,\
+           Protocols:@,\
+          \  @[<v 0>%a@]@]"
+          Signature.Public_key_hash.pp source
+          Voting_period.pp period
+          (Format.pp_print_list Protocol_hash.pp) proposals
+    | Single_and_result
+        (Ballot { source ;period ; proposal ; ballot },
+         Ballot_result) ->
+        Format.fprintf ppf
+          "@[<v 2>Ballot:@,\
+           From: %a@,\
+           Period: %a@,\
+           Protocol: %a@,\
+           Vote: %a@]"
+          Signature.Public_key_hash.pp source
+          Voting_period.pp period
+          Protocol_hash.pp proposal
+          Data_encoding.Json.pp
+          (Data_encoding.Json.construct Vote.ballot_encoding ballot)
+    | Single_and_result (Manager_operation _ as op,
+                         (Manager_operation_result _ as res))->
+        Format.fprintf ppf "%a"
+          pp_manager_operation_contents_and_result (op, res)
+    | Cons_and_result (Manager_operation _ as op,
+                       (Manager_operation_result _ as res),
+                       rest) ->
+        Format.fprintf ppf "%a@\n%a"
+          pp_manager_operation_contents_and_result (op, res)
+          pp_contents_and_result_list rest
+
+let pp_operation_result ppf
+    (op, res : 'kind contents_list * 'kind contents_result_list) =
+  Format.fprintf ppf "@[<v 0>" ;
+  let contents_and_result_list =
+    Apply_results.pack_contents_list op res in
+  pp_contents_and_result_list ppf contents_and_result_list ;
+  Format.fprintf ppf "@]@."
+
+let pp_internal_operation ppf (Internal_operation { source ; operation }) =
+  pp_manager_operation_content source true (fun _ppf () -> ())
+    ppf (operation, ())
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.mli b/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.mli
new file mode 100644
index 000000000..ef9853938
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/operation_result.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val pp_internal_operation:
+  Format.formatter -> packed_internal_operation -> unit
+
+val pp_operation_result:
+  Format.formatter ->
+  ('kind contents_list * 'kind Apply_results.contents_result_list) -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/proto_alpha.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/proto_alpha.ml
new file mode 100644
index 000000000..286d8fe71
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/proto_alpha.ml
@@ -0,0 +1,77 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Name = struct let name = "alpha" end
+module T = Tezos_protocol_environment.Make(Tezos_storage.Context)
+module Alpha_environment = T.MakeV1(Name)()
+
+module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+module Alpha_block_services = Block_services.Make(Proto)(Proto)
+
+include Proto
+module LiftedMain = Alpha_environment.Lift(Proto)
+
+class type rpc_context = object
+  inherit RPC_context.json
+  inherit [Shell_services.chain * Shell_services.block] Alpha_environment.RPC_context.simple
+end
+
+class wrap_proto_context (t : RPC_context.json) : rpc_context = object
+  method base : Uri.t = t#base
+  method generic_json_call = t#generic_json_call
+  method call_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    'p -> 'q -> 'i -> 'o tzresult Lwt.t= t#call_service
+  method call_streamed_service : 'm 'p 'q 'i 'o.
+    ([< Resto.meth ] as 'm, unit, 'p, 'q, 'i, 'o) RPC_service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i -> (unit -> unit) tzresult Lwt.t = t#call_streamed_service
+  inherit [Shell_services.chain,
+           Shell_services.block] Alpha_environment.proto_rpc_context
+      (t :> RPC_context.t)
+      Shell_services.Blocks.path
+end
+
+class type full = object
+  inherit Client_context.full
+  inherit [Shell_services.chain * Shell_services.block] Alpha_environment.RPC_context.simple
+end
+
+class wrap_full (t : Client_context.full) : full = object
+  inherit Client_context.proxy_context t
+  inherit [Shell_services.chain, Shell_services.block] Alpha_environment.proto_rpc_context
+      (t :> RPC_context.t)
+      Shell_services.Blocks.path
+end
+
+let register_error_kind
+    category ~id ~title ~description ?pp
+    encoding from_error to_error =
+  let id = "client." ^ Name.name ^ "." ^ id in
+  register_error_kind
+    category ~id ~title ~description ?pp
+    encoding from_error to_error
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/test/assert.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/test/assert.ml
new file mode 100644
index 000000000..f97fb5ca1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/test/assert.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fail expected given msg =
+  Format.kasprintf Pervasives.failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(print=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (print x) (print y) msg
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/test/dune b/vendors/tezos-modded/src/proto_alpha/lib_client/test/dune
new file mode 100644
index 000000000..d9b86eb2b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/test/dune
@@ -0,0 +1,30 @@
+(executables
+ (names test_michelson_v1_macros)
+ (libraries tezos-base
+            tezos-micheline
+            tezos-protocol-alpha
+            tezos-client-alpha
+            alcotest-lwt)
+ (flags (:standard -w -9+27-30-32-40@8 -safe-string
+                    -open Tezos_base__TzPervasives
+                    -open Tezos_micheline
+                    -open Tezos_client_alpha
+                    -open Tezos_protocol_alpha)))
+
+
+(alias
+(name buildtest)
+(deps test_michelson_v1_macros.exe))
+
+(alias
+(name runtest_michelson_v1_macros)
+(action (run %{exe:test_michelson_v1_macros.exe})))
+
+(alias
+(name runtest)
+(deps (alias runtest_michelson_v1_macros)))
+
+(alias
+(name runtest_indent)
+(deps (glob_files *.ml{,i}))
+(action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/test/test_michelson_v1_macros.ml b/vendors/tezos-modded/src/proto_alpha/lib_client/test/test_michelson_v1_macros.ml
new file mode 100644
index 000000000..177556ea0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/test/test_michelson_v1_macros.ml
@@ -0,0 +1,911 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let print expr: string =
+  expr |>
+  Micheline_printer.printable (fun s -> s) |>
+  Format.asprintf "%a" Micheline_printer.print_expr
+
+(* expands : expression with macros fully expanded *)
+
+let assert_expands
+    (original:(Micheline_parser.location, string) Micheline.node)
+    (expanded:(Micheline_parser.location, string) Micheline.node) =
+  let { Michelson_v1_parser.expanded = expansion}, errors =
+    let source = print (Micheline.strip_locations original) in
+    Michelson_v1_parser.expand_all ~source ~original
+  in
+  match errors with
+  | [] ->
+      Assert.equal ~print
+        (Michelson_v1_primitives.strings_of_prims expansion)
+        (Micheline.strip_locations expanded);
+      ok ()
+  | errors -> Error errors
+
+(****************************************************************************)
+
+open Micheline
+
+let zero_loc = Micheline_parser.location_zero
+
+let left_branch =
+  Seq (zero_loc, [Prim (zero_loc, "SWAP", [], [])])
+
+let right_branch = Seq (zero_loc, [])
+
+(***************************************************************************)
+(* Test expands *)
+(***************************************************************************)
+
+let assert_compare_macro prim_name compare_name =
+  assert_expands (Prim (zero_loc, prim_name, [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "COMPARE", [], []);
+                     Prim (zero_loc, compare_name, [], [])]))
+
+let test_compare_marco_expansion () =
+  assert_compare_macro "CMPEQ" "EQ" >>? fun () ->
+  assert_compare_macro "CMPNEQ" "NEQ" >>? fun () ->
+  assert_compare_macro "CMPLT" "LT" >>? fun () ->
+  assert_compare_macro "CMPGT" "GT" >>? fun () ->
+  assert_compare_macro "CMPLE" "LE" >>? fun () ->
+  assert_compare_macro "CMPGE" "GE"
+
+let assert_if_macro prim_name compare_name =
+  assert_expands (Prim (zero_loc, prim_name,
+                        [left_branch; right_branch], []))
+    (Seq (zero_loc, [Prim (zero_loc, compare_name, [], []);
+                     Prim (zero_loc, "IF", [left_branch; right_branch], [])]))
+
+let test_if_compare_macros_expansion () =
+  assert_if_macro "IFEQ" "EQ" >>? fun () ->
+  assert_if_macro "IFNEQ" "NEQ" >>? fun () ->
+  assert_if_macro "IFLT" "LT" >>? fun () ->
+  assert_if_macro "IFGT" "GT" >>? fun () ->
+  assert_if_macro "IFLE" "LE" >>? fun () ->
+  assert_if_macro "IFGE" "GE"
+
+let assert_if_cmp_macros prim_name compare_name =
+  assert_expands (Prim (zero_loc, prim_name, [left_branch; right_branch], []))
+    (Seq (zero_loc, [Prim (zero_loc, "COMPARE", [], []);
+                     Prim (zero_loc, compare_name, [], []);
+                     Prim (zero_loc, "IF", [left_branch; right_branch], [])]))
+
+let test_if_cmp_macros_expansion () =
+  assert_if_cmp_macros "IFCMPEQ" "EQ" >>? fun () ->
+  assert_if_cmp_macros "IFCMPNEQ" "NEQ" >>? fun () ->
+  assert_if_cmp_macros "IFCMPLT" "LT" >>? fun () ->
+  assert_if_cmp_macros "IFCMPGT" "GT" >>? fun () ->
+  assert_if_cmp_macros "IFCMPLE" "LE" >>? fun () ->
+  assert_if_cmp_macros "IFCMPGE" "GE"
+
+(****************************************************************************)
+(* Fail *)
+
+let test_fail_expansion () =
+  assert_expands (Prim (zero_loc, "FAIL", [], []))
+    (Seq (zero_loc, [
+         Prim (zero_loc, "UNIT", [], []);
+         Prim (zero_loc, "FAILWITH", [], [])]))
+
+(**********************************************************************)
+(* assertion *)
+
+let seq_unit_failwith =
+  Seq (zero_loc, [
+      Prim (zero_loc, "UNIT", [], []);
+      Prim (zero_loc, "FAILWITH", [], [])])
+
+(* {} {FAIL} *)
+let fail_false =
+  [Seq (zero_loc, []);
+   Seq (zero_loc, [seq_unit_failwith])]
+
+(* {FAIL} {} *)
+let fail_true =
+  [Seq (zero_loc, [seq_unit_failwith]);
+   Seq (zero_loc, [])]
+
+let test_assert_expansion () =
+  assert_expands (Prim (zero_loc, "ASSERT", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "IF", fail_false, [])]))
+
+
+let assert_assert_if_compare prim_name compare_name =
+  assert_expands (Prim (zero_loc, prim_name, [], []))
+    (Seq (zero_loc, [Prim (zero_loc, compare_name, [], []);
+                     Prim (zero_loc, "IF", fail_false, [])]))
+
+let test_assert_if () =
+  assert_assert_if_compare "ASSERT_EQ" "EQ" >>? fun () ->
+  assert_assert_if_compare "ASSERT_NEQ" "NEQ" >>? fun () ->
+  assert_assert_if_compare "ASSERT_LT" "LT" >>? fun () ->
+  assert_assert_if_compare "ASSERT_LE" "LE" >>? fun () ->
+  assert_assert_if_compare "ASSERT_GT" "GT" >>? fun () ->
+  assert_assert_if_compare "ASSERT_GE" "GE"
+
+let assert_cmp_if prim_name compare_name =
+  assert_expands (Prim (zero_loc, prim_name, [], []))
+    (Seq (zero_loc,
+          [Seq (zero_loc,
+                [Prim (zero_loc, "COMPARE", [], []);
+                 Prim (zero_loc, compare_name, [], [])]);
+           Prim (zero_loc, "IF", fail_false, [])]))
+
+let test_assert_cmp_if () =
+  assert_cmp_if "ASSERT_CMPEQ" "EQ" >>? fun () ->
+  assert_cmp_if "ASSERT_CMPNEQ" "NEQ" >>? fun () ->
+  assert_cmp_if "ASSERT_CMPLT" "LT" >>? fun () ->
+  assert_cmp_if "ASSERT_CMPLE" "LE" >>? fun () ->
+  assert_cmp_if "ASSERT_CMPGT" "GT" >>? fun () ->
+  assert_cmp_if "ASSERT_CMPGE" "GE"
+
+(* The work of merge request !628
+   > ASSERT_LEFT @x  =>  IF_LEFT {RENAME @x} {FAIL}
+   > ASSERT_RIGHT @x  =>  IF_LEFT {FAIL} {RENAME @x}
+   > ASSERT_SOME @x  =>  IF_NONE {FAIL} {RENAME @x}
+*)
+
+let may_rename annot =
+  Seq (zero_loc, [Prim (zero_loc, "RENAME", [], annot)])
+
+let fail_false_may_rename =
+  [may_rename ["@annot"];
+   Seq (zero_loc, [Seq (zero_loc,
+                        [Prim (zero_loc, "UNIT", [], []);
+                         Prim (zero_loc, "FAILWITH", [], [])])])]
+
+let fail_true_may_rename =
+  [Seq (zero_loc,
+        [Seq (zero_loc, [Prim (zero_loc, "UNIT", [], []);
+                         Prim (zero_loc, "FAILWITH", [], [])])])
+  ; may_rename ["@annot"]]
+
+let test_assert_some_annot () =
+  assert_expands (Prim (zero_loc, "ASSERT_SOME", [], ["@annot"]))
+    (Seq (zero_loc, [
+         Prim (zero_loc, "IF_NONE", fail_true_may_rename, [])]))
+
+let test_assert_left_annot () =
+  assert_expands (Prim (zero_loc, "ASSERT_LEFT", [], ["@annot"]))
+    (Seq (zero_loc, [
+         Prim (zero_loc, "IF_LEFT", fail_false_may_rename, [])]))
+
+let test_assert_right_annot () =
+  assert_expands (Prim (zero_loc, "ASSERT_RIGHT", [], ["@annot"]))
+    (Seq (zero_loc, [
+         Prim (zero_loc, "IF_LEFT", fail_true_may_rename, [])]))
+
+let test_assert_none () =
+  assert_expands (Prim (zero_loc, "ASSERT_NONE", [], []))
+    (Seq (zero_loc, [
+         Prim (zero_loc, "IF_NONE", fail_false, [])]))
+
+let test_assert_some () =
+  assert_expands (Prim (zero_loc, "ASSERT_SOME", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", fail_true, [])]))
+
+let test_assert_left () =
+  assert_expands (Prim (zero_loc, "ASSERT_LEFT", [], []))
+    (Seq (zero_loc,
+          [Prim (zero_loc, "IF_LEFT", fail_false, [])]))
+
+let test_assert_right () =
+  assert_expands (Prim (zero_loc, "ASSERT_RIGHT", [], []))
+    (Seq (zero_loc,
+          [Prim ((zero_loc, "IF_LEFT", fail_true, []))]))
+
+(***********************************************************************)
+(*Syntactic Conveniences*)
+
+(* diip *)
+
+let test_diip () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  let dip =
+    Prim (zero_loc, "DIP", [code], [])
+  in
+  assert_expands (Prim (zero_loc, "DIIP", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DIP",
+                           [Seq (zero_loc, [dip])], [])]))
+
+(* pair *)
+
+let test_pair () =
+  assert_expands (Prim (zero_loc, "PAIR", [], []))
+    (Prim (zero_loc, "PAIR", [], []))
+
+let test_pappaiir () =
+  let pair = Prim (zero_loc, "PAIR", [], []) in
+  assert_expands (Prim (zero_loc, "PAPPAIIR", [], []))
+    (Seq (zero_loc,
+          [Prim (zero_loc, "DIP", [Seq (zero_loc, [pair])], []);
+           Prim (zero_loc, "DIP", [Seq (zero_loc, [pair])], []); pair]))
+
+(* unpair *)
+
+let test_unpair () =
+  assert_expands (Prim (zero_loc, "UNPAIR", [], []))
+    (Seq (zero_loc,
+          [Seq (zero_loc,
+                [Prim (zero_loc, "DUP", [], []);
+                 Prim (zero_loc, "CAR", [], []);
+                 Prim (zero_loc, "DIP",
+                       [Seq (zero_loc, [Prim (zero_loc, "CDR", [], [])])], [])])]))
+
+(* duup *)
+
+let test_duup () =
+  let dup =
+    Prim (zero_loc, "DUP", [], [])
+  in
+  assert_expands (Prim (zero_loc, "DUUP", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DIP", [Seq (zero_loc, [dup])], []);
+                     Prim (zero_loc, "SWAP", [], [])]))
+
+(* car/cdr *)
+
+let test_caddadr_expansion () =
+  let car = Prim (zero_loc, "CAR", [], []) in
+  assert_expands (Prim (zero_loc, "CAR", [], []))
+    (car) >>? fun () ->
+  let cdr =  Prim (zero_loc, "CDR", [], []) in
+  assert_expands (Prim (zero_loc, "CDR", [], []))
+    (cdr) >>? fun () ->
+  assert_expands (Prim (zero_loc, "CADR", [], []))
+    (Seq (zero_loc, [car; cdr])) >>? fun () ->
+  assert_expands (Prim (zero_loc, "CDAR", [], []))
+    (Seq (zero_loc, [cdr; car]))
+
+(* if_some *)
+
+let test_if_some () =
+  assert_expands (Prim (zero_loc, "IF_SOME", [right_branch; left_branch], []))
+    (Seq (zero_loc, [Prim (zero_loc, "IF_NONE", [left_branch; right_branch], [])]))
+
+(*set_caddadr*)
+
+let test_set_car_expansion () =
+  assert_expands (Prim (zero_loc, "SET_CAR", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%"; "%@"])]))
+
+let test_set_cdr_expansion () =
+  assert_expands (Prim (zero_loc, "SET_CDR", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%"])]))
+
+let test_set_cadr_expansion () =
+  let set_car =
+    Seq (zero_loc,
+         [Prim (zero_loc, "CAR", [], ["@%%"]);
+          Prim (zero_loc, "PAIR", [], ["%@"; "%"])])
+  in
+  assert_expands (Prim (zero_loc, "SET_CADR", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP", [
+                         Seq (zero_loc,
+                              [Prim (zero_loc, "CAR",[], ["@%%"]);
+                               set_car;
+                              ])], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"]);
+                    ]))
+
+let test_set_cdar_expansion () =
+  let set_cdr =
+    Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                    Prim (zero_loc, "SWAP", [], []);
+                    Prim (zero_loc, "PAIR", [], ["%"; "%@"])
+                   ])
+  in
+  assert_expands (Prim (zero_loc, "SET_CDAR", [], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                                            set_cdr
+                                           ])], []);
+                     Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+
+(* TO BE CHANGE IN THE DOCUMENTATION: @MR!791
+   FROM:
+   > MAP_CAR code  =>  DUP ; CDR ; DIP { CAR ; code } ; SWAP ; PAIR
+   TO:
+   > MAP_CAR code  =>  DUP ; CDR ; DIP { CAR ; {code} } ; SWAP ; PAIR
+*)
+
+let test_map_car () =
+  (* code is a sequence *)
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  assert_expands (Prim (zero_loc, "MAP_CAR", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc,
+                                 [Prim (zero_loc, "CAR", [], []); code])], []);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%"; "%@"])
+                    ]))
+
+let test_map_cdr () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  assert_expands (Prim (zero_loc, "MAP_CDR", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CDR", [], []); code;
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%"])
+                    ]))
+
+let test_map_caadr () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  let map_cdr =
+    Seq (zero_loc,
+         [Prim (zero_loc, "DUP", [], []);
+          Prim (zero_loc, "CDR", [], []);
+          code;
+          Prim (zero_loc, "SWAP", [], []);
+          Prim (zero_loc, "CAR", [], ["@%%"]);
+          Prim (zero_loc, "PAIR", [], ["%@"; "%"])
+         ])
+  in
+  let map_cadr =
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc,
+                                 [Prim (zero_loc, "CAR", [], ["@%%"]);
+                                  map_cdr
+                                 ])], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+  in
+  assert_expands (Prim (zero_loc, "MAP_CAADR", [code], []))
+    (Seq (zero_loc,
+          [Prim (zero_loc, "DUP", [], []);
+           Prim (zero_loc, "DIP",
+                 [Seq (zero_loc,
+                       [Prim (zero_loc, "CAR", [], ["@%%"]);
+                        map_cadr
+                       ])], []);
+           Prim (zero_loc, "CDR", [], ["@%%"]);
+           Prim (zero_loc, "SWAP", [], []);
+           Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+          ]))
+
+let test_map_cdadr () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  let map_cdr =
+    Seq (zero_loc,
+         [Prim (zero_loc, "DUP", [], []);
+          Prim (zero_loc, "CDR", [], []);
+          code;
+          Prim (zero_loc, "SWAP", [], []);
+          Prim (zero_loc, "CAR", [], ["@%%"]);
+          Prim (zero_loc, "PAIR", [], ["%@"; "%"])
+         ])
+  in
+  let map_cadr =
+    Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                    Prim (zero_loc, "DIP",
+                          [Seq (zero_loc,
+                                [Prim (zero_loc, "CAR", [], ["@%%"]);
+                                 map_cdr
+                                ])], []);
+                    Prim (zero_loc, "CDR", [], ["@%%"]);
+                    Prim (zero_loc, "SWAP", [], []);
+                    Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                   ])
+  in
+  assert_expands (Prim (zero_loc, "MAP_CDADR", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc,
+                                 [Prim (zero_loc, "CDR", [], ["@%%"]);
+                                  map_cadr
+                                 ])
+                           ], []);
+                     Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+
+(****************************************************************************)
+(* Unexpand tests *)
+(****************************************************************************)
+
+(* unpexpanded : original expression with macros *)
+
+let assert_unexpansion original ex =
+  let { Michelson_v1_parser.expanded }, errors =
+    let source = print (Micheline.strip_locations original) in
+    Michelson_v1_parser.expand_all ~source ~original
+  in
+  let unparse =
+    Michelson_v1_printer.unparse_expression expanded
+  in
+  match errors with
+  | [] ->
+      Assert.equal ~print
+        unparse.Michelson_v1_parser.unexpanded
+        (Micheline.strip_locations ex);
+      ok ()
+  | _ :: _ -> Error errors
+
+let assert_unexpansion_consistent original =
+  let { Michelson_v1_parser.expanded }, errors =
+    let source = print (Micheline.strip_locations original) in
+    Michelson_v1_parser.expand_all ~source ~original in
+  match errors with
+  | _ :: _ -> Error errors
+  | [] ->
+      let { Michelson_v1_parser.unexpanded } =
+        Michelson_v1_printer.unparse_expression expanded in
+      Assert.equal ~print unexpanded (Micheline.strip_locations original) ;
+      ok ()
+
+
+let test_unexpand_fail () =
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "UNIT", [], []);
+                     Prim (zero_loc, "FAILWITH", [], [])
+                    ]))
+    (Prim (zero_loc, "FAIL", [], []))
+
+let test_unexpand_if_right () =
+  assert_unexpansion
+    (Seq (zero_loc,
+          [Prim (zero_loc, "IF_LEFT", [left_branch; right_branch], [])]))
+    (Prim (zero_loc, "IF_RIGHT", [right_branch; left_branch], []))
+
+let test_unexpand_if_some () =
+  assert_unexpansion
+    (Seq (zero_loc,
+          [Prim (zero_loc, "IF_NONE", [left_branch; right_branch], [])]))
+    (Prim (zero_loc, "IF_SOME", [right_branch; left_branch], []))
+
+let test_unexpand_assert () =
+  assert_unexpansion (Seq (zero_loc, [Prim (zero_loc, "IF", fail_false, [])]))
+    (Prim (zero_loc, "ASSERT", [], []))
+
+let assert_unexpansion_assert_if_compare compare_name prim_name =
+  assert_unexpansion (Seq (zero_loc, [Prim (zero_loc, compare_name, [], []);
+                                      Prim (zero_loc, "IF", fail_false, [])
+                                     ]))
+    (Prim (zero_loc, prim_name, [], []))
+
+let test_unexpand_assert_if () =
+  assert_unexpansion_assert_if_compare "EQ" "ASSERT_EQ" >>? fun () ->
+  assert_unexpansion_assert_if_compare "NEQ" "ASSERT_NEQ" >>? fun () ->
+  assert_unexpansion_assert_if_compare "LT" "ASSERT_LT" >>? fun () ->
+  assert_unexpansion_assert_if_compare "LE" "ASSERT_LE" >>? fun () ->
+  assert_unexpansion_assert_if_compare "GT" "ASSERT_GT" >>? fun () ->
+  assert_unexpansion_assert_if_compare "GE" "ASSERT_GE"
+
+let assert_unexpansion_assert_cmp_if_compare compare_name prim_name =
+  assert_unexpansion (Seq (zero_loc, [Seq (zero_loc,
+                                           [Prim (zero_loc, "COMPARE", [], []);
+                                            Prim (zero_loc, compare_name, [], [])
+                                           ]);
+                                      Prim (zero_loc, "IF", fail_false, [])]))
+    (Prim (zero_loc, prim_name, [], []))
+
+let test_unexpansion_assert_cmp_if () =
+  assert_unexpansion_assert_cmp_if_compare "EQ" "ASSERT_CMPEQ" >>? fun () ->
+  assert_unexpansion_assert_cmp_if_compare "NEQ" "ASSERT_CMPNEQ" >>? fun () ->
+  assert_unexpansion_assert_cmp_if_compare "LT" "ASSERT_CMPLT" >>? fun () ->
+  assert_unexpansion_assert_cmp_if_compare "LE" "ASSERT_CMPLE" >>? fun () ->
+  assert_unexpansion_assert_cmp_if_compare "GT" "ASSERT_CMPGT" >>? fun () ->
+  assert_unexpansion_assert_cmp_if_compare "GE" "ASSERT_CMPGE"
+
+let test_unexpand_assert_some_annot () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_NONE", fail_true_may_rename, [])]))
+    (Prim (zero_loc, "ASSERT_SOME", [], ["@annot"]))
+
+let test_unexpand_assert_left_annot () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_LEFT", fail_false_may_rename, [])]))
+    (Prim (zero_loc, "ASSERT_LEFT", [], ["@annot"]))
+
+let test_unexpand_assert_right_annot () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_LEFT", fail_true_may_rename, [])]))
+    (Prim (zero_loc, "ASSERT_RIGHT", [], ["@annot"]))
+
+let test_unexpand_assert_none () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_NONE", fail_false, [])]))
+    (Prim (zero_loc, "ASSERT_NONE", [], []))
+
+let test_unexpand_assert_some () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_NONE", fail_true, [])]))
+    (Prim (zero_loc, "ASSERT_SOME", [], []))
+
+let test_unexpand_assert_left () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_LEFT", fail_false, [])]))
+    (Prim (zero_loc, "ASSERT_LEFT", [], []))
+
+let test_unexpand_assert_right () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "IF_LEFT", fail_true, [])]))
+    (Prim (zero_loc, "ASSERT_RIGHT", [], []))
+
+let test_unexpand_unpair () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Seq (zero_loc,
+                                 [Prim (zero_loc, "DUP", [], []);
+                                  Prim (zero_loc, "CAR", [], []);
+                                  Prim (zero_loc, "DIP",
+                                        [Seq (zero_loc, [Prim (zero_loc, "CDR", [], [])])], [])
+                                 ])]))
+    (Prim (zero_loc, "UNPAIR", [], []))
+
+let test_unexpand_pair () =
+  assert_unexpansion (Prim (zero_loc, "PAIR", [], []))
+    (Prim (zero_loc, "PAIR", [], []))
+
+let test_unexpand_pappaiir () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "DIP",
+                                  [Seq (zero_loc,
+                                        [Prim (zero_loc, "PAIR", [], [])]
+                                       )], []);
+                            Prim (zero_loc, "DIP",
+                                  [Seq (zero_loc, [Prim (zero_loc, "PAIR", [], [])])], []);
+                            Prim (zero_loc, "PAIR", [], [])]))
+    (Prim (zero_loc, "PAPPAIIR", [], []))
+
+let test_unexpand_duup () =
+  assert_unexpansion (Seq (zero_loc,
+                           [Prim (zero_loc, "DIP",
+                                  [Seq (zero_loc,
+                                        [Prim (zero_loc, "DUP", [], [])])], []);
+                            Prim (zero_loc, "SWAP", [], [])]))
+    (Prim (zero_loc, "DUUP", [], []))
+
+let test_unexpand_caddadr () =
+  let car =  Prim (zero_loc, "CAR", [], []) in
+  let cdr =  Prim (zero_loc, "CDR", [], []) in
+  assert_unexpansion
+    (Seq (zero_loc, [car]))
+    (car) >>? fun () ->
+  assert_unexpansion
+    (Seq (zero_loc, [cdr]))
+    (cdr) >>? fun () ->
+  assert_unexpansion
+    (Seq (zero_loc, [car; cdr]))
+    (Prim (zero_loc, "CADR", [], [])) >>? fun () ->
+  assert_unexpansion
+    (Seq (zero_loc, [cdr; car]))
+    (Prim (zero_loc, "CDAR", [], []))
+
+let test_unexpand_set_car () =
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%"; "%@"])]))
+    (Prim (zero_loc, "SET_CAR", [], []))
+
+let test_unexpand_set_cdr () =
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%"])]))
+    (Prim (zero_loc, "SET_CDR", [], []))
+
+let test_unexpand_set_car_annot () =
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CAR", [], ["%@"]);
+                     Prim (zero_loc, "DROP", [], []);
+                     Prim (zero_loc, "CDR", [], []);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], []);
+                    ]))
+    (Prim (zero_loc, "SET_CAR", [], ["%@"]))
+
+let test_unexpand_set_cdr_annot () =
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CDR", [], ["%@"]);
+                     Prim (zero_loc, "DROP", [], []);
+                     Prim (zero_loc, "CAR", [], []);
+                     Prim (zero_loc, "PAIR", [], []);
+                    ]))
+    (Prim (zero_loc, "SET_CDR", [], ["%@"]))
+
+let test_unexpand_set_cadr () =
+  let set_car =
+    Seq (zero_loc,
+         [Prim (zero_loc, "CAR", [], ["@%%"]);
+          Prim (zero_loc, "PAIR", [], ["%@"; "%"])])
+  in
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP", [
+                         Seq (zero_loc,
+                              [Prim (zero_loc, "CAR",[], ["@%%"]);
+                               set_car;
+                              ])], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"]);
+                    ]))
+    (Prim (zero_loc, "SET_CADR", [], []))
+
+let test_unexpand_set_cdar () =
+  let set_cdr =
+    Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                    Prim (zero_loc, "SWAP", [], []);
+                    Prim (zero_loc, "PAIR", [], ["%"; "%@"])
+                   ])
+  in
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                                            set_cdr
+                                           ])], []);
+                     Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+    (Prim (zero_loc, "SET_CDAR", [], []))
+
+(* FIXME: Seq()(Prim): does not parse, raise an error unparse *)
+let test_unexpand_map_car () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  assert_unexpansion
+    (Prim (zero_loc, "MAP_CAR", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "DIP", [
+                         Seq (zero_loc, [Prim (zero_loc, "CAR", [], []);
+                                         Prim (zero_loc, "CAR", [], []);
+                                        ])
+                       ], []);
+                     Prim (zero_loc, "SWAP",[], []);
+                     Prim (zero_loc, "PAIR", [], ["%"; "%@"])
+                    ]))
+
+
+(***********************************************************************)
+(*BUG: DIIP and the test with MAP_CDR: or any map with "D" inside fail *)
+
+let test_unexpand_diip () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  let dip = Prim (zero_loc, "DIP", [code], []) in
+  assert_unexpansion
+    (Prim (zero_loc, "DIIP", [code], []))
+    (Seq (zero_loc, [Prim (zero_loc, "DIP",
+                           [Seq (zero_loc, [dip])], [])]))
+
+let test_unexpand_map_cdr () =
+  let code =
+    Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])
+  in
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "CDR", [], []); code;
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "CAR", [], []);
+                     Prim (zero_loc, "PAIR", [], []);
+                    ]))
+    (Prim (zero_loc, "MAP_CDR", [code], []))
+
+let test_unexpand_map_caadr () =
+  let code =
+    [Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])]
+  in
+  let map_cdr =
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc,
+                                 [Prim (zero_loc, "CAR", [], ["@%%"]);
+                                  Seq (zero_loc,
+                                       [Prim (zero_loc, "DUP", [], []);
+                                        Prim (zero_loc, "CDR", [], []);
+                                        Seq (zero_loc,
+                                             [Prim (zero_loc, "CAR", [], [])]);
+                                        Prim (zero_loc, "SWAP", [], []);
+                                        Prim (zero_loc, "CAR", [], ["@%%"]);
+                                        Prim (zero_loc, "PAIR", [], ["%@"; "%"])
+                                       ])
+                                 ])], []);
+                     Prim (zero_loc, "CDR", [], ["@%%"]);
+                     Prim (zero_loc, "SWAP", [], []);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+  in
+  assert_unexpansion
+    (Prim (zero_loc, "MAP_CAAR", code, []))
+    (Seq (zero_loc,
+          [Prim (zero_loc, "DUP", [], []);
+           Prim (zero_loc, "DIP",
+                 [Seq (zero_loc,
+                       [Prim (zero_loc, "CAR", [], ["@%%"]);
+                        map_cdr
+                       ])], []);
+           Prim (zero_loc, "CDR", [], ["@%%"]);
+           Prim (zero_loc, "SWAP", [], []);
+           Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+          ]))
+
+let test_unexpand_map_cdadr () =
+  let code =
+    [Seq (zero_loc, [Prim (zero_loc, "CAR", [], [])])]
+  in
+  let map_cdr =
+    Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                    Prim (zero_loc, "DIP",
+                          [Seq (zero_loc,
+                                [Prim (zero_loc, "CAR", [], ["@%%"]);
+                                 Seq (zero_loc,
+                                      [Prim (zero_loc, "DUP", [], []);
+                                       Prim (zero_loc, "CDR", [], []);
+                                       Seq (zero_loc,
+                                            [Prim (zero_loc, "CAR", [], [])]);
+                                       Prim (zero_loc, "SWAP", [], []);
+                                       Prim (zero_loc, "CAR", [], ["@%%"]);
+                                       Prim (zero_loc, "PAIR", [], ["%@"; "%"])
+                                      ])
+                                ])], []);
+                    Prim (zero_loc, "CDR", [], ["@%%"]);
+                    Prim (zero_loc, "SWAP", [], []);
+                    Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                   ])
+  in
+  assert_unexpansion
+    (Seq (zero_loc, [Prim (zero_loc, "DUP", [], []);
+                     Prim (zero_loc, "DIP",
+                           [Seq (zero_loc, [Prim (zero_loc, "CDR", [], ["@%%"]);
+                                            map_cdr
+                                           ])
+                           ], []);
+                     Prim (zero_loc, "CAR", [], ["@%%"]);
+                     Prim (zero_loc, "PAIR", [], ["%@"; "%@"])
+                    ]))
+    (Prim (zero_loc, "MAP_CDADR", code, []))
+
+(*****************************************************************************)
+(* Test           *)
+(*****************************************************************************)
+
+let tests =
+  [
+    (*compare*)
+    "compare expansion",  (fun _ -> Lwt.return (test_compare_marco_expansion ())) ;
+    "if compare expansion",  (fun _ -> Lwt.return (test_if_compare_macros_expansion ())) ;
+    "if compare expansion: IFCMP",  (fun _ -> Lwt.return (test_if_cmp_macros_expansion ())) ;
+
+    (*fail*)
+    "fail expansion", (fun _ -> Lwt.return (test_fail_expansion ())) ;
+
+    (*assertion*)
+    "assert expansion", (fun _ -> Lwt.return (test_assert_expansion ())) ;
+    "assert if expansion", (fun _ -> Lwt.return (test_assert_if ())) ;
+    "assert cmpif expansion", (fun _ -> Lwt.return (test_assert_cmp_if ())) ;
+    "assert none expansion", (fun _ -> Lwt.return (test_assert_none ())) ;
+    "assert some expansion", (fun _ -> Lwt.return (test_assert_some ())) ;
+    "assert left expansion", (fun _ -> Lwt.return (test_assert_left ())) ;
+    "assert right expansion", (fun _ -> Lwt.return (test_assert_right ())) ;
+
+    "assert some annot expansion", (fun _ -> Lwt.return (test_assert_some_annot ())) ;
+    "assert left annot expansion", (fun _ -> Lwt.return (test_assert_left_annot ())) ;
+    "assert right annot expansion", (fun _ -> Lwt.return (test_assert_right_annot ())) ;
+
+    (*syntactic conveniences*)
+    "diip expansion",  (fun _ -> Lwt.return (test_diip ())) ;
+    "duup expansion",  (fun _ -> Lwt.return (test_duup ())) ;
+    "pair expansion",  (fun _ -> Lwt.return (test_pair ())) ;
+    "pappaiir expansion",  (fun _ -> Lwt.return (test_pappaiir ())) ;
+    "unpair expansion",  (fun _ -> Lwt.return (test_unpair ())) ;
+    "caddadr expansion",  (fun _ -> Lwt.return (test_caddadr_expansion ())) ;
+    "if_some expansion", (fun _ -> Lwt.return (test_if_some ())) ;
+    "set_car expansion",  (fun _ -> Lwt.return (test_set_car_expansion ())) ;
+    "set_cdr expansion",  (fun _ -> Lwt.return (test_set_cdr_expansion ())) ;
+    "set_cadr expansion",  (fun _ -> Lwt.return (test_set_cadr_expansion ())) ;
+    "set_cdar expansion",  (fun _ -> Lwt.return (test_set_cdar_expansion ())) ;
+    "map_car expansion",  (fun _ -> Lwt.return (test_map_car ())) ;
+    "map_cdr expansion",  (fun _ -> Lwt.return (test_map_cdr ())) ;
+    "map_caadr expansion",  (fun _ -> Lwt.return (test_map_caadr ())) ;
+    "map_cdadr expansion",  (fun _ -> Lwt.return (test_map_cdadr ())) ;
+
+    (*Unexpand*)
+    "fail unexpansion",  (fun _ -> Lwt.return (test_unexpand_fail ())) ;
+    "if_right unexpansion",  (fun _ -> Lwt.return (test_unexpand_if_right ())) ;
+    "if_some unexpansion",  (fun _ -> Lwt.return (test_unexpand_if_some ())) ;
+    "assert unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert ())) ;
+
+    "assert_if unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_if ())) ;
+    "assert_cmp_if unexpansion",  (fun _ -> Lwt.return (test_unexpansion_assert_cmp_if ())) ;
+    "assert_none unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_none ())) ;
+    "assert_some unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_some ())) ;
+    "assert_left unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_left ())) ;
+    "assert_right unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_right ())) ;
+
+    "assert_some annot unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_some_annot ())) ;
+    "assert_left annot unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_left_annot ())) ;
+    "assert_right annot unexpansion",  (fun _ -> Lwt.return (test_unexpand_assert_right_annot ())) ;
+
+    "unpair unexpansion",  (fun _ -> Lwt.return (test_unexpand_unpair ())) ;
+    "pair unexpansion",  (fun _ -> Lwt.return (test_unexpand_pair ())) ;
+    "pappaiir unexpansion",  (fun _ -> Lwt.return (test_unexpand_pappaiir ())) ;
+    "duup unexpansion",  (fun _ -> Lwt.return (test_unexpand_duup ())) ;
+
+    "caddadr unexpansion",  (fun _ -> Lwt.return (test_unexpand_caddadr ())) ;
+
+    "set_car unexpansion",  (fun _ -> Lwt.return (test_unexpand_set_car ())) ;
+    "set_cdr unexpansion",  (fun _ -> Lwt.return (test_unexpand_set_cdr ())) ;
+    "set_cadr unexpansion",  (fun _ -> Lwt.return (test_unexpand_set_cadr ())) ;
+    "set_car annot unexpansion",  (fun _ -> Lwt.return (test_unexpand_set_car_annot ())) ;
+    "set_cdr annot unexpansion",  (fun _ -> Lwt.return (test_unexpand_set_cdr_annot ())) ;
+
+    "map_car unexpansion",  (fun _ -> Lwt.return (test_unexpand_map_car ())) ;
+
+    (***********************************************************************)
+    (*BUG
+      the function in Michelson_v1_macros.unexpand_map_caddadr
+      failed to test the case with the character "D".
+      It returns an empty {} for the expand *)
+    (*"diip unexpansion",  (fun _ -> Lwt.return (test_unexpand_diip ())) ;*)
+    (*"map_cdr unexpansion",  (fun _ -> Lwt.return (test_unexpand_map_cdr ())) ;*)
+    (*"map_caadr unexpansion",  (fun _ -> Lwt.return (test_unexpand_map_caadr ())) ;*)
+    (*"map_cdadr unexpansion",  (fun _ -> Lwt.return (test_unexpand_map_cdadr ())) ;*)
+  ]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-lib-client" [
+    "micheline v1 macros", List.map wrap tests
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client/tezos-client-alpha.opam b/vendors/tezos-modded/src/proto_alpha/lib_client/tezos-client-alpha.opam
new file mode 100644
index 000000000..8aa6a6887
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client/tezos-client-alpha.opam
@@ -0,0 +1,20 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-signer-backends"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/alpha_commands_registration.ml b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/alpha_commands_registration.ml
new file mode 100644
index 000000000..3c145bd3c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/alpha_commands_registration.ml
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Client_commands.register Proto_alpha.hash @@ fun network  ->
+  List.map (Clic.map_command (new Proto_alpha.wrap_full)) @@
+  Client_proto_programs_commands.commands () @
+  Client_proto_contracts_commands.commands () @
+  Client_proto_context_commands.commands network ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
new file mode 100644
index 000000000..327ccb9a1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -0,0 +1,801 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Tezos_micheline
+open Client_proto_context
+open Client_proto_contracts
+open Client_proto_programs
+open Client_keys
+open Client_proto_args
+
+let encrypted_switch =
+  Clic.switch
+    ~long:"encrypted"
+    ~doc:"encrypt the key on-disk" ()
+
+let dry_run_switch =
+  Clic.switch
+    ~long:"dry-run"
+    ~short:'D'
+    ~doc:"don't inject the operation, just display it" ()
+
+let report_michelson_errors ?(no_print_source=false) ~msg (cctxt : #Client_context.printer) = function
+  | Error errs ->
+      cctxt#warning "%a"
+        (Michelson_v1_error_reporter.report_errors
+           ~details:(not no_print_source)
+           ~show_source: (not no_print_source)
+           ?parsed:None) errs >>= fun () ->
+      cctxt#error "%s" msg >>= fun () ->
+      Lwt.return_none
+  | Ok data ->
+      Lwt.return_some data
+
+let file_parameter =
+  Clic.parameter (fun _ p ->
+      if not (Sys.file_exists p) then
+        failwith "File doesn't exist: '%s'" p
+      else
+        return p)
+
+let data_parameter =
+  Clic.parameter (fun _ data ->
+      Lwt.return (Micheline_parser.no_parsing_error
+                  @@ Michelson_v1_parser.parse_expression data))
+
+let non_negative_param =
+  Clic.parameter (fun _ s ->
+      match int_of_string_opt s with
+      | Some i when i >= 0 -> return i
+      | _ -> failwith "Parameter should be a non-negative integer literal")
+
+let block_hash_param =
+  Clic.parameter (fun _ s ->
+      try return (Block_hash.of_b58check_exn s)
+      with _ ->
+        failwith "Parameter '%s' is an invalid block hash" s)
+
+let group =
+  { Clic.name = "context" ;
+    title = "Block contextual commands (see option -block)" }
+
+let alphanet =
+  { Clic.name = "alphanet" ;
+    title = "Alphanet only commands" }
+
+let binary_description =
+  { Clic.name = "description" ;
+    title = "Binary Description" }
+
+let commands version () =
+  let open Clic in
+  [
+    command ~group ~desc: "Access the timestamp of the block."
+      (args1
+         (switch ~doc:"output time in seconds" ~short:'s' ~long:"seconds" ()))
+      (fixed [ "get" ; "timestamp" ])
+      begin fun seconds (cctxt : Proto_alpha.full) ->
+        Shell_services.Blocks.Header.shell_header
+          cctxt ~block:cctxt#block () >>=? fun { timestamp = v } ->
+        begin
+          if seconds
+          then cctxt#message "%Ld" (Time.to_seconds v)
+          else cctxt#message "%s" (Time.to_notation v)
+        end >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Lists all non empty contracts of the block."
+      no_options
+      (fixed [ "list" ; "contracts" ])
+      begin fun () (cctxt : Proto_alpha.full) ->
+        list_contract_labels cctxt
+          ~chain:`Main ~block:cctxt#block >>=? fun contracts ->
+        Lwt_list.iter_s
+          (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias)
+          contracts >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Get the balance of a contract."
+      no_options
+      (prefixes [ "get" ; "balance" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
+        get_balance cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? fun amount ->
+        cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Get the storage of a contract."
+      no_options
+      (prefixes [ "get" ; "script" ; "storage" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
+        get_storage cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? function
+        | None ->
+            cctxt#error "This is not a smart contract."
+        | Some storage ->
+            cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped storage >>= fun () ->
+            return_unit
+      end ;
+
+    command ~group ~desc: "Get the value associated to a key in the big map storage of a contract."
+      no_options
+      (prefixes [ "get" ; "big" ; "map" ; "value" ; "for" ]
+       @@ Clic.param ~name:"key" ~desc:"the key to look for"
+         data_parameter
+       @@ prefixes [ "of" ; "type" ]
+       @@ Clic.param ~name:"type" ~desc:"type of the key"
+         data_parameter
+       @@ prefix "in"
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () key key_type (_, contract) (cctxt : Proto_alpha.full) ->
+        get_big_map_value cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract (key.expanded, key_type.expanded) >>=? function
+        | None ->
+            cctxt#error "No value associated to this key."
+        | Some value ->
+            cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped value >>= fun () ->
+            return_unit
+      end ;
+
+    command ~group ~desc: "Get the storage of a contract."
+      no_options
+      (prefixes [ "get" ; "script" ; "code" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
+        get_script cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? function
+        | None ->
+            cctxt#error "This is not a smart contract."
+        | Some { code ; storage = _ } ->
+            match Script_repr.force_decode code with
+            | Error errs -> cctxt#error "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline Alpha_environment.Error_monad.pp) errs
+            | Ok (code, _) ->
+                let { Michelson_v1_parser.source } =
+                  Michelson_v1_printer.unparse_toplevel code in
+                cctxt#answer "%a" Format.pp_print_text source >>= return
+      end ;
+
+    command ~group ~desc: "Get the manager of a contract."
+      no_options
+      (prefixes [ "get" ; "manager" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
+        Client_proto_contracts.get_manager cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? fun manager ->
+        Public_key_hash.rev_find cctxt manager >>=? fun mn ->
+        Public_key_hash.to_source manager >>=? fun m ->
+        cctxt#message "%s (%s)" m
+          (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Get the delegate of a contract."
+      no_options
+      (prefixes [ "get" ; "delegate" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun () (_, contract) (cctxt : Proto_alpha.full) ->
+        Client_proto_contracts.get_delegate cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? function
+        | None ->
+            cctxt#message "none" >>= fun () ->
+            return_unit
+        | Some delegate ->
+            Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
+            Public_key_hash.to_source delegate >>=? fun m ->
+            cctxt#message "%s (%s)" m
+              (match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
+            return_unit
+      end ;
+
+    command ~group ~desc: "Set the delegate of a contract."
+      (args8
+         fee_arg dry_run_switch
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "set" ; "delegate" ; "for" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ prefix "to"
+       @@ Public_key_hash.alias_param
+         ~name: "mgr" ~desc: "new delegate of the contract"
+       @@ stop)
+      begin fun
+        (fee, dry_run, minimal_fees, minimal_nanotez_per_byte,
+         minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap)
+        (_, contract) (_, delegate) (cctxt : Proto_alpha.full) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? fun (src_pk, manager_sk) ->
+        set_delegate cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run
+          ~fee_parameter
+          ?fee
+          contract (Some delegate) ~src_pk ~manager_sk >>=? fun _ ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Withdraw the delegate from a contract."
+      (args8
+         fee_arg dry_run_switch
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "withdraw" ; "delegate" ; "from" ]
+       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+       @@ stop)
+      begin fun (fee, dry_run, minimal_fees, minimal_nanotez_per_byte,
+                 minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap)
+        (_, contract) (cctxt : Proto_alpha.full) ->
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          contract >>=? fun (src_pk, manager_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        set_delegate cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run
+          ~fee_parameter
+          contract None ?fee ~src_pk ~manager_sk >>=? fun _ ->
+        return_unit
+      end ;
+
+    command ~group ~desc:"Open a new account."
+      (args11 fee_arg dry_run_switch delegate_arg delegatable_switch (Client_keys.force_switch ())
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "originate" ; "account" ]
+       @@ RawContractAlias.fresh_alias_param
+         ~name: "new" ~desc: "name of the new contract"
+       @@ prefix "for"
+       @@ Public_key_hash.source_param
+         ~name: "mgr" ~desc: "manager of the new contract"
+       @@ prefix "transferring"
+       @@ tez_param
+         ~name: "qty" ~desc: "amount taken from source"
+       @@ prefix "from"
+       @@ ContractAlias.destination_param
+         ~name:"src" ~desc: "name of the source contract"
+       @@ stop)
+      begin fun (fee, dry_run, delegate, delegatable, force, minimal_fees, minimal_nanotez_per_byte,
+                 minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap)
+        new_contract manager_pkh balance (_, source) (cctxt : Proto_alpha.full) ->
+        RawContractAlias.of_fresh cctxt force new_contract >>=? fun alias_name ->
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          source >>=? fun (src_pk, src_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        originate_account cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run
+          ?fee ?delegate ~delegatable ~manager_pkh ~balance
+          ~fee_parameter
+          ~source ~src_pk ~src_sk () >>=? fun (_res, contract) ->
+        if dry_run then
+          return_unit
+        else
+          save_contract ~force cctxt alias_name contract >>=? fun () ->
+          return_unit
+      end ;
+
+    command ~group ~desc: "Launch a smart contract on the blockchain."
+      (args16
+         fee_arg
+         dry_run_switch gas_limit_arg storage_limit_arg delegate_arg (Client_keys.force_switch ())
+         delegatable_switch spendable_switch init_arg no_print_source_flag
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "originate" ; "contract" ]
+       @@ RawContractAlias.fresh_alias_param
+         ~name: "new" ~desc: "name of the new contract"
+       @@ prefix "for"
+       @@ Public_key_hash.source_param
+         ~name: "mgr" ~desc: "manager of the new contract"
+       @@ prefix "transferring"
+       @@ tez_param
+         ~name: "qty" ~desc: "amount taken from source"
+       @@ prefix "from"
+       @@ ContractAlias.destination_param
+         ~name:"src" ~desc: "name of the source contract"
+       @@ prefix "running"
+       @@ Program.source_param
+         ~name:"prg" ~desc: "script of the account\n\
+                             Combine with -init if the storage type is not unit."
+       @@ stop)
+      begin fun (fee, dry_run, gas_limit, storage_limit, delegate, force, delegatable, spendable, initial_storage, no_print_source, minimal_fees, minimal_nanotez_per_byte, minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap)
+        alias_name manager balance (_, source) program (cctxt : Proto_alpha.full) ->
+        RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
+        Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } ->
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          source >>=? fun (src_pk, src_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        originate_contract cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run
+          ?fee ?gas_limit ?storage_limit ~delegate ~delegatable ~spendable ~initial_storage
+          ~manager ~balance ~source ~src_pk ~src_sk ~code
+          ~fee_parameter
+          () >>= fun errors ->
+        report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function
+        | None -> return_unit
+        | Some (_res, contract) ->
+            if dry_run then
+              return_unit
+            else
+              save_contract ~force cctxt alias_name contract >>=? fun () ->
+              return_unit
+      end ;
+
+    command ~group ~desc: "Transfer tokens / call a smart contract."
+      (args13 fee_arg dry_run_switch gas_limit_arg storage_limit_arg counter_arg arg_arg no_print_source_flag
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "transfer" ]
+       @@ tez_param
+         ~name: "qty" ~desc: "amount taken from source"
+       @@ prefix "from"
+       @@ ContractAlias.destination_param
+         ~name: "src" ~desc: "name of the source contract"
+       @@ prefix "to"
+       @@ ContractAlias.destination_param
+         ~name: "dst" ~desc: "name/literal of the destination contract"
+       @@ stop)
+      begin fun (fee, dry_run, gas_limit, storage_limit, counter, arg, no_print_source, minimal_fees, minimal_nanotez_per_byte, minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap) amount (_, source) (_, destination) cctxt ->
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          source >>=? fun (src_pk, src_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        transfer cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run
+          ~fee_parameter
+          ~source ?fee ~src_pk ~src_sk ~destination ?arg ~amount ?gas_limit ?storage_limit ?counter () >>=
+        report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function
+        | None -> return_unit
+        | Some (_res, _contracts) ->
+            return_unit
+      end;
+
+    command ~group ~desc: "Reveal the public key of the contract manager."
+      (args7 fee_arg
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "reveal" ; "key" ; "for" ]
+       @@ ContractAlias.alias_param
+         ~name: "src" ~desc: "name of the source contract"
+       @@ stop)
+      begin fun (fee, minimal_fees, minimal_nanotez_per_byte,
+                 minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap) (_, source) cctxt ->
+        source_to_keys cctxt
+          ~chain:`Main ~block:cctxt#block
+          source >>=? fun (src_pk, src_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        reveal cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~source ?fee ~src_pk ~src_sk
+          ~fee_parameter
+          () >>=? fun _res ->
+        return_unit
+      end;
+
+    command ~group ~desc: "Register the public key hash as a delegate."
+      (args8 fee_arg dry_run_switch
+         minimal_fees_arg
+         minimal_nanotez_per_byte_arg
+         minimal_nanotez_per_gas_unit_arg
+         force_low_fee_arg
+         fee_cap_arg
+         burn_cap_arg)
+      (prefixes [ "register" ; "key" ]
+       @@ Public_key_hash.source_param
+         ~name: "mgr" ~desc: "the delegate key"
+       @@ prefixes [ "as" ; "delegate" ]
+       @@ stop)
+      begin fun (fee, dry_run, minimal_fees, minimal_nanotez_per_byte,
+                 minimal_nanotez_per_gas_unit, force_low_fee, fee_cap, burn_cap)  src_pkh cctxt ->
+        Client_keys.get_key cctxt src_pkh >>=? fun (_, src_pk, src_sk) ->
+        let fee_parameter = {
+          Injection.minimal_fees ;
+          minimal_nanotez_per_byte ;
+          minimal_nanotez_per_gas_unit ;
+          force_low_fee ;
+          fee_cap ;
+          burn_cap ;
+        } in
+        register_as_delegate cctxt
+          ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+          ~dry_run ~fee_parameter
+          ?fee ~manager_sk:src_sk src_pk
+        >>= function
+        | Ok _ -> return_unit
+        | Error (Alpha_environment.Ecoproto_error
+                   Proto_alpha.Proto.Delegate_storage.Active_delegate  :: []) ->
+            cctxt#message "Delegate already activated." >>= fun () ->
+            return_unit
+        | Error el -> Lwt.return (Error el)
+      end;
+  ] @
+  (if version = (Some `Mainnet) then [] else [
+      command ~group ~desc:"Register and activate an Alphanet/Zeronet faucet account."
+        (args2
+           (Secret_key.force_switch ())
+           encrypted_switch)
+        (prefixes [ "activate" ; "account" ]
+         @@ Secret_key.fresh_alias_param
+         @@ prefixes [ "with" ]
+         @@ param ~name:"activation_key"
+           ~desc:"Activate an Alphanet/Zeronet faucet account from the downloaded JSON file."
+           file_parameter
+         @@ stop)
+        (fun (force, encrypted) name activation_key_file cctxt ->
+           Secret_key.of_fresh cctxt force name >>=? fun name ->
+           Lwt_utils_unix.Json.read_file activation_key_file >>=? fun json ->
+           match Data_encoding.Json.destruct
+                   Client_proto_context.activation_key_encoding
+                   json with
+           | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
+               Format.kasprintf (fun s -> failwith "%s" s)
+                 "Invalid activation file: %a %a"
+                 (fun ppf -> Data_encoding.Json.print_error ppf) exn
+                 Data_encoding.Json.pp json
+           | key ->
+               activate_account cctxt
+                 ~chain:`Main ~block:cctxt#block ?confirmations:cctxt#confirmations
+                 ~encrypted ~force key name >>=? fun _res ->
+               return_unit
+        );
+    ]) @
+  (if version <> Some `Mainnet then [] else [
+      command ~group ~desc:"Activate a fundraiser account."
+        (args1 dry_run_switch)
+        (prefixes [ "activate" ; "fundraiser" ; "account" ]
+         @@ Public_key_hash.alias_param
+         @@ prefixes [ "with" ]
+         @@ param ~name:"code"
+           (Clic.parameter (fun _ctx code ->
+                protect (fun () ->
+                    return (Blinded_public_key_hash.activation_code_of_hex code))))
+           ~desc:"Activation code obtained from the Tezos foundation."
+         @@ stop)
+        (fun dry_run (name, _pkh) code cctxt ->
+           activate_existing_account cctxt ~chain:`Main
+             ~block:cctxt#block ?confirmations:cctxt#confirmations
+             ~dry_run
+             name code >>=? fun _res ->
+           return_unit
+        );
+    ]) @
+  [
+    command ~desc:"Wait until an operation is included in a block"
+      (args3
+         (default_arg
+            ~long:"confirmations"
+            ~placeholder:"num_blocks"
+            ~doc:"wait until 'N' additional blocks after the operation \
+                  appears in the considered chain"
+            ~default:"0"
+            non_negative_param)
+         (default_arg
+            ~long:"check-previous"
+            ~placeholder:"num_blocks"
+            ~doc:"number of previous blocks to check"
+            ~default:"10"
+            non_negative_param)
+         (arg
+            ~long:"branch"
+            ~placeholder:"block_hash"
+            ~doc:"hash of the oldest block where we should look for the operation"
+            block_hash_param))
+      (prefixes [ "wait" ; "for" ]
+       @@ param
+         ~name:"operation"
+         ~desc:"Operation to be included"
+         (parameter
+            (fun _ x ->
+               match Operation_hash.of_b58check_opt x with
+               | None -> Error_monad.failwith "Invalid operation hash: '%s'" x
+               | Some hash -> return hash))
+       @@ prefixes [ "to" ; "be" ; "included" ]
+       @@ stop)
+      begin fun (confirmations, predecessors, branch) operation_hash (ctxt : Proto_alpha.full) ->
+        Client_confirmations.wait_for_operation_inclusion ctxt
+          ~chain:`Main ~confirmations ~predecessors ?branch operation_hash >>=? fun _ ->
+        return_unit
+      end ;
+
+    command ~desc:"Get receipt for past operation"
+      (args1
+         (default_arg
+            ~long:"check-previous"
+            ~placeholder:"num_blocks"
+            ~doc:"number of previous blocks to check"
+            ~default:"10"
+            non_negative_param))
+      (prefixes [ "get" ; "receipt"; "for" ]
+       @@ param
+         ~name:"operation"
+         ~desc:"Operation to be looked up"
+         (parameter
+            (fun _ x ->
+               match Operation_hash.of_b58check_opt x with
+               | None -> Error_monad.failwith "Invalid operation hash: '%s'" x
+               | Some hash -> return hash))
+       @@ stop)
+      begin fun predecessors operation_hash (ctxt : Proto_alpha.full) ->
+        display_receipt_for_operation ctxt
+          ~chain:`Main ~predecessors operation_hash >>=? fun _ ->
+        return_unit
+      end ;
+
+    command ~group:binary_description ~desc:"Describe unsigned block header"
+      no_options
+      (fixed [ "describe" ; "unsigned" ; "block" ; "header" ])
+      begin fun () (cctxt : Proto_alpha.full) ->
+        cctxt#message "%a"
+          Data_encoding.Binary_schema.pp
+          (Data_encoding.Binary.describe
+             (Alpha_context.Block_header.unsigned_encoding)) >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group:binary_description ~desc:"Describe unsigned block header"
+      no_options
+      (fixed [ "describe" ; "unsigned" ; "operation" ])
+      begin fun () (cctxt : Proto_alpha.full) ->
+        cctxt#message "%a"
+          Data_encoding.Binary_schema.pp
+          (Data_encoding.Binary.describe
+             Alpha_context.Operation.unsigned_encoding) >>= fun () ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Submit protocol proposals"
+      no_options
+      (prefixes [ "submit" ; "proposals" ; "for" ]
+       @@ ContractAlias.destination_param
+         ~name: "delegate"
+         ~desc: "the delegate who makes the proposal"
+       @@ seq_of_param
+         (param
+            ~name:"proposal"
+            ~desc:"the protocol hash proposal to be submitted"
+            (parameter
+               (fun _ x ->
+                  match Protocol_hash.of_b58check_opt x with
+                  | None -> Error_monad.failwith "Invalid proposal hash: '%s'" x
+                  | Some hash -> return hash))))
+      begin fun () (_name, source) proposals (cctxt : Proto_alpha.full) ->
+        get_period_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun info ->
+        begin match info.current_period_kind with
+          | Proposal -> return_unit
+          | _ -> cctxt#error "Not in a proposal period"
+        end >>=? fun () ->
+        Shell_services.Protocol.list cctxt >>=? fun known_protos ->
+        get_proposals ~chain:`Main ~block:cctxt#block cctxt >>=? fun known_proposals ->
+        (* for a proposal to be valid it must either a protocol that was already
+           proposed by somebody else or a protocol known by the node, because
+           the user is the first proposer and just injected it with
+           tezos-admin-client *)
+        let check_proposals proposals : bool tzresult Lwt.t =
+          let n = List.length proposals in
+          if n = 0 then cctxt#error "Empty proposal"
+          else if n > Constants.fixed.max_proposals_per_delegate then
+            cctxt#error "Too many proposals"
+          else
+            fold_left_s (fun acc (p : Protocol_hash.t) ->
+                if (List.mem p known_protos) ||
+                   (Alpha_environment.Protocol_hash.Map.mem p known_proposals)
+                then return acc
+                else cctxt#message "Protocol %a is not a known proposal"
+                    Protocol_hash.pp p >>= fun () ->
+                  return false)
+              true proposals
+        in
+        check_proposals proposals >>=? fun all_valid ->
+        begin if all_valid then
+            cctxt#message "All proposals are valid"
+          else
+            cctxt#error "Submission failed because of invalid proposals"
+        end >>= fun () ->
+        Client_proto_context.get_manager
+          cctxt ~chain:`Main ~block:cctxt#block
+          source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
+        submit_proposals cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh
+          proposals >>=? fun _res ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Submit a ballot"
+      no_options
+      (prefixes [ "submit" ; "ballot" ; "for" ]
+       @@ ContractAlias.destination_param
+         ~name: "delegate"
+         ~desc: "the delegate who votes"
+       @@ param
+         ~name:"proposal"
+         ~desc:"the protocol hash proposal to vote for"
+         (parameter
+            (fun _ x ->
+               match Protocol_hash.of_b58check_opt x with
+               | None -> failwith "Invalid proposal hash: '%s'" x
+               | Some hash -> return hash))
+       @@ param
+         ~name:"ballot"
+         ~desc:"the ballot value (yay, nay or pass)"
+         (parameter
+            ~autocomplete: (fun _ -> return [ "yea" ; "nay" ; "pass" ])
+            (fun _ s -> (* We should have [Vote.of_string]. *)
+               match String.lowercase_ascii s with
+               | "yay" | "yea" -> return Vote.Yay
+               | "nay" -> return Vote.Nay
+               | "pass" -> return Vote.Pass
+               | s -> failwith "Invalid ballot: '%s'" s))
+       @@ stop)
+      begin fun () (_name, source) proposal ballot (cctxt : Proto_alpha.full) ->
+        get_period_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun info ->
+        begin match info.current_period_kind with
+          | Testing_vote | Promotion_vote -> return_unit
+          | _ -> cctxt#error "Not in a Testing_vote or Promotion_vote period"
+        end >>=? fun () ->
+        Client_proto_context.get_manager
+          cctxt ~chain:`Main ~block:cctxt#block
+          source >>=? fun (_src_name, src_pkh, _src_pk, src_sk) ->
+        submit_ballot cctxt ~chain:`Main ~block:cctxt#block ~src_sk src_pkh
+          proposal ballot >>=? fun _res ->
+        return_unit
+      end ;
+
+    command ~group ~desc: "Summarize the current voting period"
+      no_options
+      (fixed [ "show" ; "voting" ; "period" ])
+      begin fun () (cctxt : Proto_alpha.full) ->
+        get_period_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun info ->
+        cctxt#message "Current period: %a\n\
+                       Blocks remaining until end of period: %ld"
+          Data_encoding.Json.pp
+          (Data_encoding.Json.construct
+             Proto_alpha.Alpha_context.Voting_period.kind_encoding
+             info.current_period_kind)
+          info.remaining >>= fun () ->
+        get_proposals ~chain:`Main ~block:cctxt#block cctxt >>=? fun props ->
+        let ranks = Alpha_environment.Protocol_hash.Map.bindings props |>
+                    List.sort (fun (_,v1) (_,v2) -> Int32.(compare v2 v1)) in
+        let print_proposal = function
+          | None -> assert false (* not called during proposal phase *)
+          | Some proposal -> cctxt#message "Current proposal: %a"
+                               Protocol_hash.pp proposal
+        in
+        match info.current_period_kind with
+        | Proposal ->
+            (* TODO improve printing of proposals *)
+            let proposals_string =
+              if List.length ranks = 0 then " none" else
+                List.fold_left (fun acc (p,w) ->
+                    Format.asprintf "%s\n%a %ld" acc Protocol_hash.pp p w) "" ranks
+            in
+            cctxt#answer "Current proposals:%s" proposals_string
+            >>= fun () -> return_unit
+        | Testing_vote | Promotion_vote ->
+            print_proposal info.current_proposal >>= fun () ->
+            get_ballots_info ~chain:`Main ~block:cctxt#block cctxt >>=? fun ballots_info ->
+            cctxt#answer "Ballots: %a@,\
+                          Current participation %.2f%%, necessary quorum %.2f%%@,\
+                          Current in favor %ld, needed supermajority %ld"
+              Data_encoding.Json.pp (Data_encoding.Json.construct
+                                       Vote.ballots_encoding ballots_info.ballots)
+              (Int32.to_float ballots_info.participation /. 100.)
+              (Int32.to_float ballots_info.current_quorum /. 100.)
+              ballots_info.ballots.yay
+              ballots_info.supermajority
+            >>= fun () -> return_unit
+        | Testing -> print_proposal info.current_proposal >>= fun () ->
+            return_unit
+      end ;
+
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml
new file mode 100644
index 000000000..30135536e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_contracts_commands.ml
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Client_proto_contracts
+
+let group =
+  { Clic.name = "contracts" ;
+    title = "Commands for managing the record of known contracts" }
+
+let commands  () =
+  let open Clic in
+  [
+
+    command ~group ~desc: "Add a contract to the wallet."
+      (args1 (RawContractAlias.force_switch ()))
+      (prefixes [ "remember" ; "contract" ]
+       @@ RawContractAlias.fresh_alias_param
+       @@ RawContractAlias.source_param
+       @@ stop)
+      (fun force name hash cctxt ->
+         RawContractAlias.of_fresh cctxt force name >>=? fun name ->
+         RawContractAlias.add ~force cctxt name hash) ;
+
+    command ~group ~desc: "Remove a contract from the wallet."
+      no_options
+      (prefixes [ "forget" ; "contract" ]
+       @@ RawContractAlias.alias_param
+       @@ stop)
+      (fun () (name, _) cctxt ->
+         RawContractAlias.del cctxt name) ;
+
+    command ~group ~desc: "Lists all known contracts in the wallet."
+      no_options
+      (fixed [ "list" ; "known" ; "contracts" ])
+      (fun () (cctxt : Proto_alpha.full) ->
+         list_contracts cctxt >>=? fun contracts ->
+         iter_s
+           (fun (prefix, alias, contract) ->
+              cctxt#message "%s%s: %s" prefix alias
+                (Contract.to_b58check contract) >>= return)
+           contracts) ;
+
+    command ~group ~desc: "Forget the entire wallet of known contracts."
+      (args1 (RawContractAlias.force_switch ()))
+      (fixed [ "forget" ; "all" ; "contracts" ])
+      (fun force cctxt ->
+         fail_unless
+           force
+           (failure "this can only used with option -force") >>=? fun () ->
+         RawContractAlias.set cctxt []) ;
+
+    command ~group ~desc: "Display a contract from the wallet."
+      no_options
+      (prefixes [ "show" ; "known" ; "contract" ]
+       @@ RawContractAlias.alias_param
+       @@ stop)
+      (fun () (_, contract) (cctxt : Proto_alpha.full) ->
+         cctxt#message "%a\n%!" Contract.pp contract >>= fun () ->
+         return_unit) ;
+
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
new file mode 100644
index 000000000..016ffde84
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.ml
@@ -0,0 +1,321 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let group =
+  { Clic.name = "scripts" ;
+    title = "Commands for managing the library of known scripts" }
+
+open Tezos_micheline
+open Client_proto_programs
+open Client_proto_args
+
+let commands () =
+  let open Clic in
+  let show_types_switch =
+    switch
+      ~long:"details"
+      ~short:'v'
+      ~doc:"show the types of each instruction"
+      () in
+  let emacs_mode_switch =
+    switch
+      ~long:"emacs"
+      ?short:None
+      ~doc:"output in `michelson-mode.el` compatible format"
+      () in
+  let trace_stack_switch =
+    switch
+      ~long:"trace-stack"
+      ~doc:"show the stack after each step"
+      () in
+  let amount_arg =
+    Client_proto_args.tez_arg
+      ~parameter:"amount"
+      ~doc:"amount of the transfer in \xEA\x9C\xA9"
+      ~default:"0.05" in
+  let custom_gas_flag =
+    arg
+      ~long:"gas"
+      ~short:'G'
+      ~doc:"Initial quantity of gas for typechecking and execution"
+      ~placeholder:"gas"
+      (parameter (fun _ctx str ->
+           try
+             let v = Z.of_string str in
+             assert Compare.Z.(v >= Z.zero) ;
+             return v
+           with _ -> failwith "invalid gas limit (must be a positive number)")) in
+  let resolve_max_gas cctxt block = function
+    | None ->
+        Alpha_services.Constants.all cctxt
+          (`Main, block) >>=? fun { parametric = {
+            hard_gas_limit_per_operation
+          } } ->
+        return hard_gas_limit_per_operation
+    | Some gas -> return gas in
+  let data_parameter =
+    Clic.parameter (fun _ data ->
+        Lwt.return (Micheline_parser.no_parsing_error
+                    @@ Michelson_v1_parser.parse_expression data)) in
+  let bytes_parameter ~name ~desc =
+    Clic.param ~name ~desc
+      (parameter (fun (_cctxt : full) s ->
+           try
+             if String.length s < 2
+             || s.[0] <> '0' || s.[1] <> 'x' then
+               raise Exit
+             else
+               return (MBytes.of_hex (`Hex (String.sub s 2 (String.length s - 2))))
+           with _ ->
+             failwith "Invalid bytes, expecting hexadecimal \
+                       notation (e.g. 0x1234abcd)" )) in
+  let signature_parameter =
+    Clic.parameter
+      (fun _cctxt s ->
+         match Signature.of_b58check_opt s with
+         | Some s -> return s
+         | None -> failwith "Not given a valid signature") in
+  [
+
+    command ~group ~desc: "Lists all scripts in the library."
+      no_options
+      (fixed [ "list" ; "known" ; "scripts" ])
+      (fun () (cctxt : Proto_alpha.full) ->
+         Program.load cctxt >>=? fun list ->
+         Lwt_list.iter_s (fun (n, _) -> cctxt#message "%s" n) list >>= fun () ->
+         return_unit) ;
+
+    command ~group ~desc: "Add a script to the library."
+      (args1 (Program.force_switch ()))
+      (prefixes [ "remember" ; "script" ]
+       @@ Program.fresh_alias_param
+       @@ Program.source_param
+       @@ stop)
+      (fun force name hash cctxt ->
+         Program.of_fresh cctxt force name >>=? fun name ->
+         Program.add ~force cctxt name hash) ;
+
+    command ~group ~desc: "Remove a script from the library."
+      no_options
+      (prefixes [ "forget" ; "script" ]
+       @@ Program.alias_param
+       @@ stop)
+      (fun () (name, _) cctxt -> Program.del cctxt name) ;
+
+    command ~group ~desc: "Display a script from the library."
+      no_options
+      (prefixes [ "show" ; "known" ; "script" ]
+       @@ Program.alias_param
+       @@ stop)
+      (fun () (_, program) (cctxt : Proto_alpha.full) ->
+         Program.to_source program >>=? fun source ->
+         cctxt#message "%s\n" source >>= fun () ->
+         return_unit) ;
+
+    command ~group ~desc: "Ask the node to run a script."
+      (args3 trace_stack_switch amount_arg no_print_source_flag)
+      (prefixes [ "run" ; "script" ]
+       @@ Program.source_param
+       @@ prefixes [ "on" ; "storage" ]
+       @@ Clic.param ~name:"storage" ~desc:"the storage data"
+         data_parameter
+       @@ prefixes [ "and" ; "input" ]
+       @@ Clic.param ~name:"storage" ~desc:"the input data"
+         data_parameter
+       @@ stop)
+      (fun (trace_exec, amount, no_print_source) program storage input cctxt ->
+         Lwt.return @@ Micheline_parser.no_parsing_error program >>=? fun program ->
+         let show_source = not no_print_source in
+         (if trace_exec then
+            trace cctxt cctxt#block ~amount ~program ~storage ~input () >>= fun res ->
+            print_trace_result cctxt ~show_source ~parsed:program res
+          else
+            run cctxt cctxt#block ~amount ~program ~storage ~input () >>= fun res ->
+            print_run_result cctxt ~show_source ~parsed:program res)) ;
+    command ~group ~desc: "Ask the node to typecheck a script."
+      (args4 show_types_switch emacs_mode_switch no_print_source_flag custom_gas_flag)
+      (prefixes [ "typecheck" ; "script" ]
+       @@ Program.source_param
+       @@ stop)
+      (fun (show_types, emacs_mode, no_print_source, original_gas) program cctxt ->
+         match program with
+         | program, [] ->
+             resolve_max_gas cctxt cctxt#block original_gas >>=? fun original_gas ->
+             typecheck_program cctxt cctxt#block ~gas:original_gas program >>= fun res ->
+             print_typecheck_result
+               ~emacs:emacs_mode
+               ~show_types
+               ~print_source_on_error:(not no_print_source)
+               program
+               res
+               cctxt
+         | res_with_errors when emacs_mode ->
+             cctxt#message
+               "(@[<v 0>(types . ())@ (errors . %a)@])"
+               Michelson_v1_emacs.report_errors res_with_errors >>= fun () ->
+             return_unit
+         | (parsed, errors) ->
+             cctxt#message "%a"
+               (fun ppf () ->
+                  Michelson_v1_error_reporter.report_errors
+                    ~details:(not no_print_source) ~parsed
+                    ~show_source:(not no_print_source)
+                    ppf errors) () >>= fun () ->
+             cctxt#error "syntax error in program"
+      ) ;
+
+    command ~group ~desc: "Ask the node to typecheck a data expression."
+      (args2 no_print_source_flag custom_gas_flag)
+      (prefixes [ "typecheck" ; "data" ]
+       @@ Clic.param ~name:"data" ~desc:"the data to typecheck"
+         data_parameter
+       @@ prefixes [ "against" ; "type" ]
+       @@ Clic.param ~name:"type" ~desc:"the expected type"
+         data_parameter
+       @@ stop)
+      (fun (no_print_source, custom_gas) data ty cctxt ->
+         resolve_max_gas cctxt cctxt#block custom_gas >>=? fun original_gas ->
+         Client_proto_programs.typecheck_data cctxt cctxt#block
+           ~gas:original_gas ~data ~ty () >>= function
+         | Ok gas ->
+             cctxt#message "@[<v 0>Well typed@,Gas remaining: %a@]"
+               Proto_alpha.Alpha_context.Gas.pp gas >>= fun () ->
+             return_unit
+         | Error errs ->
+             cctxt#warning "%a"
+               (Michelson_v1_error_reporter.report_errors
+                  ~details:false
+                  ~show_source:(not no_print_source)
+                  ?parsed:None) errs >>= fun () ->
+             cctxt#error "ill-typed data") ;
+
+    command ~group
+      ~desc: "Ask the node to pack a data expression.\n\
+              The returned hash is the same as what Michelson \
+              instruction `PACK` would have produced.\n\
+              Also displays the result of hashing this packed data \
+              with `BLAKE2B`, `SHA256` or `SHA512` instruction."
+      (args1 custom_gas_flag)
+      (prefixes [ "hash" ; "data" ]
+       @@ Clic.param ~name:"data" ~desc:"the data to hash"
+         data_parameter
+       @@ prefixes [ "of" ; "type" ]
+       @@ Clic.param ~name:"type" ~desc:"type of the data"
+         data_parameter
+       @@ stop)
+      (fun custom_gas data typ cctxt ->
+         resolve_max_gas cctxt cctxt#block custom_gas >>=? fun original_gas ->
+         Alpha_services.Helpers.Scripts.pack_data cctxt (`Main, cctxt#block)
+           (data.expanded, typ.expanded, Some original_gas) >>= function
+         | Ok (bytes, remaining_gas) ->
+             let hash = Script_expr_hash.hash_bytes [ bytes ] in
+             cctxt#message
+               "Raw packed data: 0x%a@,\
+                Hash: %a@,\
+                Raw Blake2b hash: 0x%a@,\
+                Raw Sha256 hash: 0x%a@,\
+                Raw Sha512 hash: 0x%a@,\
+                Gas remaining: %a"
+               MBytes.pp_hex bytes
+               Script_expr_hash.pp hash
+               MBytes.pp_hex (Script_expr_hash.to_bytes hash)
+               MBytes.pp_hex (Alpha_environment.Raw_hashes.sha256 bytes)
+               MBytes.pp_hex (Alpha_environment.Raw_hashes.sha512 bytes)
+               Proto_alpha.Alpha_context.Gas.pp remaining_gas >>= fun () ->
+             return_unit
+         | Error errs ->
+             cctxt#warning "%a"
+               (Michelson_v1_error_reporter.report_errors
+                  ~details:false
+                  ~show_source:false
+                  ?parsed:None)
+               errs  >>= fun () ->
+             cctxt#error "ill-formed data") ;
+
+    command ~group
+      ~desc: "Parse a byte sequence (in hexadecimal notation) as a \
+              data expression, as per Michelson instruction `UNPACK`."
+      Clic.no_options
+      (prefixes [ "unpack" ; "michelson" ; "data" ]
+       @@ bytes_parameter ~name:"bytes" ~desc:"the packed data to parse"
+       @@ stop)
+      (fun () bytes cctxt ->
+         begin
+           if MBytes.get bytes 0 != '\005' then
+             failwith "Not a piece of packed Michelson data (must start with `0x05`)"
+           else return_unit
+         end >>=? fun () ->
+         (* Remove first byte *)
+         let bytes = MBytes.sub bytes 1 ((MBytes.length bytes) - 1) in
+         match Data_encoding.Binary.of_bytes Alpha_context.Script.expr_encoding bytes with
+         | None -> failwith "Could not decode bytes"
+         | Some expr ->
+             begin
+               cctxt#message "%a" Michelson_v1_printer.print_expr_unwrapped expr >>= fun () ->
+               return_unit
+             end) ;
+
+    command ~group
+      ~desc: "Sign a raw sequence of bytes and display it using the \
+              format expected by Michelson instruction \
+              `CHECK_SIGNATURE`."
+      no_options
+      (prefixes [ "sign" ; "bytes" ]
+       @@ bytes_parameter ~name:"data" ~desc:"the raw data to sign"
+       @@ prefixes [ "for" ]
+       @@ Client_keys.Secret_key.source_param
+       @@ stop)
+      (fun () bytes sk cctxt ->
+         Client_keys.sign cctxt sk bytes >>=? fun signature ->
+         cctxt#message "Signature: %a" Signature.pp signature >>= fun () ->
+         return_unit) ;
+
+    command ~group
+      ~desc: "Check the signature of a byte sequence as per Michelson \
+              instruction `CHECK_SIGNATURE`."
+      (args1 (switch ~doc:"Use only exit codes" ~short:'q' ~long:"quiet" ()))
+      (prefixes [ "check" ; "that" ]
+       @@ bytes_parameter ~name:"bytes" ~desc:"the signed data"
+       @@ prefixes [ "was" ; "signed" ; "by" ]
+       @@ Client_keys.Public_key.alias_param
+         ~name:"key"
+       @@ prefixes [ "to" ; "produce" ]
+       @@ Clic.param ~name:"signature" ~desc:"the signature to check"
+         signature_parameter
+       @@ stop)
+      (fun quiet bytes (_, (key_locator, _)) signature (cctxt : #Proto_alpha.full) ->
+         Client_keys.check key_locator signature bytes >>=? function
+         | false -> cctxt#error "invalid signature"
+         | true ->
+             if quiet then
+               return_unit
+             else
+               cctxt#message "Signature check successfull." >>= fun () ->
+               return_unit
+      ) ;
+
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.mli b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.mli
new file mode 100644
index 000000000..99058dcb5
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/client_proto_programs_commands.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 commands: unit -> Proto_alpha.full Clic.command list
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/dune b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/dune
new file mode 100644
index 000000000..15455bedb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/dune
@@ -0,0 +1,52 @@
+(library
+ (name tezos_client_alpha_commands)
+ (public_name tezos-client-alpha-commands)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-alpha
+            tezos-client-commands
+            tezos-rpc)
+ (library_flags (:standard -linkall))
+ (modules (:standard \ alpha_commands_registration))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_rpc)))
+
+(library
+ (name tezos_client_alpha_commands_registration)
+ (public_name tezos-client-alpha-commands.registration)
+ (libraries tezos-base
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-alpha
+            tezos-client-commands
+            tezos-client-alpha-commands
+            tezos-rpc)
+ (library_flags (:standard -linkall))
+ (modules alpha_commands_registration)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_client_alpha_commands
+                   -open Tezos_rpc)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam
new file mode 100644
index 000000000..bc50bfd23
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-alpha"
+  "tezos-client-commands"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.ml
new file mode 100644
index 000000000..1c201f7cd
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.ml
@@ -0,0 +1,113 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Logging
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.blocks" end)
+
+type block_info = {
+  hash: Block_hash.t ;
+  chain_id: Chain_id.t ;
+  predecessor: Block_hash.t ;
+  fitness: MBytes.t list ;
+  timestamp: Time.t ;
+  protocol: Protocol_hash.t ;
+  next_protocol: Protocol_hash.t ;
+  proto_level: int ;
+  level: Raw_level.t ;
+  context : Context_hash.t ;
+}
+
+let raw_info cctxt ?(chain = `Main) hash shell_header =
+  let block = `Hash (hash, 0) in
+  Shell_services.Chain.chain_id cctxt ~chain () >>=? fun chain_id ->
+  Shell_services.Blocks.protocols
+    cctxt ~chain ~block () >>=? fun { current_protocol = protocol ;
+                                      next_protocol } ->
+  let { Tezos_base.Block_header.predecessor ; fitness ;
+        timestamp ; level ; context ; proto_level ; _ } =
+    shell_header in
+  match Raw_level.of_int32 level with
+  | Ok level ->
+      return { hash ; chain_id ; predecessor ; fitness ;
+               timestamp ; protocol ; next_protocol ; proto_level ; level ; context }
+  | Error _ ->
+      failwith "Cannot convert level into int32"
+
+let info cctxt ?(chain = `Main) block =
+  Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
+  Shell_services.Blocks.Header.shell_header
+    cctxt ~chain ~block () >>=? fun shell_header  ->
+  raw_info cctxt ~chain hash shell_header
+
+let monitor_valid_blocks cctxt ?chains ?protocols ~next_protocols () =
+  Monitor_services.valid_blocks cctxt
+    ?chains ?protocols ?next_protocols () >>=? fun (block_stream, _stop) ->
+  return (Lwt_stream.map_s
+            (fun ((chain, block), data) ->
+               log_info Tag.DSL.(fun f ->
+                   f "Saw block %a on chain %a"
+                   -% t event "monitor_saw_valid_block"
+                   -% a Block_hash.Logging.tag block
+                   -% a State_logging.chain_id chain
+                   -% t block_header_tag data) ;
+               raw_info cctxt ~chain:(`Hash chain) block data.Tezos_base.Block_header.shell)
+            block_stream)
+
+let monitor_heads cctxt ~next_protocols chain =
+  Monitor_services.heads
+    cctxt ?next_protocols chain >>=? fun (block_stream, _stop) ->
+  return (Lwt_stream.map_s
+            (fun (block, data) ->
+               log_info Tag.DSL.(fun f ->
+                   f "Saw head %a"
+                   -% t event "monitor_saw_head"
+                   -% a Block_hash.Logging.tag block
+                   -% t block_header_tag data) ;
+               raw_info cctxt ~chain block data.Tezos_base.Block_header.shell)
+            block_stream)
+
+let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () =
+  Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
+  Shell_services.Blocks.Header.shell_header
+    cctxt ~chain ~block () >>=? fun { level } ->
+  Alpha_services.Helpers.levels_in_current_cycle
+    cctxt ~offset (chain, block) >>= function
+  | Error [RPC_context.Not_found _] ->
+      return_nil
+  | Error _ as err -> Lwt.return err
+  | Ok (first, last) ->
+      let length = Int32.to_int (Int32.sub level (Raw_level.to_int32 first)) in
+      Shell_services.Blocks.list cctxt ~heads:[hash] ~length () >>=? fun blocks ->
+      let blocks =
+        List.remove
+          (length - (Int32.to_int (Raw_level.diff last first)))
+          (List.hd blocks) in
+      if Int32.equal level (Raw_level.to_int32 last) then
+        return (hash :: blocks)
+      else
+        return blocks
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.mli
new file mode 100644
index 000000000..b92795bda
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_blocks.mli
@@ -0,0 +1,67 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type block_info = {
+  hash: Block_hash.t ;
+  chain_id: Chain_id.t ;
+  predecessor: Block_hash.t ;
+  fitness: MBytes.t list ;
+  timestamp: Time.t ;
+  protocol: Protocol_hash.t ;
+  next_protocol: Protocol_hash.t ;
+  proto_level: int ;
+  level: Raw_level.t ;
+  context : Context_hash.t ;
+}
+
+val info:
+  #Proto_alpha.rpc_context ->
+  ?chain:Chain_services.chain ->
+  Block_services.block ->
+  block_info tzresult Lwt.t
+
+val monitor_valid_blocks:
+  #Proto_alpha.rpc_context ->
+  ?chains:Chain_services.chain list ->
+  ?protocols:Protocol_hash.t list ->
+  next_protocols:Protocol_hash.t list option ->
+  unit -> block_info tzresult Lwt_stream.t tzresult Lwt.t
+
+val monitor_heads:
+  #Proto_alpha.rpc_context ->
+  next_protocols:Protocol_hash.t list option ->
+  Chain_services.chain ->
+  block_info tzresult Lwt_stream.t tzresult Lwt.t
+
+val blocks_from_current_cycle:
+  #Proto_alpha.rpc_context ->
+  ?chain:Chain_services.chain ->
+  Block_services.block ->
+  ?offset:int32 ->
+  unit ->
+  Block_hash.t list tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.ml
new file mode 100644
index 000000000..162cc4968
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.ml
@@ -0,0 +1,284 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.denunciation" end)
+
+open Proto_alpha
+open Alpha_context
+
+open Client_baking_blocks
+open Logging
+
+module HLevel = Hashtbl.Make(struct
+    include Raw_level
+    let hash lvl = Int32.to_int (to_int32 lvl)
+  end)
+
+module Delegate_Map = Map.Make(Signature.Public_key_hash)
+
+type state = {
+  (* Endorsements seen so far *)
+  endorsements_table : Kind.endorsement operation Delegate_Map.t HLevel.t ;
+  (* Blocks received so far *)
+  blocks_table : Block_hash.t Delegate_Map.t HLevel.t ;
+  (* Maximum delta of level to register *)
+  preserved_levels : int ;
+  (* Highest level seen in a block *)
+  mutable highest_level_encountered : Raw_level.t ;
+}
+
+let create_state ~preserved_levels =
+  Lwt.return { endorsements_table = HLevel.create preserved_levels ;
+               blocks_table = HLevel.create preserved_levels ;
+               preserved_levels ;
+               highest_level_encountered = Raw_level.root (* 0l *) }
+
+(* get the delegate that had the right to bake for a specific level/slot *)
+let fetch_baker (cctxt : #Proto_alpha.full) ~chain ~block =
+  Alpha_block_services.metadata cctxt ~chain ~block () >>=? fun
+    { protocol_data = { Apply_results.baker  } } ->
+  return baker
+
+(* We choose a previous offset (5 blocks from head) to ensure that the
+   injected operation is branched from a valid predecessor. *)
+let get_block_offset level =
+  match Alpha_environment.wrap_error (Raw_level.of_int32 5l) with
+  | Ok min_level ->
+      Lwt.return
+        (if Raw_level.(level < min_level) then
+           `Head 0
+         else
+           `Head 5)
+  | Error errs ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "Invalid level conversion : %a"
+          -% t event "invalid_level_conversion"
+          -% a errs_tag errs) >>= fun () ->
+      Lwt.return (`Head 0)
+
+let process_endorsements (cctxt : #Proto_alpha.full) state ~chain
+    (endorsements : Alpha_block_services.operation list) level =
+  iter_s (fun { Alpha_block_services.shell ; receipt ; hash ; protocol_data ; _ } ->
+      match protocol_data, receipt with
+      | (Operation_data ({ contents = Single (Endorsement _) ; _ } as protocol_data)),
+        Apply_results.(
+          Operation_metadata { contents = Single_result (Endorsement_result { delegate ; _ }) }) ->
+          let new_endorsement : Kind.endorsement Alpha_context.operation = { shell ; protocol_data } in
+          let map = match HLevel.find_opt state.endorsements_table level with
+            | None -> Delegate_Map.empty
+            | Some x -> x in
+          (* If a previous endorsement made by this pkh is found for
+             the same level we inject a double_endorsement *)
+          begin match Delegate_Map.find_opt delegate map with
+            | None -> return @@ HLevel.add state.endorsements_table level
+                  (Delegate_Map.add delegate new_endorsement map)
+            | Some existing_endorsement when
+                Block_hash.(existing_endorsement.shell.branch <> new_endorsement.shell.branch) ->
+                get_block_offset level >>= fun block ->
+                (* TODO : verify that the chains are coherent *)
+                Alpha_block_services.hash cctxt ~chain:`Main ~block () >>=? fun block_hash ->
+                Alpha_services.Forge.double_endorsement_evidence
+                  cctxt (`Main, block) ~branch:block_hash
+                  ~op1:existing_endorsement
+                  ~op2:new_endorsement () >>=? fun bytes ->
+                let bytes = Signature.concat bytes Signature.zero in
+                lwt_log_notice Tag.DSL.(fun f ->
+                    f "Double endorsement detected"
+                    -% t event "double_endorsement_detected"
+                    -% t conflicting_endorsements_tag (existing_endorsement, new_endorsement)) >>= fun () ->
+                (* A denunciation may have already occured *)
+                Shell_services.Injection.operation cctxt ~chain bytes >>=? fun op_hash ->
+                lwt_log_notice Tag.DSL.(fun f ->
+                    f "Double endorsement evidence injected %a"
+                    -% t event "double_endorsement_denounced"
+                    -% t signed_operation_tag bytes
+                    -% a Operation_hash.Logging.tag op_hash) >>= fun () ->
+                return @@ HLevel.replace state.endorsements_table level
+                  (Delegate_Map.add delegate new_endorsement map)
+            | Some _ ->
+                (* This endorsement is already present in another
+                   block but endorse the same predecessor *)
+                return_unit
+          end
+      | _ ->
+          lwt_log_error Tag.DSL.(fun f ->
+              f "Inconsistent endorsement found %a"
+              -% t event "inconsistent_endorsement"
+              -% a Operation_hash.Logging.tag hash) >>= fun () ->
+          return_unit
+    ) endorsements >>=? fun () ->
+  return_unit
+
+let process_block (cctxt : #Proto_alpha.full) state ~chain (header : Alpha_block_services.block_info) =
+  let { Alpha_block_services.hash ; metadata = { protocol_data = { baker ; level = { level } } } } = header in
+  let map = match HLevel.find_opt state.blocks_table level with
+    | None -> Delegate_Map.empty
+    | Some x -> x in
+  begin match Delegate_Map.find_opt baker map with
+    | None -> return @@ HLevel.add state.blocks_table level
+          (Delegate_Map.add baker hash map)
+    | Some existing_hash when Block_hash.(=) existing_hash hash ->
+        (* This case should never happen *)
+        lwt_debug Tag.DSL.(fun f -> f "Double baking detected but block hashes are equivalent. Skipping..." -% t event "double_baking_but_not") >>= fun () ->
+        return @@ HLevel.replace state.blocks_table level
+          (Delegate_Map.add baker hash map)
+    | Some existing_hash ->
+        (* If a previous endorsement made by this pkh is found for
+           the same level we inject a double_endorsement *)
+        (* TODO : verify that the chains are coherent *)
+        Alpha_block_services.header cctxt ~chain ~block:(`Hash (existing_hash, 0)) () >>=?
+        fun ( { shell ; protocol_data } : Alpha_block_services.block_header) ->
+        let bh1 = { Alpha_context.Block_header.shell = shell ; protocol_data = protocol_data } in
+        Alpha_block_services.header cctxt ~chain ~block:(`Hash (hash, 0)) () >>=?
+        fun ( { shell ; protocol_data } : Alpha_block_services.block_header) ->
+        let bh2 = { Alpha_context.Block_header.shell = shell ; protocol_data = protocol_data } in
+        get_block_offset level >>= fun block ->
+        Alpha_block_services.hash cctxt ~chain:`Main ~block () >>=? fun block_hash ->
+        Alpha_services.Forge.double_baking_evidence cctxt (`Main, block) ~branch:block_hash
+          ~bh1 ~bh2 () >>=? fun bytes ->
+        let bytes = Signature.concat bytes Signature.zero in
+        lwt_log_notice Tag.DSL.(fun f ->
+            f "Double baking detected"
+            -% t event "double_baking_detected") >>= fun () ->
+        (* A denunciation may have already occured *)
+        Shell_services.Injection.operation cctxt ~chain bytes >>=? fun op_hash ->
+        lwt_log_notice Tag.DSL.(fun f ->
+            f "Double baking evidence injected %a"
+            -% t event "double_baking_denounced"
+            -% t signed_operation_tag bytes
+            -% a Operation_hash.Logging.tag op_hash) >>= fun () ->
+        return @@ HLevel.replace state.blocks_table level
+          (Delegate_Map.add baker hash map)
+  end
+
+(* Remove levels that are lower than the [highest_level_encountered] minus [preserved_levels] *)
+let cleanup_old_operations state =
+  let highest_level_encountered =
+    Int32.to_int (Raw_level.to_int32 state.highest_level_encountered)
+  in
+  let diff = highest_level_encountered  - state.preserved_levels in
+  let threshold = begin if diff < 0 then
+      Raw_level.root
+    else
+      Raw_level.of_int32 (Int32.of_int diff) |> function
+      | Ok threshold -> threshold
+      | Error _ -> Raw_level.root
+  end in
+  let filter hmap =
+    HLevel.filter_map_inplace (fun level x ->
+        if Raw_level.(level < threshold) then
+          None
+        else
+          Some x
+      ) hmap in
+  filter state.endorsements_table ; filter state.blocks_table ;
+  ()
+
+let endorsements_index = 0
+
+(* Each new block is processed :
+   - Checking that every endorser operated only once at this level
+   - Checking that every baker injected only once at this level
+*)
+let process_new_block (cctxt : #Proto_alpha.full) state { hash ; chain_id ; level ; protocol ; next_protocol } =
+  if Protocol_hash.(protocol <> next_protocol) then
+    lwt_log_error Tag.DSL.(fun f ->
+        f "Protocol changing detected. Skipping the block."
+        -% t event "protocol_change_detected"
+        (* TODO which protocols -- in tag *)
+      ) >>= fun () ->
+    return_unit
+  else
+    lwt_debug Tag.DSL.(fun f ->
+        f "Block level : %a"
+        -% t event "accuser_saw_block"
+        -% a level_tag level
+        -% t Block_hash.Logging.tag hash) >>= fun () ->
+    let chain = `Hash chain_id in
+    let block = `Hash (hash, 0) in
+    state.highest_level_encountered <- Raw_level.max level state.highest_level_encountered ;
+    (* Processing blocks *)
+    begin
+      Alpha_block_services.info cctxt ~chain ~block () >>= function
+      | Ok block_info ->
+          process_block cctxt state ~chain block_info
+      | Error errs ->
+          lwt_log_error Tag.DSL.(fun f ->
+              f "Error while fetching operations in block %a@\n%a"
+              -% t event "fetch_operations_error"
+              -% a Block_hash.Logging.tag hash
+              -% a errs_tag errs) >>= fun () ->
+          return_unit
+    end >>=? fun () ->
+    (* Processing endorsements *)
+    begin Alpha_block_services.Operations.operations cctxt ~chain ~block () >>= function
+      | Ok operations ->
+          if List.length operations > endorsements_index then
+            let endorsements = List.nth operations endorsements_index in
+            process_endorsements cctxt state ~chain endorsements level
+          else return_unit
+      | Error errs ->
+          lwt_log_error Tag.DSL.(fun f ->
+              f "Error while fetching operations in block %a@\n%a"
+              -% t event "fetch_operations_error"
+              -% a Block_hash.Logging.tag hash
+              -% a errs_tag errs) >>= fun () ->
+          return_unit
+    end >>=? fun () ->
+    cleanup_old_operations state ;
+    return_unit
+
+let create (cctxt : #Proto_alpha.full) ~preserved_levels valid_blocks_stream =
+
+  let process_block cctxt state bi =
+    process_new_block cctxt state bi >>= function
+    | Ok () ->
+        lwt_log_notice Tag.DSL.(fun f ->
+            f "Block %a registered"
+            -% t event "accuser_processed_block"
+            -% a Block_hash.Logging.tag bi.Client_baking_blocks.hash)
+        >>= return
+    | Error errs ->
+        lwt_log_error Tag.DSL.(fun f ->
+            f "Error while processing block %a@\n%a"
+            -% t event "accuser_block_error"
+            -% a Block_hash.Logging.tag bi.hash
+            -% a errs_tag errs)
+        >>= return
+  in
+
+  let state_maker _ _ =
+    create_state ~preserved_levels >>= return
+  in
+
+  Client_baking_scheduling.main
+    ~name:"accuser"
+    ~cctxt
+    ~stream:valid_blocks_stream
+    ~state_maker
+    ~pre_loop:(fun _ _ _ -> return_unit)
+    ~compute_timeout:(fun _ -> Lwt_utils.never_ending ())
+    ~timeout_k:(fun _ _ () -> return_unit)
+    ~event_k:process_block
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.mli
new file mode 100644
index 000000000..bd3a2c991
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_denunciation.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 create:
+  #Proto_alpha.full ->
+  preserved_levels: int ->
+  Client_baking_blocks.block_info tzresult Lwt_stream.t ->
+  unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.ml
new file mode 100644
index 000000000..c25453b4e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.ml
@@ -0,0 +1,246 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.endorsement" end)
+
+open Logging
+
+module State = Daemon_state.Make(struct let name = "endorsement" end)
+
+let get_signing_slots cctxt ?(chain = `Main) block delegate level =
+  Alpha_services.Delegate.Endorsing_rights.get cctxt
+    ~levels:[level]
+    ~delegates:[delegate]
+    (chain, block) >>=? function
+  | [{ slots }] -> return_some slots
+  | _ -> return_none
+
+let inject_endorsement
+    (cctxt : #Proto_alpha.full)
+    ?(chain = `Main) block hash level ?async
+    src_sk pkh =
+  Alpha_services.Forge.endorsement cctxt
+    (chain, block)
+    ~branch:hash
+    ~level:level
+    () >>=? fun bytes ->
+  State.record cctxt pkh level >>=? fun () ->
+  Shell_services.Chain.chain_id cctxt ~chain () >>=? fun chain_id ->
+  Client_keys.append cctxt
+    src_sk ~watermark:(Endorsement chain_id) bytes >>=? fun signed_bytes ->
+  Shell_services.Injection.operation cctxt ?async ~chain signed_bytes >>=? fun oph ->
+  return oph
+
+let check_endorsement cctxt level pkh =
+  State.get cctxt pkh >>=? function
+  | None -> return_unit
+  | Some recorded_level ->
+      if Raw_level.(level = recorded_level) then
+        Error_monad.failwith "Level %a already endorsed" Raw_level.pp recorded_level
+      else
+        return_unit
+
+let previously_endorsed_level cctxt pkh new_lvl  =
+  State.get cctxt pkh >>=? function
+  | None -> return_false
+  | Some last_lvl ->
+      return (Raw_level.(last_lvl >= new_lvl))
+
+let forge_endorsement (cctxt : #Proto_alpha.full)
+    ?(chain = `Main) block ?async
+    ~src_sk src_pk =
+  let src_pkh = Signature.Public_key.hash src_pk in
+  Alpha_block_services.metadata cctxt
+    ~chain ~block () >>=? fun { protocol_data = { level = { level } } } ->
+  check_endorsement cctxt level src_pkh >>=? fun () ->
+  previously_endorsed_level cctxt src_pkh level >>=? function
+  | true ->
+      cctxt#error "Level %a : previously endorsed."
+        Raw_level.pp level
+  | false ->
+      Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
+      inject_endorsement cctxt ~chain ?async block hash level src_sk src_pkh >>=? fun oph ->
+      Client_keys.get_key cctxt src_pkh >>=? fun (name, _pk, _sk) ->
+      cctxt#message
+        "Injected endorsement level %a, contract %s '%a'"
+        Raw_level.pp level
+        name
+        Operation_hash.pp_short oph >>= fun () ->
+      return oph
+
+(** Worker *)
+
+type state = {
+  delegates: public_key_hash list ;
+  delay: int64 ;
+  mutable pending: endorsements option ;
+}
+
+and endorsements = {
+  time: Time.t ;
+  delegates: public_key_hash list ;
+  block: Client_baking_blocks.block_info ;
+}
+
+let create_state delegates delay =
+  { delegates ; delay ; pending = None }
+
+let get_delegates cctxt state = match state.delegates with
+  | [] ->
+      Client_keys.get_keys cctxt >>=? fun keys ->
+      let delegates = List.map (fun (_,pkh,_,_) -> pkh) keys in
+      return delegates
+  | (_ :: _) as delegates -> return delegates
+
+let endorse_for_delegate cctxt block delegate =
+  let { Client_baking_blocks.hash ; level } = block in
+  let b = `Hash (hash, 0) in
+  Client_keys.get_key cctxt delegate >>=? fun (name, _pk, sk) ->
+  lwt_debug Tag.DSL.(fun f ->
+      f "Endorsing %a for %s (level %a)!"
+      -% t event "endorsing"
+      -% a Block_hash.Logging.tag hash
+      -% s Client_keys.Logging.tag name
+      -% a level_tag level) >>= fun () ->
+  inject_endorsement cctxt
+    b hash level
+    sk delegate >>=? fun oph ->
+  lwt_log_notice Tag.DSL.(fun f ->
+      f "Injected endorsement for block '%a' \
+         (level %a, contract %s) '%a'"
+      -% t event "injected_endorsement"
+      -% a Block_hash.Logging.tag hash
+      -% a level_tag level
+      -% s Client_keys.Logging.tag name
+      -% t Signature.Public_key_hash.Logging.tag delegate
+      -% a Operation_hash.Logging.tag oph) >>= fun () ->
+  return_unit
+
+let allowed_to_endorse cctxt bi delegate  =
+  Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
+  lwt_debug Tag.DSL.(fun f ->
+      f "Checking if allowed to endorse block %a for %s"
+      -% t event "check_endorsement_ok"
+      -% a Block_hash.Logging.tag bi.Client_baking_blocks.hash
+      -% s Client_keys.Logging.tag name) >>= fun () ->
+  let b = `Hash (bi.hash, 0) in
+  let level = bi.level in
+  get_signing_slots cctxt b delegate level >>=? function
+  | None | Some [] ->
+      lwt_debug Tag.DSL.(fun f ->
+          f "No slot found for %a/%s"
+          -% t event "endorsement_no_slots_found"
+          -% a Block_hash.Logging.tag bi.hash
+          -% s Client_keys.Logging.tag name) >>= fun () ->
+      return_false
+  | Some (_ :: _ as slots) ->
+      lwt_debug Tag.DSL.(fun f ->
+          f "Found slots for %a/%s (%a)"
+          -% t event "endorsement_slots_found"
+          -% a Block_hash.Logging.tag bi.hash
+          -% s Client_keys.Logging.tag name
+          -% a endorsement_slots_tag slots) >>= fun () ->
+      previously_endorsed_level cctxt delegate level >>=? function
+      | true ->
+          lwt_debug Tag.DSL.(fun f ->
+              f "Level %a (or higher) previously endorsed: do not endorse."
+              -% t event "previously_endorsed"
+              -% a level_tag level) >>= fun () ->
+          return_false
+      | false ->
+          return_true
+
+let prepare_endorsement ~(max_past:int64) () (cctxt : #Proto_alpha.full) state bi =
+  if Time.diff (Time.now ()) bi.Client_baking_blocks.timestamp > max_past then
+    lwt_log_info Tag.DSL.(fun f ->
+        f "Ignore block %a: forged too far the past"
+        -% t event "endorsement_stale_block"
+        -% a Block_hash.Logging.tag bi.hash) >>= fun () ->
+    return_unit
+  else
+    lwt_log_info Tag.DSL.(fun f ->
+        f "Received new block %a"
+        -% t event "endorsement_got_block"
+        -% a Block_hash.Logging.tag bi.hash) >>= fun () ->
+    let time = Time.(add (now ()) state.delay) in
+    get_delegates cctxt state >>=? fun delegates ->
+    filter_p (allowed_to_endorse cctxt bi) delegates >>=? fun delegates ->
+    state.pending <- Some {
+        time ;
+        block = bi ;
+        delegates ;
+      } ;
+    return_unit
+
+let compute_timeout state =
+  match state.pending with
+  | None -> Lwt_utils.never_ending ()
+  | Some { time ; block ; delegates } ->
+      match Client_baking_scheduling.sleep_until time with
+      | None -> Lwt.return (block, delegates)
+      | Some timeout ->
+          lwt_log_info Tag.DSL.(fun f ->
+              f "Waiting until %a (%a) to inject endorsements"
+              -% t event "wait_before_injecting"
+              -% a timestamp_tag time
+              -% a timespan_tag (max 0L Time.(diff time (now ())))
+            ) >>= fun () ->
+          timeout >>= fun () -> Lwt.return (block, delegates)
+
+let create
+    (cctxt: #Proto_alpha.full)
+    ?(max_past=110L)
+    ~delay
+    delegates
+    block_stream
+  =
+
+  let state_maker _ _ =
+    let state = create_state delegates (Int64.of_int delay) in
+    return state
+  in
+
+  let timeout_k cctxt state (block, delegates) =
+    state.pending <- None ;
+    iter_p (endorse_for_delegate cctxt block) delegates
+  in
+
+  let event_k cctxt state bi =
+    state.pending <- None ;
+    prepare_endorsement ~max_past () cctxt state bi
+  in
+
+  Client_baking_scheduling.main
+    ~name:"endorser"
+    ~cctxt
+    ~stream:block_stream
+    ~state_maker
+    ~pre_loop:(prepare_endorsement ~max_past ())
+    ~compute_timeout
+    ~timeout_k
+    ~event_k
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.mli
new file mode 100644
index 000000000..ab81b59ab
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_endorsement.mli
@@ -0,0 +1,48 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val forge_endorsement:
+  #Proto_alpha.full ->
+  ?chain:Chain_services.chain ->
+  Block_services.block ->
+  ?async: bool ->
+  src_sk:Client_keys.sk_uri ->
+  public_key ->
+  Operation_hash.t tzresult Lwt.t
+(** [forge_endorsement cctxt blk ~src_sk src_pk] emits an endorsement
+    operation for the block [blk]
+*)
+
+
+val create :
+  #Proto_alpha.full ->
+  ?max_past:int64 (* number of seconds *) ->
+  delay:int ->
+  public_key_hash list ->
+  Client_baking_blocks.block_info tzresult Lwt_stream.t -> unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.ml
new file mode 100644
index 000000000..8ca3c3f93
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.ml
@@ -0,0 +1,1235 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.baking" end)
+module State = Daemon_state.Make(struct let name = "block" end)
+open Logging
+
+(* The index of the different components of the protocol's validation passes *)
+(* TODO: ideally, we would like this to be more abstract and possibly part of
+   the protocol, while retaining the generality of lists *)
+(* Hypothesis : we suppose [List.length Proto_alpha.Main.validation_passes = 4] *)
+let endorsements_index = 0
+let votes_index = 1
+let anonymous_index = 2
+let managers_index = 3
+
+let default_max_priority = 64
+let default_minimal_fees = Tez.zero
+let default_minimal_nanotez_per_gas_unit = Z.of_int 10000
+let default_minimal_nanotez_per_byte = Z.zero
+let default_await_endorsements = true
+
+type state = {
+  genesis: Block_hash.t ;
+  context_path: string ;
+  mutable index : Context.index ;
+  (* see [get_delegates] below to find delegates when the list is empty *)
+  delegates: public_key_hash list ;
+  (* lazy-initialisation with retry-on-error *)
+  constants: Constants.t tzlazy ;
+  (* Minimal operation fee required to include an operation in a block *)
+  minimal_fees : Tez.t ;
+  (* Minimal operation fee per gas required to include an operation in a block *)
+  minimal_nanotez_per_gas_unit : Z.t ;
+  (* Minimal operation fee per byte required to include an operation in a block *)
+  minimal_nanotez_per_byte : Z.t ;
+  (* Await endorsements *)
+  await_endorsements: bool ;
+  (* truly mutable *)
+  mutable best_slot: (Time.t * (Client_baking_blocks.block_info * int * public_key_hash)) option ;
+}
+
+let create_state
+    ?(minimal_fees = default_minimal_fees)
+    ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit)
+    ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte)
+    ?(await_endorsements = default_await_endorsements)
+    genesis context_path index delegates constants =
+  { genesis ;
+    context_path ;
+    index ;
+    delegates ;
+    constants ;
+    minimal_fees ;
+    minimal_nanotez_per_gas_unit ;
+    minimal_nanotez_per_byte ;
+    await_endorsements ;
+    best_slot = None ;
+  }
+
+let get_delegates cctxt state =
+  match state.delegates with
+  | [] ->
+      Client_keys.get_keys cctxt >>=? fun keys ->
+      return (List.map (fun (_,pkh,_,_) -> pkh) keys)
+  | _ -> return state.delegates
+
+let generate_seed_nonce () =
+  match Nonce.of_bytes (Rand.generate Constants.nonce_length) with
+  | Error _errs -> assert false
+  | Ok nonce -> nonce
+
+let forge_block_header
+    (cctxt : #Proto_alpha.full)
+    ?(chain = `Main)
+    block
+    delegate_sk
+    shell
+    priority
+    seed_nonce_hash =
+  Client_baking_pow.mine
+    cctxt chain block shell
+    (fun proof_of_work_nonce ->
+       { Block_header.priority ;
+         seed_nonce_hash ;
+         proof_of_work_nonce ;
+       }) >>=? fun contents ->
+  let unsigned_header =
+    Data_encoding.Binary.to_bytes_exn
+      Alpha_context.Block_header.unsigned_encoding
+      (shell, contents) in
+  Shell_services.Chain.chain_id cctxt ~chain () >>=? fun chain_id ->
+  Client_keys.append cctxt delegate_sk ~watermark:(Block_header chain_id) unsigned_header
+
+let forge_faked_protocol_data ~priority ~seed_nonce_hash =
+  Alpha_context.Block_header.{
+    contents = { priority ; seed_nonce_hash ;
+                 proof_of_work_nonce = Client_baking_pow.empty_proof_of_work_nonce } ;
+    signature = Signature.zero
+  }
+
+let assert_valid_operations_hash shell_header operations =
+  let operations_hash =
+    Operation_list_list_hash.compute
+      (List.map Operation_list_hash.compute
+         (List.map
+            (List.map Tezos_base.Operation.hash) operations)) in
+  fail_unless
+    (Operation_list_list_hash.equal
+       operations_hash shell_header.Tezos_base.Block_header.operations_hash)
+    (failure "Client_baking_forge.inject_block: inconsistent header.")
+
+let inject_block
+    cctxt
+    ?force
+    ?(chain = `Main)
+    ?seed_nonce_hash
+    ~shell_header
+    ~priority
+    ~src_sk
+    operations =
+  assert_valid_operations_hash shell_header operations >>=? fun () ->
+  let block = `Hash (shell_header.Tezos_base.Block_header.predecessor, 0) in
+  forge_block_header cctxt ~chain block
+    src_sk shell_header priority seed_nonce_hash >>=? fun signed_header ->
+  Shell_services.Injection.block cctxt
+    ?force ~chain signed_header operations >>=? fun block_hash ->
+  lwt_log_info Tag.DSL.(fun f ->
+      f "Client_baking_forge.inject_block: inject %a"
+      -% t event "inject_baked_block"
+      -% a Block_hash.Logging.tag block_hash
+      -% t signed_header_tag signed_header
+      -% t operations_tag operations) >>= fun () ->
+  return block_hash
+
+type error += Failed_to_preapply of Tezos_base.Operation.t * error list
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"Client_baking_forge.failed_to_preapply"
+    ~title: "Fail to preapply an operation"
+    ~description: ""
+    ~pp:(fun ppf (op, err) ->
+        let h = Tezos_base.Operation.hash op in
+        Format.fprintf ppf "@[Failed to preapply %a:@ @[<v 4>%a@]@]"
+          Operation_hash.pp_short h
+          pp_print_error err)
+    Data_encoding.
+      (obj2
+         (req "operation" (dynamic_size Tezos_base.Operation.encoding))
+         (req "error" RPC_error.encoding))
+    (function
+      | Failed_to_preapply (hash, err) -> Some (hash, err)
+      | _ -> None)
+    (fun (hash, err) -> Failed_to_preapply (hash, err))
+
+let get_manager_operation_gas_and_fee op =
+  let { protocol_data = Operation_data { contents } ; _ } = op in
+  let open Operation in
+  let l = to_list (Contents_list contents) in
+  fold_left_s (fun ((total_fee, total_gas) as acc) -> function
+      | Contents (Manager_operation { fee ; gas_limit ; _ }) ->
+          Lwt.return @@ Alpha_environment.wrap_error @@
+          Tez.(total_fee +? fee) >>=? fun total_fee ->
+          return (total_fee, (Z.add total_gas gas_limit))
+      | _ -> return acc) (Tez.zero, Z.zero) l
+
+(* Sort operation consisdering potential gas and storage usage.
+   Weight = fee / (max ( (size/size_total), (gas/gas_total))) *)
+let sort_manager_operations
+    ~max_size
+    ~hard_gas_limit_per_block
+    ~minimal_fees
+    ~minimal_nanotez_per_gas_unit
+    ~minimal_nanotez_per_byte
+    (operations : Proto_alpha.operation list) =
+  let compute_weight op (fee, gas) =
+    let size = Data_encoding.Binary.length Operation.encoding op in
+    let size_f = Q.of_int size in
+    let gas_f = Q.of_bigint gas in
+    let fee_f = Q.of_int64 (Tez.to_mutez fee) in
+    let size_ratio = Q.(size_f / (Q.of_int max_size)) in
+    let gas_ratio = Q.(gas_f / (Q.of_bigint hard_gas_limit_per_block)) in
+    (size, gas, Q.(fee_f / (max size_ratio gas_ratio)))
+  in
+  filter_map_s
+    (fun op ->
+       get_manager_operation_gas_and_fee op >>=? fun (fee, gas) ->
+       if Tez.(fee < minimal_fees) then
+         return_none
+       else
+         let (size, gas, _ratio) as weight = compute_weight op (fee, gas) in
+         let open Alpha_environment in
+         let fees_in_nanotez =
+           Z.mul (Z.of_int64 (Tez.to_mutez fee)) (Z.of_int 1000) in
+         let enough_fees_for_gas =
+           let minimal_fees_in_nanotez =
+             Z.mul minimal_nanotez_per_gas_unit gas in
+           Z.compare minimal_fees_in_nanotez fees_in_nanotez  <= 0 in
+         let enough_fees_for_size =
+           let minimal_fees_in_nanotez =
+             Z.mul minimal_nanotez_per_byte (Z.of_int size) in
+           Z.compare minimal_fees_in_nanotez fees_in_nanotez  <= 0 in
+         if enough_fees_for_size && enough_fees_for_gas then
+           return_some (op, weight)
+         else
+           return_none
+    ) operations >>=? fun operations ->
+  (* We sort by the biggest weight *)
+  return
+    (List.sort (fun (_, (_, _, w)) (_, (_, _, w')) -> Q.compare w' w) operations)
+
+let retain_operations_up_to_quota operations quota =
+  let { T.max_op ; max_size } = quota in
+  let operations = match max_op with
+    | Some n -> List.sub operations n
+    | None -> operations
+  in
+  let exception Full of packed_operation list in
+  let operations = try
+      List.fold_left (fun (ops, size) op ->
+          let operation_size =
+            Data_encoding.Binary.length Alpha_context.Operation.encoding op
+          in
+          let new_size = size + operation_size in
+          if new_size > max_size then
+            raise (Full ops)
+          else
+            (op :: ops, new_size)
+        ) ([], 0) operations |> fst
+    with
+    | Full ops -> ops in
+  List.rev operations
+
+let trim_manager_operations ~max_size ~hard_gas_limit_per_block manager_operations =
+  map_s (fun op ->
+      get_manager_operation_gas_and_fee op >>=? fun (_fee, gas) ->
+      let size = Data_encoding.Binary.length Operation.encoding op in
+      return (op, (size, gas))) manager_operations >>=? fun manager_operations ->
+  List.fold_left
+    (fun (total_size, total_gas, (good_ops, bad_ops)) (op, (size, gas)) ->
+       let new_size = total_size + size in
+       let new_gas = Z.(total_gas + gas) in
+       if new_size > max_size || (Z.gt new_gas hard_gas_limit_per_block) then
+         (new_size, new_gas, (good_ops, op :: bad_ops))
+       else
+         (new_size, new_gas, (op :: good_ops, bad_ops))
+    ) (0, Z.zero, ([], [])) manager_operations |> fun (_, _, (good_ops, bad_ops)) ->
+  (* We keep the overflowing operations, it may be used for client-side validation *)
+  return ((List.rev good_ops), (List.rev bad_ops))
+
+(* We classify operations, sort managers operation by interest and add bad ones at the end *)
+(* Hypothesis : we suppose that the received manager operations have a valid gas_limit *)
+(** [classify_operations] classify the operation in 4 lists indexed as such :
+    - 0 -> Endorsements
+    - 1 -> Votes and proposals
+    - 2 -> Anonymous operations
+    - 3 -> High-priority manager operations.
+    Returns two list :
+    - A desired set of operations to be included
+    - Potentially overflowing operations *)
+let classify_operations
+    (cctxt : #Proto_alpha.full)
+    ~block
+    ~hard_gas_limit_per_block
+    ~minimal_fees
+    ~minimal_nanotez_per_gas_unit
+    ~minimal_nanotez_per_byte
+    (ops: Proto_alpha.operation list) =
+  Alpha_block_services.live_blocks cctxt ~chain:`Main ~block ()
+  >>=? fun live_blocks ->
+  (* Remove operations that are too old *)
+  let ops =
+    List.filter (fun { shell = { branch } } ->
+        Block_hash.Set.mem branch live_blocks
+      ) ops
+  in
+  let validation_passes_len = List.length Proto_alpha.Main.validation_passes in
+  let t = Array.make validation_passes_len [] in
+  List.iter
+    (fun (op: Proto_alpha.operation) ->
+       List.iter
+         (fun pass -> t.(pass) <- op :: t.(pass))
+         (Main.acceptable_passes op))
+    ops ;
+  let t = Array.map List.rev t in
+  (* Retrieve the optimist maximum paying manager operations *)
+  let manager_operations = t.(managers_index) in
+  let { Alpha_environment.Updater.max_size } =
+    List.nth Proto_alpha.Main.validation_passes managers_index in
+  sort_manager_operations
+    ~max_size
+    ~hard_gas_limit_per_block
+    ~minimal_fees
+    ~minimal_nanotez_per_gas_unit
+    ~minimal_nanotez_per_byte
+    manager_operations
+  >>=? fun ordered_operations ->
+  (* Greedy heuristic *)
+  trim_manager_operations ~max_size ~hard_gas_limit_per_block (List.map fst ordered_operations)
+  >>=? fun (desired_manager_operations, overflowing_manager_operations) ->
+  t.(managers_index) <- desired_manager_operations ;
+  return ((Array.to_list t), overflowing_manager_operations)
+
+let parse (op : Operation.raw) : Operation.packed =
+  let protocol_data =
+    Data_encoding.Binary.of_bytes_exn
+      Alpha_context.Operation.protocol_data_encoding
+      op.proto in
+  { shell = op.shell ;
+    protocol_data ;
+  }
+
+let forge (op : Operation.packed) : Operation.raw =
+  { shell = op.shell ;
+    proto = Data_encoding.Binary.to_bytes_exn
+        Alpha_context.Operation.protocol_data_encoding
+        op.protocol_data
+  }
+
+let ops_of_mempool (ops : Alpha_block_services.Mempool.t) =
+  (* We only retain the applied, unprocessed and delayed operations *)
+  List.rev (
+    Operation_hash.Map.fold (fun _ op acc -> op :: acc) ops.unprocessed @@
+    Operation_hash.Map.fold (fun _ (op, _) acc -> op :: acc) ops.branch_delayed @@
+    List.rev_map (fun (_, op) -> op) ops.applied
+  )
+
+let unopt_operations cctxt chain mempool = function
+  | None -> begin
+      match mempool with
+      | None ->
+          Alpha_block_services.Mempool.pending_operations cctxt ~chain () >>=? fun mpool ->
+          let ops = ops_of_mempool mpool in
+          return ops
+      | Some file ->
+          Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file file >>=? fun json ->
+          let mpool = Data_encoding.Json.destruct Alpha_block_services.S.Mempool.encoding json in
+          let ops = ops_of_mempool mpool in
+          return ops
+    end
+  | Some operations ->
+      return operations
+
+let all_ops_valid (results: error Preapply_result.t list) =
+  let open Operation_hash.Map in
+  List.for_all (fun (result: error Preapply_result.t) ->
+      is_empty result.refused
+      && is_empty result.branch_refused
+      && is_empty result.branch_delayed)
+    results
+
+let decode_priority cctxt chain block = function
+  | `Set priority -> begin
+      Alpha_services.Delegate.Baking_rights.get cctxt
+        ~all:true ~max_priority:(priority+1) (chain, block) >>=? fun rights ->
+      let time =
+        Option.apply
+          ~f:(fun r -> r.Alpha_services.Delegate.Baking_rights.timestamp)
+          (List.nth_opt rights priority) in
+      return (priority, time)
+    end
+  | `Auto (src_pkh, max_priority) ->
+      Alpha_services.Helpers.current_level
+        cctxt ~offset:1l (chain, block)>>=? fun { level } ->
+      Alpha_services.Delegate.Baking_rights.get cctxt
+        ?max_priority
+        ~levels:[level]
+        ~delegates:[src_pkh]
+        (chain, block)  >>=? fun possibilities ->
+      try
+        let { Alpha_services.Delegate.Baking_rights.priority = prio ;
+              timestamp = time } =
+          List.find
+            (fun p -> p.Alpha_services.Delegate.Baking_rights.level = level)
+            possibilities in
+        return (prio, time)
+      with Not_found ->
+        failwith "No slot found at level %a" Raw_level.pp level
+
+let unopt_timestamp timestamp minimal_timestamp =
+  match timestamp, minimal_timestamp with
+  | None, None -> return (Time.now ())
+  | None, Some timestamp -> return timestamp
+  | Some timestamp, None -> return timestamp
+  | Some timestamp, Some minimal_timestamp ->
+      if timestamp < minimal_timestamp then
+        failwith
+          "Proposed timestamp %a is earlier than minimal timestamp %a"
+          Time.pp_hum timestamp
+          Time.pp_hum minimal_timestamp
+      else
+        return timestamp
+
+let merge_preapps (old: error Preapply_result.t) (neu: error Preapply_result.t) =
+  let merge _ a b = (* merge ops *)
+    match a, b with
+    | None, None -> None
+    | Some x, None -> Some x
+    | _, Some y -> Some y in
+  let merge = Operation_hash.Map.merge merge in (* merge op maps *)
+  (* merge preapplies *)
+  { Preapply_result.applied = [] ;
+    refused = merge old.refused neu.refused ;
+    branch_refused = merge old.branch_refused neu.branch_refused ;
+    branch_delayed = merge old.branch_delayed neu.branch_delayed }
+
+let error_of_op (result: error Preapply_result.t) op =
+  let op = forge op in
+  let h = Tezos_base.Operation.hash op in
+  try Some (Failed_to_preapply (op, snd @@ Operation_hash.Map.find h result.refused))
+  with Not_found ->
+  try Some (Failed_to_preapply (op, snd @@ Operation_hash.Map.find h result.branch_refused))
+  with Not_found ->
+  try Some (Failed_to_preapply (op, snd @@ Operation_hash.Map.find h result.branch_delayed))
+  with Not_found -> None
+
+let filter_and_apply_operations
+    state
+    block_info
+    ~timestamp
+    ?protocol_data
+    ((operations : packed_operation list list), overflowing_operations) =
+  let open Client_baking_simulator in
+  lwt_debug Tag.DSL.(fun f ->
+      f "Starting client-side validation %a"
+      -% t event "baking_local_validation_start"
+      -% a Block_hash.Logging.tag block_info.Client_baking_blocks.hash) >>= fun () ->
+  begin begin_construction ~timestamp ?protocol_data state.index block_info >>= function
+    | Ok inc -> return inc
+    | Error errs ->
+        lwt_log_error Tag.DSL.(fun f ->
+            f "Error while fetching current context : %a"
+            -% t event "context_fetch_error"
+            -% a errs_tag errs) >>= fun () ->
+        lwt_log_notice Tag.DSL.(fun f -> f "Retrying to open the context" -% t event "reopen_context") >>= fun () ->
+        Client_baking_simulator.load_context ~context_path:state.context_path >>= fun index ->
+        begin_construction ~timestamp ?protocol_data index block_info >>=? fun inc ->
+        state.index <- index ;
+        return inc
+  end  >>=? fun initial_inc ->
+  let endorsements = List.nth operations endorsements_index in
+  let votes = List.nth operations votes_index in
+  let anonymous = List.nth operations anonymous_index in
+  let managers = List.nth operations managers_index in
+  let validate_operation inc op =
+    add_operation inc op >>= function
+    | Error errs ->
+        lwt_debug Tag.DSL.(fun f ->
+            f "@[<v 4>Client-side validation: invalid operation filtered %a@\n%a@]"
+            -% t event "baking_rejected_invalid_operation"
+            -% a Operation_hash.Logging.tag (Operation.hash_packed op)
+            -% a errs_tag errs)
+        >>= fun () ->
+        Lwt.return_none
+    | Ok (resulting_state, _receipt) ->
+        Lwt.return_some resulting_state
+  in
+  let filter_valid_operations inc ops =
+    Lwt_list.fold_left_s (fun (inc, acc) op ->
+        validate_operation inc op >>= function
+        | None -> Lwt.return (inc, acc)
+        | Some inc' -> Lwt.return (inc', op :: acc)
+      ) (inc, []) ops
+  in
+  (* Invalid endorsements are detected during block finalization *)
+  let is_valid_endorsement inc endorsement =
+    validate_operation inc endorsement >>= function
+    | None -> Lwt.return_none
+    | Some inc' -> finalize_construction inc' >>= begin function
+        | Ok _ -> Lwt.return_some endorsement
+        | Error _ -> Lwt.return_none
+      end
+  in
+  filter_valid_operations initial_inc votes >>= fun (inc, votes) ->
+  filter_valid_operations inc anonymous >>= fun (inc, anonymous) ->
+  (* Retrieve the correct index order *)
+  let managers = List.sort Proto_alpha.compare_operations managers in
+  let overflowing_operations = List.sort Proto_alpha.compare_operations overflowing_operations in
+  filter_valid_operations inc (managers @  overflowing_operations) >>= fun (inc, managers) ->
+  (* Gives a chance to the endorser to fund their deposit in the current block *)
+  Lwt_list.filter_map_s (is_valid_endorsement inc) endorsements >>= fun endorsements ->
+  finalize_construction inc >>=? fun _ ->
+  let quota : Alpha_environment.Updater.quota list = Main.validation_passes in
+  tzforce state.constants >>=? fun
+    { Constants.parametric = { endorsers_per_block ; hard_gas_limit_per_block ; } } ->
+  let endorsements =
+    List.sub (List.rev endorsements) endorsers_per_block
+  in
+  let votes =
+    retain_operations_up_to_quota
+      (List.rev votes)
+      (List.nth quota votes_index) in
+  let anonymous =
+    retain_operations_up_to_quota
+      (List.rev anonymous)
+      (List.nth quota anonymous_index) in
+  let is_evidence  = function
+    | { protocol_data = Operation_data { contents = Single (Double_baking_evidence _ ) } } -> true
+    | { protocol_data = Operation_data { contents = Single (Double_endorsement_evidence _ ) } } -> true
+    | _ -> false in
+  let evidences, anonymous = List.partition is_evidence anonymous in
+  trim_manager_operations ~max_size:(List.nth quota managers_index).max_size
+    ~hard_gas_limit_per_block managers >>=? fun (accepted_managers, _overflowing_managers) ->
+  (* Retrieve the correct index order *)
+  let accepted_managers = List.sort Proto_alpha.compare_operations accepted_managers in
+  (* Make sure we only keep valid operations *)
+  filter_valid_operations initial_inc votes >>= fun (inc, votes) ->
+  filter_valid_operations inc anonymous >>= fun (inc, anonymous) ->
+  filter_valid_operations inc accepted_managers >>= fun (inc, accepted_managers) ->
+  Lwt_list.filter_map_s (is_valid_endorsement inc) endorsements >>= fun endorsements ->
+  (* Endorsements won't fail now *)
+  fold_left_s (fun inc op ->
+      add_operation inc op >>=? fun (inc, _receipt) ->
+      return inc) inc endorsements >>=? fun inc ->
+  (* Endorsement and double baking/endorsement evidence do not commute:
+     we apply denunciation operations after endorsements. *)
+  filter_valid_operations inc evidences >>= fun (final_inc, evidences) ->
+  let operations = List.map List.rev [ endorsements ; votes ; anonymous @ evidences ; accepted_managers ] in
+  finalize_construction final_inc >>=? fun (validation_result, metadata) ->
+  return (final_inc, (validation_result, metadata), operations)
+
+(* Build the block header : mimics node prevalidation *)
+let finalize_block_header
+    (inc : Client_baking_simulator.incremental)
+    ~timestamp
+    (validation_result, _metadata)
+    operations =
+  let { T.context ; fitness ; message ; _ } = validation_result in
+  let validation_passes = List.length LiftedMain.validation_passes in
+  let operations_hash : Operation_list_list_hash.t =
+    Operation_list_list_hash.compute
+      (List.map
+         (fun sl ->
+            Operation_list_hash.compute
+              (List.map Operation.hash_packed sl)
+         ) operations
+      ) in
+  Context.hash ~time:timestamp ?message context >>= fun context ->
+  let header =
+    { inc.header with
+      level = Raw_level.to_int32 (Raw_level.succ inc.predecessor.level) ;
+      validation_passes ;
+      operations_hash ;
+      fitness ;
+      context ;
+    } in
+  return header
+
+let forge_block
+    cctxt
+    ?(chain = `Main)
+    ?force
+    ?operations
+    ?(best_effort = operations = None)
+    ?(sort = best_effort)
+    ?(minimal_fees = default_minimal_fees)
+    ?(minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit)
+    ?(minimal_nanotez_per_byte = default_minimal_nanotez_per_byte)
+    ?(await_endorsements = default_await_endorsements)
+    ?timestamp
+    ?mempool
+    ?context_path
+    ?seed_nonce_hash
+    ~priority
+    ~src_sk
+    block =
+  (* making the arguments usable *)
+  unopt_operations cctxt chain mempool operations >>=? fun operations_arg ->
+  decode_priority cctxt chain block priority >>=? fun (priority, minimal_timestamp) ->
+  unopt_timestamp timestamp minimal_timestamp >>=? fun timestamp ->
+
+  (* get basic building blocks *)
+  let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in
+  Alpha_services.Constants.all cctxt (`Main, block) >>=?
+  fun Constants.{ parametric = { hard_gas_limit_per_block ; endorsers_per_block } } ->
+  classify_operations
+    cctxt
+    ~hard_gas_limit_per_block
+    ~block:block
+    ~minimal_fees
+    ~minimal_nanotez_per_gas_unit
+    ~minimal_nanotez_per_byte
+    operations_arg
+  >>=? fun (operations, overflowing_ops) ->
+  (* Ensure that we retain operations up to the quota *)
+  let quota : Alpha_environment.Updater.quota list = Main.validation_passes in
+  let endorsements = List.sub
+      (List.nth operations endorsements_index)
+      endorsers_per_block in
+  let votes = retain_operations_up_to_quota
+      (List.nth operations votes_index)
+      (List.nth quota votes_index) in
+  let anonymous =
+    retain_operations_up_to_quota
+      (List.nth operations anonymous_index)
+      (List.nth quota anonymous_index) in
+  (* Size/Gas check already occured in classify operations *)
+  let managers = List.nth operations managers_index in
+  let operations = [ endorsements ; votes ; anonymous ; managers ] in
+
+  begin
+    match context_path with
+    | None ->
+        Alpha_block_services.Helpers.Preapply.block
+          cctxt ~block ~timestamp ~sort ~protocol_data operations >>=? fun (shell_header, result) ->
+        let operations =
+          List.map (fun l -> List.map snd l.Preapply_result.applied) result in
+        (* everything went well (or we don't care about errors): GO! *)
+        if best_effort || all_ops_valid result then
+          return (shell_header, operations)
+          (* some errors (and we care about them) *)
+        else
+          let result = List.fold_left merge_preapps Preapply_result.empty result in
+          Lwt.return_error @@
+          List.filter_map (error_of_op result) operations_arg
+    | Some context_path ->
+        assert sort ;
+        assert best_effort ;
+        Context.init ~readonly:true context_path >>= fun index ->
+        Client_baking_blocks.info cctxt ~chain block >>=? fun bi ->
+        let state = {
+          context_path ;
+          index ;
+          genesis =
+            Block_hash.of_b58check_exn
+              "BLockGenesisGenesisGenesisGenesisGenesisf79b5d1CoW2" ;
+          constants = tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Head 0)) ;
+          delegates = [] ;
+          best_slot = None ;
+          await_endorsements ;
+          minimal_fees = default_minimal_fees ;
+          minimal_nanotez_per_gas_unit = default_minimal_nanotez_per_gas_unit ;
+          minimal_nanotez_per_byte = default_minimal_nanotez_per_byte ;
+        } in
+        filter_and_apply_operations ~timestamp ~protocol_data state bi (operations, overflowing_ops)
+        >>=? fun (final_context, validation_result, operations) ->
+        finalize_block_header final_context ~timestamp validation_result operations >>=? fun shell_header ->
+        return (shell_header, List.map (List.map forge) operations)
+  end >>=? fun (shell_header, operations) ->
+
+  (* Now for some logging *)
+  let total_op_count = List.length operations_arg in
+  let valid_op_count = List.length (List.concat operations) in
+  lwt_log_info Tag.DSL.(fun f ->
+      f "Found %d valid operations (%d refused) for timestamp %a@.Computed fitness %a"
+      -% t event "found_valid_operations"
+      -% s valid_ops valid_op_count
+      -% s refused_ops (total_op_count - valid_op_count)
+      -% a timestamp_tag timestamp
+      -% a fitness_tag shell_header.fitness) >>= fun () ->
+
+  inject_block cctxt
+    ?force ~chain ~shell_header ~priority ?seed_nonce_hash ~src_sk
+    operations >>= function
+  | Ok hash -> return hash
+  | Error errs as error ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "@[<v 4>Error while injecting block@ @[Included operations : %a@]@ %a@]"
+          -% t event "block_injection_failed"
+          -% a raw_operations_tag (List.concat operations)
+          -% a errs_tag errs
+        ) >>= fun () ->
+      Lwt.return error
+
+let shell_prevalidation
+    (cctxt : #Proto_alpha.full)
+    ~chain
+    ~block
+    seed_nonce_hash
+    operations
+    ((timestamp, (bi, priority, delegate)) as _slot) =
+  let protocol_data =
+    forge_faked_protocol_data ~priority ~seed_nonce_hash in
+  Alpha_block_services.Helpers.Preapply.block
+    cctxt ~chain ~block
+    ~timestamp ~sort:true ~protocol_data operations
+  >>= function
+  | Error errs ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "Shell-side validation: error while prevalidating operations:@\n%a"
+          -% t event "built_invalid_block_error"
+          -% a errs_tag errs) >>= fun () ->
+      return_none
+  | Ok (shell_header, operations) ->
+      let raw_ops =
+        List.map (fun l ->
+            List.map snd l.Preapply_result.applied) operations in
+      return_some (bi, priority, shell_header, raw_ops, delegate, seed_nonce_hash)
+
+let filter_outdated_endorsements expected_level ops =
+  List.filter (function
+      | { Alpha_context.protocol_data =
+            Operation_data { contents = Single (Endorsement { level }) }} ->
+          Raw_level.equal expected_level level
+      | _ -> true
+    ) ops
+
+let next_baking_delay state priority =
+  tzforce state.constants >>=? fun { Constants.parametric = { time_between_blocks }} ->
+  let rec associated_period durations prio =
+    if List.length durations = 0 then
+      (* Mimic [Baking.minimal_time] behaviour *)
+      associated_period [ Period.one_minute ] prio
+    else
+      match durations with
+      | [] -> assert false
+      | [ last ] ->
+          Period.to_seconds last
+      | first :: durations ->
+          if prio = 0 then
+            Period.to_seconds first
+          else
+            associated_period durations (prio - 1)
+  in
+  let span = associated_period time_between_blocks (priority + 1) in
+  return span
+
+let count_slots_endorsements inc (_timestamp, (head, _priority, _delegate)) operations =
+  Lwt_list.fold_left_s (fun acc -> function
+      | { Alpha_context.protocol_data =
+            Operation_data { contents = Single (Endorsement { level }) }} as op
+        when Raw_level.(level = head.Client_baking_blocks.level) ->
+          begin
+            let open Apply_results in
+            Client_baking_simulator.add_operation inc op >>= function
+            | Ok (_inc,
+                  Operation_metadata
+                    { contents = Single_result (Endorsement_result { slots })} ) ->
+                Lwt.return (acc + List.length slots)
+            | Error _ | _ ->
+                (* We do not handle errors here *)
+                Lwt.return acc
+          end
+      | _ -> Lwt.return acc
+    ) 0 operations
+
+let rec filter_limits tnow limits =
+  match limits with
+  | [] -> []
+  | (time, _) :: _ as limits when Time.(tnow < time) -> limits
+  | _ :: limits -> filter_limits tnow limits
+
+(** [fetch_operations] retrieve the operations present in the
+    mempool. If no endorsements are present in the initial set, it
+    waits until [state.max_waiting_time] seconds after its injection range start date. *)
+let fetch_operations
+    (cctxt : #Proto_alpha.full)
+    ~chain
+    state
+    (timestamp, (head, priority, _delegate) as slot)
+  =
+  Alpha_block_services.Mempool.monitor_operations cctxt ~chain
+    ~applied:true ~branch_delayed:true
+    ~refused:false ~branch_refused:false () >>=? fun (operation_stream, _stop) ->
+  (* Hypothesis : the first call to the stream returns instantly, even if the mempool is empty. *)
+  Lwt_stream.get operation_stream >>= function
+  | None -> (* New head received : not supposed to happen. *)
+      return_none
+  | Some current_mempool ->
+      let operations = ref (filter_outdated_endorsements head.Client_baking_blocks.level current_mempool) in
+      Client_baking_simulator.begin_construction ~timestamp state.index head >>=? fun inc ->
+      count_slots_endorsements inc slot !operations >>= fun nb_arrived_endorsements ->
+      tzforce state.constants >>=? fun { Constants.parametric = { endorsers_per_block }} ->
+      (* If 100% of the endorsements arrived, we don't need to wait *)
+      if (not state.await_endorsements) || nb_arrived_endorsements = endorsers_per_block then
+        return_some !operations
+      else
+        next_baking_delay state priority >>=? fun next_slot_delay ->
+        let hard_delay = Int64.div next_slot_delay 2L in
+        (* The time limit is defined as 1/2 of the next baking slot's time *)
+        let limit_date = Time.add timestamp hard_delay in
+        (* Time limits :
+           - We expect all of the endorsements until 1/3 of the time limit has passed ;
+           - We expect 2/3 of the endorsements until 2/3 of the time limit has passed ;
+           - We expect 1/3 of the endorsements until the time limit has passed ;
+           - We bake with what we have when the time limit has been reached.
+        *)
+        let limits =
+          [ (Time.add timestamp (Int64.div hard_delay 3L), endorsers_per_block) ;
+            (Time.add timestamp (Int64.div (Int64.mul hard_delay 2L) 3L), 2 * endorsers_per_block / 3) ;
+            (limit_date, endorsers_per_block / 3) ]
+        in
+        lwt_log_notice Tag.DSL.(fun f ->
+            f "No endorsements present in the mempool. Waiting until %a (%a) for new operations."
+            -% t event "waiting_operations"
+            -% a timestamp_tag limit_date
+            -% a timespan_tag (max 0L Time.(diff limit_date (now ())))
+          ) >>= fun () ->
+        Shell_services.Mempool.request_operations cctxt ~chain () >>=? fun () ->
+        let timeout = match Client_baking_scheduling.sleep_until limit_date with
+          | None -> Lwt.return_unit
+          | Some timeout -> timeout in
+        let last_get_event = ref None in
+        let get_event () =
+          match !last_get_event with
+          | None ->
+              let t = Lwt_stream.get operation_stream in
+              last_get_event := Some t ;
+              t
+          | Some t -> t in
+        let rec loop nb_arrived_endorsements limits =
+          Lwt.choose [ (timeout >|= fun () -> `Timeout) ;
+                       (get_event () >|= fun e -> `Event e) ; ]
+          >>= function
+          | `Event (Some op_list) -> begin
+              last_get_event := None ;
+              operations := op_list @ !operations ;
+              count_slots_endorsements inc slot op_list >>= fun new_endorsements ->
+              let nb_arrived_endorsements = nb_arrived_endorsements + new_endorsements in
+              let limits = filter_limits (Time.now ()) limits in
+              let required =
+                match limits with
+                | [] -> 0 (* If we are late, we do not require endorsements *)
+                | (_time, required) :: _ -> required in
+              let enough = nb_arrived_endorsements >= required in
+              if enough then
+                return_some !operations
+              else
+                loop nb_arrived_endorsements limits
+            end
+          | `Timeout -> return_some !operations
+          | `Event None ->
+              (* New head received. Should not happen : let the
+                 caller handle this case. *)
+              return_none
+        in
+        loop nb_arrived_endorsements limits
+
+(** Given a delegate baking slot [build_block] constructs a full block
+    with consistent operations that went through the client-side
+    validation *)
+let build_block
+    cctxt
+    state
+    seed_nonce_hash
+    ((timestamp, (bi, priority, delegate)) as slot) =
+  let chain = `Hash bi.Client_baking_blocks.chain_id in
+  let block = `Hash (bi.hash, 0) in
+  Alpha_services.Helpers.current_level cctxt
+    ~offset:1l (chain, block) >>=? fun next_level ->
+  let seed_nonce_hash =
+    if next_level.Level.expected_commitment then
+      Some seed_nonce_hash
+    else
+      None in
+  let timestamp =
+    if Block_hash.equal bi.Client_baking_blocks.hash state.genesis then
+      Time.now ()
+    else
+      timestamp in
+  Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
+
+  lwt_debug Tag.DSL.(fun f ->
+      f "Try baking after %a (slot %d) for %s (%a)"
+      -% t event "try_baking"
+      -% a Block_hash.Logging.tag bi.hash
+      -% s bake_priority_tag priority
+      -% s Client_keys.Logging.tag name
+      -% a timestamp_tag timestamp) >>= fun () ->
+
+  fetch_operations cctxt ~chain state slot >>=? function
+  | None ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "Received a new head while waiting for operations. Aborting this block."
+          -% t event "new_head_received") >>= fun () ->
+      return_none
+  | Some operations ->
+      tzforce state.constants >>=? fun Constants.{ parametric = { hard_gas_limit_per_block } } ->
+      classify_operations cctxt
+        ~hard_gas_limit_per_block
+        ~minimal_fees:state.minimal_fees
+        ~minimal_nanotez_per_gas_unit:state.minimal_nanotez_per_gas_unit
+        ~minimal_nanotez_per_byte:state.minimal_nanotez_per_byte
+        ~block operations
+      >>=? fun (operations, overflowing_ops) ->
+      let next_version =
+        match Tezos_base.Block_header.get_forced_protocol_upgrade ~level:(Raw_level.to_int32 next_level.Level.level) with
+        | None -> bi.next_protocol
+        | Some hash -> hash
+      in
+      if Protocol_hash.(Proto_alpha.hash <> next_version) then
+        (* Let the shell validate this *)
+        shell_prevalidation cctxt ~chain ~block seed_nonce_hash
+          operations slot
+      else
+        let protocol_data = forge_faked_protocol_data ~priority ~seed_nonce_hash in
+        filter_and_apply_operations ~timestamp ~protocol_data state bi (operations, overflowing_ops)
+        >>= function
+        | Error errs ->
+            lwt_log_error Tag.DSL.(fun f ->
+                f "Client-side validation: error while filtering invalid operations :@\n@[<v 4>%a@]"
+                -% t event "client_side_validation_error"
+                -% a errs_tag errs) >>= fun () ->
+            lwt_log_notice Tag.DSL.(fun f ->
+                f "Building a block using shell validation"
+                -% t event "shell_prevalidation_notice") >>= fun () ->
+            shell_prevalidation cctxt ~chain ~block seed_nonce_hash
+              operations slot
+        | Ok (final_context, validation_result, operations) ->
+            lwt_debug Tag.DSL.(fun f ->
+                f "Try forging locally the block header for %a (slot %d) for %s (%a)"
+                -% t event "try_forging"
+                -% a Block_hash.Logging.tag bi.hash
+                -% s bake_priority_tag priority
+                -% s Client_keys.Logging.tag name
+                -% a timestamp_tag timestamp) >>= fun () ->
+            finalize_block_header final_context ~timestamp validation_result operations >>=? fun shell_header ->
+            let raw_ops = List.map (List.map forge) operations in
+            return_some (bi, priority, shell_header, raw_ops, delegate, seed_nonce_hash)
+
+let previously_baked_level cctxt pkh new_lvl =
+  State.get cctxt pkh  >>=? function
+  | None -> return_false
+  | Some last_lvl -> return (Raw_level.(last_lvl >= new_lvl))
+
+(** [bake cctxt state] create a single block when woken up to do
+    so. All the necessary information is available in the
+    [state.best_slot]. *)
+let bake (cctxt : #Proto_alpha.full) state =
+  begin match state.best_slot with
+    | None -> assert false (* unreachable *)
+    | Some slot -> return slot end >>=? fun slot ->
+
+  let seed_nonce = generate_seed_nonce () in
+  let seed_nonce_hash = Nonce.hash seed_nonce in
+
+  build_block cctxt state seed_nonce_hash slot >>=? function
+  | Some (head, priority, shell_header, operations, delegate, seed_nonce_hash) -> begin
+      let level = Raw_level.succ head.level in
+      Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "Injecting block (priority %d, fitness %a) for %s after %a..."
+          -% t event "start_injecting_block"
+          -% s bake_priority_tag priority
+          -% a fitness_tag shell_header.fitness
+          -% s Client_keys.Logging.tag name
+          -% a Block_hash.Logging.predecessor_tag shell_header.predecessor
+          -% t Signature.Public_key_hash.Logging.tag delegate) >>= fun () ->
+
+      Client_keys.get_key cctxt delegate >>=? fun (_, src_pk, src_sk) ->
+      let src_pkh = Signature.Public_key.hash src_pk in
+      let chain = `Hash head.Client_baking_blocks.chain_id in
+      (* avoid double baking *)
+      previously_baked_level cctxt src_pkh level >>=? function
+      | true ->
+          lwt_log_error Tag.DSL.(fun f ->
+              f "Level %a : previously baked"
+              -% t event "double_bake_near_miss"
+              -% a level_tag level) >>= fun () ->
+          return_unit
+      | false ->
+          (* Record baked blocks to prevent double baking and nonces to reveal later *)
+          State.record cctxt src_pkh level >>=? fun () ->
+
+          inject_block cctxt ~chain ~force:true
+            ~shell_header ~priority ?seed_nonce_hash ~src_sk operations >>= function
+          | Error errs ->
+              lwt_log_error Tag.DSL.(fun f ->
+                  f "@[<v 4>Error while injecting block@ @[Included operations : %a@]@ %a@]"
+                  -% t event "block_injection_failed"
+                  -% a raw_operations_tag (List.concat operations)
+                  -% a errs_tag errs) >>= fun () ->
+              return_unit
+
+          | Ok block_hash ->
+              lwt_log_notice Tag.DSL.(fun f ->
+                  f "Injected block %a for %s after %a (level %a, priority %d, fitness %a, operations %a)."
+                  -% t event "injected_block"
+                  -% a Block_hash.Logging.tag block_hash
+                  -% s Client_keys.Logging.tag name
+                  -% a Block_hash.Logging.tag shell_header.predecessor
+                  -% a level_tag level
+                  -% s bake_priority_tag priority
+                  -% a fitness_tag shell_header.fitness
+                  -% a operations_tag operations) >>= fun () ->
+
+              begin if seed_nonce_hash <> None then
+                  Client_baking_nonces.add cctxt block_hash seed_nonce
+                  |> trace_exn (Failure "Error while recording nonce")
+                else return_unit end >>=? fun () ->
+              return_unit
+    end
+  | None -> (* Error while building a block *)
+      lwt_log_error Tag.DSL.(fun f ->
+          f "Error while building a block."
+          -% t event "cannot_build_block") >>= fun () ->
+      return_unit
+
+(** [get_baking_slots] calls the node via RPC to retrieve the potential
+    slots for the given delegates within a given range of priority *)
+let get_baking_slots cctxt
+    ?(max_priority = default_max_priority)
+    new_head
+    delegates =
+  let chain = `Hash new_head.Client_baking_blocks.chain_id in
+  let block = `Hash (new_head.hash, 0) in
+  let level = Raw_level.succ new_head.level in
+  Alpha_services.Delegate.Baking_rights.get cctxt
+    ~max_priority
+    ~levels:[level]
+    ~delegates
+    (chain, block) >>= function
+  | Error errs ->
+      lwt_log_error Tag.DSL.(fun f ->
+          f "Error while fetching baking possibilities:\n%a"
+          -% t event "baking_slot_fetch_errors"
+          -% a errs_tag errs) >>= fun () ->
+      Lwt.return_nil
+  | Ok [] -> Lwt.return_nil
+  | Ok slots ->
+      let slots = List.filter_map
+          (function
+            | { Alpha_services.Delegate.Baking_rights.timestamp = None } -> None
+            | { timestamp = Some timestamp ; priority ; delegate } ->
+                Some (timestamp, (new_head, priority, delegate))
+          )
+          slots in
+      Lwt.return slots
+
+(** [compute_best_slot_on_current_level] retrieves, among the given
+    delegates, the highest priority slot for the current level. Then,
+    it registers this slot in the state so the timeout knows when to
+    wake up. *)
+let compute_best_slot_on_current_level
+    ?max_priority
+    (cctxt : #Proto_alpha.full)
+    state
+    new_head =
+  get_delegates cctxt state >>=? fun delegates ->
+  let level = Raw_level.succ new_head.Client_baking_blocks.level in
+  get_baking_slots cctxt ?max_priority new_head delegates >>= function
+  | [] ->
+      lwt_log_notice Tag.DSL.(fun f ->
+          let max_priority = Option.unopt ~default:default_max_priority max_priority in
+          f "No slot found at level %a (max_priority = %d)"
+          -% t event "no_slot_found"
+          -% a level_tag level
+          -% s bake_priority_tag max_priority) >>= fun () ->
+      return_none (* No slot found *)
+  | h::t ->
+      (* One or more slot found, fetching the best (lowest) priority.
+         We do not suppose that the received slots are sorted. *)
+      let (timestamp, (_, priority, delegate) as best_slot) =
+        List.fold_left
+          (fun ((_, (_, priority, _)) as acc) ((_, (_, priority', _)) as slot) ->
+             if priority < priority' then acc else slot
+          ) h t
+      in
+      Client_keys.Public_key_hash.name cctxt delegate >>=? fun name ->
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "New baking slot found (level %a, priority %d) at %a for %s after %a."
+          -% t event "have_baking_slot"
+          -% a level_tag level
+          -% s bake_priority_tag priority
+          -% a timestamp_tag timestamp
+          -% s Client_keys.Logging.tag name
+          -% a Block_hash.Logging.tag new_head.hash
+          -% t Signature.Public_key_hash.Logging.tag delegate) >>= fun () ->
+      (* Found at least a slot *)
+      return_some best_slot
+
+(** [filter_outdated_nonces] removes nonces older than 5 cycles in the nonce file *)
+let filter_outdated_nonces
+    (cctxt : #Proto_alpha.full)
+    ?(chain = `Main)
+    head =
+  Alpha_block_services.metadata
+    cctxt ~chain ~block:head () >>=? fun { protocol_data = { level = current_level } } ->
+  let current_cycle = Cycle.to_int32 current_level.Level.cycle in
+  let is_older_than_5_cycles block_cycle =
+    Int32.sub current_cycle (Cycle.to_int32 block_cycle) > 5l in
+  cctxt#with_lock begin fun () ->
+    Client_baking_nonces.load cctxt >>=? fun nonces ->
+    Block_hash.Map.fold
+      begin fun hash nonce acc ->
+        acc >>=? fun acc ->
+        Alpha_block_services.metadata cctxt ~chain ~block:(`Hash (hash, 0)) () >>=
+        function
+        | Result.Error _ -> return (Block_hash.Map.add hash nonce acc)
+        | Result.Ok { protocol_data = { level = { Level.cycle } } } ->
+            if is_older_than_5_cycles cycle then
+              return acc
+            else
+              return (Block_hash.Map.add hash nonce acc)
+      end
+      nonces
+      (return Block_hash.Map.empty) >>=? fun new_nonces ->
+    Client_baking_nonces.save cctxt new_nonces
+  end
+
+(** [get_unrevealed_nonces] retrieve registered nonces *)
+let get_unrevealed_nonces
+    (cctxt : #Proto_alpha.full) ?(force = false) ?(chain = `Main) head =
+  cctxt#with_lock begin fun () ->
+    Client_baking_nonces.load cctxt
+  end >>=? fun nonces ->
+  Client_baking_blocks.blocks_from_current_cycle
+    cctxt head ~offset:(-1l) () >>=? fun blocks ->
+  filter_map_s (fun hash ->
+      match Block_hash.Map.find_opt hash nonces with
+      | None -> return_none
+      | Some nonce ->
+          Alpha_block_services.metadata
+            cctxt ~chain ~block:(`Hash (hash, 0)) () >>=? fun { protocol_data = { level } } ->
+          if force then
+            return_some (hash, (level.level, nonce))
+          else
+            Alpha_services.Nonce.get
+              cctxt (chain, head) level.level >>=? function
+            | Missing nonce_hash
+              when Nonce.check_hash nonce nonce_hash ->
+                lwt_log_notice Tag.DSL.(fun f ->
+                    f "Found nonce to reveal for %a (level: %a)"
+                    -% t event "found_nonce"
+                    -% a Block_hash.Logging.tag hash
+                    -% a level_tag level.level)
+                >>= fun () ->
+                return_some (hash, (level.level, nonce))
+            | Missing _nonce_hash ->
+                lwt_log_error Tag.DSL.(fun f ->
+                    f "Incoherent nonce for level %a"
+                    -% t event "bad_nonce"
+                    -% a level_tag level.level)
+                >>= fun () -> return_none
+            | Forgotten -> return_none
+            | Revealed _ -> return_none)
+    blocks >>=? function
+  | [] -> return_nil
+  | x ->
+      (* If some nonces are to be revealed it means :
+         - We entered a new cycle and we can clear old nonces ;
+         - A revelation was not included yet in the cycle beggining.
+         So, it is safe to only filter outdated_nonces there *)
+      filter_outdated_nonces cctxt ~chain head >>=? fun () ->
+      return x
+
+(** [reveal_potential_nonces] reveal registered nonces *)
+let reveal_potential_nonces cctxt new_head =
+  get_unrevealed_nonces cctxt new_head >>= function
+  | Ok nonces ->
+      Client_baking_revelation.forge_seed_nonce_revelation
+        cctxt new_head (List.map snd nonces)
+  | Error err ->
+      lwt_warn Tag.DSL.(fun f ->
+          f "Cannot read nonces: %a"
+          -% t event "read_nonce_fail"
+          -% a errs_tag err) >>= fun () ->
+      return_unit
+
+(** [create] starts the main loop of the baker. The loop monitors new blocks and
+    starts individual baking operations when baking-slots are available to any of
+    the [delegates] *)
+let create
+    (cctxt : #Proto_alpha.full)
+    ?minimal_fees
+    ?minimal_nanotez_per_gas_unit
+    ?minimal_nanotez_per_byte
+    ?await_endorsements
+    ?max_priority
+    ~context_path
+    delegates
+    block_stream =
+  let state_maker genesis_hash bi =
+    let constants =
+      tzlazy (fun () -> Alpha_services.Constants.all cctxt (`Main, `Hash (bi.Client_baking_blocks.hash, 0))) in
+    Client_baking_simulator.load_context ~context_path >>= fun index ->
+    Client_baking_simulator.check_context_consistency index bi.context >>=? fun () ->
+    let state = create_state
+        ?minimal_fees ?minimal_nanotez_per_gas_unit ?minimal_nanotez_per_byte
+        ?await_endorsements
+        genesis_hash context_path index delegates constants in
+    return state
+  in
+
+  let event_k cctxt state new_head =
+    reveal_potential_nonces cctxt (`Hash (new_head.Client_baking_blocks.hash, 0)) >>= fun _ignore_nonce_err ->
+    compute_best_slot_on_current_level ?max_priority cctxt state new_head >>=? fun slot ->
+    state.best_slot <- slot ;
+    return_unit
+  in
+
+  let compute_timeout state =
+    match state.best_slot with
+    | None ->
+        (* No slot, just wait for new blocks which will give more info *)
+        Lwt_utils.never_ending ()
+    | Some (timestamp, _) ->
+        match Client_baking_scheduling.sleep_until timestamp with
+        | None -> Lwt.return_unit
+        | Some timeout -> timeout
+  in
+
+  let timeout_k cctxt state () =
+    bake cctxt state >>=? fun () ->
+    (* Stopping the timeout and waiting for the next block *)
+    state.best_slot <- None ;
+    return_unit
+  in
+
+  Client_baking_scheduling.main
+    ~name:"baker"
+    ~cctxt
+    ~stream:block_stream
+    ~state_maker
+    ~pre_loop:event_k
+    ~compute_timeout
+    ~timeout_k
+    ~event_k
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.mli
new file mode 100644
index 000000000..6bb57d7cc
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_forge.mli
@@ -0,0 +1,130 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+module State : sig
+  val get:
+    #Client_context.wallet ->
+    Signature.Public_key_hash.t ->
+    Raw_level.t option tzresult Lwt.t
+
+  val record:
+    #Client_context.wallet ->
+    Signature.Public_key_hash.t ->
+    Raw_level.t ->
+    unit tzresult Lwt.t
+end
+
+val generate_seed_nonce: unit -> Nonce.t
+(** [generate_seed_nonce ()] is a random nonce that is typically used
+    in block headers. When baking, bakers generate random nonces whose
+    hash is commited in the block they bake. They will typically
+    reveal the aforementionned nonce during the next cycle. *)
+
+val inject_block:
+  #Proto_alpha.full ->
+  ?force:bool ->
+  ?chain:Chain_services.chain ->
+  ?seed_nonce_hash:Nonce_hash.t ->
+  shell_header:Block_header.shell_header ->
+  priority:int ->
+  src_sk:Client_keys.sk_uri ->
+  Operation.raw list list ->
+  Block_hash.t tzresult Lwt.t
+(** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness
+    ~seed_nonce ~src_sk ops] tries to inject a block in the node. If
+    [?force] is set, the fitness check will be bypassed. [priority]
+    will be used to compute the baking slot (level is
+    precomputed). [src_sk] is used to sign the block header. *)
+
+type error +=
+  | Failed_to_preapply of Tezos_base.Operation.t * error list
+
+val forge_block:
+  #Proto_alpha.full ->
+  ?chain:Chain_services.chain ->
+  ?force:bool ->
+  ?operations: Operation.packed list ->
+  ?best_effort:bool ->
+  ?sort:bool ->
+  ?minimal_fees: Tez.t ->
+  ?minimal_nanotez_per_gas_unit: Z.t ->
+  ?minimal_nanotez_per_byte: Z.t ->
+  ?await_endorsements: bool ->
+  ?timestamp:Time.t ->
+  ?mempool:string ->
+  ?context_path:string ->
+  ?seed_nonce_hash:Nonce_hash.t ->
+  priority:[`Set of int | `Auto of (public_key_hash * int option)] ->
+  src_sk:Client_keys.sk_uri ->
+  Block_services.block ->
+  Block_hash.t tzresult Lwt.t
+(** [forge_block cctxt ?fee_threshold ?force ?operations ?best_effort
+    ?sort ?timestamp ?max_priority ?priority ~seed_nonce ~src_sk
+    pk_hash parent_blk] injects a block in the node. In addition of inject_block,
+    it will:
+
+    * Operations: If [?operations] is [None], it will get pending
+      operations and add them to the block. Otherwise, provided
+      operations will be used. In both cases, they will be validated.
+
+    * Baking priority: If [`Auto] is used, it will be computed from
+      the public key hash of the specified contract, optionally capped
+      to a maximum value, and optionnaly restricting for free baking slot.
+
+    * Timestamp: If [?timestamp] is set, and is compatible with the
+      computed baking priority, it will be used. Otherwise, it will be
+      set at the best baking priority.
+
+    * Fee Threshold: If [?fee_threshold] is given, operations with fees lower than it
+      are not added to the block.
+*)
+
+val create:
+  #Proto_alpha.full ->
+  ?minimal_fees: Tez.t ->
+  ?minimal_nanotez_per_gas_unit: Z.t ->
+  ?minimal_nanotez_per_byte: Z.t ->
+  ?await_endorsements: bool ->
+  ?max_priority: int ->
+  context_path: string ->
+  public_key_hash list ->
+  Client_baking_blocks.block_info tzresult Lwt_stream.t ->
+  unit tzresult Lwt.t
+
+val get_unrevealed_nonces:
+  #Proto_alpha.full ->
+  ?force:bool ->
+  ?chain:Chain_services.chain ->
+  Block_services.block ->
+  (Block_hash.t * (Raw_level.t * Nonce.t)) list tzresult Lwt.t
+
+val filter_outdated_nonces:
+  #Proto_alpha.full ->
+  ?chain:Block_services.chain ->
+  Shell_services.block ->
+  unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.ml
new file mode 100644
index 000000000..8a4b8eecf
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.ml
@@ -0,0 +1,151 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+let bake_block
+    (cctxt : #Proto_alpha.full)
+    ?(chain = `Main)
+    ?minimal_fees
+    ?minimal_nanotez_per_gas_unit
+    ?minimal_nanotez_per_byte
+    ?(await_endorsements = false)
+    ?force
+    ?max_priority
+    ?(minimal_timestamp = false)
+    ?mempool
+    ?context_path
+    ?src_sk
+    ?src_pk
+    block
+    delegate =
+  begin
+    match src_sk with
+    | None ->
+        Client_keys.get_key cctxt delegate >>=? fun (_, _, src_sk) ->
+        return src_sk
+    | Some sk -> return sk
+  end >>=? fun src_sk ->
+  begin
+    match src_pk with
+    | None ->
+        Client_keys.get_key cctxt delegate >>=? fun (_, src_pk, _) ->
+        return src_pk
+    | Some pk -> return pk
+  end >>=? fun src_pk ->
+  Alpha_services.Helpers.current_level
+    cctxt ~offset:1l (chain, block) >>=? fun level ->
+  let seed_nonce, seed_nonce_hash =
+    if level.expected_commitment then
+      let seed_nonce = Client_baking_forge.generate_seed_nonce () in
+      let seed_nonce_hash = Nonce.hash seed_nonce in
+      Some seed_nonce, Some seed_nonce_hash
+    else
+      None, None in
+  Client_baking_forge.forge_block cctxt
+    ?force
+    ?minimal_fees
+    ?minimal_nanotez_per_gas_unit
+    ?minimal_nanotez_per_byte
+    ~await_endorsements
+    ?timestamp:(if minimal_timestamp then None else Some (Time.now ()))
+    ?seed_nonce_hash
+    ?mempool
+    ?context_path
+    ~priority:(`Auto (delegate, max_priority))
+    ~src_sk
+    block >>=? fun block_hash ->
+  let src_pkh = Signature.Public_key.hash src_pk in
+  Client_baking_forge.State.record cctxt src_pkh level.level >>=? fun () ->
+  begin match seed_nonce with
+    | None -> return_unit
+    | Some seed_nonce ->
+        Client_baking_nonces.add cctxt block_hash seed_nonce
+        |> trace_exn (Failure "Error while recording block")
+  end >>=? fun () ->
+  cctxt#message "Injected block %a" Block_hash.pp_short block_hash >>= fun () ->
+  return_unit
+
+let endorse_block cctxt delegate =
+  Client_keys.get_key cctxt delegate >>=? fun (_src_name, src_pk, src_sk) ->
+  Client_baking_endorsement.forge_endorsement cctxt
+    cctxt#block ~src_sk src_pk >>=? fun oph ->
+  cctxt#answer "Operation successfully injected in the node." >>= fun () ->
+  cctxt#answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
+  return_unit
+
+let get_predecessor_cycle (cctxt : #Client_context.printer) cycle =
+  match Cycle.pred cycle with
+  | None ->
+      if Cycle.(cycle = root) then
+        cctxt#error "No predecessor for the first cycle"
+      else
+        cctxt#error
+          "Cannot compute the predecessor of cycle %a"
+          Cycle.pp cycle
+  | Some cycle -> Lwt.return cycle
+
+let do_reveal cctxt block blocks =
+  let nonces = List.map snd blocks in
+  Client_baking_revelation.forge_seed_nonce_revelation
+    cctxt block nonces >>=? fun () ->
+  return_unit
+
+let reveal_block_nonces (cctxt : #Proto_alpha.full) block_hashes =
+  cctxt#with_lock begin fun () ->
+    Client_baking_nonces.load cctxt
+  end >>=? fun nonces ->
+  Lwt_list.filter_map_p
+    (fun hash ->
+       Lwt.catch
+         (fun () ->
+            Client_baking_blocks.info cctxt (`Hash (hash, 0)) >>= function
+            | Ok bi -> Lwt.return_some bi
+            | Error _ ->
+                Lwt.fail Not_found)
+         (fun _ ->
+            cctxt#warning
+              "Cannot find block %a in the chain. (ignoring)@."
+              Block_hash.pp_short hash >>= fun () ->
+            Lwt.return_none))
+    block_hashes >>= fun block_infos ->
+  filter_map_s (fun (bi : Client_baking_blocks.block_info) ->
+      match Block_hash.Map.find_opt bi.hash nonces with
+      | None ->
+          cctxt#warning "Cannot find nonces for block %a (ignoring)@."
+            Block_hash.pp_short bi.hash >>= fun () ->
+          return_none
+      | Some nonce ->
+          return_some (bi.hash, (bi.level, nonce)))
+    block_infos >>=? fun blocks ->
+  do_reveal cctxt cctxt#block blocks
+
+let reveal_nonces cctxt () =
+  Client_baking_forge.get_unrevealed_nonces
+    cctxt cctxt#block >>=? fun nonces ->
+  do_reveal cctxt cctxt#block nonces >>=? fun () ->
+  Client_baking_forge.filter_outdated_nonces cctxt cctxt#block >>=? fun () ->
+  return_unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.mli
new file mode 100644
index 000000000..e92c233d2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_lib.mli
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+(** Mine a block *)
+val bake_block:
+  #Proto_alpha.full ->
+  ?chain:Chain_services.chain ->
+  ?minimal_fees: Tez.t ->
+  ?minimal_nanotez_per_gas_unit: Z.t ->
+  ?minimal_nanotez_per_byte: Z.t ->
+  ?await_endorsements: bool ->
+  ?force:bool ->
+  ?max_priority: int ->
+  ?minimal_timestamp: bool ->
+  ?mempool: string ->
+  ?context_path: string ->
+  ?src_sk:Client_keys.sk_uri ->
+  ?src_pk:Signature.public_key ->
+  Block_services.block ->
+  public_key_hash ->
+  unit tzresult Lwt.t
+
+(** Endorse a block *)
+val endorse_block:
+  #Proto_alpha.full ->
+  Client_keys.Public_key_hash.t ->
+  unit Error_monad.tzresult Lwt.t
+
+(** Get the previous cycle of the given cycle *)
+val get_predecessor_cycle:
+  #Proto_alpha.full ->
+  Cycle.t ->
+  Cycle.t Lwt.t
+
+(** Reveal the nonces used to bake each block in the given list *)
+val reveal_block_nonces :
+  #Proto_alpha.full ->
+  Block_hash.t list ->
+  unit Error_monad.tzresult Lwt.t
+
+(** Reveal all unrevealed nonces *)
+val reveal_nonces :
+  #Proto_alpha.full ->
+  unit ->
+  unit Error_monad.tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.ml
new file mode 100644
index 000000000..e465ab5ee
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.ml
@@ -0,0 +1,90 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+
+type t = Nonce.t Block_hash.Map.t
+
+let encoding : t Data_encoding.t =
+  let open Data_encoding in
+  def "seed_nonce" @@
+  conv
+    (fun m ->
+       Block_hash.Map.fold (fun hash nonce acc -> (hash, nonce) :: acc) m [])
+    (fun l ->
+       List.fold_left
+         (fun map (hash, nonce) -> Block_hash.Map.add hash nonce map)
+         Block_hash.Map.empty l) @@
+  list
+    (obj2
+       (req "block" Block_hash.encoding)
+       (req "nonce" Nonce.encoding))
+
+let name = "nonce"
+
+let load (wallet : #Client_context.wallet) =
+  wallet#load ~default:Block_hash.Map.empty name encoding
+
+let save (wallet : #Client_context.wallet) list =
+  wallet#with_lock begin fun () ->
+    wallet#write name list encoding
+  end
+
+let mem (wallet : #Client_context.wallet) block_hash =
+  wallet#with_lock begin fun () ->
+    load wallet >>|? fun data ->
+    Block_hash.Map.mem block_hash data
+  end
+
+let find (wallet : #Client_context.wallet) block_hash =
+  wallet#with_lock begin fun () ->
+    load wallet >>|? fun data ->
+    try Some (Block_hash.Map.find block_hash data)
+    with Not_found -> None
+  end
+
+
+let add (wallet : #Client_context.wallet) block_hash nonce =
+  wallet#with_lock begin fun () ->
+    load wallet >>=? fun data ->
+    save wallet (Block_hash.Map.add block_hash nonce data)
+  end
+
+let del (wallet : #Client_context.wallet) block_hash =
+  wallet#with_lock begin fun () ->
+    load wallet >>=? fun data ->
+    save wallet (Block_hash.Map.remove block_hash data)
+  end
+
+let dels (wallet : #Client_context.wallet) hashes =
+  wallet#with_lock begin fun () ->
+    load wallet >>=? fun data ->
+    save wallet @@
+    List.fold_left
+      (fun data hash -> Block_hash.Map.remove hash data)
+      data hashes
+  end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.mli
new file mode 100644
index 000000000..fb3f0fcb3
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_nonces.mli
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t = Nonce.t Block_hash.Map.t
+
+val load:
+  #Client_context.wallet ->
+  t tzresult Lwt.t
+val save:
+  #Client_context.wallet ->
+  t -> unit tzresult Lwt.t
+val mem:
+  #Client_context.wallet ->
+  Block_hash.t -> bool tzresult Lwt.t
+val find:
+  #Client_context.wallet ->
+  Block_hash.t -> Nonce.t option tzresult Lwt.t
+val add:
+  #Client_context.wallet ->
+  Block_hash.t -> Nonce.t -> unit tzresult Lwt.t
+val del:
+  #Client_context.wallet ->
+  Block_hash.t -> unit tzresult Lwt.t
+val dels:
+  #Client_context.wallet ->
+  Block_hash.t list -> unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.ml
new file mode 100644
index 000000000..2f447b2c1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.ml
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let generate_proof_of_work_nonce () =
+  Rand.generate Alpha_context.Constants.proof_of_work_nonce_size
+
+let empty_proof_of_work_nonce =
+  MBytes.of_string
+    (String.make Constants_repr.proof_of_work_nonce_size  '\000')
+
+let mine cctxt chain block shell builder =
+  Alpha_services.Constants.all cctxt (chain, block) >>=? fun constants ->
+  let threshold = constants.parametric.proof_of_work_threshold in
+  let rec loop () =
+    let block = builder (generate_proof_of_work_nonce ()) in
+    if Baking.check_header_proof_of_work_stamp shell block threshold then
+      return block
+    else
+      loop ()
+  in
+  loop ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.mli
new file mode 100644
index 000000000..4e150c45d
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_pow.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+(** A null proof-of-work nonce. This should only be used to non-sensical blocks
+    of the correct size and shape. *)
+val empty_proof_of_work_nonce: Cstruct.buffer
+
+(** [mine cctxt chain block header builder] returns a block with a valid
+    proof-of-work nonce. The function [builder], provided by the caller, is used
+    to make the block. All the internal logic of generating nonces and checking
+    for the proof-of-work threshold is handled by [mine]. *)
+val mine:
+  #Proto_alpha.full ->
+  Shell_services.chain ->
+  Block_services.block ->
+  Block_header.shell_header ->
+  (Cstruct.buffer -> Proto_alpha.Alpha_context.Block_header.contents) ->
+  Proto_alpha.Alpha_context.Block_header.contents tzresult Lwt.t
+
+
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.ml
new file mode 100644
index 000000000..f80421179
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.ml
@@ -0,0 +1,71 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.nonce_revelation" end)
+
+open Proto_alpha
+
+let inject_seed_nonce_revelation rpc_config ?(chain = `Main) block ?async nonces =
+  Alpha_block_services.hash rpc_config ~chain ~block () >>=? fun branch ->
+  map_p
+    (fun (level, nonce) ->
+       Alpha_services.Forge.seed_nonce_revelation rpc_config
+         (chain, block) ~branch ~level ~nonce () >>=? fun bytes ->
+       let bytes = Signature.concat bytes Signature.zero in
+       Shell_services.Injection.operation rpc_config ?async ~chain bytes >>=? fun oph ->
+       lwt_debug Tag.DSL.(fun f ->
+           f "Revealing nonce %a from level %a at chain %a, block %a with operation %a"
+           -% t event "reveal_nonce"
+           -% a Logging.nonce_tag nonce
+           -% a Logging.level_tag level
+           -% a Logging.chain_tag chain
+           -% a Logging.block_tag block
+           -% a Operation_hash.Logging.tag oph) >>= fun () ->
+       return oph)
+    nonces >>=? fun ophs ->
+  return ophs
+
+let forge_seed_nonce_revelation
+    (cctxt: #Proto_alpha.full)
+    ?(chain = `Main)
+    block nonces =
+  Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
+  match nonces with
+  | [] ->
+      lwt_log_notice Tag.DSL.(fun f ->
+          f "Nothing to reveal for block %a"
+          -% t event "no_nonce_reveal"
+          -% a Block_hash.Logging.tag hash
+        ) >>= fun () ->
+      return_unit
+  | _ ->
+      inject_seed_nonce_revelation cctxt ~chain block nonces >>=? fun oph ->
+      cctxt#answer
+        "Operation successfully injected %d revelation(s) for %a."
+        (List.length nonces)
+        Block_hash.pp_short hash >>= fun () ->
+      cctxt#answer "@[<v 2>Operation hash are:@ %a@]"
+        (Format.pp_print_list Operation_hash.pp_short) oph >>= fun () ->
+      return_unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.mli
new file mode 100644
index 000000000..0a5545622
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_revelation.mli
@@ -0,0 +1,42 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val inject_seed_nonce_revelation:
+  #Proto_alpha.rpc_context ->
+  ?chain: Chain_services.chain ->
+  Block_services.block ->
+  ?async:bool ->
+  (Raw_level.t * Nonce.t) list ->
+  Operation_hash.t list tzresult Lwt.t
+
+val forge_seed_nonce_revelation:
+  #Proto_alpha.full ->
+  ?chain: Chain_services.chain ->
+  Block_services.block ->
+  (Raw_level.t * Nonce.t) list ->
+  unit tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.ml
new file mode 100644
index 000000000..70a6bd570
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.ml
@@ -0,0 +1,144 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Tezos_stdlib.Logging.Make_semantic(struct let name = "client.scheduling" end)
+
+open Logging
+
+let sleep_until time =
+  let delay = Time.diff time (Time.now ()) in
+  if delay < 0L then
+    None
+  else
+    Some (Lwt_unix.sleep (Int64.to_float delay))
+
+let rec wait_for_first_event ~name stream =
+  Lwt_stream.get stream >>= function
+  | None | Some (Error _) ->
+      lwt_log_info Tag.DSL.(fun f ->
+          f "Can't fetch the current event. Waiting for new event."
+          -% t event "cannot_fetch_event"
+          -% t worker_tag name) >>= fun () ->
+      (* NOTE: this is not a tight loop because of Lwt_stream.get *)
+      wait_for_first_event ~name stream
+  | Some (Ok bi) ->
+      Lwt.return bi
+
+let log_errors_and_continue ~name p =
+  p >>= function
+  | Ok () -> Lwt.return_unit
+  | Error errs -> lwt_log_error Tag.DSL.(fun f ->
+      f "Error while baking:@\n%a"
+      -% t event "daemon_error"
+      -% t worker_tag name
+      -% a errs_tag errs)
+
+let main
+    ~(name: string)
+    ~(cctxt: #Proto_alpha.full)
+    ~(stream: 'event tzresult Lwt_stream.t)
+    ~(state_maker: (Block_hash.t ->
+                    'event ->
+                    'state tzresult Lwt.t))
+    ~(pre_loop: (#Proto_alpha.full ->
+                 'state ->
+                 'event ->
+                 unit tzresult Lwt.t))
+    ~(compute_timeout: ('state -> 'timesup Lwt.t))
+    ~(timeout_k: (#Proto_alpha.full ->
+                  'state ->
+                  'timesup ->
+                  unit tzresult Lwt.t))
+    ~(event_k: (#Proto_alpha.full ->
+                'state ->
+                'event ->
+                unit tzresult Lwt.t))
+  =
+
+  lwt_log_info Tag.DSL.(fun f ->
+      f "Setting up before the %s can start."
+      -% t event "daemon_setup"
+      -% s worker_tag name) >>= fun () ->
+
+  wait_for_first_event ~name stream >>= fun first_event ->
+  Shell_services.Blocks.hash cctxt ~block:`Genesis () >>=? fun genesis_hash ->
+
+  (* statefulness *)
+  let last_get_event = ref None in
+  let get_event () =
+    match !last_get_event with
+    | None ->
+        let t = Lwt_stream.get stream in
+        last_get_event := Some t ;
+        t
+    | Some t -> t in
+  state_maker genesis_hash first_event >>=? fun state ->
+
+  log_errors_and_continue ~name @@ pre_loop cctxt state first_event >>= fun () ->
+
+  (* main loop *)
+  let rec worker_loop () =
+    begin
+      (* event construction *)
+      let timeout = compute_timeout state in
+      Lwt.choose [ (Lwt_exit.termination_thread >|= fun _ -> `Termination) ;
+                   (timeout >|= fun timesup -> `Timeout timesup) ;
+                   (get_event () >|= fun e -> `Event e) ;
+                 ] >>= function
+        (* event matching *)
+      | `Termination ->
+          return_unit
+      | `Event (None | Some (Error _)) ->
+          (* exit when the node is unavailable *)
+          last_get_event := None ;
+          lwt_log_error Tag.DSL.(fun f ->
+              f "Connection to node lost, %s exiting."
+              -% t event "daemon_connection_lost"
+              -% s worker_tag name) >>= fun () ->
+          return_unit
+      | `Event (Some (Ok event)) -> begin
+          (* new event: cancel everything and execute callback *)
+          last_get_event := None ;
+          (* TODO: pretty-print events (requires passing a pp as argument) *)
+          log_errors_and_continue ~name @@ event_k cctxt state event >>= fun () ->
+          worker_loop ()
+        end
+      | `Timeout timesup ->
+          (* main event: it's time *)
+          lwt_debug Tag.DSL.(fun f ->
+              f "Waking up for %s."
+              -% t event "daemon_wakeup"
+              -% s worker_tag name) >>= fun () ->
+          (* core functionality *)
+          log_errors_and_continue ~name @@ timeout_k cctxt state timesup >>= fun () ->
+          worker_loop ()
+    end in
+
+  (* ignition *)
+  lwt_log_info Tag.DSL.(fun f ->
+      f "Starting %s daemon"
+      -% t event "daemon_start"
+      -% s worker_tag name) >>= fun () ->
+  worker_loop ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.mli
new file mode 100644
index 000000000..a07cf267b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_scheduling.mli
@@ -0,0 +1,56 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 sleep_until: Time.t -> unit Lwt.t option
+
+val wait_for_first_event:
+  name:string ->
+  'event tzresult Lwt_stream.t ->
+  'event Lwt.t
+
+val main :
+  name:string ->
+  cctxt:(#Proto_alpha.full as 'a) ->
+  stream:'event tzresult Lwt_stream.t ->
+  state_maker:(Block_hash.t -> 'event -> 'state tzresult Lwt.t) ->
+  pre_loop:('a -> 'state -> 'event -> unit tzresult Lwt.t) ->
+  compute_timeout:('state -> 'timesup Lwt.t) ->
+  timeout_k:('a -> 'state -> 'timesup -> unit tzresult Lwt.t) ->
+  event_k:('a -> 'state -> 'event -> unit tzresult Lwt.t) ->
+  unit tzresult Lwt.t
+
+(** [main ~name ~cctxt ~stream ~state_maker ~pre_loop ~timeout_maker ~timeout_k
+    ~event_k] is an infinitely running loop that
+    monitors new events arriving on [stream]. The loop exits when the
+    [stream] gives an error.
+
+    The function [pre_loop] is called before the loop starts.
+
+    The loop maintains a state (of type ['state]) initialized by [state_maker]
+    and passed to the callbacks [timeout_maker] (used to set up waking-up
+    timeouts), [timeout_k] (when a computed timeout happens), and [event_k]
+    (when a new event arrives on the stream).
+*)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.ml
new file mode 100644
index 000000000..5baed68cd
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.ml
@@ -0,0 +1,116 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type error += Failed_to_checkout_context
+type error += Invalid_context
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"Client_baking_simulator.failed_to_checkout_context"
+    ~title: "Failed to checkout context"
+    ~description: "The given context hash does not exists in the context."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Failed to checkout the context")
+    Data_encoding.unit
+    (function
+      | Failed_to_checkout_context -> Some ()
+      | _ -> None)
+    (fun () -> Failed_to_checkout_context) ;
+  register_error_kind
+    `Permanent
+    ~id:"Client_baking_simulator.invalid_context"
+    ~title: "Invalid context"
+    ~description: "Occurs when the context is inconsistent."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The given context is invalid.")
+    Data_encoding.unit
+    (function
+      | Invalid_context -> Some ()
+      | _ -> None)
+    (fun () -> Invalid_context)
+
+type incremental = {
+  predecessor: Client_baking_blocks.block_info ;
+  context : Context.t ;
+  state: LiftedMain.validation_state ;
+  rev_operations: Operation.packed list ;
+  header: Tezos_base.Block_header.shell_header ;
+}
+
+let load_context ~context_path =
+  Context.init ~readonly:true context_path
+
+let check_context_consistency index context_hash =
+  (* Hypothesis : the version key exists *)
+  let version_key = ["version"] in
+  Context.checkout index context_hash >>= function
+  | None -> fail Failed_to_checkout_context
+  | Some context ->
+      Context.mem context version_key >>= function
+      | true -> return_unit
+      | false -> fail Invalid_context
+
+let begin_construction ~timestamp ?protocol_data index predecessor =
+  let { Client_baking_blocks.context } = predecessor in
+  Context.checkout index context >>= function
+  | None -> fail Failed_to_checkout_context
+  | Some context ->
+      let header : Tezos_base.Block_header.shell_header = Tezos_base.Block_header.{
+          predecessor = predecessor.hash  ;
+          proto_level = predecessor.proto_level ;
+          validation_passes = 0 ;
+          fitness = predecessor.fitness ;
+          timestamp ;
+          level = Raw_level.to_int32 predecessor.level ;
+          context = Context_hash.zero ;
+          operations_hash = Operation_list_list_hash.zero ;
+        } in
+      LiftedMain.begin_construction
+        ~chain_id: predecessor.chain_id
+        ~predecessor_context: context
+        ~predecessor_timestamp: predecessor.timestamp
+        ~predecessor_fitness: predecessor.fitness
+        ~predecessor_level: (Raw_level.to_int32 predecessor.level)
+        ~predecessor: predecessor.hash
+        ?protocol_data
+        ~timestamp
+        () >>=? fun state ->
+      return {
+        predecessor ;
+        context ;
+        state ;
+        rev_operations = [] ;
+        header ;
+      }
+
+let add_operation st ( op : Operation.packed ) =
+  LiftedMain.apply_operation st.state op >>=? fun (state, receipt) ->
+  return ({ st with state ; rev_operations = op :: st.rev_operations }, receipt)
+
+let finalize_construction inc =
+  LiftedMain.finalize_block inc.state
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.mli
new file mode 100644
index 000000000..b72e2ac71
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_baking_simulator.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type incremental = {
+  predecessor: Client_baking_blocks.block_info ;
+  context : Context.t ;
+  state: Main.validation_state ;
+  rev_operations: Operation.packed list ;
+  header: Tezos_base.Block_header.shell_header ;
+}
+
+val load_context : context_path:string -> Context.index Lwt.t
+
+(** Make sure that the given context is consistent by trying to read in it *)
+val check_context_consistency : Context.index -> Context_hash.t -> unit tzresult Lwt.t
+
+val begin_construction : timestamp:Time.t -> ?protocol_data: block_header_data -> Context.index -> Client_baking_blocks.block_info -> incremental tzresult Lwt.t
+
+val add_operation : incremental -> Operation.packed -> (incremental * LiftedMain.operation_receipt) tzresult Lwt.t
+
+val finalize_construction : incremental -> (T.validation_result * LiftedMain.block_header_metadata) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.ml
new file mode 100644
index 000000000..cf17838c6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.ml
@@ -0,0 +1,107 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 rec retry (cctxt: #Proto_alpha.full) ~delay ~tries f x =
+  f x >>= function
+  | Ok _ as r -> Lwt.return r
+  | Error (RPC_client.Request_failed
+             { error = Connection_failed _ ; _ } :: _) as err
+    when tries > 0 -> begin
+      cctxt#message
+        "Connection refused, retrying in %.2f seconds..."
+        delay >>= fun () ->
+      Lwt.pick
+        [ (Lwt_unix.sleep delay >|= fun () -> `Continue) ;
+          (Lwt_exit.termination_thread >|= fun _ -> `Killed) ;
+        ] >>= function
+      | `Killed ->
+          Lwt.return err
+      | `Continue ->
+          retry cctxt ~delay:(delay *. 1.5) ~tries:(tries - 1) f x
+    end
+  | Error _ as err ->
+      Lwt.return err
+
+let await_bootstrapped_node (cctxt: #Proto_alpha.full) =
+  (* Waiting for the node to be synchronized *)
+  cctxt#message "Waiting for the node to be synchronized with its \
+                 peers..." >>= fun () ->
+  retry cctxt ~tries:5 ~delay:1.
+    Shell_services.Monitor.bootstrapped cctxt >>=? fun _ ->
+  cctxt#message "Node synchronized." >>= fun () ->
+  return_unit
+
+module Endorser = struct
+
+  let run (cctxt : #Proto_alpha.full) ~delay delegates =
+    await_bootstrapped_node cctxt >>=? fun _ ->
+    Client_baking_blocks.monitor_heads
+      ~next_protocols:(Some [Proto_alpha.hash])
+      cctxt `Main >>=? fun block_stream ->
+    cctxt#message "Endorser started." >>= fun () ->
+    Client_baking_endorsement.create cctxt ~delay delegates block_stream >>=? fun () ->
+    return_unit
+
+end
+
+module Baker = struct
+
+  let run
+      (cctxt : #Proto_alpha.full)
+      ?minimal_fees
+      ?minimal_nanotez_per_gas_unit
+      ?minimal_nanotez_per_byte
+      ?await_endorsements
+      ?max_priority
+      ~context_path
+      delegates =
+    await_bootstrapped_node cctxt >>=? fun _ ->
+    Client_baking_blocks.monitor_heads
+      ~next_protocols:(Some [Proto_alpha.hash])
+      cctxt `Main >>=? fun block_stream ->
+    cctxt#message "Baker started." >>= fun () ->
+    Client_baking_forge.create cctxt
+      ?minimal_fees
+      ?minimal_nanotez_per_gas_unit
+      ?minimal_nanotez_per_byte
+      ?await_endorsements
+      ?max_priority
+      ~context_path delegates block_stream >>=? fun () ->
+    return_unit
+
+end
+
+module Accuser = struct
+
+  let run (cctxt : #Proto_alpha.full) ~preserved_levels =
+    await_bootstrapped_node cctxt >>=? fun _ ->
+    Client_baking_blocks.monitor_valid_blocks
+      ~next_protocols:(Some [Proto_alpha.hash])
+      cctxt ~chains:[ `Main ] () >>=? fun valid_blocks_stream ->
+    cctxt#message "Accuser started." >>= fun () ->
+    Client_baking_denunciation.create cctxt ~preserved_levels valid_blocks_stream >>=? fun () ->
+    return_unit
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.mli
new file mode 100644
index 000000000..a72c5ae2a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/client_daemon.mli
@@ -0,0 +1,53 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+module Endorser : sig
+  val run:
+    #Proto_alpha.full ->
+    delay: int ->
+    public_key_hash list -> unit tzresult Lwt.t
+end
+
+module Baker : sig
+  val run:
+    #Proto_alpha.full ->
+    ?minimal_fees: Tez.t ->
+    ?minimal_nanotez_per_gas_unit: Z.t ->
+    ?minimal_nanotez_per_byte: Z.t ->
+    ?await_endorsements: bool ->
+    ?max_priority: int ->
+    context_path: string ->
+    public_key_hash list -> unit tzresult Lwt.t
+end
+
+module Accuser : sig
+  val run:
+    #Proto_alpha.full ->
+    preserved_levels: int ->
+    unit tzresult Lwt.t
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/daemon_state.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/daemon_state.ml
new file mode 100644
index 000000000..da35c6ac2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/daemon_state.ml
@@ -0,0 +1,56 @@
+open Proto_alpha
+open Alpha_context
+
+module Make(M:sig val name :string end)  : sig
+
+  val get:
+    #Client_context.wallet ->
+    Signature.Public_key_hash.t ->
+    Raw_level.t option tzresult Lwt.t
+
+  val record:
+    #Client_context.wallet ->
+    Signature.Public_key_hash.t ->
+    Raw_level.t ->
+    unit tzresult Lwt.t
+
+end = struct
+  type t = (string * Raw_level.t) list
+
+  let encoding : t Data_encoding.t =
+    Data_encoding.assoc Raw_level.encoding
+
+  let name = M.name
+
+  let load (wallet : #Client_context.wallet) =
+    wallet#load name encoding ~default:[]
+
+  let save (wallet : #Client_context.wallet) list =
+    wallet#write name list encoding
+
+  let get (wallet : #Client_context.wallet) (delegate_key:Signature.public_key_hash) =
+    wallet#with_lock
+      (fun () ->
+         load wallet >>=? fun l ->
+         return (List.assoc_opt (Signature.Public_key_hash.to_short_b58check delegate_key) l)
+      )
+
+  let record (wallet : #Client_context.wallet) (delegate:Signature.public_key_hash) (new_lvl:Raw_level.t) =
+    begin
+      wallet#with_lock (fun () ->
+          begin
+            load wallet >>=? fun l  ->
+            let delegate_key = Signature.Public_key_hash.to_short_b58check delegate
+            in
+            let remove_old l =
+              List.filter
+                (fun (_, lvl) -> Raw_level.diff new_lvl lvl < 50l (* FIXME: magic constant*))
+                l
+            in
+            save wallet ((delegate_key, new_lvl)::
+                         List.remove_assoc delegate_key (remove_old l))
+          end)
+    end
+end
+
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.ml
new file mode 100644
index 000000000..ce2982825
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.ml
@@ -0,0 +1,204 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Client_proto_args
+open Client_baking_lib
+
+let group =
+  { Clic.name = "delegate" ;
+    title = "Commands related to delegate operations." }
+
+let directory_parameter =
+  Clic.parameter (fun _ p ->
+      if not (Sys.file_exists p && Sys.is_directory p) then
+        failwith "Directory doesn't exist: '%s'" p
+      else
+        return p)
+
+let mempool_arg =
+  Clic.arg
+    ~long:"mempool"
+    ~placeholder:"file"
+    ~doc:"When used the client will read the mempool in the provided file instead of querying the node through an RPC (useful for debugging only)."
+    string_parameter
+
+let context_path_arg =
+  Clic.arg
+    ~long:"context"
+    ~placeholder:"path"
+    ~doc:"When use the client will read in the local context at the provided path in order to build the block, instead of relying on the 'preapply' RPC."
+    string_parameter
+
+let pidfile_arg =
+  Clic.arg
+    ~doc: "write process id in file"
+    ~short: 'P'
+    ~long: "pidfile"
+    ~placeholder: "filename"
+    (Clic.parameter (fun _ s -> return s))
+
+let may_lock_pidfile = function
+  | None -> return_unit
+  | Some pidfile ->
+      trace (failure "Failed to create the pidfile: %s" pidfile) @@
+      Lwt_lock_file.create ~unlink_on_exit:true pidfile
+
+let delegate_commands () =
+  let open Clic in
+  [
+    command ~group ~desc: "Forge and inject block using the delegate rights."
+      (args9
+         max_priority_arg
+         minimal_fees_arg
+         minimal_nanotez_per_gas_unit_arg
+         minimal_nanotez_per_byte_arg
+         await_endorsements_arg
+         force_switch
+         minimal_timestamp_switch
+         mempool_arg
+         context_path_arg)
+      (prefixes [ "bake"; "for" ]
+       @@ Client_keys.Public_key_hash.source_param
+         ~name:"baker" ~desc: "name of the delegate owning the baking right"
+       @@ stop)
+      (fun (max_priority, minimal_fees,
+            minimal_nanotez_per_gas_unit, minimal_nanotez_per_byte,
+            await_endorsements, force,
+            minimal_timestamp, mempool, context_path)
+        delegate cctxt ->
+        bake_block cctxt cctxt#block
+          ~minimal_fees
+          ~minimal_nanotez_per_gas_unit
+          ~minimal_nanotez_per_byte
+          ~await_endorsements
+          ~force ?max_priority ~minimal_timestamp
+          ?mempool ?context_path delegate) ;
+    command ~group ~desc: "Forge and inject a seed-nonce revelation operation."
+      no_options
+      (prefixes [ "reveal"; "nonce"; "for" ]
+       @@ seq_of_param Block_hash.param)
+      (fun () block_hashes cctxt ->
+         reveal_block_nonces cctxt block_hashes) ;
+    command ~group ~desc: "Forge and inject all the possible seed-nonce revelation operations."
+      no_options
+      (prefixes [ "reveal"; "nonces" ]
+       @@ stop)
+      (fun () cctxt ->
+         reveal_nonces cctxt ()) ;
+    command ~group ~desc: "Forge and inject an endorsement operation."
+      no_options
+      (prefixes [ "endorse"; "for" ]
+       @@ Client_keys.Public_key_hash.source_param
+         ~name:"baker" ~desc: "name of the delegate owning the endorsement right"
+       @@ stop)
+      (fun () delegate cctxt -> endorse_block cctxt delegate) ;
+  ]
+
+let init_signal () =
+  let handler name id =
+    try
+      Format.eprintf "Received the %s signal, triggering shutdown.@." name ;
+      Lwt_exit.exit id
+    with _ -> () in
+  ignore (Lwt_unix.on_signal Sys.sigint (handler "INT") : Lwt_unix.signal_handler_id) ;
+  ignore (Lwt_unix.on_signal Sys.sigterm (handler "TERM") : Lwt_unix.signal_handler_id)
+
+let baker_commands () =
+  let open Clic in
+  let group =
+    { Clic.name = "delegate.baker" ;
+      title = "Commands related to the baker daemon." }
+  in
+  [
+    command ~group ~desc: "Launch the baker daemon."
+      (args6
+         pidfile_arg
+         max_priority_arg
+         minimal_fees_arg
+         minimal_nanotez_per_gas_unit_arg
+         minimal_nanotez_per_byte_arg
+         no_waiting_for_endorsements_arg)
+      (prefixes [ "run" ; "with" ; "local" ; "node" ]
+       @@ param
+         ~name:"context_path"
+         ~desc:"Path to the node data directory (e.g. $HOME/.tezos-node)"
+         directory_parameter
+       @@ seq_of_param Client_keys.Public_key_hash.alias_param)
+      (fun (pidfile, max_priority, minimal_fees, minimal_nanotez_per_gas_unit,
+            minimal_nanotez_per_byte, no_waiting_for_endorsements)
+        node_path delegates cctxt ->
+        init_signal () ;
+        may_lock_pidfile pidfile >>=? fun () ->
+        Tezos_signer_backends.Encrypted.decrypt_list
+          cctxt (List.map fst delegates) >>=? fun () ->
+        Client_daemon.Baker.run cctxt
+          ~minimal_fees
+          ~minimal_nanotez_per_gas_unit
+          ~minimal_nanotez_per_byte
+          ?max_priority
+          ~await_endorsements:(not no_waiting_for_endorsements)
+          ~context_path:(Filename.concat node_path "context")
+          (List.map snd delegates)
+      )
+  ]
+
+let endorser_commands () =
+  let open Clic in
+  let group =
+    { Clic.name = "delegate.endorser" ;
+      title = "Commands related to endorser daemon." }
+  in
+  [
+    command ~group ~desc: "Launch the endorser daemon"
+      (args2 pidfile_arg endorsement_delay_arg)
+      (prefixes [ "run" ]
+       @@ seq_of_param Client_keys.Public_key_hash.alias_param)
+      (fun (pidfile, endorsement_delay) delegates cctxt ->
+         init_signal () ;
+         may_lock_pidfile pidfile >>=? fun () ->
+         Tezos_signer_backends.Encrypted.decrypt_list
+           cctxt (List.map fst delegates) >>=? fun () ->
+         Client_daemon.Endorser.run cctxt
+           ~delay:endorsement_delay
+           (List.map snd delegates)
+      )
+  ]
+
+let accuser_commands () =
+  let open Clic in
+  let group =
+    { Clic.name = "delegate.accuser" ;
+      title = "Commands related to the accuser daemon." }
+  in
+  [
+    command ~group ~desc: "Launch the accuser daemon"
+      (args2 pidfile_arg preserved_levels_arg)
+      (prefixes [ "run" ]
+       @@ stop)
+      (fun (pidfile, preserved_levels) cctxt ->
+         init_signal () ;
+         may_lock_pidfile pidfile >>=? fun () ->
+         Client_daemon.Accuser.run ~preserved_levels cctxt) ;
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.mli
new file mode 100644
index 000000000..fb4a1555a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands.mli
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 delegate_commands : unit -> Proto_alpha.full Clic.command list
+
+val baker_commands : unit -> Proto_alpha.full Clic.command list
+val endorser_commands : unit -> Proto_alpha.full Clic.command list
+val accuser_commands : unit -> Proto_alpha.full Clic.command list
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands_registration.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands_registration.ml
new file mode 100644
index 000000000..c3896ea9e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/delegate_commands_registration.ml
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Client_commands.register Proto_alpha.hash @@ fun _network ->
+  List.map (Clic.map_command (new Proto_alpha.wrap_full)) @@
+  Delegate_commands.delegate_commands ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/dune b/vendors/tezos-modded/src/proto_alpha/lib_delegate/dune
new file mode 100644
index 000000000..bb3ed553b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/dune
@@ -0,0 +1,82 @@
+(library
+ (name tezos_baking_alpha)
+ (public_name tezos-baking-alpha)
+ (libraries tezos-base
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-alpha
+            tezos-client-commands
+            tezos-storage
+            tezos-rpc-http
+            tezos-rpc)
+ (library_flags (:standard -linkall))
+ (modules (:standard \
+                     delegate_commands
+                     delegate_commands_registration))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_storage
+                   -open Tezos_rpc
+                   -open Tezos_rpc_http)))
+
+(library
+ (name tezos_baking_alpha_commands)
+ (public_name tezos-baking-alpha-commands)
+ (libraries tezos-base
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-alpha
+            tezos-client-commands
+            tezos-baking-alpha)
+ (library_flags (:standard -linkall))
+ (modules delegate_commands)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_baking_alpha
+                   -open Tezos_rpc)))
+
+(library
+ (name tezos_baking_alpha_commands_registration)
+ (public_name tezos-baking-alpha-commands.registration)
+ (libraries tezos-base
+            tezos-protocol-alpha
+            tezos-protocol-environment
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-alpha
+            tezos-client-commands
+            tezos-baking-alpha
+            tezos-baking-alpha-commands
+            tezos-rpc)
+ (library_flags (:standard -linkall))
+ (modules delegate_commands_registration)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_alpha
+                   -open Tezos_client_commands
+                   -open Tezos_baking_alpha
+                   -open Tezos_baking_alpha_commands
+                   -open Tezos_rpc)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.ml
new file mode 100644
index 000000000..a6da7b59f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.ml
@@ -0,0 +1,70 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+let timestamp_tag = Tag.def ~doc:"Timestamp when event occurred" "timestamp" Time.pp_hum
+let valid_ops = Tag.def ~doc:"Valid Operations" "valid_ops" Format.pp_print_int
+let refused_ops = Tag.def ~doc:"Refused Operations" "refused_ops" Format.pp_print_int
+let bake_priority_tag = Tag.def ~doc:"Baking priority" "bake_priority" Format.pp_print_int
+let fitness_tag = Tag.def ~doc:"Fitness" "fitness" Fitness.pp
+let current_slots_tag = Tag.def ~doc:"Number of baking slots that can be baked at this time" "current_slots" Format.pp_print_int
+let future_slots_tag = Tag.def ~doc:"Number of baking slots in the foreseeable future but not yet bakeable" "future_slots" Format.pp_print_int
+let timespan_tag = Tag.def ~doc:"Time in seconds" "timespan" (fun fmt i -> Format.fprintf fmt "%Lds" i)
+
+let signed_header_tag = Tag.def ~doc:"Signed header" "signed_header" MBytes.pp_hex
+let signed_operation_tag = Tag.def ~doc:"Signed operation" "signed_operation" MBytes.pp_hex
+let operations_tag = Tag.def ~doc:"Block Operations" "operations"
+    (Format.pp_print_list
+       ~pp_sep:(fun ppf () -> Format.fprintf ppf "+")
+       (fun ppf operations -> Format.fprintf ppf "%d" (List.length operations)))
+
+let raw_operations_tag = Tag.def ~doc:"Raw operations" "raw_operations"
+    (fun fmt raw_ops ->
+       let pp_op fmt op =
+         let json = Data_encoding.Json.construct Operation.raw_encoding op in
+         Format.fprintf fmt "%a" Data_encoding.Json.pp json
+       in
+       Format.fprintf fmt "@[<v>%a@]" (Format.pp_print_list ~pp_sep:Format.pp_print_cut pp_op) raw_ops)
+
+let bake_op_count_tag = Tag.def ~doc:"Bake Operation Count" "operation_count" Format.pp_print_int
+
+let endorsement_slot_tag = Tag.def ~doc:"Endorsement Slot" "endorsement_slot" Format.pp_print_int
+let endorsement_slots_tag = Tag.def ~doc:"Endorsement Slots" "endorsement_slots" Format.(fun ppf v -> pp_print_int ppf (List.length v))
+let denounced_endorsements_slots_tag = Tag.def ~doc:"Endorsement Slots" "denounced_endorsement_slots" Format.(pp_print_list pp_print_int)
+let denouncement_source_tag = Tag.def ~doc:"Denounce Source" "source" Format.pp_print_text
+
+let level_tag = Tag.def ~doc:"Level" "level" Raw_level.pp
+let nonce_tag = Tag.def ~doc:"Nonce" "nonce" Data_encoding.Json.(fun ppf nonce -> pp ppf (construct Nonce.encoding nonce))
+let chain_tag = Tag.def ~doc:"Chain selector" "chain" Format.(fun ppf chain -> pp_print_string ppf @@ Block_services.chain_to_string chain)
+let block_tag = Tag.def ~doc:"Block selector" "block" Format.(fun ppf block -> pp_print_string ppf @@ Block_services.to_string block)
+
+let worker_tag = Tag.def ~doc:"Worker in which event occurred" "worker" Format.pp_print_text
+
+let block_header_tag = Tag.def ~doc:"Raw block header" "block_header" (fun ppf _ -> Format.fprintf ppf "[raw block header]")
+
+let conflicting_endorsements_tag = Tag.def ~doc:"Two conflicting endorsements signed by the same key" "conflicting_endorsements" Format.(
+    fun ppf (a,b) -> fprintf ppf "%a / %a" Operation_hash.pp (Operation.hash a) Operation_hash.pp (Operation.hash b))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.mli
new file mode 100644
index 000000000..fc6cc554b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/logging.mli
@@ -0,0 +1,52 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 timestamp_tag : Time.t Tag.def
+val valid_ops : int Tag.def
+val refused_ops : int Tag.def
+val bake_priority_tag : int Tag.def
+val fitness_tag : Fitness.t Tag.def
+val current_slots_tag : int Tag.def
+val future_slots_tag : int Tag.def
+val timespan_tag : int64 Tag.def
+
+val signed_header_tag : MBytes.t Tag.def
+val signed_operation_tag : MBytes.t Tag.def
+val operations_tag : Tezos_base.Operation.t list list Tag.def
+val raw_operations_tag : Proto_alpha.Alpha_context.Operation.raw list Tag.def
+val bake_op_count_tag : int Tag.def
+val endorsement_slot_tag : int Tag.def
+val endorsement_slots_tag : int list Tag.def
+val denounced_endorsements_slots_tag : int list Tag.def
+val denouncement_source_tag : string Tag.def
+val level_tag : Proto_alpha.Alpha_context.Raw_level.t Tag.def
+val nonce_tag : Proto_alpha.Alpha_context.Nonce.t Tag.def
+val chain_tag : Block_services.chain Tag.def
+val block_tag : Block_services.block Tag.def
+val worker_tag : string Tag.def
+val block_header_tag : Block_header.t Tag.def
+
+open Proto_alpha.Alpha_context
+val conflicting_endorsements_tag : (Kind.endorsement operation * Kind.endorsement operation) Tag.def
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/dune b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/dune
new file mode 100644
index 000000000..073fc6a81
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/dune
@@ -0,0 +1,54 @@
+(executables
+ (names test_michelson_parser
+        test_rpc
+        test_vote)
+ (libraries tezos-base
+            tezos-rpc-http
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-genesis
+            tezos-client-alpha
+            tezos-baking-alpha
+            tezos-client-base-unix
+            tezos-signer-backends
+            alcotest-lwt)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_rpc_http
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_genesis
+                   -open Tezos_client_alpha
+                   -open Tezos_baking_alpha
+                   -open Tezos_client_base_unix)))
+
+(alias
+ (name buildtest)
+ (deps test_michelson_parser.exe
+       test_rpc.exe
+       test_vote.exe))
+
+(alias
+ (name runtest_michelson_parser)
+ (action (run %{exe:test_michelson_parser.exe})))
+
+(alias
+ (name runtest_vote)
+ (locks  /tcp-port/18400)
+ (action (chdir %{workspace_root} (run %{exe:test_vote.exe} %{bin:tezos-node} 18400))))
+
+(alias
+ (name runtest_rpc)
+ (locks  /tcp-port/18500)
+ (action (chdir %{workspace_root} (run %{exe:test_rpc.exe} %{bin:tezos-node} 18500))))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_michelson_parser)
+       (alias runtest_rpc)
+       (alias runtest_vote)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.ml
new file mode 100644
index 000000000..32ffd9180
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.ml
@@ -0,0 +1,109 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+exception Node_exited_prematurely
+
+let handle_error res log_file_name =
+  match res with
+  | 0, _ ->
+      ()
+  | pid, Unix.WEXITED x ->
+      Printf.eprintf "Wait: %d, exit %d\n\nDumping log:\n\n%!" pid x ;
+      ignore (Sys.command (Printf.sprintf "cat %s" log_file_name) : int) ;
+      raise Node_exited_prematurely
+  | pid, Unix.WSIGNALED x ->
+      Printf.eprintf "Wait: %d, signaled %d\n\nDumping log:\n\n%!" pid x ;
+      ignore (Sys.command (Printf.sprintf "cat %s" log_file_name) : int) ;
+      raise Node_exited_prematurely
+  | pid, Unix.WSTOPPED x ->
+      Printf.eprintf "Wait: %d, stopped %d\n\nDumping log:\n\n%!" pid x ;
+      ignore (Sys.command (Printf.sprintf "cat %s" log_file_name) : int) ;
+      raise Node_exited_prematurely
+
+let fork_node ?exe ?(timeout = 4) ?(port = 18732) ?sandbox () =
+  let data_dir =
+    Printf.sprintf
+      "%s/tezos_node_%6X"
+      (Filename.get_temp_dir_name ())
+      (Random.int 0xFF_FF_FF) in
+  let log_file_name, log_file =
+    Filename.open_temp_file "tezos_node_" ".log" in
+  let sandbox =
+    match sandbox with
+    | None -> None
+    | Some json ->
+        let file_name, ch =
+          Filename.open_temp_file "tezos_node_" ".log" in
+        Printf.fprintf ch "%s%!"
+          (Data_encoding.Json.to_string json) ;
+        close_out ch ;
+        Some file_name in
+  let log_fd = Unix.descr_of_out_channel log_file in
+  let null_fd = Unix.(openfile "/dev/null" [O_RDONLY] 0o644) in
+  let exe =
+    match exe with
+    | Some exe -> exe
+    | None ->
+        let (//) = Filename.concat in
+        try
+          let path = Sys.argv.(1) in
+          if Filename.is_relative path then
+            Sys.getcwd () // ".." // path
+          else
+            path
+        with _ -> Sys.getcwd () // ".." // "bin_node" // "main.exe" in
+  let pid =
+    Unix.create_process exe
+      [| "tezos-node" ;
+         "run" ;
+         "--data-dir"; data_dir ;
+         (match sandbox with
+          | None -> "--sandbox"
+          | Some path -> "--sandbox=" ^ path);
+         "--rpc-addr"; "[::]:" ^ string_of_int port |]
+      null_fd log_fd log_fd in
+  Printf.printf "Created node, pid: %d, log: %s\n%!" pid log_file_name ;
+  Printf.printf "Waiting %d seconds for its initialisation\n%!" timeout ;
+  Unix.sleep timeout ;
+  match Unix.waitpid [Unix.WNOHANG] pid with
+  | 0, _ ->
+      Pervasives.at_exit begin fun () ->
+        begin
+          match Unix.waitpid [Unix.WNOHANG] pid with
+          | 0, _ ->
+              Unix.kill pid Sys.sigkill ;
+              Unix.sleep 1
+          | res ->
+              handle_error res log_file_name
+        end ;
+        ignore (Sys.command (Printf.sprintf "rm -fr \"%s\"" data_dir)) ;
+        match sandbox with
+        | None -> ()
+        | Some file -> ignore (Sys.command (Printf.sprintf "rm -f \"%s\"" file))
+      end ;
+      pid
+  | res ->
+      handle_error res log_file_name ;
+      0
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.mli
new file mode 100644
index 000000000..5701688d1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/node_helpers.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 fork_node:
+  ?exe:string -> ?timeout:int -> ?port:int ->
+  ?sandbox:Data_encoding.json ->
+  unit -> int
+(** [fork_node ()] forks a node in sandbox mode listening to rpc on
+    `localhost:port` (where the default port is 18732) and returns the
+    PID of the forked process. It waits `timeout` seconds (default 4)
+    before to return and it may fails with an exception whenever the node
+    died during the wait.  *)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml
new file mode 100644
index 000000000..3422e2172
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml
@@ -0,0 +1,650 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(* Copyright (c) 2018 Nomadic Labs, <contact@nomadic-labs.com>               *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+let (//) = Filename.concat
+
+let () = Random.self_init ()
+
+let rpc_config = ref {
+    RPC_client.host = "localhost" ;
+    port = 8192 + Random.int 8192 ;
+    tls = false ;
+    logger = RPC_client.null_logger ;
+  }
+
+let build_rpc_context config =
+  new Proto_alpha.wrap_proto_context @@
+  new RPC_client.http_ctxt config Media_type.all_media_types
+
+let rpc_ctxt = ref (build_rpc_context !rpc_config)
+
+(* Context that does not write to alias files *)
+let no_write_context ?(block = `Head 0) config : #Client_context.full = object
+  inherit RPC_client.http_ctxt config Media_type.all_media_types
+  inherit Client_context.simple_printer (fun _ _ -> Lwt.return_unit)
+  method load : type a. string -> default:a -> a Data_encoding.encoding -> a Error_monad.tzresult Lwt.t =
+    fun _ ~default _ -> return default
+  method write : type a. string ->
+    a ->
+    a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t =
+    fun _ _ _ -> return_unit
+  method with_lock : type a. (unit -> a Lwt.t) -> a Lwt.t = fun f -> f ()
+  method block = block
+  method confirmations = None
+  method password_filename = None
+  method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a =
+    Format.kasprintf (fun _ -> return "")
+  method prompt_password : type a. (a, MBytes.t tzresult) Client_context.lwt_format -> a =
+    Format.kasprintf (fun _ -> return (MBytes.of_string ""))
+end
+
+let sandbox_parameters =
+  let json_result =
+    Data_encoding.Json.from_string {json|
+{ "genesis_pubkey": "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2" }
+|json} in
+  match json_result with
+  | Error err -> raise (Failure err)
+  | Ok json -> json
+
+let protocol_parameters =
+  let json_result =
+    Data_encoding.Json.from_string {json|
+{ "bootstrap_accounts": [
+    [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", "4000000000000" ],
+    [ "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", "4000000000000" ],
+    [ "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", "4000000000000" ],
+    [ "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", "4000000000000" ],
+    [ "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n", "4000000000000" ]
+  ],
+  "commitments": [
+    [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
+    [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
+    [ "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428348" ],
+    [ "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ],
+    [ "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ],
+    [ "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ],
+    [ "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ],
+    [ "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ],
+    [ "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ],
+    [ "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ]
+  ],
+  "time_between_blocks" : [ "1", "0" ],
+  "blocks_per_cycle" : 4,
+  "blocks_per_roll_snapshot" : 2,
+  "preserved_cycles" : 1,
+  "proof_of_work_threshold": "-1"
+}
+|json} in
+  match json_result with
+  | Error err -> raise (Failure err)
+  | Ok json ->
+      Data_encoding.Binary.to_bytes_exn Data_encoding.json json
+
+let vote_protocol_parameters =
+  let json_result =
+    Data_encoding.Json.from_string {json|
+{ "bootstrap_accounts": [
+    [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", "4000000000000" ],
+    [ "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", "4000000000000" ],
+    [ "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", "4000000000000" ],
+    [ "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", "4000000000000" ],
+    [ "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n", "4000000000000" ]
+  ],
+  "time_between_blocks" : [ "1", "0" ],
+  "blocks_per_cycle" : 4,
+  "blocks_per_roll_snapshot" : 2,
+  "preserved_cycles" : 1,
+  "blocks_per_voting_period": 2,
+  "proof_of_work_threshold": "-1"
+}
+|json} in
+  match json_result with
+  | Error err -> raise (Failure err)
+  | Ok json ->
+      Data_encoding.Binary.to_bytes_exn Data_encoding.json json
+
+let activate_alpha ?(vote = false) () =
+  let fitness = Fitness_repr.from_int64 0L in
+  let activator_sk =
+    Tezos_signer_backends.Unencrypted.make_sk
+      (Signature.Secret_key.of_b58check_exn
+         "edsk31vznjHSSpGExDMHYASz45VZqXN4DPxvsa4hAyY8dHM28cZzp6") in
+  let protocol_parameters =
+    if vote then vote_protocol_parameters else protocol_parameters in
+  Tezos_client_genesis.Client_proto_main.bake
+    (no_write_context ~block:(`Head 0) !rpc_config) (`Head 0)
+    (Activate  { protocol = Proto_alpha.hash ;
+                 fitness ;
+                 protocol_parameters ;
+               })
+    activator_sk
+
+let init ?exe ?vote ?rpc_port () =
+  begin
+    match rpc_port with
+    | None -> ()
+    | Some port ->
+        rpc_config := { !rpc_config with port } ;
+        rpc_ctxt := build_rpc_context !rpc_config ;
+  end ;
+  let pid =
+    Node_helpers.fork_node
+      ?exe
+      ~port:!rpc_config.port
+      ~sandbox:sandbox_parameters
+      () in
+  activate_alpha ?vote () >>=? fun hash ->
+  return (pid, hash)
+
+let level (chain, block) =
+  Alpha_block_services.metadata
+    !rpc_ctxt ~chain ~block () >>=? fun { protocol_data = { level } } ->
+  return level
+
+let rpc_raw_context block path depth =
+  Shell_services.Blocks.Context.read !rpc_ctxt ~block ~depth path
+
+module Account = struct
+
+  type t = {
+    alias : string ;
+    sk : Signature.secret_key ;
+    pk : Signature.public_key ;
+    pkh : Signature.public_key_hash ;
+    contract : Contract.t ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { alias ; sk ; pk ; pkh ; contract } ->
+         (alias, sk, pk, pkh, contract)
+      )
+      (fun (alias, sk, pk, pkh, contract) ->
+         { alias ; sk ; pk ; pkh ; contract })
+      (obj5
+         (req "alias" string)
+         (req "sk" Signature.Secret_key.encoding)
+         (req "pk" Signature.Public_key.encoding)
+         (req "pkh" Signature.Public_key_hash.encoding)
+         (req "contract" Contract.encoding))
+
+  let pp_account ppf account =
+    let json = Data_encoding.Json.construct encoding account in
+    Format.fprintf ppf "%s" (Data_encoding.Json.to_string json)
+
+  let create ?keys alias =
+    let sk, pk = match keys with
+      | Some keys -> keys
+      | None -> let _, pk, sk = Signature.generate_key () in sk, pk in
+    let pkh = Signature.Public_key.hash pk in
+    let contract = Contract.implicit_contract pkh in
+    { alias ; contract ; pkh ; pk ; sk }
+
+  type destination = {
+    alias : string ;
+    contract : Contract.t ;
+    pk : public_key ;
+    pkh : public_key_hash ;
+  }
+
+  let destination_encoding =
+    let open Data_encoding in
+    conv
+      (fun { alias ; pk ; pkh ; contract } ->
+         (alias, pk, pkh, contract))
+      (fun (alias, pk, pkh, contract) ->
+         { alias ; pk ; pkh ; contract })
+      (obj4
+         (req "alias" string)
+         (req "pk" Signature.Public_key.encoding)
+         (req "pkh" Signature.Public_key_hash.encoding)
+         (req "contract" Contract.encoding))
+
+  let pp_destination ppf destination =
+    let json = Data_encoding.Json.construct destination_encoding destination in
+    Format.fprintf ppf "%s" (Data_encoding.Json.to_string json)
+
+  let create_destination ~alias ~contract ~pk =
+    let pkh = Signature.Public_key.hash pk in
+    { alias ; contract ; pk ; pkh }
+
+  type bootstrap_accounts = { b1 : t ; b2 : t ; b3 : t ; b4 : t ;  b5 : t  ; }
+
+  let bootstrap_accounts =
+    let bootstrap1_sk =
+      "edsk3gUfUPyBSfrS9CCgmCiQsTCHGkviBDusMxDJstFtojtc1zcpsh" in
+    let bootstrap2_sk =
+      "edsk39qAm1fiMjgmPkw1EgQYkMzkJezLNewd7PLNHTkr6w9XA2zdfo" in
+    let bootstrap3_sk =
+      "edsk4ArLQgBTLWG5FJmnGnT689VKoqhXwmDPBuGx3z4cvwU9MmrPZZ" in
+    let bootstrap4_sk =
+      "edsk2uqQB9AY4FvioK2YMdfmyMrer5R8mGFyuaLLFfSRo8EoyNdht3" in
+    let bootstrap5_sk =
+      "edsk4QLrcijEffxV31gGdN2HU7UpyJjA8drFoNcmnB28n89YjPNRFm" in
+    let cpt = ref 0 in
+    match List.map begin fun sk ->
+        incr cpt ;
+        let sk = Signature.Secret_key.of_b58check_exn sk in
+        let alias = Printf.sprintf "bootstrap%d" !cpt in
+        let pk = Signature.Secret_key.to_public_key sk in
+        let pkh = Signature.Public_key.hash pk in
+        { alias ; contract = Contract.implicit_contract pkh; pkh ; pk ; sk }
+      end [ bootstrap1_sk; bootstrap2_sk; bootstrap3_sk;
+            bootstrap4_sk; bootstrap5_sk; ]
+    with
+    | [ b1 ; b2 ; b3 ; b4 ; b5 ] -> { b1 ; b2 ; b3 ; b4 ; b5 }
+    | _ -> assert false
+
+  let transfer
+      ?(block = `Head 0)
+      ?(fee = Tez.fifty_cents)
+      ~(account:t)
+      ~destination
+      ~amount
+      ?(fee_parameter = Injection.dummy_fee_parameter)
+      () =
+    let src_sk =
+      Tezos_signer_backends.Unencrypted.make_sk account.sk in
+    Client_proto_context.transfer
+      (new wrap_full (no_write_context !rpc_config ~block))
+      ~chain:`Main
+      ~block
+      ~source:account.contract
+      ~src_pk:account.pk
+      ~src_sk
+      ~destination
+      ~amount
+      ~fee
+      ~fee_parameter
+      () >>=? fun ((oph, _, _), contracts) ->
+    return (oph, contracts)
+
+  let originate
+      ?(block = `Head 0)
+      ?delegate
+      ?(fee = Tez.fifty_cents)
+      ~(src:t)
+      ~manager_pkh
+      ~balance
+      ?(fee_parameter = Injection.dummy_fee_parameter)
+      () =
+    let delegatable, delegate = match delegate with
+      | None -> false, None
+      | Some delegate -> true, Some delegate in
+    let src_sk =
+      Tezos_signer_backends.Unencrypted.make_sk src.sk in
+    Client_proto_context.originate_account
+      (new wrap_full (no_write_context !rpc_config))
+      ~chain:`Main
+      ~block
+      ~source:src.contract
+      ~src_pk:src.pk
+      ~src_sk
+      ~manager_pkh
+      ~balance
+      ~delegatable
+      ?delegate
+      ~fee
+      ~fee_parameter
+      () >>=? fun ((oph, _, _), contracts) ->
+    return (oph, contracts)
+
+  let set_delegate
+      ?(block = `Head 0)
+      ?(fee = Tez.fifty_cents)
+      ~contract
+      ~manager_sk
+      ~src_pk
+      ?(fee_parameter = Injection.dummy_fee_parameter)
+      delegate_opt =
+    Client_proto_context.set_delegate
+      (new wrap_full (no_write_context ~block !rpc_config))
+      ~chain:`Main
+      ~block
+      ~fee
+      contract
+      ~src_pk
+      ~manager_sk
+      ~fee_parameter
+      delegate_opt >>=? fun (oph, _, _) ->
+    return oph
+
+  let balance ?(block = `Head 0) (account : t) =
+    Alpha_services.Contract.balance !rpc_ctxt
+      (`Main, block) account.contract
+
+  (* TODO: gather contract related functions in a Contract module? *)
+  let delegate ?(block = `Head 0) (contract : Contract.t) =
+    Alpha_services.Contract.delegate_opt !rpc_ctxt (`Main, block) contract
+
+end
+
+let sign ?watermark src_sk shell (Contents_list contents) =
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.unsigned_encoding
+      (shell, (Contents_list contents)) in
+  let signature = Some (Signature.sign ?watermark src_sk bytes) in
+  let protocol_data = Operation_data { contents ; signature } in
+  return { shell ; protocol_data }
+
+module Protocol = struct
+
+  open Account
+
+  let voting_period_kind ?(block = `Head 0) () =
+    Alpha_block_services.metadata
+      !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { voting_period_kind } } ->
+    return voting_period_kind
+
+  let proposals ?(block = `Head 0) ~src:({ pkh; sk } : Account.t) proposals =
+    Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
+    Alpha_services.Helpers.current_level
+      !rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
+    let shell = { Tezos_base.Operation.branch = hash } in
+    let contents =
+      Proposals { source = pkh ;
+                  period = next_level.voting_period ;
+                  proposals } in
+    sign ~watermark:Generic_operation sk shell (Contents_list (Single contents))
+
+  let ballot ?(block = `Head 0) ~src:({ pkh; sk } : Account.t) ~proposal ballot =
+    Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
+    Alpha_services.Helpers.current_level
+      !rpc_ctxt ~offset:1l (`Main, block) >>=? fun next_level ->
+    let shell = { Tezos_base.Operation.branch = hash } in
+    let contents =
+      Single
+        (Ballot { source = pkh ;
+                  period = next_level.voting_period ;
+                  proposal ;
+                  ballot }) in
+    sign ~watermark:Generic_operation sk shell (Contents_list contents)
+
+end
+
+module Assert = struct
+
+  let fail expected given msg =
+    Format.kasprintf Pervasives.failwith
+      "@[%s@ expected: %s@ got: %s@]" msg expected given
+  let fail_msg fmt = Format.kasprintf (fail "" "") fmt
+
+  let default_printer _ = ""
+
+  let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+    if not (eq x y) then fail (prn x) (prn y) msg
+  let make_equal e p = equal ~eq:e ~prn:p
+  let equal_bool = make_equal (=) string_of_bool
+  let equal_int = make_equal (=) string_of_int
+
+  let equal_pkh ?msg pkh1 pkh2 =
+    let eq pkh1 pkh2 =
+      match pkh1, pkh2 with
+      | None, None -> true
+      | Some pkh1, Some pkh2 ->
+          Signature.Public_key_hash.equal pkh1 pkh2
+      | _ -> false in
+    let prn = function
+      | None -> "none"
+      | Some pkh -> Signature.Public_key_hash.to_b58check pkh in
+    equal ?msg ~prn ~eq pkh1 pkh2
+
+  let equal_tez ?msg tz1 tz2 =
+    let eq tz1 tz2 = Int64.equal (Tez.to_mutez tz1) (Tez.to_mutez tz2) in
+    let prn = Tez.to_string in
+    equal ?msg ~prn ~eq tz1 tz2
+
+  let balance_equal ?block ~msg account expected_balance =
+    Account.balance ?block account >>=? fun actual_balance ->
+    match Tez.of_mutez expected_balance with
+    | None ->
+        failwith "invalid tez constant"
+    | Some expected_balance ->
+        return (equal_tez ~msg expected_balance actual_balance)
+
+  let delegate_equal ?block ~msg contract expected_delegate =
+    Account.delegate ?block contract >>|? fun actual_delegate ->
+    equal_pkh ~msg expected_delegate actual_delegate
+
+  let ecoproto_error f = function
+    | Alpha_environment.Ecoproto_error error -> f error
+    | _ -> false
+
+  let hash op = Tezos_base.Operation.hash op
+
+  let contain_error ?(msg="") ~f = function
+    | Ok _ -> fail "Error _" "Ok _" msg
+    | Error error when not (List.exists f error) ->
+        let error_str = Format.asprintf "%a" Error_monad.pp_print_error error in
+        fail "" error_str msg
+    | _ -> ()
+
+  let failed_to_preapply ~msg ?op f =
+    contain_error ~msg ~f:begin function
+      | Client_baking_forge.Failed_to_preapply (op', err) ->
+          begin
+            match op with
+            | None -> true
+            | Some { shell ; protocol_data = Operation_data protocol_data } ->
+                let h = Operation.hash { shell ; protocol_data } and h' = hash op' in
+                Operation_hash.equal h h'
+          end && List.exists (ecoproto_error f) err
+      | _ -> false
+    end
+
+  let generic_economic_error ~msg =
+    contain_error ~msg ~f:(ecoproto_error (fun _ -> true))
+
+  let unknown_contract ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Raw_context.Storage_error _ -> true
+        | _ -> false)
+    end
+
+  let non_existing_contract ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract_storage.Non_existing_contract _ -> true
+        | _ -> false)
+    end
+
+  let balance_too_low ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract.Balance_too_low _ -> true
+        | _ -> false)
+    end
+
+  let non_spendable ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract_storage.Unspendable_contract _ -> true
+        | _ -> false)
+    end
+
+  let inconsistent_pkh ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract_storage.Inconsistent_hash _ -> true
+        | _ -> false)
+    end
+
+  let inconsistent_public_key ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract_storage.Inconsistent_public_key _ -> true
+        | _ -> false)
+    end
+
+  let missing_public_key ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Contract_storage.Unrevealed_manager_key _ -> true
+        | _ -> false)
+    end
+
+  let non_delegatable ~msg =
+    contain_error ~msg ~f:begin ecoproto_error (function
+        | Delegate_storage.Non_delegatable_contract _ -> true
+        | _ -> false)
+    end
+
+  let check_protocol ?msg ~block h =
+    Block_services.protocols
+      !rpc_ctxt ~block () >>=? fun { next_protocol } ->
+    return @@ equal
+      ?msg
+      ~prn:Protocol_hash.to_b58check
+      ~eq:Protocol_hash.equal
+      next_protocol h
+
+  let check_voting_period_kind ?msg ~block kind =
+    Alpha_block_services.metadata
+      !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { voting_period_kind } } ->
+    return @@ equal
+      ?msg
+      voting_period_kind
+      kind
+
+  let is_none ?(msg="") x =
+    if x <> None then fail "None" "Some _" msg
+  let is_some ?(msg="") x =
+    if x = None then fail "Some _" "None" msg
+
+end
+
+module Baking = struct
+
+  let bake block (contract: Account.t) operations =
+    let ctxt = (new wrap_full (no_write_context ~block !rpc_config)) in
+    Alpha_services.Helpers.current_level
+      ctxt ~offset:1l (`Main, block) >>=? fun level ->
+    let seed_nonce_hash =
+      if level.Level.expected_commitment then
+        let seed_nonce =
+          match Nonce.of_bytes @@
+            Rand.generate Constants.nonce_length with
+          | Error _ -> assert false
+          | Ok nonce -> nonce in
+        Some (Nonce.hash seed_nonce)
+      else
+        None in
+    let src_sk =
+      Tezos_signer_backends.Unencrypted.make_sk contract.sk in
+    Client_baking_forge.forge_block
+      ctxt
+      ~operations
+      ~force:true
+      ~best_effort:false
+      ~sort:false
+      ~priority:(`Auto (contract.pkh, Some 1024))
+      ?seed_nonce_hash
+      ~src_sk
+      block
+
+end
+
+module Endorse = struct
+
+  let forge_endorsement
+      block
+      src_sk
+    =
+    Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
+    Alpha_block_services.metadata
+      !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
+    let level = level.level in
+    let shell = { Tezos_base.Operation.branch = hash } in
+    let contents =
+      Single (Endorsement { level }) in
+    sign ~watermark:(Endorsement Chain_id.zero) src_sk shell (Contents_list contents)
+
+  let signing_slots
+      block
+      delegate
+      level =
+    Alpha_services.Delegate.Endorsing_rights.get
+      !rpc_ctxt ~delegates:[delegate] ~levels:[level]
+      (`Main, block) >>=? function
+    | [{ slots }] -> return slots
+    | _ -> return_nil
+
+  let endorse
+      (contract : Account.t)
+      block =
+    forge_endorsement block contract.sk
+
+  (* FIXME @vb: I don't understand this function, copied from @cago. *)
+  let endorsers_list block =
+    let get_endorser_list result (account : Account.t) level block =
+      Alpha_services.Delegate.Endorsing_rights.get
+        !rpc_ctxt (`Main, block)
+        ~delegates:[account.pkh]
+        ~levels:[level] >>|? function
+      | [{ slots }] ->
+          List.iter (fun s -> result.(s) <- account) slots
+      | _ -> () in
+    let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in
+    let result = Array.make 32 b1 in
+    Alpha_block_services.metadata
+      !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
+    let level = level.level in
+    get_endorser_list result b1 level block >>=? fun () ->
+    get_endorser_list result b2 level block >>=? fun () ->
+    get_endorser_list result b3 level block >>=? fun () ->
+    get_endorser_list result b4 level block >>=? fun () ->
+    get_endorser_list result b5 level block >>=? fun () ->
+    return result
+
+  let endorsement_rights
+      (contract : Account.t) block =
+    Alpha_block_services.metadata
+      !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
+    let level = level.level in
+    let delegate = contract.pkh in
+    Alpha_services.Delegate.Endorsing_rights.get
+      !rpc_ctxt
+      ~levels:[level]
+      ~delegates:[delegate]
+      (`Main, block) >>=? function
+    | [{ level ; slots }] -> return (List.map (fun s -> (level, s)) slots)
+    | _ -> return_nil
+
+end
+
+let display_level block =
+  Alpha_block_services.metadata
+    !rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
+  Format.eprintf "Level: %a@." Level.pp_full level ;
+  return_unit
+
+let endorsement_security_deposit block =
+  Constants_services.all !rpc_ctxt (`Main, block) >>=? fun c ->
+  return c.parametric.endorsement_security_deposit
+
+let () =
+  Client_keys.register_signer
+    (module Tezos_signer_backends.Unencrypted)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.mli b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.mli
new file mode 100644
index 000000000..4cdcd072c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/proto_alpha_helpers.mli
@@ -0,0 +1,229 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val init :
+  ?exe:string ->
+  ?vote:bool ->
+  ?rpc_port:int ->
+  unit -> (int * Block_hash.t) tzresult Lwt.t
+(** [init ()] sets up the test environment, and return the PID of
+    forked Tezos node and the block info of the block from where the
+    tests will begin. *)
+
+val level:
+  Chain_services.chain * Block_services.block -> Alpha_context.Level.t tzresult Lwt.t
+
+(** Calls the rpc service raw_context using the right rpc context *)
+val rpc_raw_context : Block_services.block -> string list -> int ->
+  Block_services.raw_context tzresult Lwt.t
+
+module Account : sig
+
+  type t = {
+    alias : string ;
+    sk : Signature.Secret_key.t ;
+    pk : Signature.Public_key.t ;
+    pkh : Signature.Public_key_hash.t ;
+    contract : Contract.t ;
+  }
+
+  val encoding : t Data_encoding.t
+  val pp_account : Format.formatter -> t -> unit
+  val create : ?keys:(Signature.secret_key * public_key) -> string -> t
+  (** [create ?keys alias] is an account with alias [alias]. If
+      [?keys] is [None], a pair of keys will be minted. *)
+
+  type destination = {
+    alias : string ;
+    contract : Contract.t ;
+    pk : public_key ;
+    pkh : public_key_hash ;
+  }
+
+  val destination_encoding : destination Data_encoding.t
+  val pp_destination : Format.formatter -> destination -> unit
+  val create_destination :
+    alias:string ->
+    contract:Contract.t ->
+    pk:public_key -> destination
+  (** [create_destination ~alias ~contract ~pk] is a destination
+      contract [contract] with manager's publick key [pk]. *)
+
+  type bootstrap_accounts = { b1 : t ; b2 : t ; b3 : t ; b4 : t ; b5 : t }
+
+  val bootstrap_accounts : bootstrap_accounts
+  (** The hardcoded bootstrap accounts. *)
+
+  val transfer :
+    ?block:Block_services.block ->
+    ?fee: Tez.t ->
+    account:t ->
+    destination:Contract.t ->
+    amount: Tez.t ->
+    ?fee_parameter:Injection.fee_parameter ->
+    unit ->
+    (Operation_hash.t * Contract.t list) tzresult Lwt.t
+
+  val originate :
+    ?block:Block_services.block ->
+    ?delegate:public_key_hash ->
+    ?fee: Tez.t ->
+    src:t ->
+    manager_pkh:public_key_hash ->
+    balance: Tez.t ->
+    ?fee_parameter:Injection.fee_parameter ->
+    unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
+
+  val set_delegate :
+    ?block:Block_services.block ->
+    ?fee: Tez.t ->
+    contract:Contract.t ->
+    manager_sk:Client_keys.sk_uri ->
+    src_pk:public_key ->
+    ?fee_parameter:Injection.fee_parameter ->
+    public_key_hash option ->
+    Operation_hash.t tzresult Lwt.t
+
+  val balance : ?block:Block_services.block -> t -> Tez.t tzresult Lwt.t
+
+  val delegate :
+    ?block:Block_services.block ->
+    Contract.t ->
+    public_key_hash option tzresult Lwt.t
+
+end
+
+module Baking : sig
+
+  val bake:
+    Block_services.block ->
+    Account.t ->
+    Operation.packed list ->
+    Block_hash.t tzresult Lwt.t
+
+end
+
+module Endorse : sig
+
+  val endorse :
+    Account.t ->
+    Block_services.block ->
+    Operation.packed tzresult Lwt.t
+
+  val endorsers_list :
+    Block_services.block ->
+    Account.t array tzresult Lwt.t
+
+  val endorsement_rights :
+    Account.t ->
+    Block_services.block ->
+    (Raw_level.t * int) list tzresult Lwt.t
+
+end
+
+module Protocol : sig
+
+  val proposals :
+    ?block:Block_services.block ->
+    src:Account.t ->
+    Protocol_hash.t list ->
+    Operation.packed tzresult Lwt.t
+
+  val ballot :
+    ?block:Block_services.block ->
+    src:Account.t ->
+    proposal:Protocol_hash.t ->
+    Vote.ballot ->
+    Operation.packed tzresult Lwt.t
+
+end
+
+module Assert : sig
+
+  val fail : string -> string -> string -> 'a
+
+  val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+  val equal : ?eq:('a -> 'a -> bool) -> ?prn:('a -> string) -> ?msg:string -> 'a -> 'a -> unit
+  val is_none : ?msg:string -> 'a option -> unit
+  val is_some : ?msg:string -> 'a option -> unit
+  val equal_int : ?msg:string -> int -> int -> unit
+  val equal_bool : ?msg:string -> bool -> bool -> unit
+
+  val balance_equal:
+    ?block:Block_services.block ->
+    msg:string -> Account.t -> int64 -> unit tzresult Lwt.t
+  val delegate_equal:
+    ?block:Block_services.block ->
+    msg:string -> Contract.t -> public_key_hash option -> unit tzresult Lwt.t
+
+  val failed_to_preapply:
+    msg:string ->
+    ?op:Operation.packed ->
+    (Alpha_environment.Error_monad.error ->
+     bool) ->
+    'a tzresult -> unit
+
+  val ecoproto_error:
+    (Alpha_environment.Error_monad.error -> bool) ->
+    error -> bool
+
+  val generic_economic_error : msg:string -> 'a tzresult -> unit
+
+  (** Transaction assertions *)
+
+  val unknown_contract : msg:string -> 'a tzresult -> unit
+  (** [unknown_contract ~msg result] raises if result is not a
+      [Storage_error]. *)
+
+  val non_existing_contract : msg:string -> 'a tzresult -> unit
+  val balance_too_low : msg:string -> 'a tzresult -> unit
+  val non_spendable : msg:string -> 'a tzresult -> unit
+  val inconsistent_pkh : msg:string -> 'a tzresult -> unit
+  val inconsistent_public_key : msg:string -> 'a tzresult -> unit
+  val missing_public_key : msg:string -> 'a tzresult -> unit
+
+  (** Origination assertions *)
+
+  val non_delegatable : msg:string -> 'a tzresult -> unit
+
+  (** Endorsement / baking assertions *)
+
+  val check_protocol :
+    ?msg:string -> block:Block_services.block ->
+    Protocol_hash.t -> unit tzresult Lwt.t
+
+  val check_voting_period_kind :
+    ?msg:string -> block:Block_services.block ->
+    Voting_period.kind -> unit tzresult Lwt.t
+
+end
+
+val display_level: Block_services.block -> unit tzresult Lwt.t
+
+val endorsement_security_deposit: Block_services.block -> Tez.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
new file mode 100644
index 000000000..8119006ad
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_michelson_parser.ml
@@ -0,0 +1,373 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+module Helpers = Proto_alpha_helpers
+module Assert = Helpers.Assert
+open Tezos_micheline
+open Micheline
+
+let zero_loc = Micheline_parser.location_zero
+
+let prn expr =
+  expr |>
+  Micheline_printer.printable (fun s -> s) |>
+  Format.asprintf "%a" Micheline_printer.print_expr
+
+let assert_expands original expanded =
+  let { Michelson_v1_parser.expanded = expansion }, errors =
+    let source = prn (Micheline.strip_locations original) in
+    Michelson_v1_parser.expand_all ~source ~original in
+  let expanded = Micheline.strip_locations expanded in
+  let expansion = Michelson_v1_primitives.strings_of_prims expansion in
+  match errors with
+  | [] ->
+      Assert.equal ~prn expansion expanded ;
+      ok ()
+  | errors -> Error errors
+
+let left_branch = Seq(zero_loc, [ Prim(zero_loc, "SWAP", [], []) ])
+let right_branch = Seq(zero_loc, [])
+
+let test_expansion () =
+  assert_expands (Prim (zero_loc, "CAAR", [], []))
+    (Seq (zero_loc,
+          [(Prim (zero_loc, "CAR", [], []));
+           (Prim (zero_loc, "CAR", [], [])) ])) >>? fun () ->
+  assert_expands (Prim (zero_loc, "CAAR", [], [ "annot" ]))
+    (Seq (zero_loc,
+          [(Prim (zero_loc, "CAR", [], []));
+           (Prim (zero_loc, "CAR", [], [ "annot" ])) ])) >>? fun () ->
+  let car = Prim (zero_loc, "CAR", [], [ "annot" ]) in
+  assert_expands car car >>? fun () ->
+  let arg = [ Seq (zero_loc, [ car ]) ] in
+  assert_expands
+    (Prim (zero_loc, "DIP", arg, [ "new_annot" ]))
+    (Prim (zero_loc, "DIP", arg, [ "new_annot" ])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "DIIP", arg, []))
+    (Seq (zero_loc,
+          [ Prim (zero_loc, "DIP",
+                  [ (Seq (zero_loc,
+                          [ Prim (zero_loc, "DIP", arg, []) ])) ],
+                  []) ])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "DIIIP", arg, []))
+    (Seq (zero_loc,
+          [ Prim (zero_loc, "DIP",
+                  [ (Seq (zero_loc,
+                          [ Prim (zero_loc,
+                                  "DIP",
+                                  [ (Seq (zero_loc,
+                                          [ Prim (zero_loc, "DIP", arg, []) ])) ],
+                                  []) ])) ],
+                  []) ])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "DUUP", [], []))
+    (Seq (zero_loc,
+          [ Prim (zero_loc, "DIP", [ Seq (zero_loc, [ Prim (zero_loc, "DUP", [], []) ]) ], []) ;
+            Prim (zero_loc, "SWAP", [], []) ])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "DUUUP", [], []))
+    (Seq (zero_loc,
+          [ Prim (zero_loc, "DIP",
+                  [ Seq (zero_loc, [
+                        Prim (zero_loc, "DIP", [
+                            Seq (zero_loc, [ Prim (zero_loc, "DUP", [], []) ])],
+                              []);
+                        Prim (zero_loc, "SWAP", [], []) ]) ],
+                  []) ;
+            Prim (zero_loc, "SWAP", [], []) ])) >>? fun () ->
+  let assert_compare_macro prim_name compare_name =
+    assert_expands
+      (Prim (zero_loc, prim_name, [], []))
+      (Seq (zero_loc,
+            [ Prim (zero_loc, "COMPARE", [], []) ;
+              Prim (zero_loc, compare_name, [], []) ])) in
+  let assert_compare_if_macro prim_name compare_name =
+    assert_expands
+      (Prim (zero_loc, prim_name,
+             [ left_branch ; right_branch ],
+             []))
+      (Seq (zero_loc, [ Prim(zero_loc, "COMPARE", [], []);
+                        Prim(zero_loc, compare_name, [], []);
+                        Prim (zero_loc, "IF", [ left_branch ; right_branch ], []) ])) in
+  assert_compare_macro "CMPEQ" "EQ" >>? fun () ->
+  assert_compare_macro "CMPNEQ" "NEQ" >>? fun () ->
+  assert_compare_macro "CMPLT" "LT" >>? fun () ->
+  assert_compare_macro "CMPLE" "LE" >>? fun () ->
+  assert_compare_macro "CMPGT" "GT" >>? fun () ->
+  assert_compare_macro "CMPGE" "GE" >>? fun () ->
+  assert_compare_if_macro "IFCMPEQ" "EQ" >>? fun () ->
+  assert_compare_if_macro "IFCMPNEQ" "NEQ" >>? fun () ->
+  assert_compare_if_macro "IFCMPLT" "LT" >>? fun () ->
+  assert_compare_if_macro "IFCMPLE" "LE" >>? fun () ->
+  assert_compare_if_macro "IFCMPGT" "GT" >>? fun () ->
+  assert_compare_if_macro "IFCMPGE" "GE" >>? fun () ->
+  assert_expands (Prim (zero_loc, "ASSERT_LEFT", [], []))
+    (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT",
+                            [ Seq (zero_loc, []) ;
+                              Seq (zero_loc, [
+                                  Seq (zero_loc, [
+                                      Prim(zero_loc, "UNIT", [], []) ;
+                                      Prim(zero_loc, "FAILWITH", [], [])
+                                    ])
+                                ]) ],
+                            []) ])) >>? fun () ->
+  assert_expands (Prim (zero_loc, "ASSERT_RIGHT", [], []))
+    (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT",
+                            [ Seq (zero_loc, [
+                                  Seq (zero_loc, [
+                                      Prim(zero_loc, "UNIT", [], []) ;
+                                      Prim(zero_loc, "FAILWITH", [], [])
+                                    ])
+                                ]) ;
+                              Seq (zero_loc, []) ],
+                            []) ])) >>? fun () ->
+  assert_expands (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch ], []))
+    (Seq (zero_loc, [ Prim (zero_loc, "IF_LEFT", [ right_branch ; left_branch ], []) ])) >>? fun () ->
+  assert_expands (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch ], []))
+    (Seq (zero_loc, [ Prim (zero_loc, "IF_NONE", [ right_branch ; left_branch ], []) ])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "PAIR", [], []))
+    (Prim (zero_loc, "PAIR", [], [])) >>? fun () ->
+  assert_expands
+    (Prim (zero_loc, "PAPPAIIR", [], []))
+    (Seq (zero_loc, [Prim
+                       (zero_loc,
+                        "DIP",
+                        [Seq
+                           (zero_loc,
+                            [Prim (zero_loc, "PAIR", [], [])])],
+                        []);
+                     Prim
+                       (zero_loc,
+                        "DIP",
+                        [Seq
+                           (zero_loc,
+                            [Prim (zero_loc, "PAIR", [], [])])],
+                        []);
+                     Prim (zero_loc, "PAIR", [], [])]))
+
+let assert_unexpansion_consistent original =
+  let { Michelson_v1_parser.expanded }, errors =
+    let source = prn (Micheline.strip_locations original) in
+    Michelson_v1_parser.expand_all ~source ~original in
+  match errors with
+  | _ :: _ -> Error errors
+  | [] ->
+      let { Michelson_v1_parser.unexpanded } =
+        Michelson_v1_printer.unparse_expression expanded in
+      Assert.equal ~prn unexpanded (Micheline.strip_locations original) ;
+      ok ()
+
+let test_unexpansion_consistency () =
+  assert_unexpansion_consistent (Prim (zero_loc, "PAPPAIIR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "PPAIPAIR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "UNPAPPAIIR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "UNPAPAPAIR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent
+    (Prim (zero_loc, "DIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
+  assert_unexpansion_consistent
+    (Prim (zero_loc, "DIVP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
+  assert_unexpansion_consistent
+    (Prim (zero_loc, "DIIIIIP", [ Seq (zero_loc, [ Prim (zero_loc, "DROP", [], []) ]) ], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "SET_CAR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "SET_CDR", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "DUP", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "DUUP", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "DUUUP", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "DUUUUP", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "DUUUUUP", [], [])) >>? fun () ->
+
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_EQ", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_NEQ", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LT", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LE", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_GT", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_GE", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_NONE", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_SOME", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_LEFT", [], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "ASSERT_RIGHT", [], [])) >>? fun () ->
+
+  assert_unexpansion_consistent (Prim (zero_loc, "IF_RIGHT", [ left_branch ; right_branch], [])) >>? fun () ->
+  assert_unexpansion_consistent (Prim (zero_loc, "IF_SOME", [ left_branch ; right_branch], []))
+
+let test_lexing () =
+  let open Micheline_parser in
+  let assert_tokenize_result source expected =
+    match tokenize source with
+    | tokens, [] ->
+        let tokens =
+          List.map (fun x -> x.token) tokens in
+        Assert.equal tokens expected ;
+        ok ()
+    | _, errors -> Error errors in
+  assert_tokenize_result "int"
+    [ (Ident "int") ] >>? fun () ->
+  assert_tokenize_result "100"
+    [ (Int "100") ] >>? fun () ->
+  assert_tokenize_result "(option int)"
+    [ Open_paren ; Ident "option" ; Ident "int" ; Close_paren ] >>? fun () ->
+  assert_tokenize_result "DIP { ADD }"
+    [ Ident "DIP" ; Open_brace ; Ident "ADD" ; Close_brace ] >>? fun () ->
+  assert_tokenize_result "\"hello\""
+    [ String "hello" ] >>? fun () ->
+  assert_tokenize_result "parameter int;"
+    [ Ident "parameter" ; Ident "int" ; Semi ] >>? fun () ->
+  assert_tokenize_result "PUSH string \"abcd\";"
+    [ Ident "PUSH" ; Ident "string" ; String "abcd" ; Semi ] >>? fun () ->
+  assert_tokenize_result "DROP; SWAP"
+    [ Ident "DROP" ; Semi ; Ident "SWAP" ] >>? fun () ->
+  assert_tokenize_result "string"
+    [ Ident "string" ]
+
+let test_parsing () =
+  let assert_parses source expected =
+    let open Micheline_parser in
+    match tokenize source with
+    | _, (_ :: _ as errors) -> Error errors
+    | tokens, [] ->
+        match Micheline_parser.parse_toplevel tokens with
+        | _, (_ :: _ as errors) -> Error errors
+        | ast, [] ->
+            let ast = List.map Micheline.strip_locations ast in
+            let expected = List.map Micheline.strip_locations expected in
+            Assert.equal (List.length ast) (List.length expected) ;
+            List.iter2 (Assert.equal ~prn) ast expected ;
+            ok () in
+
+  assert_parses "PUSH int 100"
+    [ (Prim ((), "PUSH", [ Prim ((), "int", [], []) ;
+                           Int ((), Z.of_int 100) ], [])) ] >>? fun () ->
+
+  assert_parses "DROP" [ (Prim ((), "DROP", [], [])) ] >>? fun () ->
+  assert_parses "DIP{DROP}"
+    [ Prim ((), "DIP", [ Seq((), [ Prim ((), "DROP", [], []) ]) ], []) ] >>? fun () ->
+
+  assert_parses "LAMBDA int int {}"
+    [ Prim ((), "LAMBDA", [ Prim ((), "int", [], []) ;
+                            Prim ((), "int", [], []) ;
+                            Seq ((), []) ], []) ] >>? fun () ->
+
+  assert_parses "LAMBDA @name int int {}"
+    [ Prim ((), "LAMBDA", [ Prim ((), "int", [], []) ;
+                            Prim ((), "int", [], []) ;
+                            Seq ((), []) ], [ "@name" ]) ] >>? fun () ->
+
+  assert_parses "NIL @annot string; # comment\n"
+    [ Prim ((), "NIL", [ Prim ((), "string", [], []) ], [ "@annot" ]) ] >>? fun () ->
+
+  assert_parses "PUSH (pair bool string) (Pair False \"abc\")"
+    [ Prim ((), "PUSH", [ Prim ((), "pair",
+                                [ Prim ((), "bool", [], []) ;
+                                  Prim ((), "string", [], []) ], []) ;
+                          Prim ((), "Pair",
+                                [ Prim ((), "False", [], []) ;
+                                  String ((), "abc")], []) ], []) ] >>? fun () ->
+  assert_parses "PUSH (list nat) (List 1 2 3)"
+    [ Prim ((), "PUSH", [ Prim ((), "list",
+                                [ Prim ((), "nat", [], []) ], []) ;
+                          Prim ((), "List",
+                                [ Int((), Z.of_int 1);
+                                  Int ((), Z.of_int 2);
+                                  Int ((), Z.of_int 3)],
+                                []) ], []) ] >>? fun () ->
+  assert_parses "PUSH (lambda nat nat) {}"
+    [ Prim ((), "PUSH", [ Prim ((), "lambda",
+                                [ Prim ((), "nat", [], []);
+                                  Prim ((), "nat", [], [])], []) ;
+                          Seq((), [])],
+            []) ] >>? fun () ->
+  assert_parses "PUSH key \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\""
+    [ Prim ((), "PUSH", [ Prim ((), "key", [], []) ;
+                          String ((),"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx") ],
+            []) ] >>? fun () ->
+  assert_parses "PUSH (map int bool) (Map (Item 100 False))"
+    [ Prim ((), "PUSH", [ Prim ((), "map",
+                                [ Prim((), "int", [], []);
+                                  Prim((), "bool", [], [])], []) ;
+                          Prim ((), "Map",
+                                [Prim ((), "Item",
+                                       [Int ((), Z.of_int 100);
+                                        Prim ((), "False", [], [])], [])], []) ],
+            []) ] >>? fun () ->
+  assert_parses
+    "parameter int; \
+     return int; \
+     storage unit; \
+     code {}"
+    [ Prim ((), "parameter", [ Prim((), "int", [], []) ], []);
+      Prim ((), "return", [ Prim((), "int", [], []) ], []);
+      Prim ((), "storage", [ Prim((), "unit", [], []) ], []);
+      Prim ((), "code", [ Seq((), []) ], [])] >>? fun () ->
+  assert_parses
+    "parameter int; \
+     storage unit; \
+     return int; \
+     code {CAR; PUSH int 1; ADD; UNIT; SWAP; PAIR};"
+    [ Prim ((), "parameter", [ Prim((), "int", [], []) ], []);
+      Prim ((), "storage", [ Prim((), "unit", [], []) ], []);
+      Prim ((), "return", [ Prim((), "int", [], []) ], []);
+      Prim ((), "code", [ Seq((), [ Prim ((), "CAR", [], []) ;
+                                    Prim ((), "PUSH", [ Prim((), "int", [], []) ;
+                                                        Int ((), Z.of_int 1)], []) ;
+                                    Prim ((), "ADD", [], []) ;
+                                    Prim ((), "UNIT", [], []) ;
+                                    Prim ((), "SWAP", [], []) ;
+                                    Prim ((), "PAIR", [], [])]) ], [])] >>? fun () ->
+  assert_parses
+    "code {DUP @test; DROP}"
+    [ Prim ((), "code", [Seq ((), [ Prim ((), "DUP", [], [ "@test" ]);
+                                    Prim ((), "DROP", [], [])])], []) ] >>? fun () ->
+  assert_parses
+    "IF {CAR} {CDR}"
+    [ Prim ((), "IF", [ Seq ((), [ Prim ((), "CAR", [], []) ]);
+                        Seq ((), [ Prim ((), "CDR", [], []) ]) ], []) ] >>? fun () ->
+  assert_parses
+    "IF_NONE {FAIL} {}"
+    [ Prim ((), "IF_NONE", [ Seq ((), [ Prim ((), "FAIL", [], []) ]);
+                             Seq ((), []) ], []) ]
+
+let tests = [
+  "lexing", (fun _ -> Lwt.return (test_lexing ())) ;
+  "parsing", (fun _ -> Lwt.return (test_parsing ())) ;
+  "expansion", (fun _ -> Lwt.return (test_expansion ())) ;
+  "consistency", (fun _ -> Lwt.return (test_unexpansion_consistency ()))
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
+    "michelson", List.map wrap tests
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_rpc.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_rpc.ml
new file mode 100644
index 000000000..37be8e0c8
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_rpc.ml
@@ -0,0 +1,96 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Helpers = Proto_alpha_helpers
+module Assert = Helpers.Assert
+
+(* Test for the rpc call Block_services.raw_context
+   A similar test is bin_client/test/test_basic.sh
+*)
+let run blkid =
+
+  let open Block_services in
+  let is_equal a = function
+    | Ok b -> a = b
+    | _ -> false
+  in
+  let is_not_found : raw_context tzresult -> bool = function
+    | Error [RPC_context.Not_found _] -> true
+    | _ -> false
+  in
+
+  (* files and directories that are in context *)
+  let dir_depth0 = Cut in
+  let dir_depth2 = Dir [("02", Dir [("29", Cut)]);
+                        ("a9", Dir [("ce", Cut)]);
+                        ("c5", Dir [("5c", Cut)]);
+                        ("da", Dir [("c9", Cut)]);
+                        ("e7", Dir [("67", Cut)]);
+                       ] in
+
+  let tests = [(([""],0), is_equal dir_depth0);
+               ((["delegates";"ed25519"],2), is_equal dir_depth2);
+               (* (([""],-1), is_not_found); *)
+               ((["not-existent"],1), is_not_found);
+               ((["not-existent"],0), is_not_found);
+               (* ((["not-existent"],-1), is_not_found); *)
+              ] in
+
+  let success = ref true in
+  iter_s (fun ((path,depth),predicate) ->
+      Helpers.rpc_raw_context blkid path depth >>= fun result ->
+      let res = predicate result in
+      Format.eprintf "/%s (%d) -> %B@." (String.concat "/" path) depth res ;
+      success := !success  && res ;
+      return_unit
+    ) tests >>=? fun () ->
+  if !success then
+    return_unit
+  else
+    failwith "Error!"
+
+let exe = try Sys.argv.(1) with _ -> "tezos-node"
+let rpc_port = try int_of_string Sys.argv.(2) with _ -> 18500
+
+let main () =
+  Helpers.init ~exe ~rpc_port () >>=? fun (_node_pid, genesis) ->
+  run (`Hash (genesis, 0))
+
+let tests = [
+  "main", (fun _ -> main ()) ;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
+    "rpcs", List.map wrap tests
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_vote.ml b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_vote.ml
new file mode 100644
index 000000000..cf535d666
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/test/test_vote.ml
@@ -0,0 +1,126 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Proto_alpha_helpers
+
+let demo_protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let print_level head =
+  level (`Main, `Hash (head, 0)) >>=? fun lvl ->
+  return @@ Format.eprintf "voting_period = %a.%ld@."
+    Voting_period.pp lvl.voting_period lvl.voting_period_position
+
+let run_change_to_demo_proto block
+    ({ b1 ; b2 ; b3 ; b4 ; b5 } : Account.bootstrap_accounts) =
+  Baking.bake block b1 [] >>=? fun head ->
+  Format.eprintf "Entering `Proposal` voting period@.";
+  Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
+    Voting_period.Proposal >>=? fun () ->
+  Baking.bake (`Hash (head, 0)) b2 [] >>=? fun head ->
+
+  (* 1. Propose the 'demo' protocol as b1 (during the Proposal period) *)
+  Protocol.proposals
+    ~block:(`Hash (head, 0))
+    ~src:b1
+    [demo_protocol] >>=? fun op ->
+
+  (* Mine blocks to switch to next vote period (Testing_vote) *)
+  Baking.bake (`Hash (head, 0)) b3 [op] >>=? fun head ->
+  Format.eprintf "Entering `Testing_vote` voting period@.";
+  Baking.bake (`Hash (head, 0)) b4 [] >>=? fun head ->
+  Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
+    Voting_period.Testing_vote >>=? fun () ->
+
+  (* 2. Vote unanimously for a proposal *)
+
+  let vote_for_demo ~src ~block ballot =
+    Protocol.ballot
+      ~block
+      ~src
+      ~proposal:demo_protocol
+      ballot
+  in
+  let all_accounts = [b1; b2; b3; b4; b5] in
+
+  map_s (fun src -> vote_for_demo ~src ~block:(`Hash (head, 0)) Vote.Yay)
+    all_accounts >>=? fun operations ->
+
+  (* Mine blocks to switch to next vote period (Testing) *)
+  Baking.bake (`Hash (head, 0)) b5 operations >>=? fun head ->
+  Format.eprintf "Entering `Testing` voting period@.";
+  Baking.bake (`Hash (head, 0)) b1 [] >>=? fun head ->
+  Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
+    Voting_period.Testing >>=? fun () ->
+
+  (* 3. Test the proposed protocol *)
+
+  (* Mine blocks to switch to next vote period (Promote_vote) *)
+  Baking.bake (`Hash (head, 0)) b2 [] >>=? fun head ->
+  Format.eprintf "Entering `Promote_vote` voting period@.";
+  Baking.bake (`Hash (head, 0)) b3 [] >>=? fun head ->
+  Assert.check_voting_period_kind ~msg:__LOC__ ~block:(`Hash (head, 0))
+    Voting_period.Promotion_vote >>=? fun () ->
+
+  (* 4. Vote unanimously for promoting the protocol *)
+  map_s (fun src -> vote_for_demo ~src ~block:(`Hash (head, 0)) Vote.Yay)
+    all_accounts >>=? fun operations ->
+
+  (* Mine blocks to switch to end the vote cycle (back to Proposal) *)
+  Format.eprintf "Switching to `demo` protocol@.";
+  Baking.bake (`Hash (head, 0)) b4 operations >>=? fun head ->
+
+  Assert.check_protocol
+    ~msg:__LOC__ ~block:(`Hash (head, 0)) demo_protocol >>=? fun () ->
+
+  return (`Hash (head, 0))
+
+let exe = try Sys.argv.(1) with _ -> "tezos-node"
+let rpc_port = try int_of_string Sys.argv.(2) with _ -> 18400
+
+let change_to_demo_proto () =
+  init ~exe ~vote:true ~rpc_port () >>=? fun (_node_pid, hash) ->
+  run_change_to_demo_proto (`Hash (hash, 0)) Account.bootstrap_accounts >>=? fun _blkh ->
+  return_unit
+
+let tests = [
+  "change_to_demo_proto", (fun _ -> change_to_demo_proto ()) ;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let () =
+  Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
+    "amendment", List.map wrap tests
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-accuser-alpha-commands.opam b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-accuser-alpha-commands.opam
new file mode 100644
index 000000000..9eb56574c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-accuser-alpha-commands.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-client-alpha"
+  "tezos-baking-alpha"
+  "tezos-signer-backends" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baker-alpha-commands.opam b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baker-alpha-commands.opam
new file mode 100644
index 000000000..9eb56574c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baker-alpha-commands.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-client-alpha"
+  "tezos-baking-alpha"
+  "tezos-signer-backends" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha-commands.opam b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha-commands.opam
new file mode 100644
index 000000000..9eb56574c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha-commands.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-client-alpha"
+  "tezos-baking-alpha"
+  "tezos-signer-backends" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam
new file mode 100644
index 000000000..7ca8b47c2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-baking-alpha.opam
@@ -0,0 +1,28 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-client-alpha"
+  "tezos-node" { with-test }
+  "tezos-client-genesis" { with-test }
+  "tezos-client-base-unix" { with-test }
+  "alcotest-lwt" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-endorser-alpha-commands.opam b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-endorser-alpha-commands.opam
new file mode 100644
index 000000000..9eb56574c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_delegate/tezos-endorser-alpha-commands.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-environment"
+  "tezos-protocol-alpha"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-client-alpha"
+  "tezos-baking-alpha"
+  "tezos-signer-backends" { with-test }
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/vendors/tezos-modded/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
new file mode 100644
index 000000000..227ece362
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL
@@ -0,0 +1,81 @@
+{
+    "hash": "ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK",
+    "modules": [
+        "Misc",
+        "Storage_description",
+        "State_hash",
+        "Nonce_hash",
+        "Script_expr_hash",
+        "Contract_hash",
+        "Blinded_public_key_hash",
+
+        "Qty_repr",
+        "Tez_repr",
+        "Period_repr",
+        "Time_repr",
+        "Constants_repr",
+        "Fitness_repr",
+        "Raw_level_repr",
+        "Voting_period_repr",
+        "Cycle_repr",
+        "Level_repr",
+        "Seed_repr",
+        "Gas_limit_repr",
+        "Script_int_repr",
+        "Script_timestamp_repr",
+        "Michelson_v1_primitives",
+        "Script_repr",
+        "Contract_repr",
+        "Roll_repr",
+        "Vote_repr",
+        "Block_header_repr",
+        "Operation_repr",
+        "Manager_repr",
+        "Commitment_repr",
+        "Parameters_repr",
+
+        "Raw_context",
+        "Storage_sigs",
+        "Storage_functors",
+        "Storage",
+
+        "Constants_storage",
+        "Level_storage",
+        "Nonce_storage",
+        "Seed_storage",
+        "Roll_storage",
+        "Delegate_storage",
+        "Contract_storage",
+        "Bootstrap_storage",
+        "Fitness_storage",
+        "Vote_storage",
+        "Commitment_storage",
+        "Init_storage",
+        "Fees_storage",
+
+        "Alpha_context",
+
+        "Script_typed_ir",
+        "Script_tc_errors",
+        "Michelson_v1_gas",
+        "Script_ir_annot",
+        "Script_ir_translator",
+        "Script_tc_errors_registration",
+        "Script_interpreter",
+
+        "Baking",
+        "Amendment",
+        "Apply_results",
+        "Apply",
+
+        "Services_registration",
+        "Constants_services",
+        "Contract_services",
+        "Delegate_services",
+        "Helpers_services",
+        "Voting_services",
+        "Alpha_services",
+
+        "Main"
+    ]
+}
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.ml
new file mode 100644
index 000000000..61290bebc
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -0,0 +1,193 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Raw_context.t
+type context = t
+
+module type BASIC_DATA = sig
+  type t
+  include Compare.S with type t := t
+  val encoding: t Data_encoding.t
+  val pp: Format.formatter -> t -> unit
+end
+
+module Tez = Tez_repr
+module Period = Period_repr
+
+module Timestamp = struct
+  include Time_repr
+  let current = Raw_context.current_timestamp
+end
+
+include Operation_repr
+module Operation = struct
+  type 'kind t = 'kind operation = {
+    shell: Operation.shell_header ;
+    protocol_data: 'kind protocol_data ;
+  }
+  type packed = packed_operation
+  let unsigned_encoding = unsigned_operation_encoding
+  include Operation_repr
+end
+module Block_header = Block_header_repr
+module Vote = struct
+  include Vote_repr
+  include Vote_storage
+end
+module Raw_level = Raw_level_repr
+module Cycle = Cycle_repr
+module Script_int = Script_int_repr
+module Script_timestamp = struct
+  include Script_timestamp_repr
+  let now ctxt =
+    Raw_context.current_timestamp ctxt
+    |> Timestamp.to_seconds
+    |> of_int64
+
+  let set_now ctxt timestamp =
+    timestamp
+    |> to_zint
+    |> Z.to_int64
+    |> Time.of_seconds
+    |> (Raw_context.set_current_timestamp ctxt)
+end
+module Script = struct
+  include Michelson_v1_primitives
+  include Script_repr
+  let force_decode ctxt lexpr =
+    Lwt.return
+      (Script_repr.force_decode lexpr >>? fun (v, cost) ->
+       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
+       (v, ctxt))
+  let force_bytes ctxt lexpr =
+    Lwt.return
+      (Script_repr.force_bytes lexpr >>? fun (b, cost) ->
+       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
+       (b, ctxt))
+end
+module Fees = Fees_storage
+
+type public_key = Signature.Public_key.t
+type public_key_hash = Signature.Public_key_hash.t
+type signature  = Signature.t
+
+module Constants = struct
+  include Constants_repr
+  include Constants_storage
+end
+
+module Voting_period = Voting_period_repr
+
+module Gas = struct
+  include Gas_limit_repr
+  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high
+  let check_limit = Raw_context.check_gas_limit
+  let set_limit = Raw_context.set_gas_limit
+  let set_unlimited = Raw_context.set_gas_unlimited
+  let consume = Raw_context.consume_gas
+  let check_enough = Raw_context.check_enough_gas
+  let level = Raw_context.gas_level
+  let consumed = Raw_context.gas_consumed
+  let block_level = Raw_context.block_gas_level
+end
+module Level = struct
+  include Level_repr
+  include Level_storage
+end
+module Contract = struct
+  include Contract_repr
+  include Contract_storage
+
+  let originate c contract ~balance ~manager ?script ~delegate
+      ~spendable ~delegatable =
+    originate c contract ~balance ~manager ?script ~delegate
+      ~spendable ~delegatable
+  let init_origination_nonce = Raw_context.init_origination_nonce
+  let unset_origination_nonce = Raw_context.unset_origination_nonce
+end
+module Delegate = Delegate_storage
+module Roll = struct
+  include Roll_repr
+  include Roll_storage
+end
+module Nonce = Nonce_storage
+module Seed = struct
+  include Seed_repr
+  include Seed_storage
+end
+
+module Fitness = struct
+
+  include Fitness_repr
+  include Fitness
+  type fitness = t
+  include Fitness_storage
+
+end
+
+module Bootstrap = Bootstrap_storage
+
+module Commitment = struct
+  include Commitment_repr
+  include Commitment_storage
+end
+
+module Global = struct
+  let get_last_block_priority = Storage.Last_block_priority.get
+  let set_last_block_priority = Storage.Last_block_priority.set
+end
+
+let prepare_first_block = Init_storage.prepare_first_block
+let prepare = Init_storage.prepare
+
+let finalize ?commit_message:message c =
+  let fitness = Fitness.from_int64 (Fitness.current c) in
+  let context = Raw_context.recover c in
+  { Updater.context ; fitness ; message ; max_operations_ttl = 60 ;
+    last_allowed_fork_level =
+      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
+  }
+
+let activate = Raw_context.activate
+let fork_test_chain = Raw_context.fork_test_chain
+
+let record_endorsement = Raw_context.record_endorsement
+let allowed_endorsements = Raw_context.allowed_endorsements
+let init_endorsements = Raw_context.init_endorsements
+
+let reset_internal_nonce = Raw_context.reset_internal_nonce
+let fresh_internal_nonce = Raw_context.fresh_internal_nonce
+let record_internal_nonce = Raw_context.record_internal_nonce
+let internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded
+
+let add_deposit = Raw_context.add_deposit
+let add_fees = Raw_context.add_fees
+let add_rewards = Raw_context.add_rewards
+
+let get_deposits = Raw_context.get_deposits
+let get_fees = Raw_context.get_fees
+let get_rewards = Raw_context.get_rewards
+
+let description = Raw_context.description
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.mli
new file mode 100644
index 000000000..ce3617329
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -0,0 +1,1164 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type BASIC_DATA = sig
+  type t
+  include Compare.S with type t := t
+  val encoding: t Data_encoding.t
+  val pp: Format.formatter -> t -> unit
+end
+
+type t
+type context = t
+
+type public_key = Signature.Public_key.t
+type public_key_hash = Signature.Public_key_hash.t
+type signature = Signature.t
+
+module Tez : sig
+
+  include BASIC_DATA
+  type tez = t
+
+  val zero: tez
+  val one_mutez: tez
+  val one_cent: tez
+  val fifty_cents: tez
+  val one: tez
+
+  val ( -? ) : tez -> tez -> tez tzresult
+  val ( +? ) : tez -> tez -> tez tzresult
+  val ( *? ) : tez -> int64 -> tez tzresult
+  val ( /? ) : tez -> int64 -> tez tzresult
+
+  val of_string: string -> tez option
+  val to_string: tez -> string
+
+  val of_mutez: int64 -> tez option
+  val to_mutez: tez -> int64
+
+end
+
+module Period : sig
+
+  include BASIC_DATA
+  type period = t
+
+  val of_seconds: int64 -> period tzresult
+  val to_seconds: period -> int64
+  val mult: int32 -> period -> period tzresult
+
+  val one_second: period
+  val one_minute: period
+  val one_hour: period
+
+end
+
+module Timestamp : sig
+
+  include BASIC_DATA with type t = Time.t
+  type time = t
+  val (+?) : time -> Period.t -> time tzresult
+
+  val of_notation: string -> time option
+  val to_notation: time -> string
+
+  val of_seconds: string -> time option
+  val to_seconds_string: time -> string
+
+  val current: context -> time
+
+end
+
+module Raw_level : sig
+
+  include BASIC_DATA
+  type raw_level = t
+  val rpc_arg: raw_level RPC_arg.arg
+
+  val diff: raw_level -> raw_level -> int32
+
+  val root: raw_level
+  val succ: raw_level -> raw_level
+  val pred: raw_level -> raw_level option
+  val to_int32: raw_level -> int32
+  val of_int32: int32 -> raw_level tzresult
+
+end
+
+module Cycle : sig
+
+  include BASIC_DATA
+  type cycle = t
+  val rpc_arg: cycle RPC_arg.arg
+
+  val root: cycle
+  val succ: cycle -> cycle
+  val pred: cycle -> cycle option
+  val add: cycle -> int -> cycle
+  val sub: cycle -> int -> cycle option
+  val to_int32: cycle -> int32
+
+  module Map : S.MAP with type key = cycle
+
+end
+
+module Gas : sig
+  type t = private
+    | Unaccounted
+    | Limited of { remaining : Z.t }
+
+  val encoding : t Data_encoding.encoding
+  val pp : Format.formatter -> t -> unit
+
+  type cost
+
+  val cost_encoding : cost Data_encoding.encoding
+  val pp_cost : Format.formatter -> cost -> unit
+
+  type error += Block_quota_exceeded (* `Temporary *)
+  type error += Operation_quota_exceeded (* `Temporary *)
+  type error += Gas_limit_too_high (* `Permanent *)
+
+  val free : cost
+  val step_cost : int -> cost
+  val alloc_cost : int -> cost
+  val alloc_bytes_cost : int -> cost
+  val alloc_mbytes_cost : int -> cost
+  val alloc_bits_cost : int -> cost
+  val read_bytes_cost : Z.t -> cost
+  val write_bytes_cost : Z.t -> cost
+
+  val ( *@ ) : int -> cost -> cost
+  val ( +@ ) : cost -> cost -> cost
+
+  val check_limit: context -> Z.t -> unit tzresult
+  val set_limit: context -> Z.t -> context
+  val set_unlimited: context -> context
+  val consume: context -> cost -> context tzresult
+  val check_enough: context -> cost -> unit tzresult
+  val level: context -> t
+  val consumed: since: context -> until: context -> Z.t
+  val block_level: context -> Z.t
+end
+
+module Script_int : module type of Script_int_repr
+
+module Script_timestamp : sig
+  open Script_int
+  type t
+  val compare: t -> t -> int
+  val to_string: t -> string
+  val to_notation: t -> string option
+  val to_num_str: t -> string
+  val of_string: string -> t option
+  val diff: t -> t -> z num
+  val add_delta: t -> z num -> t
+  val sub_delta: t -> z num -> t
+  val now: context -> t
+  val set_now: context -> t -> context
+  val to_zint: t -> Z.t
+  val of_zint: Z.t -> t
+end
+
+module Script : sig
+
+  type prim = Micheline.Michelson_primitives.prim =
+    | K_parameter
+    | K_storage
+    | K_code
+    | D_False
+    | D_Elt
+    | D_Left
+    | D_None
+    | D_Pair
+    | D_Right
+    | D_Some
+    | D_True
+    | D_Unit
+    | I_PACK
+    | I_UNPACK
+    | I_BLAKE2B
+    | I_SHA256
+    | I_SHA512
+    | I_ABS
+    | I_ADD
+    | I_AMOUNT
+    | I_AND
+    | I_BALANCE
+    | I_CAR
+    | I_CDR
+    | I_CHECK_SIGNATURE
+    | I_COMPARE
+    | I_CONCAT
+    | I_CONS
+    | I_CREATE_ACCOUNT
+    | I_CREATE_CONTRACT
+    | I_IMPLICIT_ACCOUNT
+    | I_DIP
+    | I_DROP
+    | I_DUP
+    | I_EDIV
+    | I_EMPTY_MAP
+    | I_EMPTY_SET
+    | I_EQ
+    | I_EXEC
+    | I_FAILWITH
+    | I_GE
+    | I_GET
+    | I_GT
+    | I_HASH_KEY
+    | I_IF
+    | I_IF_CONS
+    | I_IF_LEFT
+    | I_IF_NONE
+    | I_INT
+    | I_LAMBDA
+    | I_LE
+    | I_LEFT
+    | I_LOOP
+    | I_LSL
+    | I_LSR
+    | I_LT
+    | I_MAP
+    | I_MEM
+    | I_MUL
+    | I_NEG
+    | I_NEQ
+    | I_NIL
+    | I_NONE
+    | I_NOP
+    | I_NOT
+    | I_NOW
+    | I_OR
+    | I_PAIR
+    | I_PUSH
+    | I_RIGHT
+    | I_SIZE
+    | I_SOME
+    | I_SOURCE
+    | I_SENDER
+    | I_SELF
+    | I_SLICE
+    | I_STEPS_TO_QUOTA
+    | I_SUB
+    | I_SWAP
+    | I_TRANSFER_TOKENS
+    | I_SET_DELEGATE
+    | I_UNIT
+    | I_UPDATE
+    | I_XOR
+    | I_ITER
+    | I_LOOP_LEFT
+    | I_ADDRESS
+    | I_CONTRACT
+    | I_ISNAT
+    | I_CAST
+    | I_RENAME
+    | T_bool
+    | T_contract
+    | T_int
+    | T_key
+    | T_key_hash
+    | T_lambda
+    | T_list
+    | T_map
+    | T_big_map
+    | T_nat
+    | T_option
+    | T_or
+    | T_pair
+    | T_set
+    | T_signature
+    | T_string
+    | T_bytes
+    | T_mutez
+    | T_timestamp
+    | T_unit
+    | T_operation
+    | T_address
+
+
+  type location = Micheline.canonical_location
+
+  type annot = Micheline.annot
+
+  type expr = prim Micheline.canonical
+
+  type lazy_expr = expr Data_encoding.lazy_t
+
+  val lazy_expr : expr -> lazy_expr
+
+  type node = (location, prim) Micheline.node
+
+  type t =
+    { code: lazy_expr ;
+      storage: lazy_expr }
+
+  val location_encoding: location Data_encoding.t
+  val expr_encoding: expr Data_encoding.t
+  val prim_encoding: prim Data_encoding.t
+  val encoding: t Data_encoding.t
+  val lazy_expr_encoding: lazy_expr Data_encoding.t
+  val deserialized_cost : expr -> Gas.cost
+  val serialized_cost : MBytes.t -> Gas.cost
+  val traversal_cost : node -> Gas.cost
+  val node_cost : node -> Gas.cost
+  val int_node_cost : Z.t -> Gas.cost
+  val int_node_cost_of_numbits : int -> Gas.cost
+  val string_node_cost : string -> Gas.cost
+  val string_node_cost_of_length : int -> Gas.cost
+  val bytes_node_cost : MBytes.t -> Gas.cost
+  val bytes_node_cost_of_length : int -> Gas.cost
+  val prim_node_cost_nonrec : expr list -> annot  -> Gas.cost
+  val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost
+  val seq_node_cost_nonrec : expr list -> Gas.cost
+  val seq_node_cost_nonrec_of_length : int -> Gas.cost
+  val minimal_deserialize_cost : lazy_expr -> Gas.cost
+  val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t
+  val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t
+end
+
+module Constants : sig
+
+  (** Fixed constants *)
+  type fixed = {
+    proof_of_work_nonce_size : int ;
+    nonce_length : int ;
+    max_revelations_per_block : int ;
+    max_operation_data_length : int ;
+    max_proposals_per_delegate : int ;
+  }
+  val fixed_encoding: fixed Data_encoding.t
+  val fixed: fixed
+
+  val proof_of_work_nonce_size: int
+  val nonce_length: int
+  val max_revelations_per_block: int
+  val max_operation_data_length: int
+  val max_proposals_per_delegate: int
+
+  (** Constants parameterized by context *)
+  type parametric = {
+    preserved_cycles: int ;
+    blocks_per_cycle: int32 ;
+    blocks_per_commitment: int32 ;
+    blocks_per_roll_snapshot: int32 ;
+    blocks_per_voting_period: int32 ;
+    time_between_blocks: Period.t list ;
+    endorsers_per_block: int ;
+    hard_gas_limit_per_operation: Z.t ;
+    hard_gas_limit_per_block: Z.t ;
+    proof_of_work_threshold: int64 ;
+    tokens_per_roll: Tez.t ;
+    michelson_maximum_type_size: int;
+    seed_nonce_revelation_tip: Tez.t ;
+    origination_size: int ;
+    block_security_deposit: Tez.t ;
+    endorsement_security_deposit: Tez.t ;
+    block_reward: Tez.t ;
+    endorsement_reward: Tez.t ;
+    cost_per_byte: Tez.t ;
+    hard_storage_limit_per_operation: Z.t ;
+  }
+  val parametric_encoding: parametric Data_encoding.t
+  val parametric: context -> parametric
+  val preserved_cycles: context -> int
+  val blocks_per_cycle: context -> int32
+  val blocks_per_commitment: context -> int32
+  val blocks_per_roll_snapshot: context -> int32
+  val blocks_per_voting_period: context -> int32
+  val time_between_blocks: context -> Period.t list
+  val endorsers_per_block: context -> int
+  val hard_gas_limit_per_operation: context -> Z.t
+  val hard_gas_limit_per_block: context -> Z.t
+  val cost_per_byte: context -> Tez.t
+  val hard_storage_limit_per_operation: context -> Z.t
+  val proof_of_work_threshold: context -> int64
+  val tokens_per_roll: context -> Tez.t
+  val michelson_maximum_type_size: context -> int
+  val block_reward: context -> Tez.t
+  val endorsement_reward: context -> Tez.t
+  val seed_nonce_revelation_tip: context -> Tez.t
+  val origination_size: context -> int
+  val block_security_deposit: context -> Tez.t
+  val endorsement_security_deposit: context -> Tez.t
+
+  (** All constants: fixed and parametric *)
+  type t = {
+    fixed : fixed ;
+    parametric : parametric ;
+  }
+  val encoding: t Data_encoding.t
+
+end
+
+module Voting_period : sig
+
+  include BASIC_DATA
+  type voting_period = t
+  val rpc_arg: voting_period RPC_arg.arg
+
+  val root: voting_period
+  val succ: voting_period -> voting_period
+
+  type kind =
+    | Proposal
+    | Testing_vote
+    | Testing
+    | Promotion_vote
+  val kind_encoding: kind Data_encoding.encoding
+  val to_int32: voting_period -> int32
+
+end
+
+module Level : sig
+
+  type t = private {
+    level: Raw_level.t ;
+    level_position: int32 ;
+    cycle: Cycle.t ;
+    cycle_position: int32 ;
+    voting_period: Voting_period.t ;
+    voting_period_position: int32 ;
+    expected_commitment: bool ;
+  }
+  include BASIC_DATA with type t := t
+  val pp_full: Format.formatter -> t -> unit
+  type level = t
+
+  val root: context -> level
+
+  val succ: context -> level -> level
+  val pred: context -> level -> level option
+
+  val from_raw: context -> ?offset:int32 -> Raw_level.t -> level
+
+  val diff: level -> level -> int32
+
+  val current: context -> level
+
+  val last_level_in_cycle: context -> Cycle.t -> level
+  val levels_in_cycle: context -> Cycle.t -> level list
+  val levels_in_current_cycle: context -> ?offset:int32 -> unit -> level list
+
+  val last_allowed_fork_level: context -> Raw_level.t
+
+end
+
+module Fitness : sig
+
+  include (module type of Fitness)
+  type fitness = t
+
+  val increase: ?gap:int -> context -> context
+
+  val current: context -> int64
+
+  val to_int64: fitness -> int64 tzresult
+
+end
+
+module Nonce : sig
+
+  type t
+  type nonce = t
+  val encoding: nonce Data_encoding.t
+
+  type unrevealed = {
+    nonce_hash: Nonce_hash.t ;
+    delegate: public_key_hash ;
+    rewards: Tez.t ;
+    fees: Tez.t ;
+  }
+
+  val record_hash:
+    context -> unrevealed -> context tzresult Lwt.t
+
+  val reveal:
+    context -> Level.t -> nonce ->
+    context tzresult Lwt.t
+
+  type status =
+    | Unrevealed of unrevealed
+    | Revealed of nonce
+
+  val get: context -> Level.t -> status tzresult Lwt.t
+
+  val of_bytes: MBytes.t -> nonce tzresult
+  val hash: nonce -> Nonce_hash.t
+  val check_hash: nonce -> Nonce_hash.t -> bool
+
+end
+
+module Seed : sig
+
+  type seed
+
+  type error +=
+    | Unknown of { oldest : Cycle.t ;
+                   cycle : Cycle.t ;
+                   latest : Cycle.t }
+
+  val for_cycle:
+    context -> Cycle.t -> seed tzresult Lwt.t
+
+  val cycle_end:
+    context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t
+
+  val seed_encoding : seed Data_encoding.t
+
+end
+
+module Contract : sig
+
+  include BASIC_DATA
+  type contract = t
+  val rpc_arg: contract RPC_arg.arg
+
+  val to_b58check: contract -> string
+  val of_b58check: string -> contract tzresult
+
+  val implicit_contract: public_key_hash -> contract
+  val is_implicit: contract -> public_key_hash option
+
+  val exists: context -> contract -> bool tzresult Lwt.t
+  val must_exist: context -> contract -> unit tzresult Lwt.t
+
+  val allocated: context -> contract -> bool tzresult Lwt.t
+  val must_be_allocated: context -> contract -> unit tzresult Lwt.t
+
+  val list: context -> contract list Lwt.t
+
+  val get_manager:
+    context -> contract -> public_key_hash tzresult Lwt.t
+
+  val get_manager_key:
+    context -> contract -> public_key tzresult Lwt.t
+  val is_manager_key_revealed:
+    context -> contract -> bool tzresult Lwt.t
+
+  val reveal_manager_key:
+    context -> contract -> public_key -> context tzresult Lwt.t
+
+  val is_delegatable:
+    context -> contract -> bool tzresult Lwt.t
+  val is_spendable:
+    context -> contract -> bool tzresult Lwt.t
+  val get_script:
+    context -> contract -> (context * Script.t option) tzresult Lwt.t
+  val get_storage:
+    context -> contract -> (context * Script.expr option) tzresult Lwt.t
+
+  val get_counter: context -> contract -> Z.t tzresult Lwt.t
+  val get_balance:
+    context -> contract -> Tez.t tzresult Lwt.t
+
+  val init_origination_nonce: context -> Operation_hash.t -> context
+  val unset_origination_nonce: context -> context
+  val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t
+  val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t
+
+  type big_map_diff_item = {
+    diff_key : Script_repr.expr;
+    diff_key_hash : Script_expr_hash.t;
+    diff_value : Script_repr.expr option;
+  }
+  type big_map_diff = big_map_diff_item list
+  val big_map_diff_encoding : big_map_diff Data_encoding.t
+
+  val originate:
+    context -> contract ->
+    balance: Tez.t ->
+    manager: public_key_hash ->
+    ?script: (Script.t * big_map_diff option) ->
+    delegate: public_key_hash option ->
+    spendable: bool ->
+    delegatable: bool -> context tzresult Lwt.t
+
+  type error += Balance_too_low of contract * Tez.t * Tez.t
+
+  val spend:
+    context -> contract -> Tez.t -> context tzresult Lwt.t
+  val spend_from_script:
+    context -> contract -> Tez.t -> context tzresult Lwt.t
+
+  val credit:
+    context -> contract -> Tez.t -> context tzresult Lwt.t
+
+  val update_script_storage:
+    context -> contract ->
+    Script.expr -> big_map_diff option ->
+    context tzresult Lwt.t
+
+  val used_storage_space: context -> t -> Z.t tzresult Lwt.t
+
+  val increment_counter:
+    context -> contract -> context tzresult Lwt.t
+
+  val check_counter_increment:
+    context -> contract -> Z.t -> unit tzresult Lwt.t
+
+  module Big_map : sig
+    val mem:
+      context -> contract -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t
+    val get_opt:
+      context -> contract -> Script_expr_hash.t -> (context * Script_repr.expr option) tzresult Lwt.t
+  end
+
+  (**/**)
+  (* Only for testing *)
+  type origination_nonce
+  val initial_origination_nonce  : Operation_hash.t -> origination_nonce
+  val originated_contract : origination_nonce -> contract
+
+end
+
+module Delegate : sig
+
+  type balance =
+    | Contract of Contract.t
+    | Rewards of Signature.Public_key_hash.t * Cycle.t
+    | Fees of Signature.Public_key_hash.t * Cycle.t
+    | Deposits of Signature.Public_key_hash.t * Cycle.t
+
+  type balance_update =
+    | Debited of Tez.t
+    | Credited of Tez.t
+
+  type balance_updates = (balance * balance_update) list
+
+  val balance_updates_encoding : balance_updates Data_encoding.t
+
+  val cleanup_balance_updates : balance_updates -> balance_updates
+
+  val get: context -> Contract.t -> public_key_hash option tzresult Lwt.t
+
+  val set:
+    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
+
+  val set_from_script:
+    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t
+
+  val fold:
+    context ->
+    init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  val list: context -> public_key_hash list Lwt.t
+
+  val freeze_deposit:
+    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
+
+  val freeze_rewards:
+    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
+
+  val freeze_fees:
+    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t
+
+  val cycle_end:
+    context -> Cycle.t -> Nonce.unrevealed list ->
+    (context * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t
+
+  type frozen_balance = {
+    deposit : Tez.t ;
+    fees : Tez.t ;
+    rewards : Tez.t ;
+  }
+
+  val punish:
+    context -> public_key_hash -> Cycle.t ->
+    (context * frozen_balance) tzresult Lwt.t
+
+  val full_balance:
+    context -> public_key_hash -> Tez.t tzresult Lwt.t
+
+  val has_frozen_balance:
+    context -> public_key_hash -> Cycle.t ->
+    bool tzresult Lwt.t
+
+  val frozen_balance:
+    context -> public_key_hash -> Tez.t tzresult Lwt.t
+
+  val frozen_balance_encoding: frozen_balance Data_encoding.t
+  val frozen_balance_by_cycle_encoding: frozen_balance Cycle.Map.t Data_encoding.t
+
+  val frozen_balance_by_cycle:
+    context -> Signature.Public_key_hash.t ->
+    frozen_balance Cycle.Map.t Lwt.t
+
+  val staking_balance:
+    context -> Signature.Public_key_hash.t ->
+    Tez.t tzresult Lwt.t
+
+  val delegated_contracts:
+    context -> Signature.Public_key_hash.t ->
+    Contract_hash.t list Lwt.t
+
+  val delegated_balance:
+    context -> Signature.Public_key_hash.t ->
+    Tez.t tzresult Lwt.t
+
+  val deactivated:
+    context -> Signature.Public_key_hash.t ->
+    bool tzresult Lwt.t
+
+  val grace_period:
+    context -> Signature.Public_key_hash.t ->
+    Cycle.t tzresult Lwt.t
+
+end
+
+module Vote : sig
+
+  type proposal = Protocol_hash.t
+
+  val record_proposal:
+    context -> Protocol_hash.t -> public_key_hash ->
+    context tzresult Lwt.t
+  val get_proposals:
+    context -> int32 Protocol_hash.Map.t tzresult Lwt.t
+  val clear_proposals: context -> context Lwt.t
+
+  val recorded_proposal_count_for_delegate:
+    context -> public_key_hash -> int tzresult Lwt.t
+
+  val listings_encoding : (Signature.Public_key_hash.t * int32) list Data_encoding.t
+  val freeze_listings: context -> context tzresult Lwt.t
+  val clear_listings: context -> context tzresult Lwt.t
+  val listing_size: context -> int32 tzresult Lwt.t
+  val in_listings: context -> public_key_hash -> bool Lwt.t
+  val get_listings : context -> (public_key_hash * int32) list Lwt.t
+
+  type ballot = Yay | Nay | Pass
+  val ballot_encoding : ballot Data_encoding.t
+
+  type ballots = {
+    yay: int32 ;
+    nay: int32 ;
+    pass: int32 ;
+  }
+
+  val ballots_encoding : ballots Data_encoding.t
+
+  val has_recorded_ballot :
+    context -> public_key_hash -> bool Lwt.t
+  val record_ballot:
+    context -> public_key_hash -> ballot -> context tzresult Lwt.t
+  val get_ballots: context -> ballots tzresult Lwt.t
+  val get_ballot_list: context -> (Signature.Public_key_hash.t * ballot) list Lwt.t
+  val clear_ballots: context -> context Lwt.t
+
+  val get_current_period_kind:
+    context -> Voting_period.kind tzresult Lwt.t
+  val set_current_period_kind:
+    context -> Voting_period.kind -> context tzresult Lwt.t
+
+  val get_current_quorum: context -> int32 tzresult Lwt.t
+  val set_current_quorum: context -> int32 -> context tzresult Lwt.t
+
+  val get_current_proposal:
+    context -> proposal tzresult Lwt.t
+  val init_current_proposal:
+    context -> proposal -> context tzresult Lwt.t
+  val clear_current_proposal:
+    context -> context tzresult Lwt.t
+
+end
+
+module Block_header : sig
+
+  type t = {
+    shell: Block_header.shell_header ;
+    protocol_data: protocol_data ;
+  }
+
+  and protocol_data = {
+    contents: contents ;
+    signature: Signature.t ;
+  }
+
+  and contents = {
+    priority: int ;
+    seed_nonce_hash: Nonce_hash.t option ;
+    proof_of_work_nonce: MBytes.t ;
+  }
+
+  type block_header = t
+
+  type raw = Block_header.t
+  type shell_header = Block_header.shell_header
+
+  val raw: block_header -> raw
+
+  val hash: block_header -> Block_hash.t
+  val hash_raw: raw -> Block_hash.t
+
+  val encoding: block_header Data_encoding.encoding
+  val raw_encoding: raw Data_encoding.t
+  val contents_encoding: contents Data_encoding.t
+  val unsigned_encoding: (shell_header * contents) Data_encoding.t
+  val protocol_data_encoding: protocol_data Data_encoding.encoding
+  val shell_header_encoding: shell_header Data_encoding.encoding
+
+  val max_header_length: int
+  (** The maximum size of block headers in bytes *)
+
+end
+
+module Kind : sig
+  type seed_nonce_revelation = Seed_nonce_revelation_kind
+  type double_endorsement_evidence = Double_endorsement_evidence_kind
+  type double_baking_evidence = Double_baking_evidence_kind
+  type activate_account = Activate_account_kind
+  type endorsement = Endorsement_kind
+  type proposals = Proposals_kind
+  type ballot = Ballot_kind
+  type reveal = Reveal_kind
+  type transaction = Transaction_kind
+  type origination = Origination_kind
+  type delegation = Delegation_kind
+  type 'a manager =
+    | Reveal_manager_kind : reveal manager
+    | Transaction_manager_kind : transaction manager
+    | Origination_manager_kind : origination manager
+    | Delegation_manager_kind : delegation manager
+end
+
+type 'kind operation = {
+  shell: Operation.shell_header ;
+  protocol_data: 'kind protocol_data ;
+}
+
+and 'kind protocol_data = {
+  contents: 'kind contents_list ;
+  signature: Signature.t option ;
+}
+
+and _ contents_list =
+  | Single : 'kind contents -> 'kind contents_list
+  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+    (('kind * 'rest) Kind.manager ) contents_list
+
+and _ contents =
+  | Endorsement : {
+      level: Raw_level.t ;
+    } -> Kind.endorsement contents
+  | Seed_nonce_revelation : {
+      level: Raw_level.t ;
+      nonce: Nonce.t ;
+    } -> Kind.seed_nonce_revelation contents
+  | Double_endorsement_evidence : {
+      op1: Kind.endorsement operation ;
+      op2: Kind.endorsement operation ;
+    } -> Kind.double_endorsement_evidence contents
+  | Double_baking_evidence : {
+      bh1: Block_header.t ;
+      bh2: Block_header.t ;
+    } -> Kind.double_baking_evidence contents
+  | Activate_account : {
+      id: Ed25519.Public_key_hash.t ;
+      activation_code: Blinded_public_key_hash.activation_code ;
+    } -> Kind.activate_account contents
+  | Proposals : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period.t ;
+      proposals: Protocol_hash.t list ;
+    } -> Kind.proposals contents
+  | Ballot : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period.t ;
+      proposal: Protocol_hash.t ;
+      ballot: Vote.ballot ;
+    } -> Kind.ballot contents
+  | Manager_operation : {
+      source: Contract.contract ;
+      fee: Tez.tez ;
+      counter: counter ;
+      operation: 'kind manager_operation ;
+      gas_limit: Z.t;
+      storage_limit: Z.t;
+    } -> 'kind Kind.manager contents
+
+and _ manager_operation =
+  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
+  | Transaction : {
+      amount: Tez.tez ;
+      parameters: Script.lazy_expr option ;
+      destination: Contract.contract ;
+    } -> Kind.transaction manager_operation
+  | Origination : {
+      manager: Signature.Public_key_hash.t ;
+      delegate: Signature.Public_key_hash.t option ;
+      script: Script.t option ;
+      spendable: bool ;
+      delegatable: bool ;
+      credit: Tez.tez ;
+      preorigination: Contract.t option ;
+    } -> Kind.origination manager_operation
+  | Delegation :
+      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
+
+and counter = Z.t
+
+type 'kind internal_operation = {
+  source: Contract.contract ;
+  operation: 'kind manager_operation ;
+  nonce: int ;
+}
+
+type packed_manager_operation =
+  | Manager : 'kind manager_operation -> packed_manager_operation
+
+type packed_contents =
+  | Contents : 'kind contents -> packed_contents
+
+type packed_contents_list =
+  | Contents_list : 'kind contents_list -> packed_contents_list
+
+type packed_protocol_data =
+  | Operation_data : 'kind protocol_data -> packed_protocol_data
+
+type packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: packed_protocol_data ;
+}
+
+type packed_internal_operation =
+  | Internal_operation : 'kind internal_operation -> packed_internal_operation
+
+val manager_kind: 'kind manager_operation -> 'kind Kind.manager
+
+module Fees : sig
+
+  val origination_burn:
+    context -> (context * Tez.t) tzresult Lwt.t
+
+  val record_paid_storage_space:
+    context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t
+
+  val start_counting_storage_fees :
+    context -> context
+
+  val burn_storage_fees:
+    context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t
+
+  type error += Cannot_pay_storage_fee (* `Temporary *)
+  type error += Operation_quota_exceeded (* `Temporary *)
+  type error += Storage_limit_too_high (* `Permanent *)
+
+  val check_storage_limit: context -> storage_limit:Z.t -> unit tzresult
+
+end
+
+module Operation : sig
+
+  type nonrec 'kind contents = 'kind contents
+  type nonrec packed_contents = packed_contents
+  val contents_encoding: packed_contents Data_encoding.t
+
+  type nonrec 'kind protocol_data = 'kind protocol_data
+  type nonrec packed_protocol_data = packed_protocol_data
+  val protocol_data_encoding: packed_protocol_data Data_encoding.t
+  val unsigned_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
+
+  type raw = Operation.t = {
+    shell: Operation.shell_header ;
+    proto: MBytes.t ;
+  }
+  val raw_encoding: raw Data_encoding.t
+  val contents_list_encoding: packed_contents_list Data_encoding.t
+
+  type 'kind t = 'kind operation = {
+    shell: Operation.shell_header ;
+    protocol_data: 'kind protocol_data ;
+  }
+  type nonrec packed = packed_operation
+  val encoding: packed Data_encoding.t
+
+  val raw: _ operation -> raw
+
+  val hash: _ operation -> Operation_hash.t
+  val hash_raw: raw -> Operation_hash.t
+  val hash_packed: packed_operation -> Operation_hash.t
+
+  val acceptable_passes: packed_operation -> int list
+
+  type error += Missing_signature (* `Permanent *)
+  type error += Invalid_signature (* `Permanent *)
+
+  val check_signature: public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t
+  val check_signature_sync: public_key -> Chain_id.t -> _ operation -> unit tzresult
+
+  val internal_operation_encoding: packed_internal_operation Data_encoding.t
+
+  val pack: 'kind operation -> packed_operation
+
+  type ('a, 'b) eq = Eq : ('a, 'a) eq
+  val equal: 'a operation -> 'b operation -> ('a, 'b) eq option
+
+  module Encoding : sig
+
+    type 'b case =
+        Case : { tag: int ;
+                 name: string ;
+                 encoding: 'a Data_encoding.t ;
+                 select: packed_contents -> 'b contents option ;
+                 proj: 'b contents -> 'a ;
+                 inj: 'a -> 'b contents } -> 'b case
+
+    val endorsement_case: Kind.endorsement case
+    val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
+    val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
+    val double_baking_evidence_case: Kind.double_baking_evidence case
+    val activate_account_case: Kind.activate_account case
+    val proposals_case: Kind.proposals case
+    val ballot_case: Kind.ballot case
+    val reveal_case: Kind.reveal Kind.manager case
+    val transaction_case: Kind.transaction Kind.manager case
+    val origination_case: Kind.origination Kind.manager case
+    val delegation_case: Kind.delegation Kind.manager case
+
+    module Manager_operations : sig
+
+      type 'b case =
+          MCase : { tag: int ;
+                    name: string ;
+                    encoding: 'a Data_encoding.t ;
+                    select: packed_manager_operation -> 'kind manager_operation option ;
+                    proj: 'kind manager_operation -> 'a ;
+                    inj: 'a -> 'kind manager_operation } -> 'kind case
+
+      val reveal_case: Kind.reveal case
+      val transaction_case: Kind.transaction case
+      val origination_case: Kind.origination case
+      val delegation_case: Kind.delegation case
+
+    end
+
+  end
+
+  val of_list: packed_contents list -> packed_contents_list
+  val to_list: packed_contents_list -> packed_contents list
+
+end
+
+module Roll : sig
+
+  type t = private int32
+  type roll = t
+
+  val encoding: roll Data_encoding.t
+
+  val snapshot_rolls: context -> context tzresult Lwt.t
+  val cycle_end: context -> Cycle.t -> context tzresult Lwt.t
+
+  val baking_rights_owner:
+    context -> Level.t -> priority:int -> public_key tzresult Lwt.t
+
+  val endorsement_rights_owner:
+    context -> Level.t -> slot:int -> public_key tzresult Lwt.t
+
+  val delegate_pubkey:
+    context -> public_key_hash -> public_key tzresult Lwt.t
+
+  val get_rolls:
+    context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t
+  val get_change:
+    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
+
+end
+
+module Commitment : sig
+
+  type t =
+    { blinded_public_key_hash : Blinded_public_key_hash.t ;
+      amount : Tez.tez }
+
+  val get_opt:
+    context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t
+  val delete:
+    context ->  Blinded_public_key_hash.t -> context tzresult Lwt.t
+
+end
+
+module Bootstrap : sig
+
+  val cycle_end:
+    context -> Cycle.t -> context tzresult Lwt.t
+
+end
+
+module Global : sig
+
+  val get_last_block_priority: context -> int tzresult Lwt.t
+  val set_last_block_priority: context -> int -> context tzresult Lwt.t
+
+end
+
+val prepare_first_block:
+  Context.t ->
+  typecheck:(context -> Script.t -> context tzresult Lwt.t) ->
+  level:Int32.t ->
+  timestamp:Time.t ->
+  fitness:Fitness.t ->
+  context tzresult Lwt.t
+
+val prepare:
+  Context.t ->
+  level:Int32.t ->
+  timestamp:Time.t ->
+  fitness:Fitness.t ->
+  context tzresult Lwt.t
+
+val finalize: ?commit_message:string -> context -> Updater.validation_result
+
+val activate: context -> Protocol_hash.t -> context Lwt.t
+val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
+
+val record_endorsement:
+  context -> Signature.Public_key_hash.t -> context
+val allowed_endorsements:
+  context ->
+  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t
+val init_endorsements:
+  context ->
+  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
+  context
+
+val reset_internal_nonce: context -> context
+val fresh_internal_nonce: context -> (context * int) tzresult
+val record_internal_nonce: context -> int -> context
+val internal_nonce_already_recorded: context -> int -> bool
+
+val add_fees: context -> Tez.t -> context tzresult Lwt.t
+val add_rewards: context -> Tez.t -> context tzresult Lwt.t
+val add_deposit:
+  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t
+
+val get_fees: context -> Tez.t
+val get_rewards: context -> Tez.t
+val get_deposits: context -> Tez.t Signature.Public_key_hash.Map.t
+
+val description: context Storage_description.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.ml
new file mode 100644
index 000000000..5194db531
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.ml
@@ -0,0 +1,127 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+let custom_root = RPC_path.open_root
+
+module Seed = struct
+
+  module S = struct
+
+    open Data_encoding
+
+    let seed =
+      RPC_service.post_service
+        ~description: "Seed of the cycle to which the block belongs."
+        ~query: RPC_query.empty
+        ~input: empty
+        ~output: Seed.seed_encoding
+        RPC_path.(custom_root / "context" / "seed")
+
+  end
+
+  let () =
+    let open Services_registration in
+    register0 S.seed begin fun ctxt () () ->
+      let l = Level.current ctxt in
+      Seed.for_cycle ctxt l.cycle
+    end
+
+
+  let get ctxt block =
+    RPC_context.make_call0 S.seed ctxt block () ()
+
+end
+
+module Nonce = struct
+
+  type info =
+    | Revealed of Nonce.t
+    | Missing of Nonce_hash.t
+    | Forgotten
+
+  let info_encoding =
+    let open Data_encoding in
+    union [
+      case (Tag 0)
+        ~title:"Revealed"
+        (obj1 (req "nonce" Nonce.encoding))
+        (function Revealed nonce -> Some nonce | _ -> None)
+        (fun nonce -> Revealed nonce) ;
+      case (Tag 1)
+        ~title:"Missing"
+        (obj1 (req "hash" Nonce_hash.encoding))
+        (function Missing nonce -> Some nonce | _ -> None)
+        (fun nonce -> Missing nonce) ;
+      case (Tag 2)
+        ~title:"Forgotten"
+        empty
+        (function Forgotten -> Some () | _ -> None)
+        (fun () -> Forgotten) ;
+    ]
+
+  module S = struct
+
+    let get =
+      RPC_service.get_service
+        ~description: "Info about the nonce of a previous block."
+        ~query: RPC_query.empty
+        ~output: info_encoding
+        RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
+
+  end
+
+  let register () =
+    let open Services_registration in
+    register1 S.get begin fun ctxt raw_level () () ->
+      let level = Level.from_raw ctxt raw_level in
+      Nonce.get ctxt level >>= function
+      | Ok (Revealed nonce) -> return (Revealed nonce)
+      | Ok (Unrevealed { nonce_hash ; _ }) ->
+          return (Missing nonce_hash)
+      | Error _ -> return Forgotten
+    end
+
+  let get ctxt block level =
+    RPC_context.make_call1 S.get ctxt block level () ()
+
+end
+
+module Contract = Contract_services
+module Constants = Constants_services
+module Delegate = Delegate_services
+module Helpers = Helpers_services
+module Forge = Helpers_services.Forge
+module Parse = Helpers_services.Parse
+module Voting = Voting_services
+
+let register () =
+  Contract.register () ;
+  Constants.register () ;
+  Delegate.register () ;
+  Helpers.register () ;
+  Nonce.register () ;
+  Voting.register ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.mli
new file mode 100644
index 000000000..f6e4a6b25
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/alpha_services.mli
@@ -0,0 +1,55 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+module Seed : sig
+
+  val get: 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
+
+end
+
+module Nonce : sig
+
+  type info =
+    | Revealed of Nonce.t
+    | Missing of Nonce_hash.t
+    | Forgotten
+
+  val get:
+    'a #RPC_context.simple ->
+    'a -> Raw_level.t -> info shell_tzresult Lwt.t
+
+end
+
+module Contract = Contract_services
+module Constants = Constants_services
+module Delegate = Delegate_services
+module Helpers = Helpers_services
+module Forge = Helpers_services.Forge
+module Parse = Helpers_services.Parse
+module Voting = Voting_services
+
+val register: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.ml
new file mode 100644
index 000000000..75ad7c65e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.ml
@@ -0,0 +1,260 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+let () = ()
+
+let select_winning_proposal proposals =
+  let merge proposal vote winners =
+    match winners with
+    | None -> Some ([proposal], vote)
+    | Some (winners, winners_vote) as previous ->
+        if Compare.Int32.(vote = winners_vote) then
+          Some (proposal :: winners, winners_vote)
+        else if Compare.Int32.(vote >= winners_vote) then
+          Some ([proposal], vote)
+        else
+          previous in
+  match Protocol_hash.Map.fold merge proposals None with
+  | None -> None
+  | Some ([proposal], _) -> Some proposal
+  | Some _ -> None (* in case of a tie, lets do nothing. *)
+
+let check_approval_and_update_quorum ctxt =
+  Vote.get_ballots ctxt >>=? fun ballots ->
+  Vote.listing_size ctxt >>=? fun maximum_vote ->
+  Vote.get_current_quorum ctxt >>=? fun expected_quorum ->
+  (* FIXME check overflow ??? *)
+  let casted_vote = Int32.add ballots.yay ballots.nay in
+  let actual_vote = Int32.add casted_vote ballots.pass in
+  let actual_quorum =
+    Int32.div (Int32.mul actual_vote 100_00l) maximum_vote in
+  let supermajority = Int32.div (Int32.mul 8l casted_vote) 10l in
+  let updated_quorum =
+    Int32.div
+      (Int32.add (Int32.mul 8l expected_quorum)
+         (Int32.mul 2l actual_quorum))
+      10l in
+  Vote.set_current_quorum ctxt updated_quorum >>=? fun ctxt ->
+  return
+    (ctxt,
+     Compare.Int32.(actual_quorum >= expected_quorum
+                    && ballots.yay >= supermajority))
+
+let start_new_voting_cycle ctxt =
+  Vote.get_current_period_kind ctxt >>=? function
+  | Proposal -> begin
+      Vote.get_proposals ctxt >>=? fun proposals ->
+      Vote.clear_proposals ctxt >>= fun ctxt ->
+      Vote.clear_listings ctxt >>=? fun ctxt ->
+      match select_winning_proposal proposals with
+      | None ->
+          Vote.freeze_listings ctxt >>=? fun ctxt ->
+          return ctxt
+      | Some proposal ->
+          Vote.init_current_proposal ctxt proposal >>=? fun ctxt ->
+          Vote.freeze_listings ctxt >>=? fun ctxt ->
+          Vote.set_current_period_kind ctxt Testing_vote >>=? fun ctxt ->
+          return ctxt
+    end
+  | Testing_vote ->
+      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->
+      Vote.clear_ballots ctxt >>= fun ctxt ->
+      Vote.clear_listings ctxt >>=? fun ctxt ->
+      if approved then
+        let expiration = (* in two days maximum... *)
+          Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in
+        Vote.get_current_proposal ctxt >>=? fun proposal ->
+        fork_test_chain ctxt proposal expiration >>= fun ctxt ->
+        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
+        return ctxt
+      else
+        Vote.clear_current_proposal ctxt >>=? fun ctxt ->
+        Vote.freeze_listings ctxt >>=? fun ctxt ->
+        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
+        return ctxt
+  | Testing ->
+      Vote.freeze_listings ctxt >>=? fun ctxt ->
+      Vote.set_current_period_kind ctxt Promotion_vote >>=? fun ctxt ->
+      return ctxt
+  | Promotion_vote ->
+      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->
+      begin
+        if approved then
+          Vote.get_current_proposal ctxt >>=? fun proposal ->
+          activate ctxt proposal >>= fun ctxt ->
+          return ctxt
+        else
+          return ctxt
+      end >>=? fun ctxt ->
+      Vote.clear_ballots ctxt >>= fun ctxt ->
+      Vote.clear_listings ctxt >>=? fun ctxt ->
+      Vote.clear_current_proposal ctxt >>=? fun ctxt ->
+      Vote.freeze_listings ctxt >>=? fun ctxt ->
+      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
+      return ctxt
+
+type error += (* `Branch *)
+  | Invalid_proposal
+  | Unexpected_proposal
+  | Unauthorized_proposal
+  | Too_many_proposals
+  | Empty_proposal
+  | Unexpected_ballot
+  | Unauthorized_ballot
+
+let () =
+  let open Data_encoding in
+  (* Invalid proposal *)
+  register_error_kind
+    `Branch
+    ~id:"invalid_proposal"
+    ~title:"Invalid proposal"
+    ~description:"Ballot provided for a proposal that is not the current one."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
+    empty
+    (function Invalid_proposal -> Some () | _ -> None)
+    (fun () -> Invalid_proposal) ;
+  (* Unexpected proposal *)
+  register_error_kind
+    `Branch
+    ~id:"unexpected_proposal"
+    ~title:"Unexpected proposal"
+    ~description:"Proposal recorded outside of a proposal period."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
+    empty
+    (function Unexpected_proposal -> Some () | _ -> None)
+    (fun () -> Unexpected_proposal) ;
+  (* Unauthorized proposal *)
+  register_error_kind
+    `Branch
+    ~id:"unauthorized_proposal"
+    ~title:"Unauthorized proposal"
+    ~description:"The delegate provided for the proposal is not in the voting listings."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
+    empty
+    (function Unauthorized_proposal -> Some () | _ -> None)
+    (fun () -> Unauthorized_proposal) ;
+  (* Unexpected ballot *)
+  register_error_kind
+    `Branch
+    ~id:"unexpected_ballot"
+    ~title:"Unexpected ballot"
+    ~description:"Ballot recorded outside of a voting period."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
+    empty
+    (function Unexpected_ballot -> Some () | _ -> None)
+    (fun () -> Unexpected_ballot) ;
+  (* Unauthorized ballot *)
+  register_error_kind
+    `Branch
+    ~id:"unauthorized_ballot"
+    ~title:"Unauthorized ballot"
+    ~description:"The delegate provided for the ballot is not in the voting listings."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
+    empty
+    (function Unauthorized_ballot -> Some () | _ -> None)
+    (fun () -> Unauthorized_ballot) ;
+  (* Too many proposals *)
+  register_error_kind
+    `Branch
+    ~id:"too_many_proposals"
+    ~title:"Too many proposals"
+    ~description:"The delegate reached the maximum number of allowed proposals."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
+    empty
+    (function Too_many_proposals -> Some () | _ -> None)
+    (fun () -> Too_many_proposals) ;
+  (* Empty proposal *)
+  register_error_kind
+    `Branch
+    ~id:"empty_proposal"
+    ~title:"Empty proposal"
+    ~description:"Proposal lists cannot be empty."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal")
+    empty
+    (function Empty_proposal -> Some () | _ -> None)
+    (fun () -> Empty_proposal)
+
+(* @return [true] if [List.length l] > [n] w/o computing length *)
+let rec longer_than l n =
+  if Compare.Int.(n < 0) then assert false else
+    match l with
+    | [] -> false
+    | _ :: rest ->
+        if Compare.Int.(n = 0) then true
+        else (* n > 0 *)
+          longer_than rest (n-1)
+
+let record_proposals ctxt delegate proposals =
+  begin match proposals with
+    | [] -> fail Empty_proposal
+    | _ :: _ -> return ()
+  end >>=? fun () ->
+  Vote.get_current_period_kind ctxt >>=? function
+  | Proposal ->
+      Vote.in_listings ctxt delegate >>= fun in_listings ->
+      if in_listings then
+        Vote.recorded_proposal_count_for_delegate ctxt delegate >>=? fun count ->
+        fail_when
+          (longer_than proposals (Constants.max_proposals_per_delegate - count))
+          Too_many_proposals >>=? fun () ->
+        fold_left_s
+          (fun ctxt proposal ->
+             Vote.record_proposal ctxt proposal delegate)
+          ctxt proposals >>=? fun ctxt ->
+        return ctxt
+      else
+        fail Unauthorized_proposal
+  | Testing_vote | Testing | Promotion_vote ->
+      fail Unexpected_proposal
+
+let record_ballot ctxt delegate proposal ballot =
+  Vote.get_current_period_kind ctxt >>=? function
+  | Testing_vote | Promotion_vote ->
+      Vote.get_current_proposal ctxt >>=? fun current_proposal ->
+      fail_unless (Protocol_hash.equal proposal current_proposal)
+        Invalid_proposal >>=? fun () ->
+      Vote.has_recorded_ballot ctxt delegate >>= fun has_ballot ->
+      fail_when has_ballot Unauthorized_ballot >>=? fun () ->
+      Vote.in_listings ctxt delegate >>= fun in_listings ->
+      if in_listings then
+        Vote.record_ballot ctxt delegate ballot
+      else
+        fail Unauthorized_ballot
+  | Testing | Proposal ->
+      fail Unexpected_ballot
+
+let last_of_a_voting_period ctxt l =
+  Compare.Int32.(Int32.succ l.Level.voting_period_position =
+                 Constants.blocks_per_voting_period ctxt )
+
+let may_start_new_voting_cycle ctxt =
+  let level = Level.current ctxt in
+  if last_of_a_voting_period ctxt level then
+    start_new_voting_cycle ctxt
+  else
+    return ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.mli
new file mode 100644
index 000000000..baffcff97
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/amendment.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+val may_start_new_voting_cycle:
+  context -> context tzresult Lwt.t
+
+type error +=
+  | Unexpected_proposal
+  | Unauthorized_proposal
+  | Too_many_proposals
+  | Empty_proposal
+
+val record_proposals:
+  context ->
+  public_key_hash -> Protocol_hash.t list ->
+  context tzresult Lwt.t
+
+type error +=
+  | Invalid_proposal
+  | Unexpected_ballot
+  | Unauthorized_ballot
+
+val record_ballot:
+  context ->
+  public_key_hash -> Protocol_hash.t -> Vote.ballot ->
+  context tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply.ml
new file mode 100644
index 000000000..1dc701d3a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply.ml
@@ -0,0 +1,1039 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Main Entry Points *)
+
+open Alpha_context
+
+type error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *)
+type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *)
+type error += Duplicate_endorsement of Signature.Public_key_hash.t (* `Branch *)
+type error += Invalid_endorsement_level
+type error += Invalid_commitment of { expected: bool }
+type error += Internal_operation_replay of packed_internal_operation
+
+type error += Invalid_double_endorsement_evidence (* `Permanent *)
+type error += Inconsistent_double_endorsement_evidence
+  of { delegate1: Signature.Public_key_hash.t ; delegate2: Signature.Public_key_hash.t } (* `Permanent *)
+type error += Unrequired_double_endorsement_evidence (* `Branch*)
+type error += Too_early_double_endorsement_evidence
+  of { level: Raw_level.t ; current: Raw_level.t } (* `Temporary *)
+type error += Outdated_double_endorsement_evidence
+  of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)
+
+type error += Invalid_double_baking_evidence
+  of { hash1: Block_hash.t ;
+       level1: Int32.t ;
+       hash2: Block_hash.t ;
+       level2: Int32.t } (* `Permanent *)
+type error += Inconsistent_double_baking_evidence
+  of { delegate1: Signature.Public_key_hash.t ; delegate2: Signature.Public_key_hash.t } (* `Permanent *)
+type error += Unrequired_double_baking_evidence (* `Branch*)
+type error += Too_early_double_baking_evidence
+  of { level: Raw_level.t ; current: Raw_level.t } (* `Temporary *)
+type error += Outdated_double_baking_evidence
+  of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)
+type error += Invalid_activation of { pkh : Ed25519.Public_key_hash.t }
+type error += Multiple_revelation
+type error += Gas_quota_exceeded_init_deserialize (* Permanent *)
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"operation.wrong_endorsement_predecessor"
+    ~title:"Wrong endorsement predecessor"
+    ~description:"Trying to include an endorsement in a block \
+                  that is not the successor of the endorsed one"
+    ~pp:(fun ppf (e, p) ->
+        Format.fprintf ppf "Wrong predecessor %a, expected %a"
+          Block_hash.pp p Block_hash.pp e)
+    Data_encoding.(obj2
+                     (req "expected" Block_hash.encoding)
+                     (req "provided" Block_hash.encoding))
+    (function Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)
+    (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;
+  register_error_kind
+    `Temporary
+    ~id:"operation.wrong_voting_period"
+    ~title:"Wrong voting period"
+    ~description:"Trying to onclude a proposal or ballot \
+                  meant for another voting period"
+    ~pp:(fun ppf (e, p) ->
+        Format.fprintf ppf "Wrong voting period %a, current is %a"
+          Voting_period.pp p Voting_period.pp e)
+    Data_encoding.(obj2
+                     (req "current" Voting_period.encoding)
+                     (req "provided" Voting_period.encoding))
+    (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
+    (fun (e, p) -> Wrong_voting_period (e, p));
+  register_error_kind
+    `Branch
+    ~id:"operation.duplicate_endorsement"
+    ~title:"Duplicate endorsement"
+    ~description:"Two endorsements received from same delegate"
+    ~pp:(fun ppf k ->
+        Format.fprintf ppf "Duplicate endorsement from delegate %a (possible replay attack)."
+          Signature.Public_key_hash.pp_short k)
+    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
+    (function Duplicate_endorsement k -> Some k | _ -> None)
+    (fun k -> Duplicate_endorsement k);
+  register_error_kind
+    `Temporary
+    ~id:"operation.invalid_endorsement_level"
+    ~title:"Unexpected level in endorsement"
+    ~description:"The level of an endorsement is inconsistent with the \
+                 \ provided block hash."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Unexpected level in endorsement.")
+    Data_encoding.unit
+    (function Invalid_endorsement_level -> Some () | _ -> None)
+    (fun () -> Invalid_endorsement_level) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.invalid_commitment"
+    ~title:"Invalid commitment in block header"
+    ~description:"The block header has invalid commitment."
+    ~pp:(fun ppf expected ->
+        if expected then
+          Format.fprintf ppf "Missing seed's nonce commitment in block header."
+        else
+          Format.fprintf ppf "Unexpected seed's nonce commitment in block header.")
+    Data_encoding.(obj1 (req "expected" bool))
+    (function Invalid_commitment { expected } -> Some expected | _ -> None)
+    (fun expected -> Invalid_commitment { expected }) ;
+  register_error_kind
+    `Permanent
+    ~id:"internal_operation_replay"
+    ~title:"Internal operation replay"
+    ~description:"An internal operation was emitted twice by a script"
+    ~pp:(fun ppf (Internal_operation { nonce ; _ }) ->
+        Format.fprintf ppf "Internal operation %d was emitted twice by a script" nonce)
+    Operation.internal_operation_encoding
+    (function Internal_operation_replay op -> Some op | _ -> None)
+    (fun op -> Internal_operation_replay op) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.invalid_double_endorsement_evidence"
+    ~title:"Invalid double endorsement evidence"
+    ~description:"A double-endorsement evidence is malformed"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Malformed double-endorsement evidence")
+    Data_encoding.empty
+    (function Invalid_double_endorsement_evidence -> Some () | _ -> None)
+    (fun () -> Invalid_double_endorsement_evidence) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.inconsistent_double_endorsement_evidence"
+    ~title:"Inconsistent double endorsement evidence"
+    ~description:"A double-endorsement evidence is inconsistent \
+                 \ (two distinct delegates)"
+    ~pp:(fun ppf (delegate1, delegate2) ->
+        Format.fprintf ppf
+          "Inconsistent double-endorsement evidence \
+          \ (distinct delegate: %a and %a)"
+          Signature.Public_key_hash.pp_short delegate1
+          Signature.Public_key_hash.pp_short delegate2)
+    Data_encoding.(obj2
+                     (req "delegate1" Signature.Public_key_hash.encoding)
+                     (req "delegate2" Signature.Public_key_hash.encoding))
+    (function
+      | Inconsistent_double_endorsement_evidence { delegate1 ; delegate2 } ->
+          Some (delegate1, delegate2)
+      | _ -> None)
+    (fun (delegate1, delegate2) ->
+       Inconsistent_double_endorsement_evidence { delegate1 ; delegate2 }) ;
+  register_error_kind
+    `Branch
+    ~id:"block.unrequired_double_endorsement_evidence"
+    ~title:"Unrequired double endorsement evidence"
+    ~description:"A double-endorsement evidence is unrequired"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "A valid double-endorsement operation cannot \
+                           \ be applied: the associated delegate \
+                           \ has previously been denunciated in this cycle.")
+    Data_encoding.empty
+    (function Unrequired_double_endorsement_evidence -> Some () | _ -> None)
+    (fun () -> Unrequired_double_endorsement_evidence) ;
+  register_error_kind
+    `Temporary
+    ~id:"block.too_early_double_endorsement_evidence"
+    ~title:"Too early double endorsement evidence"
+    ~description:"A double-endorsement evidence is in the future"
+    ~pp:(fun ppf (level, current) ->
+        Format.fprintf ppf
+          "A double-endorsement evidence is in the future \
+          \ (current level: %a, endorsement level: %a)"
+          Raw_level.pp current
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "current" Raw_level.encoding))
+    (function
+      | Too_early_double_endorsement_evidence { level ; current } ->
+          Some (level, current)
+      | _ -> None)
+    (fun (level, current) ->
+       Too_early_double_endorsement_evidence { level ; current }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.outdated_double_endorsement_evidence"
+    ~title:"Outdated double endorsement evidence"
+    ~description:"A double-endorsement evidence is outdated."
+    ~pp:(fun ppf (level, last) ->
+        Format.fprintf ppf
+          "A double-endorsement evidence is outdated \
+          \ (last acceptable level: %a, endorsement level: %a)"
+          Raw_level.pp last
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "last" Raw_level.encoding))
+    (function
+      | Outdated_double_endorsement_evidence { level ; last } ->
+          Some (level, last)
+      | _ -> None)
+    (fun (level, last) ->
+       Outdated_double_endorsement_evidence { level ; last }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.invalid_double_baking_evidence"
+    ~title:"Invalid double baking evidence"
+    ~description:"A double-baking evidence is inconsistent \
+                 \ (two distinct level)"
+    ~pp:(fun ppf (hash1, level1, hash2, level2) ->
+        Format.fprintf ppf
+          "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
+          Block_hash.pp hash1 Block_hash.pp hash2
+          level1 level2)
+    Data_encoding.(obj4
+                     (req "hash1" Block_hash.encoding)
+                     (req "level1" int32)
+                     (req "hash2" Block_hash.encoding)
+                     (req "level2" int32))
+    (function
+      | Invalid_double_baking_evidence { hash1 ; level1 ; hash2 ; level2 } ->
+          Some (hash1, level1, hash2, level2)
+      | _ -> None)
+    (fun (hash1, level1, hash2, level2) ->
+       Invalid_double_baking_evidence { hash1 ; level1 ; hash2 ; level2 }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.inconsistent_double_baking_evidence"
+    ~title:"Inconsistent double baking evidence"
+    ~description:"A double-baking evidence is inconsistent \
+                 \ (two distinct delegates)"
+    ~pp:(fun ppf (delegate1, delegate2) ->
+        Format.fprintf ppf
+          "Inconsistent double-baking evidence \
+          \ (distinct delegate: %a and %a)"
+          Signature.Public_key_hash.pp_short delegate1
+          Signature.Public_key_hash.pp_short delegate2)
+    Data_encoding.(obj2
+                     (req "delegate1" Signature.Public_key_hash.encoding)
+                     (req "delegate2" Signature.Public_key_hash.encoding))
+    (function
+      | Inconsistent_double_baking_evidence { delegate1 ; delegate2 } ->
+          Some (delegate1, delegate2)
+      | _ -> None)
+    (fun (delegate1, delegate2) ->
+       Inconsistent_double_baking_evidence { delegate1 ; delegate2 }) ;
+  register_error_kind
+    `Branch
+    ~id:"block.unrequired_double_baking_evidence"
+    ~title:"Unrequired double baking evidence"
+    ~description:"A double-baking evidence is unrequired"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "A valid double-baking operation cannot \
+                           \ be applied: the associated delegate \
+                           \ has previously been denunciated in this cycle.")
+    Data_encoding.empty
+    (function Unrequired_double_baking_evidence -> Some () | _ -> None)
+    (fun () -> Unrequired_double_baking_evidence) ;
+  register_error_kind
+    `Temporary
+    ~id:"block.too_early_double_baking_evidence"
+    ~title:"Too early double baking evidence"
+    ~description:"A double-baking evidence is in the future"
+    ~pp:(fun ppf (level, current) ->
+        Format.fprintf ppf
+          "A double-baking evidence is in the future \
+          \ (current level: %a, baking level: %a)"
+          Raw_level.pp current
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "current" Raw_level.encoding))
+    (function
+      | Too_early_double_baking_evidence { level ; current } ->
+          Some (level, current)
+      | _ -> None)
+    (fun (level, current) ->
+       Too_early_double_baking_evidence { level ; current }) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.outdated_double_baking_evidence"
+    ~title:"Outdated double baking evidence"
+    ~description:"A double-baking evidence is outdated."
+    ~pp:(fun ppf (level, last) ->
+        Format.fprintf ppf
+          "A double-baking evidence is outdated \
+          \ (last acceptable level: %a, baking level: %a)"
+          Raw_level.pp last
+          Raw_level.pp level)
+    Data_encoding.(obj2
+                     (req "level" Raw_level.encoding)
+                     (req "last" Raw_level.encoding))
+    (function
+      | Outdated_double_baking_evidence { level ; last } ->
+          Some (level, last)
+      | _ -> None)
+    (fun (level, last) ->
+       Outdated_double_baking_evidence { level ; last }) ;
+  register_error_kind
+    `Permanent
+    ~id:"operation.invalid_activation"
+    ~title:"Invalid activation"
+    ~description:"The given key and secret do not correspond to any \
+                  existing preallocated contract"
+    ~pp:(fun ppf pkh ->
+        Format.fprintf ppf "Invalid activation. The public key %a does \
+                            not match any commitment."
+          Ed25519.Public_key_hash.pp pkh
+      )
+    Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding))
+    (function Invalid_activation { pkh } -> Some pkh | _ -> None)
+    (fun pkh -> Invalid_activation { pkh } ) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.multiple_revelation"
+    ~title:"Multiple revelations were included in a manager operation"
+    ~description:"A manager operation should not contain more than one revelation"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf
+          "Multiple revelations were included in a manager operation")
+    Data_encoding.empty
+    (function Multiple_revelation -> Some () | _ -> None)
+    (fun () -> Multiple_revelation) ;
+  register_error_kind
+    `Permanent
+    ~id:"gas_exhausted.init_deserialize"
+    ~title:"Not enough gas for initial deserialization of script expresions"
+    ~description:"Gas limit was not high enough to deserialize the \
+                  transaction parameters or origination script code or \
+                  initial storage, making the operation impossible to \
+                  parse within the provided gas bounds."
+    Data_encoding.empty
+    (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
+    (fun () -> Gas_quota_exceeded_init_deserialize)
+
+open Apply_results
+
+let apply_manager_operation_content :
+  type kind.
+  ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->
+    internal:bool -> kind manager_operation ->
+    (context * kind successful_manager_operation_result * packed_internal_operation list) tzresult Lwt.t ) =
+  fun ctxt mode ~payer ~source ~internal operation ->
+    let before_operation =
+      (* This context is not used for backtracking. Only to compute
+         gas consumption and originations for the operation result. *)
+      ctxt in
+    Contract.must_exist ctxt source >>=? fun () ->
+    let spend =
+      (* Ignore the spendable flag for smart contracts. *)
+      if internal then Contract.spend_from_script else Contract.spend in
+    let set_delegate =
+      (* Ignore the delegatable flag for smart contracts. *)
+      if internal then Delegate.set_from_script else Delegate.set in
+    Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation) >>=? fun ctxt ->
+    match operation with
+    | Reveal _ ->
+        return (* No-op: action already performed by `precheck_manager_contents`. *)
+          (ctxt, (Reveal_result { consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt } : kind successful_manager_operation_result), [])
+    | Transaction { amount ; parameters ; destination } -> begin
+        spend ctxt source amount >>=? fun ctxt ->
+        begin match Contract.is_implicit destination with
+          | None -> return (ctxt, [], false)
+          | Some _ ->
+              Contract.allocated ctxt destination >>=? function
+              | true -> return (ctxt, [], false)
+              | false ->
+                  Fees.origination_burn ctxt >>=? fun (ctxt, origination_burn) ->
+                  return (ctxt, [ Delegate.Contract payer, Delegate.Debited origination_burn ], true)
+        end >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract) ->
+        Contract.credit ctxt destination amount >>=? fun ctxt ->
+        Contract.get_script ctxt destination >>=? fun (ctxt, script) ->
+        match script with
+        | None -> begin
+            match parameters with
+            | None -> return ctxt
+            | Some arg ->
+                Script.force_decode ctxt arg >>=? fun (arg, ctxt) -> (* see [note] *)
+                (* [note]: for toplevel ops, cost is nil since the
+                   lazy value has already been forced at precheck, so
+                   we compute and consume the full cost again *)
+                let cost_arg = Script.deserialized_cost arg in
+                Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
+                match Micheline.root arg with
+                | Prim (_, D_Unit, [], _) ->
+                    (* Allow [Unit] parameter to non-scripted contracts. *)
+                    return ctxt
+                | _ -> fail (Script_interpreter.Bad_contract_parameter destination)
+          end >>=? fun ctxt ->
+            let result =
+              Transaction_result
+                { storage = None ;
+                  big_map_diff = None;
+                  balance_updates =
+                    Delegate.cleanup_balance_updates
+                      ([ Delegate.Contract source, Delegate.Debited amount ;
+                         Contract destination, Credited amount ]
+                       @ maybe_burn_balance_update) ;
+                  originated_contracts = [] ;
+                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
+                  storage_size = Z.zero ;
+                  paid_storage_size_diff = Z.zero ;
+                  allocated_destination_contract ;
+                } in
+            return (ctxt, result, [])
+        | Some script ->
+            begin match parameters with
+              | None ->
+                  (* Forge a [Unit] parameter that will be checked by [execute]. *)
+                  let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], [])) in
+                  return (ctxt, unit)
+              | Some parameters ->
+                  Script.force_decode ctxt parameters >>=? fun (arg, ctxt) -> (* see [note] *)
+                  let cost_arg = Script.deserialized_cost arg in
+                  Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->
+                  return (ctxt, arg)
+            end >>=? fun (ctxt, parameter) ->
+            Script_interpreter.execute
+              ctxt mode
+              ~source ~payer ~self:(destination, script) ~amount ~parameter
+            >>=? fun { ctxt ; storage ; big_map_diff ; operations } ->
+            Contract.update_script_storage
+              ctxt destination storage big_map_diff >>=? fun ctxt ->
+            Fees.record_paid_storage_space
+              ctxt destination >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->
+            Contract.originated_from_current_nonce
+              ~since: before_operation
+              ~until: ctxt >>=? fun originated_contracts ->
+            let result =
+              Transaction_result
+                { storage = Some storage ;
+                  big_map_diff;
+                  balance_updates =
+                    Delegate.cleanup_balance_updates
+                      [ Contract payer, Debited fees ;
+                        Contract source, Debited amount ;
+                        Contract destination, Credited amount ] ;
+                  originated_contracts ;
+                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
+                  storage_size = new_size ;
+                  paid_storage_size_diff ;
+                  allocated_destination_contract } in
+            return (ctxt, result, operations)
+      end
+    | Origination { manager ; delegate ; script ; preorigination ;
+                    spendable ; delegatable ; credit } ->
+        begin match script with
+          | None -> return (None, ctxt)
+          | Some script ->
+              Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)
+              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
+              Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
+              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
+              Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
+              Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->
+              return (Some (script, big_map_diff), ctxt)
+        end >>=? fun (script, ctxt) ->
+        spend ctxt source credit >>=? fun ctxt ->
+        begin match preorigination with
+          | Some contract ->
+              assert internal ;
+              (* The preorigination field is only used to early return
+                 the address of an originated contract in Michelson.
+                 It cannot come from the outside. *)
+              return (ctxt, contract)
+          | None ->
+              Contract.fresh_contract_from_current_nonce ctxt
+        end >>=? fun (ctxt, contract) ->
+        Contract.originate ctxt contract
+          ~manager ~delegate ~balance:credit
+          ?script
+          ~spendable ~delegatable >>=? fun ctxt ->
+        Fees.origination_burn ctxt >>=? fun (ctxt, origination_burn) ->
+        Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
+        let result =
+          Origination_result
+            { balance_updates =
+                Delegate.cleanup_balance_updates
+                  [ Contract payer, Debited fees ;
+                    Contract payer, Debited origination_burn ;
+                    Contract source, Debited credit ;
+                    Contract contract, Credited credit ] ;
+              originated_contracts = [ contract ] ;
+              consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;
+              storage_size = size ;
+              paid_storage_size_diff } in
+        return (ctxt, result, [])
+    | Delegation delegate ->
+        set_delegate ctxt source delegate >>=? fun ctxt ->
+        return (ctxt, Delegation_result { consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt }, [])
+
+let apply_internal_manager_operations ctxt mode ~payer ops =
+  let rec apply ctxt applied worklist =
+    match worklist with
+    | [] -> Lwt.return (`Success ctxt, List.rev applied)
+    | (Internal_operation
+         ({ source ; operation ; nonce } as op)) :: rest ->
+        begin
+          if internal_nonce_already_recorded ctxt nonce then
+            fail (Internal_operation_replay (Internal_operation op))
+          else
+            let ctxt = record_internal_nonce ctxt nonce in
+            apply_manager_operation_content
+              ctxt mode ~source ~payer ~internal:true operation
+        end >>= function
+        | Error errors ->
+            let result =
+              Internal_operation_result (op, Failed (manager_kind op.operation, errors)) in
+            let skipped =
+              List.rev_map
+                (fun (Internal_operation op) ->
+                   Internal_operation_result (op, Skipped (manager_kind op.operation)))
+                rest in
+            Lwt.return (`Failure, List.rev (skipped @ (result :: applied)))
+        | Ok (ctxt, result, emitted) ->
+            apply ctxt
+              (Internal_operation_result (op, Applied result) :: applied)
+              (rest @ emitted) in
+  apply ctxt [] ops
+
+let precheck_manager_contents
+    (type kind) ctxt chain_id raw_operation (op : kind Kind.manager contents)
+  : context tzresult Lwt.t =
+  let Manager_operation { source ; fee ; counter ; operation ; gas_limit ; storage_limit } = op in
+  Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->
+  let ctxt = Gas.set_limit ctxt gas_limit in
+  Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->
+  Contract.must_be_allocated ctxt source >>=? fun () ->
+  Contract.check_counter_increment ctxt source counter >>=? fun () ->
+  begin
+    match operation with
+    | Reveal pk ->
+        Contract.reveal_manager_key ctxt source pk
+    | Transaction { parameters = Some arg ; _ } ->
+        (* Fail quickly if not enough gas for minimal deserialization cost *)
+        Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@
+        Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) >>=? fun () ->
+        (* Fail if not enough gas for complete deserialization cost *)
+        trace Gas_quota_exceeded_init_deserialize @@
+        Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt
+    | Origination { script = Some script ; _ } ->
+        (* Fail quickly if not enough gas for minimal deserialization cost *)
+        Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@
+        (Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->
+         Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)) >>=? fun () ->
+        (* Fail if not enough gas for complete deserialization cost *)
+        trace Gas_quota_exceeded_init_deserialize @@
+        Script.force_decode ctxt script.code >>=? fun (_code, ctxt) ->
+        trace Gas_quota_exceeded_init_deserialize @@
+        Script.force_decode ctxt script.storage >>|? fun (_storage, ctxt) ->
+        ctxt
+    | _ -> return ctxt
+  end >>=? fun ctxt ->
+  Contract.get_manager_key ctxt source >>=? fun public_key ->
+  (* Currently, the `raw_operation` only contains one signature, so
+     all operations are required to be from the same manager. This may
+     change in the future, allowing several managers to group-sign a
+     sequence of transactions.  *)
+  Operation.check_signature public_key chain_id raw_operation >>=? fun () ->
+  Contract.increment_counter ctxt source >>=? fun ctxt ->
+  Contract.spend ctxt source fee >>=? fun ctxt ->
+  add_fees ctxt fee >>=? fun ctxt ->
+  return ctxt
+
+let apply_manager_contents
+    (type kind) ctxt mode (op : kind Kind.manager contents)
+  : ([ `Success of context | `Failure ] *
+     kind manager_operation_result *
+     packed_internal_operation_result list) Lwt.t =
+  let Manager_operation
+      { source ; operation ; gas_limit ; storage_limit } = op in
+  let ctxt = Gas.set_limit ctxt gas_limit in
+  let ctxt = Fees.start_counting_storage_fees ctxt in
+  apply_manager_operation_content ctxt mode
+    ~source ~payer:source ~internal:false operation >>= function
+  | Ok (ctxt, operation_results, internal_operations) -> begin
+      apply_internal_manager_operations
+        ctxt mode ~payer:source internal_operations >>= function
+      | (`Success ctxt, internal_operations_results) -> begin
+          Fees.burn_storage_fees ctxt ~storage_limit ~payer:source >>= function
+          | Ok ctxt ->
+              Lwt.return
+                (`Success ctxt, Applied operation_results, internal_operations_results)
+          | Error errors ->
+              Lwt.return
+                (`Failure, Backtracked (operation_results, Some errors), internal_operations_results)
+        end
+      | (`Failure, internal_operations_results) ->
+          Lwt.return
+            (`Failure, Applied operation_results, internal_operations_results)
+    end
+  | Error errors ->
+      Lwt.return
+        (`Failure, Failed (manager_kind operation, errors), [])
+
+let skipped_operation_result
+  : type kind. kind manager_operation -> kind manager_operation_result
+  = function operation ->
+  match operation with
+  | Reveal _ ->
+      Applied ( Reveal_result { consumed_gas = Z.zero } : kind successful_manager_operation_result )
+  | _ -> Skipped (manager_kind operation)
+
+let rec mark_skipped
+  : type kind.
+    baker : Signature.Public_key_hash.t -> Level.t -> kind Kind.manager contents_list ->
+  kind Kind.manager contents_result_list = fun ~baker level -> function
+  | Single (Manager_operation { source ; fee ; operation } ) ->
+      Single_result
+        (Manager_operation_result
+           { balance_updates =
+               Delegate.cleanup_balance_updates
+                 [ Contract source, Debited fee ;
+                   Fees (baker, level.cycle), Credited fee ] ;
+             operation_result = skipped_operation_result operation ;
+             internal_operation_results = [] })
+  | Cons (Manager_operation { source ; fee ; operation } , rest) ->
+      Cons_result
+        (Manager_operation_result {
+            balance_updates =
+              Delegate.cleanup_balance_updates
+                [ Contract source, Debited fee ;
+                  Fees (baker, level.cycle), Credited fee ] ;
+            operation_result = skipped_operation_result operation ;
+            internal_operation_results = [] },
+         mark_skipped ~baker level rest)
+
+let rec precheck_manager_contents_list
+  : type kind.
+    Alpha_context.t -> Chain_id.t -> _ Operation.t -> kind Kind.manager contents_list ->
+    context tzresult Lwt.t =
+  fun ctxt chain_id raw_operation contents_list ->
+    match contents_list with
+    | Single (Manager_operation _ as op) ->
+        precheck_manager_contents ctxt chain_id raw_operation op
+    | Cons (Manager_operation _ as op, rest) ->
+        precheck_manager_contents ctxt chain_id raw_operation op >>=? fun ctxt ->
+        precheck_manager_contents_list ctxt chain_id raw_operation rest
+
+let rec apply_manager_contents_list_rec
+  : type kind.
+    Alpha_context.t -> Script_ir_translator.unparsing_mode ->
+    public_key_hash -> kind Kind.manager contents_list ->
+    ([ `Success of context | `Failure ] *
+     kind Kind.manager contents_result_list) Lwt.t =
+  fun ctxt mode baker contents_list ->
+    let level = Level.current ctxt in
+    match contents_list with
+    | Single (Manager_operation { source ; fee ; _ } as op) -> begin
+        apply_manager_contents ctxt mode op
+        >>= fun (ctxt_result, operation_result, internal_operation_results) ->
+        let result =
+          Manager_operation_result {
+            balance_updates =
+              Delegate.cleanup_balance_updates
+                [ Contract source, Debited fee ;
+                  Fees (baker, level.cycle), Credited fee ] ;
+            operation_result ;
+            internal_operation_results ;
+          } in
+        Lwt.return (ctxt_result, Single_result (result))
+      end
+    | Cons (Manager_operation { source ; fee ; _ } as op, rest) ->
+        apply_manager_contents ctxt mode op >>= function
+        | (`Failure, operation_result, internal_operation_results) ->
+            let result =
+              Manager_operation_result {
+                balance_updates =
+                  Delegate.cleanup_balance_updates
+                    [ Contract source, Debited fee ;
+                      Fees (baker, level.cycle), Credited fee ] ;
+                operation_result ;
+                internal_operation_results ;
+              } in
+            Lwt.return (`Failure, Cons_result (result, mark_skipped ~baker level rest))
+        | (`Success ctxt, operation_result, internal_operation_results) ->
+            let result =
+              Manager_operation_result {
+                balance_updates =
+                  Delegate.cleanup_balance_updates
+                    [ Contract source, Debited fee ;
+                      Fees (baker, level.cycle), Credited fee ] ;
+                operation_result ;
+                internal_operation_results ;
+              } in
+            apply_manager_contents_list_rec ctxt mode baker rest >>= fun (ctxt_result, results) ->
+            Lwt.return (ctxt_result, Cons_result (result, results))
+
+let mark_backtracked results =
+  let rec mark_contents_list
+    : type kind. kind Kind.manager contents_result_list -> kind Kind.manager contents_result_list
+    = function
+      | Single_result (Manager_operation_result op) ->
+          Single_result (Manager_operation_result
+                           { balance_updates =
+                               op.balance_updates ;
+                             operation_result =
+                               mark_manager_operation_result op.operation_result ;
+                             internal_operation_results =
+                               List.map mark_internal_operation_results op.internal_operation_results})
+      | Cons_result (Manager_operation_result op, rest) ->
+          Cons_result (Manager_operation_result
+                         { balance_updates =
+                             op.balance_updates ;
+                           operation_result =
+                             mark_manager_operation_result op.operation_result ;
+                           internal_operation_results =
+                             List.map mark_internal_operation_results op.internal_operation_results},
+                       mark_contents_list rest)
+  and mark_internal_operation_results (Internal_operation_result (kind, result)) =
+    (Internal_operation_result (kind, mark_manager_operation_result result))
+  and mark_manager_operation_result
+    : type kind. kind manager_operation_result -> kind manager_operation_result
+    = function
+      | Failed _ | Skipped _ | Backtracked _ as result -> result
+      | Applied (Reveal_result _) as result -> result
+      | Applied result -> Backtracked (result, None) in
+  mark_contents_list results
+
+let apply_manager_contents_list ctxt mode baker contents_list =
+  apply_manager_contents_list_rec ctxt mode baker contents_list >>= fun (ctxt_result, results) ->
+  match ctxt_result with
+  | `Failure -> Lwt.return (ctxt (* backtracked *), mark_backtracked results)
+  | `Success ctxt -> Lwt.return (ctxt, results)
+
+let apply_contents_list
+    (type kind) ctxt ~partial chain_id mode pred_block baker
+    (operation : kind operation)
+    (contents_list : kind contents_list)
+  : (context * kind contents_result_list) tzresult Lwt.t =
+  match contents_list with
+  | Single (Endorsement { level }) ->
+      let block = operation.shell.branch in
+      fail_unless
+        (Block_hash.equal block pred_block)
+        (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
+      let current_level = (Level.current ctxt).level in
+      fail_unless
+        Raw_level.(succ level = current_level)
+        Invalid_endorsement_level >>=? fun () ->
+      Baking.check_endorsement_rights ctxt chain_id operation >>=? fun (delegate, slots, used) ->
+      if used then fail (Duplicate_endorsement delegate)
+      else
+        let ctxt = record_endorsement ctxt delegate in
+        let gap = List.length slots in
+        let ctxt = Fitness.increase ~gap ctxt in
+        Lwt.return
+          Tez.(Constants.endorsement_security_deposit ctxt *?
+               Int64.of_int gap) >>=? fun deposit ->
+        begin
+          if partial then
+            Delegate.freeze_deposit ctxt delegate deposit
+          else
+            add_deposit ctxt delegate deposit
+        end >>=? fun ctxt ->
+        Global.get_last_block_priority ctxt >>=? fun block_priority ->
+        Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
+        Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
+        let level = Level.from_raw ctxt level in
+        return (ctxt, Single_result
+                  (Endorsement_result
+                     { balance_updates = Delegate.cleanup_balance_updates
+                           [ Contract (Contract.implicit_contract delegate), Debited deposit;
+                             Deposits (delegate, level.cycle), Credited deposit;
+                             Rewards (delegate, level.cycle), Credited reward; ] ;
+                       delegate ; slots }))
+  | Single (Seed_nonce_revelation { level ; nonce }) ->
+      let level = Level.from_raw ctxt level in
+      Nonce.reveal ctxt level nonce >>=? fun ctxt ->
+      let seed_nonce_revelation_tip =
+        Constants.seed_nonce_revelation_tip ctxt in
+      add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->
+      return (ctxt, Single_result
+                (Seed_nonce_revelation_result
+                   [ Rewards (baker, level.cycle), Credited seed_nonce_revelation_tip ]))
+  | Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
+      match op1.protocol_data.contents, op2.protocol_data.contents with
+      | Single (Endorsement e1),
+        Single (Endorsement e2)
+        when Raw_level.(e1.level = e2.level) &&
+             not (Block_hash.equal op1.shell.branch op2.shell.branch) ->
+          let level = Level.from_raw ctxt e1.level in
+          let oldest_level = Level.last_allowed_fork_level ctxt in
+          fail_unless Level.(level < Level.current ctxt)
+            (Too_early_double_endorsement_evidence
+               { level = level.level ;
+                 current = (Level.current ctxt).level }) >>=? fun () ->
+          fail_unless Raw_level.(oldest_level <= level.level)
+            (Outdated_double_endorsement_evidence
+               { level = level.level ;
+                 last = oldest_level }) >>=? fun () ->
+          Baking.check_endorsement_rights ctxt chain_id op1 >>=? fun (delegate1, _, _) ->
+          Baking.check_endorsement_rights ctxt chain_id op2 >>=? fun (delegate2, _, _) ->
+          fail_unless
+            (Signature.Public_key_hash.equal delegate1 delegate2)
+            (Inconsistent_double_endorsement_evidence
+               { delegate1 ; delegate2 }) >>=? fun () ->
+          Delegate.has_frozen_balance ctxt delegate1 level.cycle >>=? fun valid ->
+          fail_unless valid Unrequired_double_endorsement_evidence >>=? fun () ->
+          Delegate.punish ctxt delegate1 level.cycle >>=? fun (ctxt, balance) ->
+          Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->
+          let reward =
+            match Tez.(burned /? 2L) with
+            | Ok v -> v
+            | Error _ -> Tez.zero in
+          add_rewards ctxt reward >>=? fun ctxt ->
+          let current_cycle = (Level.current ctxt).cycle in
+          return (ctxt, Single_result
+                    (Double_endorsement_evidence_result
+                       (Delegate.cleanup_balance_updates [
+                           Deposits (delegate1, level.cycle), Debited balance.deposit ;
+                           Fees (delegate1, level.cycle), Debited balance.fees ;
+                           Rewards (delegate1, level.cycle), Debited balance.rewards ;
+                           Rewards (baker, current_cycle), Credited reward ])))
+      | _, _ -> fail Invalid_double_endorsement_evidence
+    end
+  | Single (Double_baking_evidence { bh1 ; bh2 }) ->
+      let hash1 = Block_header.hash bh1 in
+      let hash2 = Block_header.hash bh2 in
+      fail_unless
+        (Compare.Int32.(bh1.shell.level = bh2.shell.level) &&
+         not (Block_hash.equal hash1 hash2))
+        (Invalid_double_baking_evidence
+           { hash1 ;
+             level1 = bh1.shell.level ;
+             hash2 ;
+             level2 = bh2.shell.level ;
+           }) >>=? fun () ->
+      Lwt.return (Raw_level.of_int32 bh1.shell.level) >>=? fun raw_level ->
+      let oldest_level = Level.last_allowed_fork_level ctxt in
+      fail_unless Raw_level.(raw_level < (Level.current ctxt).level)
+        (Too_early_double_baking_evidence
+           { level = raw_level ;
+             current = (Level.current ctxt).level }) >>=? fun () ->
+      fail_unless Raw_level.(oldest_level <= raw_level)
+        (Outdated_double_baking_evidence
+           { level = raw_level ;
+             last = oldest_level }) >>=? fun () ->
+      let level = Level.from_raw ctxt raw_level in
+      Roll.baking_rights_owner
+        ctxt level ~priority:bh1.protocol_data.contents.priority >>=? fun delegate1 ->
+      Baking.check_signature bh1 chain_id delegate1 >>=? fun () ->
+      Roll.baking_rights_owner
+        ctxt level ~priority:bh2.protocol_data.contents.priority >>=? fun delegate2 ->
+      Baking.check_signature bh2 chain_id delegate2 >>=? fun () ->
+      fail_unless
+        (Signature.Public_key.equal delegate1 delegate2)
+        (Inconsistent_double_baking_evidence
+           { delegate1 = Signature.Public_key.hash delegate1 ;
+             delegate2 = Signature.Public_key.hash delegate2 }) >>=? fun () ->
+      let delegate = Signature.Public_key.hash delegate1 in
+      Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->
+      fail_unless valid Unrequired_double_baking_evidence >>=? fun () ->
+      Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, balance) ->
+      Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->
+      let reward =
+        match Tez.(burned /? 2L) with
+        | Ok v -> v
+        | Error _ -> Tez.zero in
+      add_rewards ctxt reward >>=? fun ctxt ->
+      let current_cycle = (Level.current ctxt).cycle in
+      return (ctxt, Single_result
+                (Double_baking_evidence_result
+                   (Delegate.cleanup_balance_updates [
+                       Deposits (delegate, level.cycle), Debited balance.deposit ;
+                       Fees (delegate, level.cycle), Debited balance.fees ;
+                       Rewards (delegate, level.cycle), Debited balance.rewards ;
+                       Rewards (baker, current_cycle), Credited reward ; ])))
+  | Single (Activate_account { id = pkh ; activation_code }) -> begin
+      let blinded_pkh =
+        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
+      Commitment.get_opt ctxt blinded_pkh >>=? function
+      | None -> fail (Invalid_activation { pkh })
+      | Some amount ->
+          Commitment.delete ctxt blinded_pkh >>=? fun ctxt ->
+          let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in
+          Contract.(credit ctxt contract amount) >>=? fun ctxt ->
+          return (ctxt, Single_result (Activate_account_result
+                                         [ Contract contract, Credited amount ]))
+    end
+  | Single (Proposals { source ; period ; proposals }) ->
+      Roll.delegate_pubkey ctxt source >>=? fun delegate ->
+      Operation.check_signature delegate chain_id operation >>=? fun () ->
+      let level = Level.current ctxt in
+      fail_unless Voting_period.(level.voting_period = period)
+        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
+      Amendment.record_proposals ctxt source proposals >>=? fun ctxt ->
+      return (ctxt, Single_result Proposals_result)
+  | Single (Ballot { source ; period ; proposal ; ballot }) ->
+      Roll.delegate_pubkey ctxt source >>=? fun delegate ->
+      Operation.check_signature delegate chain_id operation >>=? fun () ->
+      let level = Level.current ctxt in
+      fail_unless Voting_period.(level.voting_period = period)
+        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
+      Amendment.record_ballot ctxt source proposal ballot >>=? fun ctxt ->
+      return (ctxt, Single_result Ballot_result)
+  | Single (Manager_operation _) as op ->
+      precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->
+      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
+      return (ctxt, result)
+  | Cons (Manager_operation _, _) as op ->
+      precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->
+      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->
+      return (ctxt, result)
+
+let apply_operation ctxt ~partial chain_id mode pred_block baker hash operation =
+  let ctxt = Contract.init_origination_nonce ctxt hash in
+  apply_contents_list
+    ctxt ~partial chain_id mode pred_block baker operation
+    operation.protocol_data.contents >>=? fun (ctxt, result) ->
+  let ctxt = Gas.set_unlimited ctxt in
+  let ctxt = Contract.unset_origination_nonce ctxt in
+  return (ctxt, { contents = result })
+
+let may_snapshot_roll ctxt =
+  let level = Alpha_context.Level.current ctxt in
+  let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in
+  if Compare.Int32.equal
+      (Int32.rem level.cycle_position blocks_per_roll_snapshot)
+      (Int32.pred blocks_per_roll_snapshot)
+  then
+    Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt ->
+    return ctxt
+  else
+    return ctxt
+
+let may_start_new_cycle ctxt =
+  Baking.dawn_of_a_new_cycle ctxt >>=? function
+  | None -> return (ctxt, [], [])
+  | Some last_cycle ->
+      Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) ->
+      Roll.cycle_end ctxt last_cycle >>=? fun ctxt ->
+      Delegate.cycle_end ctxt last_cycle unrevealed >>=? fun (ctxt, update_balances, deactivated) ->
+      Bootstrap.cycle_end ctxt last_cycle >>=? fun ctxt ->
+      return (ctxt, update_balances, deactivated)
+
+let begin_full_construction ctxt pred_timestamp protocol_data =
+  Baking.check_baking_rights
+    ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
+  let ctxt = Fitness.increase ctxt in
+  match Level.pred ctxt (Level.current ctxt) with
+  | None -> assert false (* genesis *)
+  | Some pred_level ->
+      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
+      let ctxt = init_endorsements ctxt rights in
+      return (ctxt, protocol_data, delegate_pk)
+
+let begin_partial_construction ctxt =
+  let ctxt = Fitness.increase ctxt in
+  match Level.pred ctxt (Level.current ctxt) with
+  | None -> assert false (* genesis *)
+  | Some pred_level ->
+      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
+      let ctxt = init_endorsements ctxt rights in
+      return ctxt
+
+let begin_application ctxt chain_id block_header pred_timestamp =
+  let current_level = Alpha_context.Level.current ctxt in
+  Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () ->
+  Baking.check_fitness_gap ctxt block_header >>=? fun () ->
+  Baking.check_baking_rights
+    ctxt block_header.protocol_data.contents pred_timestamp >>=? fun delegate_pk ->
+  Baking.check_signature block_header chain_id delegate_pk >>=? fun () ->
+  let has_commitment =
+    match block_header.protocol_data.contents.seed_nonce_hash with
+    | None -> false
+    | Some _ -> true in
+  fail_unless
+    Compare.Bool.(has_commitment = current_level.expected_commitment)
+    (Invalid_commitment
+       { expected = current_level.expected_commitment }) >>=? fun () ->
+  let ctxt = Fitness.increase ctxt in
+  match Level.pred ctxt (Level.current ctxt) with
+  | None -> assert false (* genesis *)
+  | Some pred_level ->
+      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
+      let ctxt = init_endorsements ctxt rights in
+      return (ctxt, delegate_pk)
+
+let finalize_application ctxt protocol_data delegate =
+  let deposit = Constants.block_security_deposit ctxt in
+  add_deposit ctxt delegate deposit >>=? fun ctxt ->
+  let reward = (Constants.block_reward ctxt) in
+  add_rewards ctxt reward >>=? fun ctxt ->
+  Signature.Public_key_hash.Map.fold
+    (fun delegate deposit ctxt ->
+       ctxt >>=? fun ctxt ->
+       Delegate.freeze_deposit ctxt delegate deposit)
+    (get_deposits ctxt)
+    (return ctxt) >>=? fun ctxt ->
+  (* end of level (from this point nothing should fail) *)
+  let fees = Alpha_context.get_fees ctxt in
+  Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt ->
+  let rewards = Alpha_context.get_rewards ctxt in
+  Delegate.freeze_rewards ctxt delegate rewards >>=? fun ctxt ->
+  begin
+    match protocol_data.Block_header.seed_nonce_hash with
+    | None -> return ctxt
+    | Some nonce_hash ->
+        Nonce.record_hash ctxt
+          { nonce_hash ; delegate ; rewards ; fees }
+  end >>=? fun ctxt ->
+  Alpha_context.Global.set_last_block_priority
+    ctxt protocol_data.priority >>=? fun ctxt ->
+  (* end of cycle *)
+  may_snapshot_roll ctxt >>=? fun ctxt ->
+  may_start_new_cycle ctxt >>=? fun (ctxt, balance_updates, deactivated) ->
+  Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt ->
+  let cycle = (Level.current ctxt).cycle in
+  let balance_updates =
+    Delegate.(cleanup_balance_updates
+                ([ Contract (Contract.implicit_contract delegate), Debited deposit ;
+                   Deposits (delegate, cycle), Credited deposit ;
+                   Rewards (delegate, cycle), Credited reward ] @ balance_updates)) in
+  let consumed_gas = Z.sub (Constants.hard_gas_limit_per_block ctxt) (Alpha_context.Gas.block_level ctxt) in
+  Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+  let receipt = Apply_results.{ baker = delegate ;
+                                level = Level.current ctxt;
+                                voting_period_kind ;
+                                nonce_hash = protocol_data.seed_nonce_hash ;
+                                consumed_gas ;
+                                deactivated ;
+                                balance_updates } in
+  return (ctxt, receipt)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.ml
new file mode 100644
index 000000000..0ef56ef6e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.ml
@@ -0,0 +1,988 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Data_encoding
+
+let error_encoding =
+  def "error"
+    ~description:
+      "The full list of RPC errors would be too long to include.\n\
+       It is available at RPC `/errors` (GET).\n\
+       Errors specific to protocol Alpha have an id that starts with `proto.alpha`." @@
+  splitted
+    ~json:(conv
+             (fun err ->
+                Data_encoding.Json.construct Error_monad.error_encoding err)
+             (fun json ->
+                Data_encoding.Json.destruct Error_monad.error_encoding json)
+             json)
+    ~binary:Error_monad.error_encoding
+
+type _ successful_manager_operation_result =
+  | Reveal_result :
+      { consumed_gas : Z.t
+      } -> Kind.reveal successful_manager_operation_result
+  | Transaction_result :
+      { storage : Script.expr option ;
+        big_map_diff : Contract.big_map_diff option ;
+        balance_updates : Delegate.balance_updates ;
+        originated_contracts : Contract.t list ;
+        consumed_gas : Z.t ;
+        storage_size : Z.t ;
+        paid_storage_size_diff : Z.t ;
+        allocated_destination_contract : bool ;
+      } -> Kind.transaction successful_manager_operation_result
+  | Origination_result :
+      { balance_updates : Delegate.balance_updates ;
+        originated_contracts : Contract.t list ;
+        consumed_gas : Z.t ;
+        storage_size : Z.t ;
+        paid_storage_size_diff : Z.t ;
+      } -> Kind.origination successful_manager_operation_result
+  | Delegation_result :
+      { consumed_gas : Z.t
+      } -> Kind.delegation successful_manager_operation_result
+
+type packed_successful_manager_operation_result =
+  | Successful_manager_result :
+      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
+
+type 'kind manager_operation_result =
+  | Applied of 'kind successful_manager_operation_result
+  | Backtracked of 'kind successful_manager_operation_result * error list option
+  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
+  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
+
+type packed_internal_operation_result =
+  | Internal_operation_result :
+      'kind internal_operation * 'kind manager_operation_result -> packed_internal_operation_result
+
+module Manager_result = struct
+
+  type 'kind case =
+      MCase : {
+        op_case: 'kind Operation.Encoding.Manager_operations.case ;
+        encoding: 'a Data_encoding.t ;
+        kind: 'kind Kind.manager ;
+        iselect:
+          packed_internal_operation_result ->
+          ('kind internal_operation * 'kind manager_operation_result) option;
+        select:
+          packed_successful_manager_operation_result ->
+          'kind successful_manager_operation_result option ;
+        proj: 'kind successful_manager_operation_result -> 'a ;
+        inj: 'a -> 'kind successful_manager_operation_result ;
+        t: 'kind manager_operation_result Data_encoding.t ;
+      } -> 'kind case
+
+  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
+    let Operation.Encoding.Manager_operations.MCase { name ; _ } = op_case in
+    let t =
+      def (Format.asprintf "operation.alpha.operation_result.%s" name) @@
+      union ~tag_size:`Uint8 [
+        case (Tag 0)
+          ~title:"Applied"
+          (merge_objs
+             (obj1
+                (req "status" (constant "applied")))
+             encoding)
+          (fun o ->
+             match o with
+             | Skipped _ | Failed _ | Backtracked _ -> None
+             | Applied o ->
+                 match select (Successful_manager_result o) with
+                 | None -> None
+                 | Some o -> Some ((), proj o))
+          (fun ((), x) ->  (Applied (inj x))) ;
+        case (Tag 1)
+          ~title:"Failed"
+          (obj2
+             (req "status" (constant "failed"))
+             (req "errors" (list error_encoding)))
+          (function  (Failed (_, errs)) -> Some ((), errs) | _ -> None)
+          (fun ((), errs) -> Failed (kind, errs)) ;
+        case (Tag 2)
+          ~title:"Skipped"
+          (obj1 (req "status" (constant "skipped")))
+          (function Skipped _ -> Some () | _ -> None)
+          (fun () -> Skipped kind) ;
+        case (Tag 3)
+          ~title:"Backtracked"
+          (merge_objs
+             (obj2
+                (req "status" (constant "backtracked"))
+                (opt "errors" (list error_encoding)))
+             encoding)
+          (fun o ->
+             match o with
+             | Skipped _ | Failed _ | Applied _ -> None
+             | Backtracked (o, errs) ->
+                 match select (Successful_manager_result o) with
+                 | None -> None
+                 | Some o -> Some (((), errs), proj o))
+          (fun (((), errs), x) ->  (Backtracked (inj x, errs))) ;
+      ] in
+    MCase { op_case ; encoding ; kind ; iselect ; select ; proj ; inj ; t }
+
+  let reveal_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.reveal_case
+      ~encoding: Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
+
+      ~iselect:
+        (function
+          | Internal_operation_result
+              ({ operation = Reveal _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Reveal_result _ as op) -> Some op
+          | _ -> None)
+      ~kind: Kind.Reveal_manager_kind
+      ~proj: (function Reveal_result { consumed_gas } -> consumed_gas)
+      ~inj: (fun consumed_gas -> Reveal_result { consumed_gas })
+
+  let transaction_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.transaction_case
+      ~encoding:
+        (obj8
+           (opt "storage" Script.expr_encoding)
+           (opt "big_map_diff" Contract.big_map_diff_encoding)
+           (dft "balance_updates" Delegate.balance_updates_encoding [])
+           (dft "originated_contracts" (list Contract.encoding) [])
+           (dft "consumed_gas" z Z.zero)
+           (dft "storage_size" z Z.zero)
+           (dft "paid_storage_size_diff" z Z.zero)
+           (dft "allocated_destination_contract" bool false))
+      ~iselect:
+        (function
+          | Internal_operation_result
+              ({ operation = Transaction _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Transaction_result _ as op) -> Some op
+          | _ -> None)
+      ~kind: Kind.Transaction_manager_kind
+      ~proj:
+        (function
+          | Transaction_result
+              { storage ; big_map_diff ; balance_updates ;
+                originated_contracts ; consumed_gas ;
+                storage_size ; paid_storage_size_diff ;
+                allocated_destination_contract } ->
+              (storage, big_map_diff, balance_updates,
+               originated_contracts, consumed_gas,
+               storage_size, paid_storage_size_diff,
+               allocated_destination_contract))
+      ~inj:
+        (fun (storage, big_map_diff, balance_updates,
+              originated_contracts, consumed_gas,
+              storage_size, paid_storage_size_diff,
+              allocated_destination_contract) ->
+          Transaction_result { storage ; big_map_diff ; balance_updates ;
+                               originated_contracts ; consumed_gas ;
+                               storage_size ; paid_storage_size_diff ;
+                               allocated_destination_contract })
+
+  let origination_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.origination_case
+      ~encoding:
+        (obj5
+           (dft "balance_updates" Delegate.balance_updates_encoding [])
+           (dft "originated_contracts" (list Contract.encoding) [])
+           (dft "consumed_gas" z Z.zero)
+           (dft "storage_size" z Z.zero)
+           (dft "paid_storage_size_diff" z Z.zero))
+      ~iselect:
+        (function
+          | Internal_operation_result
+              ({ operation = Origination _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Origination_result _ as op) -> Some op
+          | _ -> None)
+      ~proj:
+        (function
+          | Origination_result
+              { balance_updates ;
+                originated_contracts ; consumed_gas ;
+                storage_size ; paid_storage_size_diff } ->
+              (balance_updates,
+               originated_contracts, consumed_gas,
+               storage_size, paid_storage_size_diff))
+      ~kind: Kind.Origination_manager_kind
+      ~inj:
+        (fun (balance_updates,
+              originated_contracts, consumed_gas,
+              storage_size, paid_storage_size_diff) ->
+          Origination_result
+            { balance_updates ;
+              originated_contracts ; consumed_gas ;
+              storage_size ; paid_storage_size_diff })
+
+  let delegation_case =
+    make
+      ~op_case: Operation.Encoding.Manager_operations.delegation_case
+      ~encoding: Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
+      ~iselect:
+        (function
+          | Internal_operation_result
+              ({ operation = Delegation _ ; _} as op, res) ->
+              Some (op, res)
+          | _ -> None)
+      ~select:
+        (function
+          | Successful_manager_result (Delegation_result _ as op) -> Some op
+          | _ -> None)
+      ~kind: Kind.Delegation_manager_kind
+      ~proj: (function Delegation_result { consumed_gas } -> consumed_gas)
+      ~inj: (fun consumed_gas -> Delegation_result { consumed_gas })
+
+end
+
+let internal_operation_result_encoding :
+  packed_internal_operation_result Data_encoding.t =
+  let make (type kind)
+      (Manager_result.MCase res_case : kind Manager_result.case) =
+    let Operation.Encoding.Manager_operations.MCase op_case = res_case.op_case in
+    case (Tag op_case.tag)
+      ~title:op_case.name
+      (merge_objs
+         (obj3
+            (req "kind" (constant op_case.name))
+            (req "source" Contract.encoding)
+            (req "nonce" uint16))
+         (merge_objs
+            op_case.encoding
+            (obj1 (req "result" res_case.t))))
+      (fun op ->
+         match res_case.iselect op with
+         | Some (op, res) ->
+             Some (((), op.source, op.nonce),
+                   (op_case.proj op.operation, res))
+         | None -> None)
+      (fun (((), source, nonce), (op, res)) ->
+         let op = { source ; operation = op_case.inj op ; nonce } in
+         Internal_operation_result (op, res)) in
+  def "operation.alpha.internal_operation_result" @@
+  union [
+    make Manager_result.reveal_case ;
+    make Manager_result.transaction_case ;
+    make Manager_result.origination_case ;
+    make Manager_result.delegation_case ;
+  ]
+
+type 'kind contents_result =
+  | Endorsement_result :
+      { balance_updates : Delegate.balance_updates ;
+        delegate : Signature.Public_key_hash.t ;
+        slots: int list ;
+      } -> Kind.endorsement contents_result
+  | Seed_nonce_revelation_result :
+      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result
+  | Double_endorsement_evidence_result :
+      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result
+  | Double_baking_evidence_result :
+      Delegate.balance_updates -> Kind.double_baking_evidence contents_result
+  | Activate_account_result :
+      Delegate.balance_updates -> Kind.activate_account contents_result
+  | Proposals_result : Kind.proposals contents_result
+  | Ballot_result : Kind.ballot contents_result
+  | Manager_operation_result :
+      { balance_updates : Delegate.balance_updates ;
+        operation_result : 'kind manager_operation_result ;
+        internal_operation_results : packed_internal_operation_result list ;
+      } -> 'kind Kind.manager contents_result
+
+type packed_contents_result =
+  | Contents_result : 'kind contents_result -> packed_contents_result
+
+type packed_contents_and_result =
+  | Contents_and_result :
+      'kind Operation.contents * 'kind contents_result -> packed_contents_and_result
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+
+let equal_manager_kind
+  : type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option
+  = fun ka kb -> match ka, kb with
+    | Kind.Reveal_manager_kind, Kind.Reveal_manager_kind -> Some Eq
+    | Kind.Reveal_manager_kind, _ -> None
+    | Kind.Transaction_manager_kind, Kind.Transaction_manager_kind -> Some Eq
+    | Kind.Transaction_manager_kind, _ -> None
+    | Kind.Origination_manager_kind, Kind.Origination_manager_kind -> Some Eq
+    | Kind.Origination_manager_kind, _ -> None
+    | Kind.Delegation_manager_kind, Kind.Delegation_manager_kind -> Some Eq
+    | Kind.Delegation_manager_kind, _ -> None
+
+module Encoding = struct
+
+  type 'kind case =
+      Case : { op_case: 'kind Operation.Encoding.case ;
+               encoding: 'a Data_encoding.t ;
+               select: packed_contents_result -> 'kind contents_result option ;
+               mselect: packed_contents_and_result -> ('kind contents * 'kind contents_result) option ;
+               proj: 'kind contents_result -> 'a ;
+               inj: 'a -> 'kind contents_result ;
+             } -> 'kind case
+
+  let tagged_case tag name args proj inj =
+    let open Data_encoding in
+    case tag
+      ~title:(String.capitalize_ascii name)
+      (merge_objs
+         (obj1 (req "kind" (constant name)))
+         args)
+      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
+      (fun ((), x) -> inj x)
+
+  let endorsement_case =
+    Case {
+      op_case = Operation.Encoding.endorsement_case ;
+      encoding =
+        (obj3
+           (req "balance_updates" Delegate.balance_updates_encoding)
+           (req "delegate" Signature.Public_key_hash.encoding)
+           (req "slots" (list uint8)));
+      select =
+        (function
+          | Contents_result (Endorsement_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Endorsement _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (function
+          | Endorsement_result { balance_updates ; delegate ; slots }
+            -> (balance_updates, delegate, slots)) ;
+      inj =
+        (fun (balance_updates, delegate, slots) ->
+           Endorsement_result { balance_updates ; delegate ; slots })
+    }
+
+  let seed_nonce_revelation_case =
+    Case {
+      op_case = Operation.Encoding.seed_nonce_revelation_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" Delegate.balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Seed_nonce_revelation_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Seed_nonce_revelation _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun (Seed_nonce_revelation_result bus) -> bus) ;
+      inj = (fun bus -> Seed_nonce_revelation_result bus) ;
+    }
+
+  let double_endorsement_evidence_case =
+    Case {
+      op_case = Operation.Encoding.double_endorsement_evidence_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" Delegate.balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Double_endorsement_evidence_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Double_endorsement_evidence _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (fun (Double_endorsement_evidence_result bus) -> bus) ;
+      inj = (fun bus -> Double_endorsement_evidence_result bus)
+    }
+
+  let double_baking_evidence_case =
+    Case {
+      op_case = Operation.Encoding.double_baking_evidence_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" Delegate.balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Double_baking_evidence_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Double_baking_evidence _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj =
+        (fun (Double_baking_evidence_result bus) -> bus) ;
+      inj = (fun bus -> Double_baking_evidence_result bus) ;
+    }
+
+  let activate_account_case =
+    Case {
+      op_case = Operation.Encoding.activate_account_case ;
+      encoding =
+        (obj1
+           (req "balance_updates" Delegate.balance_updates_encoding)) ;
+      select =
+        (function
+          | Contents_result (Activate_account_result _ as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Activate_account _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun (Activate_account_result bus) -> bus) ;
+      inj = (fun bus -> Activate_account_result bus) ;
+    }
+
+  let proposals_case =
+    Case {
+      op_case = Operation.Encoding.proposals_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Proposals_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Proposals _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Proposals_result -> ()) ;
+      inj = (fun () -> Proposals_result) ;
+    }
+
+  let ballot_case =
+    Case {
+      op_case = Operation.Encoding.ballot_case ;
+      encoding = Data_encoding.empty ;
+      select =
+        (function
+          | Contents_result (Ballot_result as op) -> Some op
+          | _ -> None) ;
+      mselect =
+        (function
+          | Contents_and_result (Ballot _ as op, res) -> Some (op, res)
+          | _ -> None) ;
+      proj = (fun Ballot_result -> ()) ;
+      inj = (fun () -> Ballot_result) ;
+    }
+
+  let make_manager_case
+      (type kind)
+      (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case)
+      (Manager_result.MCase res_case : kind Manager_result.case)
+      mselect =
+    Case {
+      op_case = Operation.Encoding.Case op_case ;
+      encoding =
+        (obj3
+           (req "balance_updates" Delegate.balance_updates_encoding)
+           (req "operation_result" res_case.t)
+           (dft "internal_operation_results"
+              (list internal_operation_result_encoding) [])) ;
+      select =
+        (function
+          | Contents_result
+              (Manager_operation_result
+                 ({ operation_result = Applied res ; _ } as op)) -> begin
+              match res_case.select (Successful_manager_result res) with
+              | Some res ->
+                  Some (Manager_operation_result
+                          { op with operation_result = Applied res })
+              | None -> None
+            end
+          | Contents_result
+              (Manager_operation_result
+                 ({ operation_result = Backtracked (res, errs) ; _ } as op)) -> begin
+              match res_case.select (Successful_manager_result res) with
+              | Some res ->
+                  Some (Manager_operation_result
+                          { op with operation_result = Backtracked (res, errs) })
+              | None -> None
+            end
+          | Contents_result
+              (Manager_operation_result
+                 ({ operation_result = Skipped kind ; _ } as op)) ->
+              begin match equal_manager_kind kind res_case.kind with
+                | None -> None
+                | Some Eq ->
+                    Some (Manager_operation_result
+                            { op with operation_result = Skipped kind })
+              end
+          | Contents_result
+              (Manager_operation_result
+                 ({ operation_result = Failed (kind, errs) ; _ } as op)) ->
+              begin match equal_manager_kind kind res_case.kind with
+                | None -> None
+                | Some Eq ->
+                    Some (Manager_operation_result
+                            { op with operation_result = Failed (kind, errs) })
+              end
+          | Contents_result Ballot_result -> None
+          | Contents_result (Endorsement_result _) -> None
+          | Contents_result (Seed_nonce_revelation_result _) -> None
+          | Contents_result (Double_endorsement_evidence_result _) -> None
+          | Contents_result (Double_baking_evidence_result _) -> None
+          | Contents_result (Activate_account_result _) -> None
+          | Contents_result Proposals_result -> None) ;
+      mselect ;
+      proj =
+        (fun (Manager_operation_result
+                { balance_updates = bus ; operation_result = r ;
+                  internal_operation_results = rs }) ->
+          (bus, r, rs)) ;
+      inj =
+        (fun (bus, r, rs) ->
+           Manager_operation_result
+             { balance_updates = bus ; operation_result = r ;
+               internal_operation_results = rs }) ;
+    }
+
+  let reveal_case =
+    make_manager_case
+      Operation.Encoding.reveal_case
+      Manager_result.reveal_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Reveal _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let transaction_case =
+    make_manager_case
+      Operation.Encoding.transaction_case
+      Manager_result.transaction_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Transaction _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let origination_case =
+    make_manager_case
+      Operation.Encoding.origination_case
+      Manager_result.origination_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Origination _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+  let delegation_case =
+    make_manager_case
+      Operation.Encoding.delegation_case
+      Manager_result.delegation_case
+      (function
+        | Contents_and_result
+            (Manager_operation
+               { operation = Delegation _ ; _ } as op, res) ->
+            Some (op, res)
+        | _ -> None)
+
+end
+
+let contents_result_encoding =
+  let open Encoding in
+  let make (Case { op_case = Operation.Encoding.Case { tag ; name ; _ } ;
+                   encoding ; mselect = _ ; select ; proj ; inj }) =
+    let proj x =
+      match select x with
+      | None -> None
+      | Some x -> Some (proj x) in
+    let inj x = Contents_result (inj x) in
+    tagged_case (Tag tag) name encoding proj inj in
+  def "operation.alpha.contents_result" @@
+  union [
+    make endorsement_case ;
+    make seed_nonce_revelation_case ;
+    make double_endorsement_evidence_case ;
+    make double_baking_evidence_case ;
+    make activate_account_case ;
+    make proposals_case ;
+    make ballot_case ;
+    make reveal_case ;
+    make transaction_case ;
+    make origination_case ;
+    make delegation_case ;
+  ]
+
+let contents_and_result_encoding =
+  let open Encoding in
+  let make
+      (Case { op_case = Operation.Encoding.Case { tag ; name ; encoding ; proj ; inj ; _ } ;
+              mselect ; encoding = meta_encoding ; proj = meta_proj ; inj = meta_inj ; _ }) =
+    let proj c =
+      match mselect c with
+      | Some (op, res) -> Some (proj op, meta_proj res)
+      | _ -> None in
+    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
+    let encoding =
+      merge_objs
+        encoding
+        (obj1
+           (req "metadata" meta_encoding)) in
+    tagged_case (Tag tag) name encoding proj inj in
+  def "operation.alpha.operation_contents_and_result" @@
+  union [
+    make endorsement_case ;
+    make seed_nonce_revelation_case ;
+    make double_endorsement_evidence_case ;
+    make double_baking_evidence_case ;
+    make activate_account_case ;
+    make proposals_case ;
+    make ballot_case ;
+    make reveal_case ;
+    make transaction_case ;
+    make origination_case ;
+    make delegation_case ;
+  ]
+
+type 'kind contents_result_list =
+  | Single_result : 'kind contents_result -> 'kind contents_result_list
+  | Cons_result :
+      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
+    (('kind * 'rest) Kind.manager ) contents_result_list
+
+type packed_contents_result_list =
+    Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+
+let contents_result_list_encoding =
+  let rec to_list = function
+    | Contents_result_list (Single_result o) -> [Contents_result o]
+    | Contents_result_list (Cons_result (o, os)) ->
+        Contents_result o :: to_list (Contents_result_list os) in
+  let rec of_list = function
+    | [] -> Pervasives.failwith "cannot decode empty operation result"
+    | [Contents_result o] -> Contents_result_list (Single_result o)
+    | (Contents_result o) :: os ->
+        let Contents_result_list os = of_list os in
+        match o, os with
+        | Manager_operation_result _, Single_result (Manager_operation_result _) ->
+            Contents_result_list (Cons_result (o, os))
+        | Manager_operation_result _, Cons_result _ ->
+            Contents_result_list (Cons_result (o, os))
+        | _ -> Pervasives.failwith "cannot decode ill-formed operation result" in
+  def "operation.alpha.contents_list_result" @@
+  conv to_list of_list (list contents_result_encoding)
+
+type 'kind contents_and_result_list =
+  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
+  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+
+type packed_contents_and_result_list =
+  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+
+let contents_and_result_list_encoding =
+  let rec to_list = function
+    | Contents_and_result_list (Single_and_result (op, res)) ->
+        [Contents_and_result (op, res)]
+    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->
+        Contents_and_result (op, res) ::
+        to_list (Contents_and_result_list rest) in
+  let rec of_list = function
+    | [] -> Pervasives.failwith "cannot decode empty combined operation result"
+    | [Contents_and_result (op, res)] ->
+        Contents_and_result_list (Single_and_result (op, res))
+    | (Contents_and_result (op, res)) :: rest ->
+        let Contents_and_result_list rest = of_list rest in
+        match op, rest with
+        | Manager_operation _, Single_and_result (Manager_operation _, _) ->
+            Contents_and_result_list (Cons_and_result (op, res, rest))
+        | Manager_operation _, Cons_and_result (_, _, _) ->
+            Contents_and_result_list (Cons_and_result (op, res, rest))
+        | _ -> Pervasives.failwith "cannot decode ill-formed combined operation result" in
+  conv to_list of_list (Variable.list contents_and_result_encoding)
+
+type 'kind operation_metadata = {
+  contents: 'kind contents_result_list ;
+}
+
+type packed_operation_metadata =
+  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
+  | No_operation_metadata : packed_operation_metadata
+
+let operation_metadata_encoding =
+  def "operation.alpha.result" @@
+  union [
+    case (Tag 0)
+      ~title:"Operation_metadata"
+      contents_result_list_encoding
+      (function
+        | Operation_metadata { contents } ->
+            Some (Contents_result_list contents)
+        | _ -> None)
+      (fun (Contents_result_list contents) -> Operation_metadata { contents }) ;
+    case (Tag 1)
+      ~title:"No_operation_metadata"
+      empty
+      (function
+        | No_operation_metadata -> Some ()
+        | _ -> None)
+      (fun () -> No_operation_metadata) ;
+  ]
+
+let kind_equal
+  : type kind kind2. kind contents -> kind2 contents_result -> (kind, kind2) eq option =
+  fun op res ->
+    match op, res with
+    | Endorsement _, Endorsement_result _ -> Some Eq
+    | Endorsement _, _ -> None
+    | Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq
+    | Seed_nonce_revelation _, _ -> None
+    | Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq
+    | Double_endorsement_evidence _, _ -> None
+    | Double_baking_evidence _, Double_baking_evidence_result _ -> Some Eq
+    | Double_baking_evidence _, _ -> None
+    | Activate_account _, Activate_account_result _ -> Some Eq
+    | Activate_account _, _ -> None
+    | Proposals _, Proposals_result -> Some Eq
+    | Proposals _, _ -> None
+    | Ballot _, Ballot_result -> Some Eq
+    | Ballot _, _ -> None
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Reveal_result _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result = Backtracked (Reveal_result _, _) ; _ } -> Some Eq
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Reveal_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Reveal _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Reveal_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Reveal _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Transaction_result _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result = Backtracked (Transaction_result _, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Transaction_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Transaction _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Transaction_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Transaction _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Origination_result _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result = Backtracked (Origination_result _, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Origination_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Origination _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Origination_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Origination _ ; _ }, _ -> None
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result = Applied (Delegation_result _) ; _ } -> Some Eq
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result = Backtracked (Delegation_result _, _) ; _ } -> Some Eq
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Failed (Alpha_context.Kind.Delegation_manager_kind, _); _ } -> Some Eq
+    | Manager_operation
+        { operation = Delegation _ ; _ },
+      Manager_operation_result
+        { operation_result =
+            Skipped (Alpha_context.Kind.Delegation_manager_kind); _ } -> Some Eq
+    | Manager_operation { operation = Delegation _ ; _ }, _ -> None
+
+let rec kind_equal_list
+  : type kind kind2. kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option =
+  fun contents res ->
+    match contents, res with
+    | Single op, Single_result res -> begin
+        match kind_equal op res with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+    | Cons (op, ops), Cons_result (res, ress) -> begin
+        match kind_equal op res with
+        | None -> None
+        | Some Eq ->
+            match kind_equal_list ops ress with
+            | None -> None
+            | Some Eq -> Some Eq
+      end
+    | _ -> None
+
+let rec pack_contents_list :
+  type kind. kind contents_list -> kind contents_result_list -> kind contents_and_result_list =
+  fun contents res -> begin
+      match contents, res with
+      | Single op, Single_result res -> Single_and_result (op, res)
+      | Cons (op, ops), Cons_result (res, ress) ->
+          Cons_and_result (op, res, pack_contents_list ops ress)
+      | Single (Manager_operation _),
+        Cons_result (Manager_operation_result _, Single_result _) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Failed _ ; _}) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Skipped _ ; _}) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Applied _ ; _}) -> .
+      | Cons (_, _),
+        Single_result (Manager_operation_result
+                         { operation_result = Backtracked _ ; _}) -> .
+      | Single _, Cons_result _ -> .
+    end
+
+let rec unpack_contents_list :
+  type kind. kind contents_and_result_list ->
+  (kind contents_list * kind contents_result_list) =
+  function
+  | Single_and_result (op, res) -> Single op, Single_result res
+  | Cons_and_result (op, res, rest) ->
+      let ops, ress = unpack_contents_list rest in
+      Cons (op, ops), Cons_result (res, ress)
+
+let rec to_list = function
+  | Contents_result_list (Single_result o) -> [Contents_result o]
+  | Contents_result_list (Cons_result (o, os)) ->
+      Contents_result o :: to_list (Contents_result_list os)
+
+let rec of_list = function
+  | [] -> assert false
+  | [Contents_result o] -> Contents_result_list (Single_result o)
+  | (Contents_result o) :: os ->
+      let Contents_result_list os = of_list os in
+      match o, os with
+      | Manager_operation_result _, Single_result (Manager_operation_result _) ->
+          Contents_result_list (Cons_result (o, os))
+      | Manager_operation_result _, Cons_result _ ->
+          Contents_result_list (Cons_result (o, os))
+      | _ ->
+          Pervasives.failwith "Operation result list of length > 1 \
+                               should only contains manager operations result."
+
+let operation_data_and_metadata_encoding =
+  def "operation.alpha.operation_with_metadata" @@
+  union [
+    case (Tag 0)
+      ~title:"Operation_with_metadata"
+      (obj2
+         (req "contents" (dynamic_size contents_and_result_list_encoding))
+         (opt "signature" Signature.encoding))
+      (function
+        | (Operation_data _, No_operation_metadata) -> None
+        | (Operation_data op, Operation_metadata res) ->
+            match kind_equal_list op.contents res.contents with
+            | None -> Pervasives.failwith "cannot decode inconsistent combined operation result"
+            | Some Eq ->
+                Some
+                  (Contents_and_result_list
+                     (pack_contents_list op.contents res.contents),
+                   op.signature))
+      (fun (Contents_and_result_list contents, signature) ->
+         let op_contents, res_contents = unpack_contents_list contents in
+         (Operation_data { contents = op_contents ; signature },
+          Operation_metadata { contents = res_contents })) ;
+    case (Tag 1)
+      ~title:"Operation_without_metadata"
+      (obj2
+         (req "contents" (dynamic_size Operation.contents_list_encoding))
+         (opt "signature" Signature.encoding))
+      (function
+        | (Operation_data op, No_operation_metadata) ->
+            Some (Contents_list op.contents, op.signature)
+        | (Operation_data _, Operation_metadata _) ->
+            None)
+      (fun (Contents_list contents, signature) ->
+         (Operation_data { contents ; signature }, No_operation_metadata))
+  ]
+
+type block_metadata = {
+  baker: Signature.Public_key_hash.t ;
+  level: Level.t ;
+  voting_period_kind: Voting_period.kind ;
+  nonce_hash: Nonce_hash.t option ;
+  consumed_gas: Z.t ;
+  deactivated: Signature.Public_key_hash.t list ;
+  balance_updates: Delegate.balance_updates ;
+}
+
+let block_metadata_encoding =
+  let open Data_encoding in
+  def "block_header.alpha.metadata" @@
+  conv
+    (fun { baker ; level ; voting_period_kind ; nonce_hash ;
+           consumed_gas ; deactivated ; balance_updates } ->
+      ( baker, level, voting_period_kind, nonce_hash,
+        consumed_gas, deactivated, balance_updates ))
+    (fun ( baker, level, voting_period_kind, nonce_hash,
+           consumed_gas, deactivated, balance_updates ) ->
+      { baker ; level ; voting_period_kind ; nonce_hash ;
+        consumed_gas ; deactivated ; balance_updates })
+    (obj7
+       (req "baker" Signature.Public_key_hash.encoding)
+       (req "level" Level.encoding)
+       (req "voting_period_kind" Voting_period.kind_encoding)
+       (req "nonce_hash" (option Nonce_hash.encoding))
+       (req "consumed_gas" (check_size 10 n))
+       (req "deactivated" (list Signature.Public_key_hash.encoding))
+       (req "balance_updates" Delegate.balance_updates_encoding))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.mli
new file mode 100644
index 000000000..b4505f502
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/apply_results.mli
@@ -0,0 +1,167 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Result of applying an operation, can be used for experimenting
+    with protocol updates, by clients to print out a summary of the
+    operation at pre-injection simulation and at confirmation time,
+    and by block explorers. *)
+
+open Alpha_context
+
+(** Result of applying a {!Operation.t}. Follows the same structure. *)
+type 'kind operation_metadata = {
+  contents: 'kind contents_result_list ;
+}
+
+and packed_operation_metadata =
+  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
+  | No_operation_metadata : packed_operation_metadata
+
+(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
+and 'kind contents_result_list =
+  | Single_result : 'kind contents_result -> 'kind contents_result_list
+  | Cons_result :
+      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
+    (('kind * 'rest) Kind.manager ) contents_result_list
+
+and packed_contents_result_list =
+  | Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+
+(** Result of applying an {!Operation.contents}. Follows the same structure. *)
+and 'kind contents_result =
+  | Endorsement_result :
+      { balance_updates : Delegate.balance_updates ;
+        delegate : Signature.Public_key_hash.t ;
+        slots: int list ;
+      } -> Kind.endorsement contents_result
+  | Seed_nonce_revelation_result :
+      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result
+  | Double_endorsement_evidence_result :
+      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result
+  | Double_baking_evidence_result :
+      Delegate.balance_updates -> Kind.double_baking_evidence contents_result
+  | Activate_account_result :
+      Delegate.balance_updates -> Kind.activate_account contents_result
+  | Proposals_result : Kind.proposals contents_result
+  | Ballot_result : Kind.ballot contents_result
+  | Manager_operation_result :
+      { balance_updates : Delegate.balance_updates ;
+        operation_result : 'kind manager_operation_result ;
+        internal_operation_results : packed_internal_operation_result list ;
+      } -> 'kind Kind.manager contents_result
+
+and packed_contents_result =
+  | Contents_result : 'kind contents_result -> packed_contents_result
+
+(** The result of an operation in the queue. [Skipped] ones should
+    always be at the tail, and after a single [Failed]. *)
+and 'kind manager_operation_result =
+  | Applied of 'kind successful_manager_operation_result
+  | Backtracked of 'kind successful_manager_operation_result * error list option
+  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
+  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
+
+(** Result of applying a {!manager_operation_content}, either internal
+    or external. *)
+and _ successful_manager_operation_result =
+  | Reveal_result :
+      { consumed_gas : Z.t
+      } -> Kind.reveal successful_manager_operation_result
+  | Transaction_result :
+      { storage : Script.expr option ;
+        big_map_diff : Contract.big_map_diff option ;
+        balance_updates : Delegate.balance_updates ;
+        originated_contracts : Contract.t list ;
+        consumed_gas : Z.t ;
+        storage_size : Z.t ;
+        paid_storage_size_diff : Z.t ;
+        allocated_destination_contract : bool ;
+      } -> Kind.transaction successful_manager_operation_result
+  | Origination_result :
+      { balance_updates : Delegate.balance_updates ;
+        originated_contracts : Contract.t list ;
+        consumed_gas : Z.t ;
+        storage_size : Z.t ;
+        paid_storage_size_diff : Z.t ;
+      } -> Kind.origination successful_manager_operation_result
+  | Delegation_result :
+      { consumed_gas : Z.t
+      } -> Kind.delegation successful_manager_operation_result
+
+and packed_successful_manager_operation_result =
+  | Successful_manager_result :
+      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
+
+and packed_internal_operation_result =
+  | Internal_operation_result :
+      'kind internal_operation * 'kind manager_operation_result ->
+    packed_internal_operation_result
+
+(** Serializer for {!packed_operation_result}. *)
+val operation_metadata_encoding : packed_operation_metadata Data_encoding.t
+
+val operation_data_and_metadata_encoding
+  : (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
+
+
+
+type 'kind contents_and_result_list =
+  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
+  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+
+type packed_contents_and_result_list =
+  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+
+val contents_and_result_list_encoding :
+  packed_contents_and_result_list Data_encoding.t
+
+val pack_contents_list :
+  'kind contents_list -> 'kind contents_result_list ->
+  'kind contents_and_result_list
+
+val unpack_contents_list :
+  'kind contents_and_result_list ->
+  'kind contents_list * 'kind contents_result_list
+
+val to_list :
+  packed_contents_result_list -> packed_contents_result list
+
+val of_list :
+  packed_contents_result list -> packed_contents_result_list
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+val kind_equal_list :
+  'kind contents_list -> 'kind2 contents_result_list -> ('kind, 'kind2) eq option
+
+type block_metadata = {
+  baker: Signature.Public_key_hash.t ;
+  level: Level.t ;
+  voting_period_kind: Voting_period.kind ;
+  nonce_hash: Nonce_hash.t option ;
+  consumed_gas: Z.t ;
+  deactivated: Signature.Public_key_hash.t list ;
+  balance_updates: Delegate.balance_updates ;
+}
+val block_metadata_encoding: block_metadata Data_encoding.encoding
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.ml
new file mode 100644
index 000000000..d8d222c20
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.ml
@@ -0,0 +1,296 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Misc
+
+type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
+type error += Unexpected_endorsement (* `Permanent *)
+type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+type error += Invalid_signature  (* `Permanent *)
+type error += Invalid_stamp  (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"baking.timestamp_too_early"
+    ~title:"Block forged too early"
+    ~description:"The block timestamp is before the first slot \
+                  for this baker at this level"
+    ~pp:(fun ppf (r, p) ->
+        Format.fprintf ppf "Block forged too early (%a is before %a)"
+          Time.pp_hum p Time.pp_hum r)
+    Data_encoding.(obj2
+                     (req "minimum" Time.encoding)
+                     (req "provided" Time.encoding))
+    (function Timestamp_too_early (r, p)   -> Some (r, p) | _ -> None)
+    (fun (r, p) -> Timestamp_too_early (r, p)) ;
+  register_error_kind
+    `Permanent
+    ~id:"baking.invalid_fitness_gap"
+    ~title:"Invalid fitness gap"
+    ~description:"The gap of fitness is out of bounds"
+    ~pp:(fun ppf (m, g) ->
+        Format.fprintf ppf
+          "The gap of fitness %Ld is not between 0 and %Ld" g m)
+    Data_encoding.(obj2
+                     (req "maximum" int64)
+                     (req "provided" int64))
+    (function Invalid_fitness_gap (m, g)   -> Some (m, g) | _ -> None)
+    (fun (m, g) -> Invalid_fitness_gap (m, g)) ;
+  register_error_kind
+    `Permanent
+    ~id:"baking.invalid_block_signature"
+    ~title:"Invalid block signature"
+    ~description:
+      "A block was not signed with the expected private key."
+    ~pp:(fun ppf (block, pkh) ->
+        Format.fprintf ppf "Invalid signature for block %a. Expected: %a."
+          Block_hash.pp_short block
+          Signature.Public_key_hash.pp_short pkh)
+    Data_encoding.(obj2
+                     (req "block" Block_hash.encoding)
+                     (req "expected" Signature.Public_key_hash.encoding))
+    (function Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
+    (fun (block, pkh) -> Invalid_block_signature (block, pkh));
+  register_error_kind
+    `Permanent
+    ~id:"baking.invalid_signature"
+    ~title:"Invalid block signature"
+    ~description:"The block's signature is invalid"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Invalid block signature")
+    Data_encoding.empty
+    (function Invalid_signature -> Some () | _ -> None)
+    (fun () -> Invalid_signature) ;
+  register_error_kind
+    `Permanent
+    ~id:"baking.insufficient_proof_of_work"
+    ~title:"Insufficient block proof-of-work stamp"
+    ~description:"The block's proof-of-work stamp is insufficient"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Insufficient proof-of-work stamp")
+    Data_encoding.empty
+    (function Invalid_stamp -> Some () | _ -> None)
+    (fun () -> Invalid_stamp) ;
+  register_error_kind
+    `Permanent
+    ~id:"baking.unexpected_endorsement"
+    ~title:"Endorsement from unexpected delegate"
+    ~description:"The operation is signed by a delegate without endorsement rights."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf
+          "The endorsement is signed by a delegate without endorsement rights.")
+    Data_encoding.unit
+    (function Unexpected_endorsement -> Some () | _ -> None)
+    (fun () -> Unexpected_endorsement)
+
+let minimal_time c priority pred_timestamp =
+  let priority = Int32.of_int priority in
+  let rec cumsum_time_between_blocks acc durations p =
+    if Compare.Int32.(<=) p 0l then
+      ok acc
+    else match durations with
+      | [] -> cumsum_time_between_blocks acc [ Period.one_minute ] p
+      | [ last ] ->
+          Period.mult p last >>? fun period ->
+          Timestamp.(acc +? period)
+      | first :: durations ->
+          Timestamp.(acc +? first) >>? fun acc ->
+          let p = Int32.pred p in
+          cumsum_time_between_blocks acc durations p in
+  Lwt.return
+    (cumsum_time_between_blocks
+       pred_timestamp (Constants.time_between_blocks c) (Int32.succ priority))
+
+let earlier_predecessor_timestamp ctxt level =
+  let current = Level.current ctxt in
+  let current_timestamp = Timestamp.current ctxt in
+  let gap = Level.diff level current in
+  let step = List.hd (Constants.time_between_blocks ctxt) in
+  if Compare.Int32.(gap < 1l) then
+    failwith "Baking.earlier_block_timestamp: past block."
+  else
+    Lwt.return (Period.mult (Int32.pred gap) step) >>=? fun delay ->
+    Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result ->
+    return result
+
+let check_timestamp c priority pred_timestamp =
+  minimal_time c priority pred_timestamp >>=? fun minimal_time ->
+  let timestamp = Alpha_context.Timestamp.current c in
+  fail_unless Timestamp.(minimal_time <= timestamp)
+    (Timestamp_too_early (minimal_time, timestamp))
+
+let check_baking_rights c { Block_header.priority ; _ }
+    pred_timestamp =
+  let level = Level.current c in
+  Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
+  check_timestamp c priority pred_timestamp >>=? fun () ->
+  return delegate
+
+type error += Incorrect_priority (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"incorrect_priority"
+    ~title:"Incorrect priority"
+    ~description:"Block priority must be non-negative."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The block priority must be non-negative.")
+    Data_encoding.unit
+    (function Incorrect_priority -> Some () | _ -> None)
+    (fun () -> Incorrect_priority)
+
+let endorsement_reward ctxt ~block_priority:prio n =
+  if Compare.Int.(prio >= 0)
+  then
+    Lwt.return
+      Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) >>=? fun tez ->
+    Lwt.return Tez.(tez *? Int64.of_int n)
+  else fail Incorrect_priority
+
+let baking_priorities c level =
+  let rec f priority =
+    Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
+    return (LCons (delegate, (fun () -> f (succ priority))))
+  in
+  f 0
+
+let endorsement_rights c level =
+  fold_left_s
+    (fun acc slot ->
+       Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->
+       let pkh = Signature.Public_key.hash pk in
+       let right =
+         match Signature.Public_key_hash.Map.find_opt pkh acc with
+         | None -> (pk, [slot], false)
+         | Some (pk, slots, used) -> (pk, slot :: slots, used) in
+       return (Signature.Public_key_hash.Map.add pkh right acc))
+    Signature.Public_key_hash.Map.empty
+    (0 --> (Constants.endorsers_per_block c - 1))
+
+let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t) =
+  let current_level = Level.current ctxt in
+  let Single (Endorsement { level ; _ }) = op.protocol_data.contents in
+  begin
+    if Raw_level.(succ level = current_level.level) then
+      return (Alpha_context.allowed_endorsements ctxt)
+    else
+      endorsement_rights ctxt (Level.from_raw ctxt level)
+  end >>=? fun endorsements ->
+  match
+    Signature.Public_key_hash.Map.fold (* no find_first *)
+      (fun pkh (pk, slots, used) acc ->
+         match Operation.check_signature_sync pk chain_id op with
+         | Error _ -> acc
+         | Ok () -> Some (pkh, slots, used))
+      endorsements None
+  with
+  | None -> fail Unexpected_endorsement
+  | Some v -> return v
+
+let select_delegate delegate delegate_list max_priority =
+  let rec loop acc l n =
+    if Compare.Int.(n >= max_priority)
+    then return (List.rev acc)
+    else
+      let LCons (pk, t) = l in
+      let acc =
+        if Signature.Public_key_hash.equal delegate (Signature.Public_key.hash pk)
+        then n :: acc
+        else acc in
+      t () >>=? fun t ->
+      loop acc t (succ n)
+  in
+  loop [] delegate_list 0
+
+let first_baking_priorities
+    ctxt
+    ?(max_priority = 32)
+    delegate level =
+  baking_priorities ctxt level >>=? fun delegate_list ->
+  select_delegate delegate delegate_list max_priority
+
+let check_hash hash stamp_threshold =
+  let bytes = Block_hash.to_bytes hash in
+  let word = MBytes.get_int64 bytes 0 in
+  Compare.Uint64.(word <= stamp_threshold)
+
+let check_header_proof_of_work_stamp shell contents stamp_threshold =
+  let hash =
+    Block_header.hash
+      { shell ; protocol_data = { contents ; signature = Signature.zero } } in
+  check_hash hash stamp_threshold
+
+let check_proof_of_work_stamp ctxt block =
+  let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
+  if check_header_proof_of_work_stamp
+      block.Block_header.shell
+      block.protocol_data.contents
+      proof_of_work_threshold then
+    return_unit
+  else
+    fail Invalid_stamp
+
+let check_signature block chain_id key =
+  let check_signature key
+      { Block_header.shell ; protocol_data = { contents ; signature } } =
+    let unsigned_header =
+      Data_encoding.Binary.to_bytes_exn
+        Block_header.unsigned_encoding
+        (shell, contents) in
+    Signature.check ~watermark:(Block_header chain_id) key signature unsigned_header in
+  if check_signature key block then
+    return_unit
+  else
+    fail (Invalid_block_signature (Block_header.hash block,
+                                   Signature.Public_key.hash key))
+
+let max_fitness_gap ctxt =
+  let slots = Int64.of_int (Constants.endorsers_per_block ctxt + 1) in
+  Int64.add slots 1L
+
+let check_fitness_gap ctxt (block : Block_header.t) =
+  let current_fitness = Fitness.current ctxt in
+  Lwt.return (Fitness.to_int64 block.shell.fitness) >>=? fun announced_fitness ->
+  let gap = Int64.sub announced_fitness current_fitness in
+  if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
+    fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
+  else
+    return_unit
+
+let last_of_a_cycle ctxt l =
+  Compare.Int32.(Int32.succ l.Level.cycle_position =
+                 Constants.blocks_per_cycle ctxt)
+
+let dawn_of_a_new_cycle ctxt =
+  let level = Level.current ctxt in
+  if last_of_a_cycle ctxt level then
+    return_some level.cycle
+  else
+    return_none
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.mli
new file mode 100644
index 000000000..52c78f74b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/baking.mli
@@ -0,0 +1,108 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Misc
+
+type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
+type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+type error += Unexpected_endorsement
+type error += Invalid_signature  (* `Permanent *)
+type error += Invalid_stamp  (* `Permanent *)
+
+(** [minimal_time ctxt priority pred_block_time] returns the minimal
+    time, given the predecessor block timestamp [pred_block_time],
+    after which a baker with priority [priority] is allowed to
+    bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
+    time cannot be computed. *)
+val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
+
+(** [check_baking_rights ctxt block pred_timestamp] verifies that:
+    * the contract that owned the roll at cycle start has the block signer as delegate.
+    * the timestamp is coherent with the announced slot.
+*)
+val check_baking_rights:
+  context -> Block_header.contents -> Time.t ->
+  public_key tzresult Lwt.t
+
+(** For a given level computes who has the right to
+    include an endorsement in the next block.
+    The result can be stored in Alpha_context.allowed_endorsements *)
+val endorsement_rights:
+  context ->
+  Level.t ->
+  (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t
+
+(** Check that the operation was signed by a delegate allowed
+    to endorse at the level specified by the endorsement. *)
+val check_endorsement_rights:
+  context -> Chain_id.t -> Kind.endorsement Operation.t ->
+  (public_key_hash * int list * bool) tzresult Lwt.t
+
+(** Returns the endorsement reward calculated w.r.t a given priority.  *)
+val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
+
+(** [baking_priorities ctxt level] is the lazy list of contract's
+    public key hashes that are allowed to bake for [level]. *)
+val baking_priorities:
+  context -> Level.t -> public_key lazy_list
+
+(** [first_baking_priorities ctxt ?max_priority contract_hash level]
+    is a list of priorities of max [?max_priority] elements, where the
+    delegate of [contract_hash] is allowed to bake for [level]. If
+    [?max_priority] is [None], a sensible number of priorities is
+    returned. *)
+val first_baking_priorities:
+  context ->
+  ?max_priority:int ->
+  public_key_hash ->
+  Level.t ->
+  int list tzresult Lwt.t
+
+(** [check_signature ctxt chain_id block id] check if the block is
+    signed with the given key, and belongs to the given [chain_id] *)
+val check_signature: Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
+
+(** Checks if the header that would be built from the given components
+    is valid for the given diffculty. The signature is not passed as it
+    is does not impact the proof-of-work stamp. The stamp is checked on
+    the hash of a block header whose signature has been zeroed-out. *)
+val check_header_proof_of_work_stamp:
+  Block_header.shell_header -> Block_header.contents -> int64 -> bool
+
+(** verify if the proof of work stamp is valid *)
+val check_proof_of_work_stamp:
+  context -> Block_header.t -> unit tzresult Lwt.t
+
+(** check if the gap between the fitness of the current context
+    and the given block is within the protocol parameters *)
+val check_fitness_gap:
+  context -> Block_header.t -> unit tzresult Lwt.t
+
+val dawn_of_a_new_cycle: context -> Cycle.t option tzresult Lwt.t
+
+val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.ml
new file mode 100644
index 000000000..b18824748
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.ml
@@ -0,0 +1,51 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module H = Blake2B.Make(Base58)(struct
+    let name = "Blinded public key hash"
+    let title = "A blinded public key hash"
+    let b58check_prefix = "\001\002\049\223"
+    let size = Some Ed25519.Public_key_hash.size
+  end)
+
+include H
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "btz1" 37
+
+let of_ed25519_pkh activation_code pkh =
+  hash_bytes ~key:activation_code [ Ed25519.Public_key_hash.to_bytes pkh ]
+
+type activation_code = MBytes.t
+
+let activation_code_size = Ed25519.Public_key_hash.size
+let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size
+
+let activation_code_of_hex h =
+  if Compare.Int.(String.length h <> activation_code_size * 2) then
+    invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ;
+  MBytes.of_hex (`Hex h)
+
+module Index = H
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.mli
new file mode 100644
index 000000000..c9306c867
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/blinded_public_key_hash.mli
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include S.HASH
+
+val encoding : t Data_encoding.t
+val rpc_arg : t RPC_arg.t
+
+type activation_code
+val activation_code_encoding : activation_code Data_encoding.t
+
+val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t
+
+val activation_code_of_hex : string -> activation_code
+
+module Index : Storage_description.INDEX with type t = t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.ml
new file mode 100644
index 000000000..7fb78dedf
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.ml
@@ -0,0 +1,138 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Block header *)
+
+type t = {
+  shell: Block_header.shell_header ;
+  protocol_data: protocol_data ;
+}
+
+and protocol_data = {
+  contents: contents ;
+  signature: Signature.t ;
+}
+
+and contents = {
+  priority: int ;
+  seed_nonce_hash: Nonce_hash.t option ;
+  proof_of_work_nonce: MBytes.t ;
+}
+
+type block_header = t
+
+type raw = Block_header.t
+type shell_header = Block_header.shell_header
+
+let raw_encoding = Block_header.encoding
+let shell_header_encoding = Block_header.shell_header_encoding
+
+let contents_encoding =
+  let open Data_encoding in
+  def "block_header.alpha.unsigned_contents" @@
+  conv
+    (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
+       (priority, proof_of_work_nonce, seed_nonce_hash))
+    (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
+       { priority ; seed_nonce_hash ; proof_of_work_nonce })
+    (obj3
+       (req "priority" uint16)
+       (req "proof_of_work_nonce"
+          (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
+       (opt "seed_nonce_hash" Nonce_hash.encoding))
+
+let protocol_data_encoding =
+  let open Data_encoding in
+  def "block_header.alpha.signed_contents" @@
+  conv
+    (fun { contents ; signature } -> (contents, signature))
+    (fun (contents, signature) -> { contents ; signature })
+    (merge_objs
+       contents_encoding
+       (obj1 (req "signature" Signature.encoding)))
+
+let raw { shell ; protocol_data ; } =
+  let protocol_data =
+    Data_encoding.Binary.to_bytes_exn
+      protocol_data_encoding
+      protocol_data in
+  { Block_header.shell ; protocol_data }
+
+let unsigned_encoding =
+  let open Data_encoding in
+  merge_objs
+    Block_header.shell_header_encoding
+    contents_encoding
+
+let encoding =
+  let open Data_encoding in
+  def "block_header.alpha.full_header" @@
+  conv
+    (fun { shell ; protocol_data } ->
+       (shell, protocol_data))
+    (fun (shell, protocol_data) ->
+       { shell ; protocol_data })
+    (merge_objs
+       Block_header.shell_header_encoding
+       protocol_data_encoding)
+
+(** Constants *)
+
+let max_header_length =
+  let fake_shell = {
+    Block_header.level = 0l ;
+    proto_level = 0 ;
+    predecessor = Block_hash.zero ;
+    timestamp = Time.of_seconds 0L ;
+    validation_passes = 0 ;
+    operations_hash = Operation_list_list_hash.zero ;
+    fitness = Fitness_repr.from_int64 0L ;
+    context = Context_hash.zero ;
+  }
+  and fake_contents =
+    { priority = 0 ;
+      proof_of_work_nonce =
+        MBytes.create Constants_repr.proof_of_work_nonce_size ;
+      seed_nonce_hash = Some Nonce_hash.zero
+    } in
+  Data_encoding.Binary.length
+    encoding
+    { shell = fake_shell ;
+      protocol_data = {
+        contents = fake_contents ;
+        signature = Signature.zero ;
+      }
+    }
+
+(** Header parsing entry point  *)
+
+let hash_raw = Block_header.hash
+let hash { shell ; protocol_data } =
+  Block_header.hash
+    { shell ;
+      protocol_data =
+        Data_encoding.Binary.to_bytes_exn
+          protocol_data_encoding
+          protocol_data }
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.mli
new file mode 100644
index 000000000..9ce44a3d5
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/block_header_repr.mli
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  shell: Block_header.shell_header ;
+  protocol_data: protocol_data ;
+}
+
+and protocol_data = {
+  contents: contents ;
+  signature: Signature.t ;
+}
+
+and contents = {
+  priority: int ;
+  seed_nonce_hash: Nonce_hash.t option ;
+  proof_of_work_nonce: MBytes.t ;
+}
+
+type block_header = t
+
+type raw = Block_header.t
+type shell_header = Block_header.shell_header
+
+val raw: block_header -> raw
+
+val encoding: block_header Data_encoding.encoding
+val raw_encoding: raw Data_encoding.t
+val contents_encoding: contents Data_encoding.t
+val unsigned_encoding: (Block_header.shell_header * contents) Data_encoding.t
+val protocol_data_encoding: protocol_data Data_encoding.encoding
+val shell_header_encoding: shell_header Data_encoding.encoding
+
+val max_header_length: int
+(** The maximum size of block headers in bytes *)
+
+val hash: block_header -> Block_hash.t
+val hash_raw: raw -> Block_hash.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.ml
new file mode 100644
index 000000000..4cbd64bd7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.ml
@@ -0,0 +1,128 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Misc
+
+let init_account ctxt
+    ({ public_key_hash ; public_key ; amount }: Parameters_repr.bootstrap_account) =
+  let contract = Contract_repr.implicit_contract public_key_hash in
+  Contract_storage.credit ctxt contract amount >>=? fun ctxt ->
+  match public_key with
+  | Some public_key ->
+      Contract_storage.reveal_manager_key ctxt contract public_key >>=? fun ctxt ->
+      Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->
+      return ctxt
+  | None -> return ctxt
+
+let init_contract ~typecheck ctxt
+    ({ delegate ; amount ; script }: Parameters_repr.bootstrap_contract) =
+  Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+  typecheck ctxt script >>=? fun ctxt ->
+  Contract_storage.originate ctxt contract
+    ~balance:amount
+    ~prepaid_bootstrap_storage:true
+    ~manager:Signature.Public_key_hash.zero
+    ~script:(script, None)
+    ~delegate:(Some delegate)
+    ~spendable:false
+    ~delegatable:false >>=? fun ctxt ->
+  return ctxt
+
+let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
+  let nonce =
+    Operation_hash.hash_bytes
+      [ MBytes.of_string "Un festival de GADT." ] in
+  let ctxt = Raw_context.init_origination_nonce ctxt nonce in
+  fold_left_s init_account ctxt accounts >>=? fun ctxt ->
+  fold_left_s (init_contract ~typecheck) ctxt contracts >>=? fun ctxt ->
+  begin
+    match no_reward_cycles with
+    | None -> return ctxt
+    | Some cycles ->
+        (* Store pending ramp ups. *)
+        let constants = Raw_context.constants ctxt in
+        (* Start without reward *)
+        Raw_context.patch_constants ctxt
+          (fun c ->
+             { c with
+               block_reward = Tez_repr.zero ;
+               endorsement_reward = Tez_repr.zero  }) >>= fun ctxt ->
+        (* Store the final reward. *)
+        Storage.Ramp_up.Rewards.init ctxt
+          (Cycle_repr.of_int32_exn (Int32.of_int cycles))
+          (constants.block_reward,
+           constants.endorsement_reward)
+  end >>=? fun ctxt ->
+  match ramp_up_cycles with
+  | None -> return ctxt
+  | Some cycles ->
+      (* Store pending ramp ups. *)
+      let constants = Raw_context.constants ctxt in
+      Lwt.return Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) >>=? fun block_step ->
+      Lwt.return Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) >>=? fun endorsement_step ->
+      (* Start without security_deposit *)
+      Raw_context.patch_constants ctxt
+        (fun c ->
+           { c with
+             block_security_deposit = Tez_repr.zero ;
+             endorsement_security_deposit = Tez_repr.zero  }) >>= fun ctxt ->
+      fold_left_s
+        (fun ctxt cycle ->
+           Lwt.return Tez_repr.(block_step *? Int64.of_int cycle) >>=? fun block_security_deposit ->
+           Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle) >>=? fun endorsement_security_deposit ->
+           let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
+           Storage.Ramp_up.Security_deposits.init ctxt cycle
+             (block_security_deposit, endorsement_security_deposit))
+        ctxt
+        (1 --> (cycles - 1)) >>=? fun ctxt ->
+      (* Store the final security deposits. *)
+      Storage.Ramp_up.Security_deposits.init ctxt
+        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
+        (constants.block_security_deposit,
+         constants.endorsement_security_deposit) >>=? fun ctxt ->
+      return ctxt
+
+let cycle_end ctxt last_cycle =
+  let next_cycle = Cycle_repr.succ last_cycle in
+  begin
+    Storage.Ramp_up.Rewards.get_option ctxt next_cycle >>=? function
+    | None -> return ctxt
+    | Some (block_reward, endorsement_reward) ->
+        Storage.Ramp_up.Rewards.delete ctxt next_cycle >>=? fun ctxt ->
+        Raw_context.patch_constants ctxt
+          (fun c ->
+             { c with block_reward ;
+                      endorsement_reward }) >>= fun ctxt ->
+        return ctxt
+  end >>=? fun ctxt ->
+  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle >>=? function
+  | None -> return ctxt
+  | Some (block_security_deposit, endorsement_security_deposit) ->
+      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle >>=? fun ctxt ->
+      Raw_context.patch_constants ctxt
+        (fun c ->
+           { c with block_security_deposit ;
+                    endorsement_security_deposit }) >>= fun ctxt ->
+      return ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.mli
new file mode 100644
index 000000000..ed370b27d
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/bootstrap_storage.mli
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 init:
+  Raw_context.t ->
+  typecheck:(Raw_context.t -> Script_repr.t -> Raw_context.t tzresult Lwt.t) ->
+  ?ramp_up_cycles:int ->
+  ?no_reward_cycles:int ->
+  Parameters_repr.bootstrap_account list ->
+  Parameters_repr.bootstrap_contract list ->
+  Raw_context.t tzresult Lwt.t
+
+val cycle_end:
+  Raw_context.t ->
+  Cycle_repr.t ->
+  Raw_context.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.ml
new file mode 100644
index 000000000..89b9272de
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.ml
@@ -0,0 +1,40 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  blinded_public_key_hash : Blinded_public_key_hash.t ;
+  amount : Tez_repr.t
+}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { blinded_public_key_hash ; amount } ->
+       ( blinded_public_key_hash, amount ))
+    (fun ( blinded_public_key_hash, amount) ->
+       { blinded_public_key_hash ; amount })
+    (tup2
+       Blinded_public_key_hash.encoding
+       Tez_repr.encoding)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.mli
new file mode 100644
index 000000000..4bd74810a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_repr.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  blinded_public_key_hash : Blinded_public_key_hash.t ;
+  amount : Tez_repr.t ;
+}
+
+val encoding : t Data_encoding.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.ml
new file mode 100644
index 000000000..a8680b976
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 get_opt = Storage.Commitments.get_option
+let delete = Storage.Commitments.delete
+
+let init ctxt commitments  =
+  let init_commitment ctxt Commitment_repr.{ blinded_public_key_hash ; amount } =
+    Storage.Commitments.init ctxt blinded_public_key_hash amount in
+  fold_left_s init_commitment ctxt commitments >>=? fun ctxt ->
+  return ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.mli
new file mode 100644
index 000000000..1e5be6dc5
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/commitment_storage.mli
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 init:
+  Raw_context.t ->
+  Commitment_repr.t list ->
+  Raw_context.t tzresult Lwt.t
+
+val get_opt:
+  Raw_context.t -> Blinded_public_key_hash.t ->
+  Tez_repr.t option tzresult Lwt.t
+
+val delete:
+  Raw_context.t -> Blinded_public_key_hash.t ->
+  Raw_context.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_repr.ml
new file mode 100644
index 000000000..3f8cfe734
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_repr.ml
@@ -0,0 +1,232 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 version_number = "\000"
+let proof_of_work_nonce_size = 8
+let nonce_length = 32
+let max_revelations_per_block = 32
+let max_proposals_per_delegate = 20
+let max_operation_data_length = 16 * 1024 (* 16kB *)
+
+type fixed = {
+  proof_of_work_nonce_size : int ;
+  nonce_length : int ;
+  max_revelations_per_block : int ;
+  max_operation_data_length : int ;
+  max_proposals_per_delegate : int ;
+}
+
+let fixed_encoding =
+  let open Data_encoding in
+  conv
+    (fun c ->
+       (c.proof_of_work_nonce_size,
+        c.nonce_length,
+        c.max_revelations_per_block,
+        c.max_operation_data_length,
+        c.max_proposals_per_delegate))
+    (fun (proof_of_work_nonce_size,
+          nonce_length,
+          max_revelations_per_block,
+          max_operation_data_length,
+          max_proposals_per_delegate) ->
+      { proof_of_work_nonce_size ;
+        nonce_length ;
+        max_revelations_per_block ;
+        max_operation_data_length ;
+        max_proposals_per_delegate ;
+      } )
+    (obj5
+       (req "proof_of_work_nonce_size" uint8)
+       (req "nonce_length" uint8)
+       (req "max_revelations_per_block" uint8)
+       (req "max_operation_data_length" int31)
+       (req "max_proposals_per_delegate" uint8))
+
+let fixed = {
+  proof_of_work_nonce_size ;
+  nonce_length ;
+  max_revelations_per_block ;
+  max_operation_data_length ;
+  max_proposals_per_delegate ;
+}
+
+type parametric = {
+  preserved_cycles: int ;
+  blocks_per_cycle: int32 ;
+  blocks_per_commitment: int32 ;
+  blocks_per_roll_snapshot: int32 ;
+  blocks_per_voting_period: int32 ;
+  time_between_blocks: Period_repr.t list ;
+  endorsers_per_block: int ;
+  hard_gas_limit_per_operation: Z.t ;
+  hard_gas_limit_per_block: Z.t ;
+  proof_of_work_threshold: int64 ;
+  tokens_per_roll: Tez_repr.t ;
+  michelson_maximum_type_size: int;
+  seed_nonce_revelation_tip: Tez_repr.t ;
+  origination_size: int ;
+  block_security_deposit: Tez_repr.t ;
+  endorsement_security_deposit: Tez_repr.t ;
+  block_reward: Tez_repr.t ;
+  endorsement_reward: Tez_repr.t ;
+  cost_per_byte: Tez_repr.t ;
+  hard_storage_limit_per_operation: Z.t ;
+}
+
+let default = {
+  preserved_cycles = 5 ;
+  blocks_per_cycle = 4096l ;
+  blocks_per_commitment = 32l ;
+  blocks_per_roll_snapshot = 256l ;
+  blocks_per_voting_period = 32768l ;
+  time_between_blocks =
+    List.map Period_repr.of_seconds_exn [ 60L ; 75L ] ;
+  endorsers_per_block = 32 ;
+  hard_gas_limit_per_operation = Z.of_int 400_000 ;
+  hard_gas_limit_per_block = Z.of_int 4_000_000 ;
+  proof_of_work_threshold =
+    Int64.(sub (shift_left 1L 46) 1L) ;
+  tokens_per_roll =
+    Tez_repr.(mul_exn one 10_000) ;
+  michelson_maximum_type_size = 1000 ;
+  seed_nonce_revelation_tip = begin
+    match Tez_repr.(one /? 8L) with
+    | Ok c -> c
+    | Error _ -> assert false
+  end ;
+  origination_size = 257 ;
+  block_security_deposit = Tez_repr.(mul_exn one 512) ;
+  endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
+  block_reward = Tez_repr.(mul_exn one 16) ;
+  endorsement_reward = Tez_repr.(mul_exn one 2) ;
+  hard_storage_limit_per_operation = Z.of_int 60_000 ;
+  cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
+}
+
+module CompareListInt = Compare.List (Compare.Int)
+
+let parametric_encoding =
+  let open Data_encoding in
+  conv
+    (fun c ->
+       (( c.preserved_cycles,
+          c.blocks_per_cycle,
+          c.blocks_per_commitment,
+          c.blocks_per_roll_snapshot,
+          c.blocks_per_voting_period,
+          c.time_between_blocks,
+          c.endorsers_per_block,
+          c.hard_gas_limit_per_operation,
+          c.hard_gas_limit_per_block),
+        ((c.proof_of_work_threshold,
+          c.tokens_per_roll,
+          c.michelson_maximum_type_size,
+          c.seed_nonce_revelation_tip,
+          c.origination_size,
+          c.block_security_deposit,
+          c.endorsement_security_deposit,
+          c.block_reward),
+         (c.endorsement_reward,
+          c.cost_per_byte,
+          c.hard_storage_limit_per_operation))) )
+    (fun (( 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))) ->
+      { 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 ;
+      } )
+    (merge_objs
+       (obj9
+          (req "preserved_cycles" uint8)
+          (req "blocks_per_cycle" int32)
+          (req "blocks_per_commitment" int32)
+          (req "blocks_per_roll_snapshot" int32)
+          (req "blocks_per_voting_period" int32)
+          (req "time_between_blocks" (list Period_repr.encoding))
+          (req "endorsers_per_block" uint16)
+          (req "hard_gas_limit_per_operation" z)
+          (req "hard_gas_limit_per_block" z))
+       (merge_objs
+          (obj8
+             (req "proof_of_work_threshold" int64)
+             (req "tokens_per_roll" Tez_repr.encoding)
+             (req "michelson_maximum_type_size" uint16)
+             (req "seed_nonce_revelation_tip" Tez_repr.encoding)
+             (req "origination_size" int31)
+             (req "block_security_deposit" Tez_repr.encoding)
+             (req "endorsement_security_deposit" Tez_repr.encoding)
+             (req "block_reward" Tez_repr.encoding))
+          (obj3
+             (req "endorsement_reward" Tez_repr.encoding)
+             (req "cost_per_byte" Tez_repr.encoding)
+             (req "hard_storage_limit_per_operation" z))))
+
+type t = {
+  fixed : fixed ;
+  parametric : parametric ;
+}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { fixed ; parametric } -> (fixed, parametric))
+    (fun (fixed , parametric) -> { fixed ; parametric })
+    (merge_objs fixed_encoding parametric_encoding)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.ml
new file mode 100644
index 000000000..8e07c7a87
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.ml
@@ -0,0 +1,65 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+let custom_root =
+  (RPC_path.(open_root / "context" / "constants") : RPC_context.t RPC_path.context)
+
+module S = struct
+
+  open Data_encoding
+
+  let errors =
+    RPC_service.get_service
+      ~description: "Schema for all the RPC errors from this protocol version"
+      ~query: RPC_query.empty
+      ~output: json_schema
+      RPC_path.(custom_root / "errors")
+
+  let all =
+    RPC_service.get_service
+      ~description: "All constants"
+      ~query: RPC_query.empty
+      ~output: Alpha_context.Constants.encoding
+      custom_root
+
+end
+
+let register () =
+  let open Services_registration in
+  register0_noctxt S.errors begin fun () () ->
+    return (Data_encoding.Json.(schema error_encoding))
+  end ;
+  register0 S.all begin fun ctxt () () ->
+    let open Constants in
+    return { fixed = fixed ;
+             parametric = parametric ctxt }
+  end
+
+let errors ctxt block =
+  RPC_context.make_call0 S.errors ctxt block () ()
+let all ctxt block =
+  RPC_context.make_call0 S.all ctxt block () ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.mli
new file mode 100644
index 000000000..5234cd843
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_services.mli
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+val errors:
+  'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t
+
+(** Returns all the constants of the protocol *)
+val all:
+  'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t
+
+val register: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_storage.ml
new file mode 100644
index 000000000..9613853fe
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/constants_storage.ml
@@ -0,0 +1,87 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 preserved_cycles c =
+  let constants = Raw_context.constants c in
+  constants.preserved_cycles
+let blocks_per_cycle c =
+  let constants = Raw_context.constants c in
+  constants.blocks_per_cycle
+let blocks_per_commitment c =
+  let constants = Raw_context.constants c in
+  constants.blocks_per_commitment
+let blocks_per_roll_snapshot c =
+  let constants = Raw_context.constants c in
+  constants.blocks_per_roll_snapshot
+let blocks_per_voting_period c =
+  let constants = Raw_context.constants c in
+  constants.blocks_per_voting_period
+let time_between_blocks c =
+  let constants = Raw_context.constants c in
+  constants.time_between_blocks
+let endorsers_per_block c =
+  let constants = Raw_context.constants c in
+  constants.endorsers_per_block
+let hard_gas_limit_per_operation c =
+  let constants = Raw_context.constants c in
+  constants.hard_gas_limit_per_operation
+let hard_gas_limit_per_block c =
+  let constants = Raw_context.constants c in
+  constants.hard_gas_limit_per_block
+let cost_per_byte c =
+  let constants = Raw_context.constants c in
+  constants.cost_per_byte
+let hard_storage_limit_per_operation c =
+  let constants = Raw_context.constants c in
+  constants.hard_storage_limit_per_operation
+let proof_of_work_threshold c =
+  let constants = Raw_context.constants c in
+  constants.proof_of_work_threshold
+let tokens_per_roll c =
+  let constants = Raw_context.constants c in
+  constants.tokens_per_roll
+let michelson_maximum_type_size c =
+  let constants = Raw_context.constants c in
+  constants.michelson_maximum_type_size
+let seed_nonce_revelation_tip c =
+  let constants = Raw_context.constants c in
+  constants.seed_nonce_revelation_tip
+let origination_size c =
+  let constants = Raw_context.constants c in
+  constants.origination_size
+let block_security_deposit c =
+  let constants = Raw_context.constants c in
+  constants.block_security_deposit
+let endorsement_security_deposit c =
+  let constants = Raw_context.constants c in
+  constants.endorsement_security_deposit
+let block_reward c =
+  let constants = Raw_context.constants c in
+  constants.block_reward
+let endorsement_reward c =
+  let constants = Raw_context.constants c in
+  constants.endorsement_reward
+let parametric c =
+  Raw_context.constants c
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_hash.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_hash.ml
new file mode 100644
index 000000000..74b2bbf54
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_hash.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* 20 *)
+let contract_hash = "\002\090\121" (* KT1(36) *)
+
+include Blake2B.Make(Base58)(struct
+    let name = "Contract_hash"
+    let title = "A contract ID"
+    let b58check_prefix = contract_hash
+    let size = Some 20
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "KT1" 36
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.ml
new file mode 100644
index 000000000..1740fa03f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.ml
@@ -0,0 +1,210 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t =
+  | Implicit of Signature.Public_key_hash.t
+  | Originated of Contract_hash.t
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare l1 l2 =
+      match l1, l2 with
+      | Implicit pkh1, Implicit pkh2 ->
+          Signature.Public_key_hash.compare pkh1 pkh2
+      | Originated h1, Originated h2 ->
+          Contract_hash.compare h1 h2
+      | Implicit _, Originated _ -> -1
+      | Originated _, Implicit _ -> 1
+  end)
+
+type contract = t
+
+type error += Invalid_contract_notation of string (* `Permanent *)
+
+let to_b58check = function
+  | Implicit pbk -> Signature.Public_key_hash.to_b58check pbk
+  | Originated h -> Contract_hash.to_b58check h
+
+let of_b58check s =
+  match Base58.decode s with
+  | Some (Ed25519.Public_key_hash.Data h) -> ok (Implicit (Signature.Ed25519 h))
+  | Some (Secp256k1.Public_key_hash.Data h) -> ok (Implicit (Signature.Secp256k1 h))
+  | Some (P256.Public_key_hash.Data h) -> ok (Implicit (Signature.P256 h))
+  | Some (Contract_hash.Data h) -> ok (Originated h)
+  | _ -> error (Invalid_contract_notation s)
+
+let pp ppf = function
+  | Implicit pbk -> Signature.Public_key_hash.pp ppf pbk
+  | Originated h -> Contract_hash.pp ppf h
+
+let pp_short ppf = function
+  | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk
+  | Originated h -> Contract_hash.pp_short ppf h
+
+let encoding =
+  let open Data_encoding in
+  def "contract_id"
+    ~title:
+      "A contract handle"
+    ~description:
+      "A contract notation as given to an RPC or inside scripts. \
+       Can be a base58 implicit contract hash \
+       or a base58 originated contract hash." @@
+  splitted
+    ~binary:
+      (union ~tag_size:`Uint8 [
+          case (Tag 0)
+            ~title:"Implicit"
+            Signature.Public_key_hash.encoding
+            (function Implicit k -> Some k | _ -> None)
+            (fun k -> Implicit k) ;
+          case (Tag 1) (Fixed.add_padding Contract_hash.encoding 1)
+            ~title:"Originated"
+            (function Originated k -> Some k | _ -> None)
+            (fun k -> Originated k) ;
+        ])
+    ~json:
+      (conv
+         to_b58check
+         (fun s ->
+            match of_b58check s with
+            | Ok s -> s
+            | Error _ -> Json.cannot_destruct "Invalid contract notation.")
+         string)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"contract.invalid_contract_notation"
+    ~title: "Invalid contract notation"
+    ~pp: (fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
+    ~description:
+      "A malformed contract notation was given to an RPC or in a script."
+    (obj1 (req "notation" string))
+    (function Invalid_contract_notation loc -> Some loc | _ -> None)
+    (fun loc -> Invalid_contract_notation loc)
+
+let implicit_contract id = Implicit id
+
+let is_implicit = function
+  | Implicit m -> Some m
+  | Originated _ -> None
+
+let is_originated = function
+  | Implicit _ -> None
+  | Originated h -> Some h
+
+type origination_nonce =
+  { operation_hash: Operation_hash.t ;
+    origination_index: int32 }
+
+let origination_nonce_encoding =
+  let open Data_encoding in
+  conv
+    (fun { operation_hash ; origination_index } ->
+       (operation_hash, origination_index))
+    (fun (operation_hash, origination_index) ->
+       { operation_hash ; origination_index }) @@
+  obj2
+    (req "operation" Operation_hash.encoding)
+    (dft "index" int32 0l)
+
+let originated_contract nonce =
+  let data =
+    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in
+  Originated (Contract_hash.hash_bytes [data])
+
+let originated_contracts
+    ~since: { origination_index = first ; operation_hash = first_hash }
+    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =
+  assert (Operation_hash.equal first_hash last_hash) ;
+  let rec contracts acc origination_index =
+    if Compare.Int32.(origination_index < first) then
+      acc
+    else
+      let origination_nonce =
+        { origination_nonce with origination_index } in
+      let acc = originated_contract origination_nonce :: acc in
+      contracts acc (Int32.pred origination_index) in
+  contracts [] (Int32.pred last)
+
+let initial_origination_nonce operation_hash =
+  { operation_hash ; origination_index = 0l }
+
+let incr_origination_nonce nonce =
+  let origination_index = Int32.succ nonce.origination_index in
+  { nonce with origination_index }
+
+let rpc_arg =
+  let construct = to_b58check in
+  let destruct hash =
+    match of_b58check hash with
+    | Error _ -> Error "Cannot parse contract id"
+    | Ok contract -> Ok contract in
+  RPC_arg.make
+    ~descr: "A contract identifier encoded in b58check."
+    ~name: "contract_id"
+    ~construct
+    ~destruct
+    ()
+
+module Index = struct
+  type t = contract
+  let path_length =
+
+    assert Compare.Int.(Signature.Public_key_hash.path_length =
+                        1 + Contract_hash.path_length) ;
+    Signature.Public_key_hash.path_length
+  let to_path c l =
+    match c with
+    | Implicit k ->
+        Signature.Public_key_hash.to_path k l
+    | Originated h ->
+        "originated" :: Contract_hash.to_path h l
+  let of_path = function
+    | "originated" :: key -> begin
+        match Contract_hash.of_path key with
+        | None -> None
+        | Some h -> Some (Originated h)
+      end
+    | key -> begin
+        match Signature.Public_key_hash.of_path key with
+        | None -> None
+        | Some h -> Some (Implicit h)
+      end
+  let contract_prefix s =
+    "originated" :: Contract_hash.prefix_path s
+  let pkh_prefix_ed25519 s =
+    Ed25519.Public_key_hash.prefix_path s
+  let pkh_prefix_secp256k1 s =
+    Secp256k1.Public_key_hash.prefix_path s
+  let pkh_prefix_p256 s =
+    P256.Public_key_hash.prefix_path s
+
+  let rpc_arg = rpc_arg
+  let encoding = encoding
+  let compare = compare
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.mli
new file mode 100644
index 000000000..042613c83
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_repr.mli
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = private
+  | Implicit of Signature.Public_key_hash.t
+  | Originated of Contract_hash.t
+type contract = t
+
+include Compare.S with type t := contract
+
+(** {2 Implicit contracts} *****************************************************)
+
+val implicit_contract : Signature.Public_key_hash.t -> contract
+
+val is_implicit : contract -> Signature.Public_key_hash.t option
+
+(** {2 Originated contracts} **************************************************)
+
+(** Originated contracts handles are crafted from the hash of the
+    operation that triggered their origination (and nothing else).
+    As a single operation can trigger several originations, the
+    corresponding handles are forged from a deterministic sequence of
+    nonces, initialized with the hash of the operation. *)
+type origination_nonce
+
+val originated_contract : origination_nonce -> contract
+
+val originated_contracts : since: origination_nonce -> until: origination_nonce -> contract list
+
+val initial_origination_nonce : Operation_hash.t -> origination_nonce
+
+val incr_origination_nonce : origination_nonce -> origination_nonce
+
+val is_originated : contract -> Contract_hash.t option
+
+
+(** {2 Human readable notation} ***********************************************)
+
+type error += Invalid_contract_notation of string (* `Permanent *)
+
+val to_b58check: contract -> string
+
+val of_b58check: string -> contract tzresult
+
+val pp: Format.formatter -> contract -> unit
+
+val pp_short: Format.formatter -> contract -> unit
+
+(** {2 Serializers} ***********************************************************)
+
+val encoding : contract Data_encoding.t
+
+val origination_nonce_encoding : origination_nonce Data_encoding.t
+
+val rpc_arg : contract RPC_arg.arg
+
+module Index : sig
+  include Storage_description.INDEX with type t = t
+  val contract_prefix: string -> string list
+  val pkh_prefix_ed25519: string -> string list
+  val pkh_prefix_secp256k1: string -> string list
+  val pkh_prefix_p256: string -> string list
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.ml
new file mode 100644
index 000000000..3951a34ae
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.ml
@@ -0,0 +1,273 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+let custom_root =
+  (RPC_path.(open_root / "context" / "contracts") : RPC_context.t RPC_path.context)
+
+type info = {
+  manager: public_key_hash ;
+  balance: Tez.t ;
+  spendable: bool ;
+  delegate: bool * public_key_hash option ;
+  counter: counter ;
+  script: Script.t option ;
+}
+
+let info_encoding =
+  let open Data_encoding in
+  conv
+    (fun {manager ; balance ; spendable ; delegate ;
+          script ; counter } ->
+      (manager, balance, spendable, delegate,
+       script, counter))
+    (fun (manager, balance, spendable, delegate,
+          script, counter) ->
+      {manager ; balance ; spendable ; delegate ;
+       script ; counter}) @@
+  obj6
+    (req "manager" Signature.Public_key_hash.encoding)
+    (req "balance" Tez.encoding)
+    (req "spendable" bool)
+    (req "delegate" @@ obj2
+       (req "setable" bool)
+       (opt "value" Signature.Public_key_hash.encoding))
+    (opt "script" Script.encoding)
+    (req "counter" n)
+
+module S = struct
+
+  open Data_encoding
+
+  let balance =
+    RPC_service.get_service
+      ~description: "Access the balance of a contract."
+      ~query: RPC_query.empty
+      ~output: Tez.encoding
+      RPC_path.(custom_root /: Contract.rpc_arg / "balance")
+
+  let manager =
+    RPC_service.get_service
+      ~description: "Access the manager of a contract."
+      ~query: RPC_query.empty
+      ~output: Signature.Public_key_hash.encoding
+      RPC_path.(custom_root /: Contract.rpc_arg / "manager")
+
+  let manager_key =
+    RPC_service.get_service
+      ~description: "Access the manager of a contract."
+      ~query: RPC_query.empty
+      ~output: (obj2
+                  (req "manager" Signature.Public_key_hash.encoding)
+                  (opt "key" Signature.Public_key.encoding))
+      RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")
+
+  let delegate =
+    RPC_service.get_service
+      ~description: "Access the delegate of a contract, if any."
+      ~query: RPC_query.empty
+      ~output: Signature.Public_key_hash.encoding
+      RPC_path.(custom_root /: Contract.rpc_arg / "delegate")
+
+  let counter =
+    RPC_service.get_service
+      ~description: "Access the counter of a contract, if any."
+      ~query: RPC_query.empty
+      ~output: z
+      RPC_path.(custom_root /: Contract.rpc_arg / "counter")
+
+  let spendable =
+    RPC_service.get_service
+      ~description: "Tells if the contract tokens can be spent by the manager."
+      ~query: RPC_query.empty
+      ~output: bool
+      RPC_path.(custom_root /: Contract.rpc_arg / "spendable")
+
+  let delegatable =
+    RPC_service.get_service
+      ~description: "Tells if the contract delegate can be changed."
+      ~query: RPC_query.empty
+      ~output: bool
+      RPC_path.(custom_root /: Contract.rpc_arg / "delegatable")
+
+  let script =
+    RPC_service.get_service
+      ~description: "Access the code and data of the contract."
+      ~query: RPC_query.empty
+      ~output: Script.encoding
+      RPC_path.(custom_root /: Contract.rpc_arg / "script")
+
+  let storage =
+    RPC_service.get_service
+      ~description: "Access the data of the contract."
+      ~query: RPC_query.empty
+      ~output: Script.expr_encoding
+      RPC_path.(custom_root /: Contract.rpc_arg / "storage")
+
+  let big_map_get =
+    RPC_service.post_service
+      ~description: "Access the value associated with a key in the big map storage  of the contract."
+      ~query: RPC_query.empty
+      ~input: (obj2
+                 (req "key" Script.expr_encoding)
+                 (req "type" Script.expr_encoding))
+      ~output: (option Script.expr_encoding)
+      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")
+
+  let info =
+    RPC_service.get_service
+      ~description: "Access the complete status of a contract."
+      ~query: RPC_query.empty
+      ~output: info_encoding
+      RPC_path.(custom_root /: Contract.rpc_arg)
+
+  let list =
+    RPC_service.get_service
+      ~description:
+        "All existing contracts (including non-empty default contracts)."
+      ~query: RPC_query.empty
+      ~output: (list Contract.encoding)
+      custom_root
+
+end
+
+let register () =
+  let open Services_registration in
+  register0 S.list begin fun ctxt () () ->
+    Contract.list ctxt >>= return
+  end ;
+  let register_field s f =
+    register1 s (fun ctxt contract () () ->
+        Contract.exists ctxt contract >>=? function
+        | true -> f ctxt contract
+        | false -> raise Not_found) in
+  let register_opt_field s f =
+    register_field s
+      (fun ctxt a1 ->
+         f ctxt a1 >>=? function
+         | None -> raise Not_found
+         | Some v -> return v) in
+  register_field S.balance Contract.get_balance ;
+  register_field S.manager Contract.get_manager ;
+  register_field S.manager_key
+    (fun ctxt c ->
+       Contract.get_manager ctxt c >>=? fun mgr ->
+       Contract.is_manager_key_revealed ctxt c >>=? fun revealed ->
+       if revealed then
+         Contract.get_manager_key ctxt c >>=? fun key ->
+         return (mgr, Some key)
+       else return (mgr, None)) ;
+  register_opt_field S.delegate Delegate.get ;
+  register_field S.counter Contract.get_counter ;
+  register_field S.spendable Contract.is_spendable ;
+  register_field S.delegatable Contract.is_delegatable ;
+  register_opt_field S.script
+    (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
+  register_opt_field S.storage (fun ctxt contract ->
+      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      match script with
+      | None -> return_none
+      | Some script ->
+          let ctxt = Gas.set_unlimited ctxt in
+          let open Script_ir_translator in
+          parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
+          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
+          Script.force_decode ctxt script.storage >>=? fun (storage, _ctxt) ->
+          return_some storage) ;
+  register1 S.big_map_get (fun ctxt contract () (key, key_type) ->
+      let open Script_ir_translator in
+      let ctxt = Gas.set_unlimited ctxt in
+      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root key_type))
+      >>=? fun (Ex_ty key_type, ctxt) ->
+      parse_data ctxt key_type (Micheline.root key) >>=? fun (key, ctxt) ->
+      hash_data ctxt key_type key >>=? fun (key_hash, ctxt) ->
+      Contract.Big_map.get_opt ctxt contract key_hash >>=? fun (_ctxt, value) ->
+      return value) ;
+  register_field S.info (fun ctxt contract ->
+      Contract.get_balance ctxt contract >>=? fun balance ->
+      Contract.get_manager ctxt contract >>=? fun manager ->
+      Delegate.get ctxt contract >>=? fun delegate ->
+      Contract.get_counter ctxt contract >>=? fun counter ->
+      Contract.is_delegatable ctxt contract >>=? fun delegatable ->
+      Contract.is_spendable ctxt contract >>=? fun spendable ->
+      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      begin match script with
+        | None -> return (None, ctxt)
+        | Some script ->
+            let ctxt = Gas.set_unlimited ctxt in
+            let open Script_ir_translator in
+            parse_script ctxt script >>=? fun (Ex_script script, ctxt) ->
+            unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
+            return (Some script, ctxt)
+      end >>=? fun (script, _ctxt) ->
+      return { manager ; balance ;
+               spendable ; delegate = (delegatable, delegate) ;
+               script ; counter })
+
+let list ctxt block =
+  RPC_context.make_call0 S.list ctxt block () ()
+
+let info ctxt block contract =
+  RPC_context.make_call1 S.info ctxt block contract () ()
+
+let balance ctxt block contract =
+  RPC_context.make_call1 S.balance ctxt block contract () ()
+
+let manager ctxt block contract =
+  RPC_context.make_call1 S.manager ctxt block contract () ()
+
+let manager_key ctxt block contract =
+  RPC_context.make_call1 S.manager_key ctxt block contract () ()
+
+let delegate ctxt block contract =
+  RPC_context.make_call1 S.delegate ctxt block contract () ()
+
+let delegate_opt ctxt block contract =
+  RPC_context.make_opt_call1 S.delegate ctxt block contract () ()
+
+let counter ctxt block contract =
+  RPC_context.make_call1 S.counter ctxt block contract () ()
+
+let is_delegatable ctxt block contract =
+  RPC_context.make_call1 S.delegatable ctxt block contract () ()
+
+let is_spendable ctxt block contract =
+  RPC_context.make_call1 S.spendable ctxt block contract () ()
+
+let script ctxt block contract =
+  RPC_context.make_call1 S.script ctxt block contract () ()
+
+let script_opt ctxt block contract =
+  RPC_context.make_opt_call1 S.script ctxt block contract () ()
+
+let storage ctxt block contract =
+  RPC_context.make_call1 S.storage ctxt block contract () ()
+
+let storage_opt ctxt block contract =
+  RPC_context.make_opt_call1 S.storage ctxt block contract () ()
+
+let big_map_get_opt ctxt block contract key =
+  RPC_context.make_call1 S.big_map_get ctxt block contract () key
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.mli
new file mode 100644
index 000000000..0682c387b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_services.mli
@@ -0,0 +1,86 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+val list:
+  'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
+
+type info = {
+  manager: public_key_hash ;
+  balance: Tez.t ;
+  spendable: bool ;
+  delegate: bool * public_key_hash option ;
+  counter: counter ;
+  script: Script.t option ;
+}
+
+val info_encoding: info Data_encoding.t
+
+val info:
+  'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t
+
+val balance:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t
+
+val manager:
+  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
+
+val manager_key:
+  'a #RPC_context.simple -> 'a -> Contract.t -> (public_key_hash * public_key option) shell_tzresult Lwt.t
+
+val delegate:
+  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
+
+val delegate_opt:
+  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t
+
+val is_delegatable:
+  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
+
+val is_spendable:
+  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t
+
+val counter:
+  'a #RPC_context.simple -> 'a -> Contract.t -> counter shell_tzresult Lwt.t
+
+val script:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t
+
+val script_opt:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t option shell_tzresult Lwt.t
+
+val storage:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t
+
+val storage_opt:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t
+
+val big_map_get_opt:
+  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr * Script.expr ->
+  Script.expr option shell_tzresult Lwt.t
+
+
+val register: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.ml
new file mode 100644
index 000000000..64b672004
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.ml
@@ -0,0 +1,539 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error +=
+  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
+  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)
+  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)
+  | Unspendable_contract of Contract_repr.contract (* `Permanent *)
+  | Non_existing_contract of Contract_repr.contract (* `Temporary *)
+  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)
+  | Empty_transaction of Contract_repr.t (* `Temporary *)
+  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)
+  | Failure of string (* `Permanent *)
+  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
+  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"contract.unspendable_contract"
+    ~title:"Unspendable contract"
+    ~description:"An operation tried to spend tokens from an unspendable contract"
+    ~pp:(fun ppf c ->
+        Format.fprintf ppf "The tokens of contract %a can only be spent by its script"
+          Contract_repr.pp c)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Unspendable_contract c   -> Some c | _ -> None)
+    (fun c -> Unspendable_contract c) ;
+  register_error_kind
+    `Temporary
+    ~id:"contract.balance_too_low"
+    ~title:"Balance too low"
+    ~description:"An operation tried to spend more tokens than the contract has"
+    ~pp:(fun ppf (c, b, a) ->
+        Format.fprintf ppf "Balance of contract %a too low (%a) to spend %a"
+          Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)
+    Data_encoding.(obj3
+                     (req "contract" Contract_repr.encoding)
+                     (req "balance" Tez_repr.encoding)
+                     (req "amount" Tez_repr.encoding))
+    (function Balance_too_low (c, b, a)   -> Some (c, b, a) | _ -> None)
+    (fun (c, b, a) -> Balance_too_low (c, b, a)) ;
+  register_error_kind
+    `Temporary
+    ~id:"contract.counter_in_the_future"
+    ~title:"Invalid counter (not yet reached) in a manager operation"
+    ~description:"An operation assumed a contract counter in the future"
+    ~pp:(fun ppf (contract, exp, found) ->
+        Format.fprintf ppf
+          "Counter %s not yet reached for contract %a (expected %s)"
+          (Z.to_string found)
+          Contract_repr.pp contract
+          (Z.to_string exp))
+    Data_encoding.
+      (obj3
+         (req "contract" Contract_repr.encoding)
+         (req "expected" z)
+         (req "found" z))
+    (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)
+    (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;
+  register_error_kind
+    `Branch
+    ~id:"contract.counter_in_the_past"
+    ~title:"Invalid counter (already used) in a manager operation"
+    ~description:"An operation assumed a contract counter in the past"
+    ~pp:(fun ppf (contract, exp, found) ->
+        Format.fprintf ppf
+          "Counter %s already used for contract %a (expected %s)"
+          (Z.to_string found)
+          Contract_repr.pp contract
+          (Z.to_string exp))
+    Data_encoding.
+      (obj3
+         (req "contract" Contract_repr.encoding)
+         (req "expected" z)
+         (req "found" z))
+    (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
+    (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;
+  register_error_kind
+    `Temporary
+    ~id:"contract.non_existing_contract"
+    ~title:"Non existing contract"
+    ~description:"A contract handle is not present in the context \
+                  (either it never was or it has been destroyed)"
+    ~pp:(fun ppf contract ->
+        Format.fprintf ppf "Contract %a does not exist"
+          Contract_repr.pp contract)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Non_existing_contract c -> Some c | _ -> None)
+    (fun c -> Non_existing_contract c) ;
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.inconsistent_hash"
+    ~title:"Inconsistent public key hash"
+    ~description:"A revealed manager public key is inconsistent with the announced hash"
+    ~pp:(fun ppf (k, eh, ph) ->
+        Format.fprintf ppf "The hash of the manager public key %s is not %a as announced but %a"
+          (Signature.Public_key.to_b58check k)
+          Signature.Public_key_hash.pp ph
+          Signature.Public_key_hash.pp eh)
+    Data_encoding.(obj3
+                     (req "public_key" Signature.Public_key.encoding)
+                     (req "expected_hash" Signature.Public_key_hash.encoding)
+                     (req "provided_hash" Signature.Public_key_hash.encoding))
+    (function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)
+    (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.inconsistent_public_key"
+    ~title:"Inconsistent public key"
+    ~description:"A provided manager public key is different with the public key stored in the contract"
+    ~pp:(fun ppf (eh, ph) ->
+        Format.fprintf ppf "Expected manager public key %s but %s was provided"
+          (Signature.Public_key.to_b58check ph)
+          (Signature.Public_key.to_b58check eh))
+    Data_encoding.(obj2
+                     (req "public_key" Signature.Public_key.encoding)
+                     (req "expected_public_key" Signature.Public_key.encoding))
+    (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
+    (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;
+  register_error_kind
+    `Permanent
+    ~id:"contract.failure"
+    ~title:"Contract storage failure"
+    ~description:"Unexpected contract storage error"
+    ~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
+    Data_encoding.(obj1 (req "message" string))
+    (function Failure s -> Some s | _ -> None)
+    (fun s -> Failure s) ;
+  register_error_kind
+    `Branch
+    ~id:"contract.unrevealed_key"
+    ~title:"Manager operation precedes key revelation"
+    ~description:
+      "One tried to apply a manager operation \
+       without revealing the manager public key"
+    ~pp:(fun ppf s ->
+        Format.fprintf ppf "Unrevealed manager key for contract %a."
+          Contract_repr.pp s)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Unrevealed_manager_key s -> Some s | _ -> None)
+    (fun s -> Unrevealed_manager_key s) ;
+  register_error_kind
+    `Branch
+    ~id:"contract.previously_revealed_key"
+    ~title:"Manager operation already revealed"
+    ~description:
+      "One tried to revealed twice a manager public key"
+    ~pp:(fun ppf s ->
+        Format.fprintf ppf "Previously revealed manager key for contract %a."
+          Contract_repr.pp s)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Previously_revealed_key s -> Some s | _ -> None)
+    (fun s -> Previously_revealed_key s) ;
+  register_error_kind
+    `Branch
+    ~id:"implicit.empty_implicit_contract"
+    ~title:"Empty implicit contract"
+    ~description:"No manager operations are allowed on an empty implicit contract."
+    ~pp:(fun ppf implicit ->
+        Format.fprintf ppf
+          "Empty implicit contract (%a)"
+          Signature.Public_key_hash.pp implicit)
+    Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
+    (function Empty_implicit_contract c -> Some c | _ -> None)
+    (fun c -> Empty_implicit_contract c) ;
+  register_error_kind
+    `Branch
+    ~id:"contract.empty_transaction"
+    ~title:"Empty transaction"
+    ~description:"Forbidden to credit 0ꜩ to a contract without code."
+    ~pp:(fun ppf contract ->
+        Format.fprintf ppf
+          "Transaction of 0ꜩ towards a contract without code are forbidden (%a)."
+          Contract_repr.pp contract)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Empty_transaction c -> Some c | _ -> None)
+    (fun c -> Empty_transaction c)
+
+let failwith msg = fail (Failure msg)
+
+type big_map_diff_item = {
+  diff_key : Script_repr.expr;
+  diff_key_hash : Script_expr_hash.t;
+  diff_value : Script_repr.expr option;
+}
+type big_map_diff = big_map_diff_item list
+
+let big_map_diff_item_encoding =
+  let open Data_encoding in
+  conv
+    (fun { diff_key_hash ; diff_key ; diff_value } -> (diff_key_hash, diff_key, diff_value))
+    (fun (diff_key_hash, diff_key, diff_value) -> { diff_key_hash ; diff_key ; diff_value })
+    (obj3
+       (req "key_hash" Script_expr_hash.encoding)
+       (req "key" Script_repr.expr_encoding)
+       (opt "value" Script_repr.expr_encoding))
+
+let big_map_diff_encoding =
+  let open Data_encoding in
+  def "contract.big_map_diff" @@
+  list big_map_diff_item_encoding
+
+let update_script_big_map c contract = function
+  | None -> return (c, Z.zero)
+  | Some diff ->
+      fold_left_s (fun (c, total) diff_item ->
+          match diff_item.diff_value with
+          | None ->
+              Storage.Contract.Big_map.remove (c, contract) diff_item.diff_key_hash
+              >>=? fun (c, freed) ->
+              return (c, Z.sub total (Z.of_int freed))
+          | Some v ->
+              Storage.Contract.Big_map.init_set (c, contract) diff_item.diff_key_hash v
+              >>=? fun (c, size_diff) ->
+              return (c, Z.add total (Z.of_int size_diff)))
+        (c, Z.zero) diff
+
+let create_base c
+    ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)
+    contract
+    ~balance ~manager ~delegate ?script ~spendable ~delegatable =
+  (match Contract_repr.is_implicit contract with
+   | None -> return Z.zero
+   | Some _ -> Storage.Contract.Global_counter.get c) >>=? fun counter ->
+  Storage.Contract.Balance.init c contract balance >>=? fun c ->
+  Storage.Contract.Manager.init c contract (Manager_repr.Hash manager) >>=? fun c ->
+  begin
+    match delegate with
+    | None -> return c
+    | Some delegate ->
+        Delegate_storage.init c contract delegate
+  end >>=? fun c ->
+  Storage.Contract.Spendable.set c contract spendable >>= fun c ->
+  Storage.Contract.Delegatable.set c contract delegatable >>= fun c ->
+  Storage.Contract.Counter.init c contract counter >>=? fun c ->
+  (match script with
+   | Some ({ Script_repr.code ; storage }, big_map_diff) ->
+       Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
+       Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->
+       update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size) ->
+       let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
+       assert Compare.Z.(total_size >= Z.zero) ;
+       let prepaid_bootstrap_storage =
+         if prepaid_bootstrap_storage then
+           total_size
+         else
+           Z.zero
+       in
+       Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->
+       Storage.Contract.Used_storage_space.init c contract total_size
+   | None -> begin
+       match Contract_repr.is_implicit contract with
+       | None ->
+           Storage.Contract.Paid_storage_space.init c contract Z.zero >>=? fun c ->
+           Storage.Contract.Used_storage_space.init c contract Z.zero
+       | Some _ ->
+           return c
+     end >>=? fun c ->
+       return c) >>=? fun c ->
+  return c
+
+let originate c ?prepaid_bootstrap_storage contract
+    ~balance ~manager ?script ~delegate ~spendable ~delegatable =
+  create_base c ?prepaid_bootstrap_storage contract ~balance ~manager
+    ~delegate ?script ~spendable ~delegatable
+
+let create_implicit c manager ~balance =
+  create_base c (Contract_repr.implicit_contract manager)
+    ~balance ~manager ?script:None ~delegate:None
+    ~spendable:true ~delegatable:false
+
+let delete c contract =
+  match Contract_repr.is_implicit contract with
+  | None ->
+      (* For non implicit contract Big_map should be cleared *)
+      failwith "Non implicit contracts cannot be removed"
+  | Some _ ->
+      Delegate_storage.remove c contract >>=? fun c ->
+      Storage.Contract.Balance.delete c contract >>=? fun c ->
+      Storage.Contract.Manager.delete c contract >>=? fun c ->
+      Storage.Contract.Spendable.del c contract >>= fun c ->
+      Storage.Contract.Delegatable.del c contract >>= fun c ->
+      Storage.Contract.Counter.delete c contract >>=? fun c ->
+      Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
+      Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
+      Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
+      Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
+      return c
+
+let allocated c contract =
+  Storage.Contract.Counter.get_option c contract >>=? function
+  | None -> return_false
+  | Some _ -> return_true
+
+let exists c contract =
+  match Contract_repr.is_implicit contract with
+  | Some _ -> return_true
+  | None -> allocated c contract
+
+let must_exist c contract =
+  exists c contract >>=? function
+  | true -> return_unit
+  | false -> fail (Non_existing_contract contract)
+
+let must_be_allocated c contract =
+  allocated c contract >>=? function
+  | true -> return_unit
+  | false ->
+      match Contract_repr.is_implicit contract with
+      | Some pkh -> fail (Empty_implicit_contract pkh)
+      | None -> fail (Non_existing_contract contract)
+
+let list c = Storage.Contract.list c
+
+let fresh_contract_from_current_nonce c =
+  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
+  return (c, Contract_repr.originated_contract nonce)
+
+let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =
+  Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since ->
+  Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->
+  filter_map_s
+    (fun contract -> exists ctxt_until contract >>=? function
+       | true -> return_some contract
+       | false -> return_none)
+    (Contract_repr.originated_contracts ~since ~until)
+
+let check_counter_increment c contract counter =
+  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
+  let expected = Z.succ contract_counter in
+  if Compare.Z.(expected = counter)
+  then return_unit
+  else if Compare.Z.(expected > counter) then
+    fail (Counter_in_the_past (contract, expected, counter))
+  else
+    fail (Counter_in_the_future (contract, expected, counter))
+
+let increment_counter c contract =
+  Storage.Contract.Global_counter.get c >>=? fun global_counter ->
+  Storage.Contract.Global_counter.set c (Z.succ global_counter) >>=? fun c ->
+  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
+  Storage.Contract.Counter.set c contract (Z.succ contract_counter)
+
+let get_script c contract =
+  Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
+  Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) ->
+  match code, storage with
+  | None, None -> return (c, None)
+  | Some code, Some storage -> return (c, Some { Script_repr.code ; storage })
+  | None, Some _ | Some _, None -> failwith "get_script"
+
+let get_storage ctxt contract =
+  Storage.Contract.Storage.get_option ctxt contract >>=? function
+  | (ctxt, None) -> return (ctxt, None)
+  | (ctxt, Some storage) ->
+      Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) ->
+      Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->
+      return (ctxt, Some storage)
+
+let get_counter c contract =
+  Storage.Contract.Counter.get_option c contract >>=? function
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | Some _ -> Storage.Contract.Global_counter.get c
+      | None -> failwith "get_counter"
+    end
+  | Some v -> return v
+
+let get_manager c contract =
+  Storage.Contract.Manager.get_option c contract >>=? function
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | Some manager -> return manager
+      | None -> failwith "get_manager"
+    end
+  | Some (Manager_repr.Hash v) -> return v
+  | Some (Manager_repr.Public_key v) -> return (Signature.Public_key.hash v)
+
+let get_manager_key c contract =
+  Storage.Contract.Manager.get_option c contract >>=? function
+  | None -> failwith "get_manager_key"
+  | Some (Manager_repr.Hash _) -> fail (Unrevealed_manager_key contract)
+  | Some (Manager_repr.Public_key v) -> return v
+
+let is_manager_key_revealed c contract =
+  Storage.Contract.Manager.get_option c contract >>=? function
+  | None -> return_false
+  | Some (Manager_repr.Hash _) -> return_false
+  | Some (Manager_repr.Public_key _) -> return_true
+
+let reveal_manager_key c contract public_key =
+  Storage.Contract.Manager.get c contract >>=? function
+  | Public_key _ -> fail (Previously_revealed_key contract)
+  | Hash v ->
+      let actual_hash = Signature.Public_key.hash public_key in
+      if (Signature.Public_key_hash.equal actual_hash v) then
+        let v = (Manager_repr.Public_key public_key) in
+        Storage.Contract.Manager.set c contract v >>=? fun c ->
+        return c
+      else fail (Inconsistent_hash (public_key,v,actual_hash))
+
+let get_balance c contract =
+  Storage.Contract.Balance.get_option c contract >>=? function
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | Some _ -> return Tez_repr.zero
+      | None -> failwith "get_balance"
+    end
+  | Some v -> return v
+
+let is_delegatable = Delegate_storage.is_delegatable
+let is_spendable c contract =
+  match Contract_repr.is_implicit contract with
+  | Some _ -> return_true
+  | None ->
+      Storage.Contract.Spendable.mem c contract >>= return
+
+let update_script_storage c contract storage big_map_diff =
+  let storage = Script_repr.lazy_expr storage in
+  update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size_diff) ->
+  Storage.Contract.Storage.set c contract storage >>=? fun (c, size_diff) ->
+  Storage.Contract.Used_storage_space.get c contract >>=? fun previous_size ->
+  let new_size = Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) in
+  Storage.Contract.Used_storage_space.set c contract new_size
+
+let spend_from_script c contract amount =
+  Storage.Contract.Balance.get c contract >>=? fun balance ->
+  match Tez_repr.(balance -? amount) with
+  | Error _ ->
+      fail (Balance_too_low (contract, balance, amount))
+  | Ok new_balance ->
+      Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
+      Roll_storage.Contract.remove_amount c contract amount >>=? fun c ->
+      if Tez_repr.(new_balance > Tez_repr.zero) then
+        return c
+      else match Contract_repr.is_implicit contract with
+        | None -> return c (* Never delete originated contracts *)
+        | Some pkh ->
+            Delegate_storage.get c contract >>=? function
+            | Some pkh' ->
+                (* Don't delete "delegate" contract *)
+                assert (Signature.Public_key_hash.equal pkh pkh') ;
+                return c
+            | None ->
+                (* Delete empty implicit contract *)
+                delete c contract
+
+let credit c contract amount =
+  begin
+    if Tez_repr.(amount <> Tez_repr.zero) then
+      return c
+    else
+      Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->
+      fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->
+      return c
+  end >>=? fun c ->
+  Storage.Contract.Balance.get_option c contract >>=? function
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | None -> fail (Non_existing_contract contract)
+      | Some manager ->
+          create_implicit c manager ~balance:amount
+    end
+  | Some balance ->
+      Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->
+      Storage.Contract.Balance.set c contract balance >>=? fun c ->
+      Roll_storage.Contract.add_amount c contract amount >>=? fun c ->
+      begin
+        match contract with
+        | Implicit delegate ->
+            Delegate_storage.registered c delegate >>= fun registered ->
+            if registered then
+              Roll_storage.Delegate.set_active c delegate >>=? fun c ->
+              return c
+            else
+              return c
+        | Originated _ ->
+            return c
+      end >>=? fun c ->
+      return c
+
+let spend c contract amount =
+  is_spendable c contract >>=? fun spendable ->
+  if not spendable
+  then fail (Unspendable_contract contract)
+  else spend_from_script c contract amount
+
+let init c =
+  Storage.Contract.Global_counter.init c Z.zero
+
+let used_storage_space c contract =
+  Storage.Contract.Used_storage_space.get_option c contract >>=? function
+  | None -> return Z.zero
+  | Some fees -> return fees
+
+let paid_storage_space c contract =
+  Storage.Contract.Paid_storage_space.get_option c contract >>=? function
+  | None -> return Z.zero
+  | Some paid_space -> return paid_space
+
+let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =
+  Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_space ->
+  if Compare.Z.(already_paid_space >= new_storage_space) then
+    return (Z.zero, c)
+  else
+    let to_pay = Z.sub new_storage_space already_paid_space in
+    Storage.Contract.Paid_storage_space.set c contract new_storage_space >>=? fun c ->
+    return (to_pay, c)
+
+module Big_map = struct
+  let mem ctxt contract key =
+    Storage.Contract.Big_map.mem (ctxt, contract) key
+  let get_opt ctxt contract key =
+    Storage.Contract.Big_map.get_option (ctxt, contract) key
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.mli
new file mode 100644
index 000000000..00ab16462
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/contract_storage.mli
@@ -0,0 +1,140 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error +=
+  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
+  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)
+  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)
+  | Unspendable_contract of Contract_repr.contract (* `Permanent *)
+  | Non_existing_contract of Contract_repr.contract (* `Temporary *)
+  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)
+  | Empty_transaction of Contract_repr.t (* `Temporary *)
+  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)
+  | Failure of string (* `Permanent *)
+  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
+  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)
+
+val exists: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+val must_exist: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
+
+val allocated: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+val must_be_allocated: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
+
+
+val list: Raw_context.t -> Contract_repr.t list Lwt.t
+
+val check_counter_increment:
+  Raw_context.t -> Contract_repr.t -> Z.t -> unit tzresult Lwt.t
+
+val increment_counter:
+  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+
+val is_delegatable:
+  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
+val is_spendable: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
+val get_manager:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t tzresult Lwt.t
+
+val get_manager_key:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t tzresult Lwt.t
+val is_manager_key_revealed:
+  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
+val reveal_manager_key:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t  ->
+  Raw_context.t tzresult Lwt.t
+
+val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
+val get_counter: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+
+val get_script:
+  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
+val get_storage:
+  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
+
+
+type big_map_diff_item = {
+  diff_key : Script_repr.expr;
+  diff_key_hash : Script_expr_hash.t;
+  diff_value : Script_repr.expr option;
+}
+type big_map_diff = big_map_diff_item list
+
+val big_map_diff_encoding : big_map_diff Data_encoding.t
+
+val update_script_storage:
+  Raw_context.t -> Contract_repr.t ->
+  Script_repr.expr -> big_map_diff option ->
+  Raw_context.t tzresult Lwt.t
+
+val credit:
+  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+(** checks that the contract is spendable and decrease_balance *)
+val spend:
+  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+(** decrease_balance even if the contract is not spendable *)
+val spend_from_script:
+  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+val originate:
+  Raw_context.t ->
+  ?prepaid_bootstrap_storage:bool ->
+  Contract_repr.t ->
+  balance:Tez_repr.t ->
+  manager:Signature.Public_key_hash.t ->
+  ?script:(Script_repr.t * big_map_diff option) ->
+  delegate:Signature.Public_key_hash.t option ->
+  spendable:bool ->
+  delegatable:bool ->
+  Raw_context.t tzresult Lwt.t
+
+val fresh_contract_from_current_nonce :
+  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t
+val originated_from_current_nonce :
+  since: Raw_context.t ->
+  until: Raw_context.t ->
+  Contract_repr.t list tzresult Lwt.t
+
+val init:
+  Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+val set_paid_storage_space_and_return_fees_to_pay: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
+
+module Big_map : sig
+  val mem :
+    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * bool) tzresult Lwt.t
+  val get_opt :
+    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.ml
new file mode 100644
index 000000000..5c24319e8
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.ml
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = int32
+type cycle = t
+
+let encoding = Data_encoding.int32
+let rpc_arg =
+  let construct = Int32.to_string in
+  let destruct str =
+    match Int32.of_string str with
+    | exception _ -> Error "Cannot parse cycle"
+    | cycle -> Ok cycle in
+  RPC_arg.make
+    ~descr:"A cycle integer"
+    ~name: "block_cycle"
+    ~construct
+    ~destruct
+    ()
+
+let pp ppf cycle = Format.fprintf ppf "%ld" cycle
+
+include (Compare.Int32 : Compare.S with type t := t)
+
+module Map = Map.Make(Compare.Int32)
+
+let root = 0l
+let succ = Int32.succ
+let pred = function
+  | 0l -> None
+  | i -> Some (Int32.pred i)
+
+let add c i =
+  assert Compare.Int.(i > 0) ;
+  Int32.add c (Int32.of_int i)
+
+let sub c i =
+  assert Compare.Int.(i > 0) ;
+  let r = Int32.sub c (Int32.of_int i) in
+  if Compare.Int32.(r < 0l) then None else Some r
+
+let to_int32 i = i
+
+let of_int32_exn l =
+  if Compare.Int32.(l >= 0l)
+  then l
+  else invalid_arg "Level_repr.Cycle.of_int32"
+
+module Index = struct
+  type t = cycle
+  let path_length = 1
+  let to_path c l =
+    Int32.to_string (to_int32 c) :: l
+  let of_path = function
+    | [s] -> begin
+        try Some (Int32.of_string s)
+        with _ -> None
+      end
+    | _ -> None
+  let rpc_arg = rpc_arg
+  let encoding = encoding
+  let compare = compare
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.mli
new file mode 100644
index 000000000..c3502f665
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/cycle_repr.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+type cycle = t
+include Compare.S with type t := t
+val encoding: cycle Data_encoding.t
+val rpc_arg: cycle RPC_arg.arg
+val pp: Format.formatter -> cycle -> unit
+
+val root: cycle
+val pred: cycle -> cycle option
+val add: cycle -> int -> cycle
+val sub: cycle -> int -> cycle option
+val succ: cycle -> cycle
+
+val to_int32: cycle -> int32
+val of_int32_exn: int32 -> cycle
+
+module Map : S.MAP with type key = cycle
+
+module Index : Storage_description.INDEX with type t = cycle
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.ml
new file mode 100644
index 000000000..1f01c3cef
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.ml
@@ -0,0 +1,553 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+type info = {
+  balance: Tez.t ;
+  frozen_balance: Tez.t ;
+  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+  staking_balance: Tez.t ;
+  delegated_contracts: Contract_hash.t list ;
+  delegated_balance: Tez.t ;
+  deactivated: bool ;
+  grace_period: Cycle.t ;
+}
+
+let info_encoding =
+  let open Data_encoding in
+  conv
+    (fun { balance ; frozen_balance ; frozen_balance_by_cycle ;
+           staking_balance ; delegated_contracts ;  delegated_balance ;
+           deactivated ; grace_period } ->
+      (balance, frozen_balance, frozen_balance_by_cycle,
+       staking_balance, delegated_contracts, delegated_balance,
+       deactivated, grace_period))
+    (fun (balance, frozen_balance, frozen_balance_by_cycle,
+          staking_balance, delegated_contracts, delegated_balance,
+          deactivated, grace_period) ->
+      { balance ; frozen_balance ; frozen_balance_by_cycle ;
+        staking_balance ; delegated_contracts ;  delegated_balance ;
+        deactivated ; grace_period })
+    (obj8
+       (req "balance" Tez.encoding)
+       (req "frozen_balance" Tez.encoding)
+       (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding)
+       (req "staking_balance" Tez.encoding)
+       (req "delegated_contracts" (list Contract_hash.encoding))
+       (req "delegated_balance" Tez.encoding)
+       (req "deactivated" bool)
+       (req "grace_period" Cycle.encoding))
+
+module S = struct
+
+  let path = RPC_path.(open_root / "context" / "delegates")
+
+  open Data_encoding
+
+  type list_query = {
+    active: bool ;
+    inactive: bool ;
+  }
+  let list_query :list_query RPC_query.t =
+    let open RPC_query in
+    query (fun active inactive -> { active ; inactive })
+    |+ flag "active" (fun t -> t.active)
+    |+ flag "inactive" (fun t -> t.inactive)
+    |> seal
+
+  let list_delegate =
+    RPC_service.get_service
+      ~description:
+        "Lists all registered delegates."
+      ~query: list_query
+      ~output: (list Signature.Public_key_hash.encoding)
+      path
+
+  let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg)
+
+  let info =
+    RPC_service.get_service
+      ~description:
+        "Everything about a delegate."
+      ~query: RPC_query.empty
+      ~output: info_encoding
+      path
+
+  let balance =
+    RPC_service.get_service
+      ~description:
+        "Returns the full balance of a given delegate, \
+         including the frozen balances."
+      ~query: RPC_query.empty
+      ~output: Tez.encoding
+      RPC_path.(path / "balance")
+
+  let frozen_balance =
+    RPC_service.get_service
+      ~description:
+        "Returns the total frozen balances of a given delegate, \
+         this includes the frozen deposits, rewards and fees."
+      ~query: RPC_query.empty
+      ~output: Tez.encoding
+      RPC_path.(path / "frozen_balance")
+
+  let frozen_balance_by_cycle =
+    RPC_service.get_service
+      ~description:
+        "Returns the frozen balances of a given delegate, \
+         indexed by the cycle by which it will be unfrozen"
+      ~query: RPC_query.empty
+      ~output: Delegate.frozen_balance_by_cycle_encoding
+      RPC_path.(path / "frozen_balance_by_cycle")
+
+  let staking_balance =
+    RPC_service.get_service
+      ~description:
+        "Returns the total amount of tokens delegated to a given delegate. \
+         This includes the balances of all the contracts that delegate \
+         to it, but also the balance of the delegate itself and its frozen \
+         fees and deposits. The rewards do not count in the delegated balance \
+         until they are unfrozen."
+      ~query: RPC_query.empty
+      ~output: Tez.encoding
+      RPC_path.(path / "staking_balance")
+
+  let delegated_contracts =
+    RPC_service.get_service
+      ~description:
+        "Returns the list of contracts that delegate to a given delegate."
+      ~query: RPC_query.empty
+      ~output: (list Contract_hash.encoding)
+      RPC_path.(path / "delegated_contracts")
+
+  let delegated_balance =
+    RPC_service.get_service
+      ~description:
+        "Returns the balances of all the contracts that delegate to a \
+         given delegate. This excludes the delegate's own balance and \
+         its frozen balances."
+      ~query: RPC_query.empty
+      ~output: Tez.encoding
+      RPC_path.(path / "delegated_balance")
+
+  let deactivated =
+    RPC_service.get_service
+      ~description:
+        "Tells whether the delegate is currently tagged as deactivated or not."
+      ~query: RPC_query.empty
+      ~output: bool
+      RPC_path.(path / "deactivated")
+
+  let grace_period =
+    RPC_service.get_service
+      ~description:
+        "Returns the cycle by the end of which the delegate might be \
+         deactivated if she fails to execute any delegate action. \
+         A deactivated delegate might be reactivated \
+         (without loosing any rolls) by simply re-registering as a delegate. \
+         For deactivated delegates, this value contains the cycle by which \
+         they were deactivated."
+      ~query: RPC_query.empty
+      ~output: Cycle.encoding
+      RPC_path.(path / "grace_period")
+
+end
+
+let register () =
+  let open Services_registration in
+  register0 S.list_delegate begin fun ctxt q () ->
+    Delegate.list ctxt >>= fun delegates ->
+    if q.active && q.inactive then
+      return delegates
+    else if q.active then
+      filter_map_s
+        (fun pkh ->
+           Delegate.deactivated ctxt pkh >>=? function
+           | true -> return_none
+           | false -> return_some pkh)
+        delegates
+    else if q.inactive then
+      filter_map_s
+        (fun pkh ->
+           Delegate.deactivated ctxt pkh >>=? function
+           | false -> return_none
+           | true -> return_some pkh)
+        delegates
+    else
+      return_nil
+  end ;
+  register1 S.info begin fun ctxt pkh () () ->
+    Delegate.full_balance ctxt pkh >>=? fun balance ->
+    Delegate.frozen_balance ctxt pkh >>=? fun frozen_balance ->
+    Delegate.frozen_balance_by_cycle ctxt pkh >>= fun frozen_balance_by_cycle ->
+    Delegate.staking_balance ctxt pkh >>=? fun staking_balance ->
+    Delegate.delegated_contracts ctxt pkh >>= fun delegated_contracts ->
+    Delegate.delegated_balance ctxt pkh >>=? fun delegated_balance ->
+    Delegate.deactivated ctxt pkh >>=? fun deactivated ->
+    Delegate.grace_period ctxt pkh >>=? fun grace_period ->
+    return {
+      balance ; frozen_balance ; frozen_balance_by_cycle ;
+      staking_balance ; delegated_contracts ; delegated_balance ;
+      deactivated ; grace_period
+    }
+  end ;
+  register1 S.balance begin fun ctxt pkh () () ->
+    Delegate.full_balance ctxt pkh
+  end ;
+  register1 S.frozen_balance begin fun ctxt pkh () () ->
+    Delegate.frozen_balance ctxt pkh
+  end ;
+  register1 S.frozen_balance_by_cycle begin fun ctxt pkh () () ->
+    Delegate.frozen_balance_by_cycle ctxt pkh >>= return
+  end ;
+  register1 S.staking_balance begin fun ctxt pkh () () ->
+    Delegate.staking_balance ctxt pkh
+  end ;
+  register1 S.delegated_contracts begin fun ctxt pkh () () ->
+    Delegate.delegated_contracts ctxt pkh >>= return
+  end ;
+  register1 S.delegated_balance begin fun ctxt pkh () () ->
+    Delegate.delegated_balance ctxt pkh
+  end ;
+  register1 S.deactivated begin fun ctxt pkh () () ->
+    Delegate.deactivated ctxt pkh
+  end ;
+  register1 S.grace_period begin fun ctxt pkh () () ->
+    Delegate.grace_period ctxt pkh
+  end
+
+let list ctxt block ?(active = true) ?(inactive = false) () =
+  RPC_context.make_call0 S.list_delegate ctxt block { active ; inactive } ()
+
+let info ctxt block pkh =
+  RPC_context.make_call1 S.info ctxt block pkh () ()
+
+let balance ctxt block pkh =
+  RPC_context.make_call1 S.balance ctxt block pkh () ()
+
+let frozen_balance ctxt block pkh =
+  RPC_context.make_call1 S.frozen_balance ctxt block pkh () ()
+
+let frozen_balance_by_cycle ctxt block pkh =
+  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () ()
+
+let staking_balance ctxt block pkh =
+  RPC_context.make_call1 S.staking_balance ctxt block pkh () ()
+
+let delegated_contracts ctxt block pkh =
+  RPC_context.make_call1 S.delegated_contracts ctxt block pkh () ()
+
+let delegated_balance ctxt block pkh =
+  RPC_context.make_call1 S.delegated_balance ctxt block pkh () ()
+
+let deactivated ctxt block pkh =
+  RPC_context.make_call1 S.deactivated ctxt block pkh () ()
+
+let grace_period ctxt block pkh =
+  RPC_context.make_call1 S.grace_period ctxt block pkh () ()
+
+let requested_levels ~default ctxt cycles levels =
+  match levels, cycles with
+  | [], [] ->
+      return [default]
+  | levels, cycles ->
+      (* explicitly fail when requested levels or cycle are in the past...
+         or too far in the future... *)
+      let levels =
+        List.sort_uniq
+          Level.compare
+          (List.concat (List.map (Level.from_raw ctxt) levels ::
+                        List.map (Level.levels_in_cycle ctxt) cycles)) in
+      map_p
+        (fun level ->
+           let current_level = Level.current ctxt in
+           if Level.(level <= current_level) then
+             return (level, None)
+           else
+             Baking.earlier_predecessor_timestamp
+               ctxt level >>=? fun timestamp ->
+             return (level, Some timestamp))
+        levels
+
+module Baking_rights = struct
+
+  type t = {
+    level: Raw_level.t ;
+    delegate: Signature.Public_key_hash.t ;
+    priority: int ;
+    timestamp: Timestamp.t option ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { level ; delegate ; priority ; timestamp } ->
+         (level, delegate, priority, timestamp))
+      (fun (level, delegate, priority, timestamp) ->
+         { level ; delegate ; priority ; timestamp })
+      (obj4
+         (req "level" Raw_level.encoding)
+         (req "delegate" Signature.Public_key_hash.encoding)
+         (req "priority" uint16)
+         (opt "estimated_time" Timestamp.encoding))
+
+  module S = struct
+
+    open Data_encoding
+
+    let custom_root =
+      RPC_path.(open_root / "helpers" / "baking_rights")
+
+    type baking_rights_query = {
+      levels: Raw_level.t list ;
+      cycles: Cycle.t list ;
+      delegates: Signature.Public_key_hash.t list ;
+      max_priority: int option ;
+      all: bool ;
+    }
+
+    let baking_rights_query =
+      let open RPC_query in
+      query (fun levels cycles delegates max_priority all ->
+          { levels ; cycles ; delegates ; max_priority ; all })
+      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
+      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
+      |+ flag "all" (fun t -> t.all)
+      |> seal
+
+    let baking_rights =
+      RPC_service.get_service
+        ~description:
+          "Retrieves the list of delegates allowed to bake a block.\n\
+           By default, it gives the best baking priorities for bakers \
+           that have at least one opportunity below the 64th priority \
+           for the next block.\n\
+           Parameters `level` and `cycle` can be used to specify the \
+           (valid) level(s) in the past or future at which the baking \
+           rights have to be returned. Parameter `delegate` can be \
+           used to restrict the results to the given delegates. If \
+           parameter `all` is set, all the baking opportunities for \
+           each baker at each level are returned, instead of just the \
+           first one.\n\
+           Returns the list of baking slots. Also returns the minimal \
+           timestamps that correspond to these slots. The timestamps \
+           are omitted for levels in the past, and are only estimates \
+           for levels later that the next block, based on the \
+           hypothesis that all predecessor blocks were baked at the \
+           first priority."
+        ~query: baking_rights_query
+        ~output: (list encoding)
+        custom_root
+
+  end
+
+  let baking_priorities ctxt max_prio (level, pred_timestamp) =
+    Baking.baking_priorities ctxt level >>=? fun contract_list ->
+    let rec loop l acc priority =
+      if Compare.Int.(priority >= max_prio) then
+        return (List.rev acc)
+      else
+        let Misc.LCons (pk, next) = l in
+        let delegate = Signature.Public_key.hash pk in
+        begin
+          match pred_timestamp with
+          | None -> return_none
+          | Some pred_timestamp ->
+              Baking.minimal_time ctxt priority pred_timestamp >>=? fun t ->
+              return_some t
+        end>>=? fun timestamp ->
+        let acc =
+          { level = level.level ; delegate ; priority ; timestamp } :: acc in
+        next () >>=? fun l ->
+        loop l acc (priority+1) in
+    loop contract_list [] 0
+
+  let remove_duplicated_delegates rights =
+    List.rev @@ fst @@
+    List.fold_left
+      (fun (acc, previous) r ->
+         if Signature.Public_key_hash.Set.mem r.delegate previous then
+           (acc, previous)
+         else
+           (r :: acc,
+            Signature.Public_key_hash.Set.add r.delegate previous))
+      ([], Signature.Public_key_hash.Set.empty)
+      rights
+
+  let register () =
+    let open Services_registration in
+    register0 S.baking_rights begin fun ctxt q () ->
+      requested_levels
+        ~default:
+          (Level.succ ctxt (Level.current ctxt), Some (Timestamp.current ctxt))
+        ctxt q.cycles q.levels >>=? fun levels ->
+      let max_priority =
+        match q.max_priority with
+        | None -> 64
+        | Some max -> max in
+      map_p (baking_priorities ctxt max_priority) levels >>=? fun rights ->
+      let rights =
+        if q.all then
+          rights
+        else
+          List.map remove_duplicated_delegates rights in
+      let rights = List.concat rights in
+      match q.delegates with
+      | [] -> return rights
+      | _ :: _ as delegates ->
+          let is_requested p =
+            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
+          return (List.filter is_requested rights)
+    end
+
+  let get ctxt
+      ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
+      ?max_priority block =
+    RPC_context.make_call0 S.baking_rights ctxt block
+      { levels ; cycles ; delegates ; max_priority ; all }
+      ()
+
+end
+
+module Endorsing_rights = struct
+
+  type t = {
+    level: Raw_level.t ;
+    delegate: Signature.Public_key_hash.t ;
+    slots: int list ;
+    estimated_time: Time.t option ;
+  }
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { level ; delegate ; slots ; estimated_time } ->
+         (level, delegate, slots, estimated_time))
+      (fun (level, delegate, slots, estimated_time) ->
+         { level ; delegate ; slots ; estimated_time })
+      (obj4
+         (req "level" Raw_level.encoding)
+         (req "delegate" Signature.Public_key_hash.encoding)
+         (req "slots" (list uint16))
+         (opt "estimated_time" Timestamp.encoding))
+
+  module S = struct
+
+    open Data_encoding
+
+    let custom_root =
+      RPC_path.(open_root / "helpers" / "endorsing_rights")
+
+    type endorsing_rights_query = {
+      levels: Raw_level.t list ;
+      cycles: Cycle.t list ;
+      delegates: Signature.Public_key_hash.t list ;
+    }
+
+    let endorsing_rights_query =
+      let open RPC_query in
+      query (fun levels cycles delegates ->
+          { levels ; cycles ; delegates })
+      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
+      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |> seal
+
+    let endorsing_rights =
+      RPC_service.get_service
+        ~description:
+          "Retrieves the delegates allowed to endorse a block.\n\
+           By default, it gives the endorsement slots for delegates that \
+           have at least one in the next block.\n\
+           Parameters `level` and `cycle` can be used to specify the \
+           (valid) level(s) in the past or future at which the \
+           endorsement rights have to be returned. Parameter \
+           `delegate` can be used to restrict the results to the given \
+           delegates.\n\
+           Returns the list of endorsement slots. Also returns the \
+           minimal timestamps that correspond to these slots. The \
+           timestamps are omitted for levels in the past, and are only \
+           estimates for levels later that the next block, based on \
+           the hypothesis that all predecessor blocks were baked at \
+           the first priority."
+        ~query: endorsing_rights_query
+        ~output: (list encoding)
+        custom_root
+
+  end
+
+  let endorsement_slots ctxt (level, estimated_time) =
+    Baking.endorsement_rights ctxt level >>=? fun rights ->
+    return
+      (Signature.Public_key_hash.Map.fold
+         (fun delegate (_, slots, _) acc -> {
+              level = level.level ; delegate ; slots ; estimated_time
+            } :: acc)
+         rights [])
+
+  let register () =
+    let open Services_registration in
+    register0 S.endorsing_rights begin fun ctxt q () ->
+      requested_levels
+        ~default: (Level.current ctxt, Some (Timestamp.current ctxt))
+        ctxt q.cycles q.levels >>=? fun levels ->
+      map_p (endorsement_slots ctxt) levels >>=? fun rights ->
+      let rights = List.concat rights in
+      match q.delegates with
+      | [] -> return rights
+      | _ :: _ as delegates ->
+          let is_requested p =
+            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
+          return (List.filter is_requested rights)
+    end
+
+  let get ctxt
+      ?(levels = []) ?(cycles = []) ?(delegates = []) block =
+    RPC_context.make_call0 S.endorsing_rights ctxt block
+      { levels ; cycles ; delegates }
+      ()
+
+end
+
+let register () =
+  register () ;
+  Baking_rights.register () ;
+  Endorsing_rights.register ()
+
+let endorsement_rights ctxt level =
+  Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l ->
+  return (List.map (fun { Endorsing_rights.delegate ; _ } -> delegate) l)
+
+let baking_rights ctxt max_priority =
+  let max = match max_priority with None -> 64 | Some m -> m in
+  let level = Level.current ctxt in
+  Baking_rights.baking_priorities ctxt max (level, None) >>=? fun l ->
+  return (level.level,
+          List.map
+            (fun { Baking_rights.delegate ; timestamp ; _ } ->
+               (delegate, timestamp)) l)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.mli
new file mode 100644
index 000000000..4061a665c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_services.mli
@@ -0,0 +1,176 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+val list:
+  'a #RPC_context.simple -> 'a ->
+  ?active:bool ->
+  ?inactive:bool ->
+  unit -> Signature.Public_key_hash.t list shell_tzresult Lwt.t
+
+type info = {
+  balance: Tez.t ;
+  frozen_balance: Tez.t ;
+  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+  staking_balance: Tez.t ;
+  delegated_contracts: Contract_hash.t list ;
+  delegated_balance: Tez.t ;
+  deactivated: bool ;
+  grace_period: Cycle.t ;
+}
+
+val info_encoding: info Data_encoding.t
+
+val info:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  info shell_tzresult Lwt.t
+
+val balance:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Tez.t shell_tzresult Lwt.t
+
+val frozen_balance:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Tez.t shell_tzresult Lwt.t
+
+val frozen_balance_by_cycle:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t
+
+val staking_balance:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Tez.t shell_tzresult Lwt.t
+
+val delegated_contracts:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Contract_hash.t list shell_tzresult Lwt.t
+
+val delegated_balance:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Tez.t shell_tzresult Lwt.t
+
+val deactivated:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  bool shell_tzresult Lwt.t
+
+val grace_period:
+  'a #RPC_context.simple -> 'a ->
+  Signature.Public_key_hash.t ->
+  Cycle.t shell_tzresult Lwt.t
+
+
+module Baking_rights : sig
+
+  type t = {
+    level: Raw_level.t ;
+    delegate: Signature.Public_key_hash.t ;
+    priority: int ;
+    timestamp: Timestamp.t option ;
+  }
+
+  (** Retrieves the list of delegates allowed to bake a block.
+
+      By default, it gives the best baking priorities for bakers
+      that have at least one opportunity below the 64th priority for
+      the next block.
+
+      Parameters [levels] and [cycles] can be used to specify the
+      (valid) level(s) in the past or future at which the baking rights
+      have to be returned. Parameter [delegates] can be used to
+      restrict the results to the given delegates. If parameter [all]
+      is [true], all the baking opportunities for each baker at each level
+      are returned, instead of just the first one.
+
+      Returns the list of baking slots. Also returns the minimal
+      timestamps that correspond to these slots. The timestamps are
+      omitted for levels in the past, and are only estimates for levels
+      later that the next block, based on the hypothesis that all
+      predecessor blocks were baked at the first priority. *)
+  val get:
+    'a #RPC_context.simple ->
+    ?levels: Raw_level.t list ->
+    ?cycles: Cycle.t list ->
+    ?delegates: Signature.public_key_hash list ->
+    ?all: bool ->
+    ?max_priority: int ->
+    'a -> t list shell_tzresult Lwt.t
+
+end
+
+module Endorsing_rights : sig
+
+  type t = {
+    level: Raw_level.t ;
+    delegate: Signature.Public_key_hash.t ;
+    slots: int list ;
+    estimated_time: Timestamp.t option ;
+  }
+
+  (** Retrieves the delegates allowed to endorse a block.
+
+      By default, it gives the endorsement slots for bakers that have
+      at least one in the next block.
+
+      Parameters [levels] and [cycles] can be used to specify the
+      (valid) level(s) in the past or future at which the endorsement
+      rights have to be returned. Parameter [delegates] can be used to
+      restrict the results to the given delegates.  Returns the list of
+      endorsement slots. Also returns the minimal timestamps that
+      correspond to these slots.
+
+      Timestamps are omitted for levels in the past, and are only
+      estimates for levels later that the next block, based on the
+      hypothesis that all predecessor blocks were baked at the first
+      priority. *)
+  val get:
+    'a #RPC_context.simple ->
+    ?levels: Raw_level.t list ->
+    ?cycles: Cycle.t list ->
+    ?delegates: Signature.public_key_hash list ->
+    'a -> t list shell_tzresult Lwt.t
+
+end
+
+(* temporary export for deprecated unit test *)
+val endorsement_rights:
+  Alpha_context.t ->
+  Level.t ->
+  public_key_hash list tzresult Lwt.t
+
+val baking_rights:
+  Alpha_context.t ->
+  int option ->
+  (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t
+
+val register: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.ml
new file mode 100644
index 000000000..f00941a48
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.ml
@@ -0,0 +1,627 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type balance =
+  | Contract of Contract_repr.t
+  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
+  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
+  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t
+
+let balance_encoding =
+  let open Data_encoding in
+  def "operation_metadata.alpha.balance" @@
+  union
+    [ case (Tag 0)
+        ~title:"Contract"
+        (obj2
+           (req "kind" (constant "contract"))
+           (req "contract" Contract_repr.encoding))
+        (function Contract c -> Some ((), c) | _ -> None )
+        (fun ((), c) -> (Contract c)) ;
+      case (Tag 1)
+        ~title:"Rewards"
+        (obj4
+           (req "kind" (constant "freezer"))
+           (req "category" (constant "rewards"))
+           (req "delegate" Signature.Public_key_hash.encoding)
+           (req "level" Cycle_repr.encoding))
+        (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
+        (fun ((), (), d, l) -> Rewards (d, l)) ;
+      case (Tag 2)
+        ~title:"Fees"
+        (obj4
+           (req "kind" (constant "freezer"))
+           (req "category" (constant "fees"))
+           (req "delegate" Signature.Public_key_hash.encoding)
+           (req "level" Cycle_repr.encoding))
+        (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
+        (fun ((), (), d, l) -> Fees (d, l)) ;
+      case (Tag 3)
+        ~title:"Deposits"
+        (obj4
+           (req "kind" (constant "freezer"))
+           (req "category" (constant "deposits"))
+           (req "delegate" Signature.Public_key_hash.encoding)
+           (req "level" Cycle_repr.encoding))
+        (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)
+        (fun ((), (), d, l) -> Deposits (d, l)) ]
+
+type balance_update =
+  | Debited of Tez_repr.t
+  | Credited of Tez_repr.t
+
+let balance_update_encoding =
+  let open Data_encoding in
+  def "operation_metadata.alpha.balance_update" @@
+  obj1
+    (req "change"
+       (conv
+          (function
+            | Credited v -> Tez_repr.to_mutez v
+            | Debited v -> Int64.neg (Tez_repr.to_mutez v))
+          (Json.wrap_error @@
+           fun v ->
+           if Compare.Int64.(v < 0L) then
+             match Tez_repr.of_mutez (Int64.neg v) with
+             | Some v -> Debited v
+             | None -> failwith "Qty.of_mutez"
+           else
+             match Tez_repr.of_mutez v with
+             | Some v -> Credited v
+             | None -> failwith "Qty.of_mutez")
+          int64))
+
+type balance_updates = (balance * balance_update) list
+
+let balance_updates_encoding =
+  let open Data_encoding in
+  def "operation_metadata.alpha.balance_updates" @@
+  list (merge_objs balance_encoding balance_update_encoding)
+
+let cleanup_balance_updates balance_updates =
+  List.filter
+    (fun (_, (Credited update | Debited update)) ->
+       not (Tez_repr.equal update Tez_repr.zero))
+    balance_updates
+
+type frozen_balance = {
+  deposit : Tez_repr.t ;
+  fees : Tez_repr.t ;
+  rewards : Tez_repr.t ;
+}
+
+let frozen_balance_encoding =
+  let open Data_encoding in
+  conv
+    (fun { deposit ; fees ; rewards } -> (deposit, fees, rewards))
+    (fun (deposit, fees, rewards) -> { deposit ; fees ; rewards })
+    (obj3
+       (req "deposit" Tez_repr.encoding)
+       (req "fees" Tez_repr.encoding)
+       (req "rewards" Tez_repr.encoding))
+
+type error +=
+  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
+  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
+  | Active_delegate (* `Temporary *)
+  | Current_delegate (* `Temporary *)
+  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
+  | Balance_too_low_for_deposit of
+      { delegate : Signature.Public_key_hash.t ;
+        deposit : Tez_repr.t ;
+        balance : Tez_repr.t } (* `Temporary *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"contract.undelegatable_contract"
+    ~title:"Non delegatable contract"
+    ~description:"Tried to delegate an implicit contract \
+                  or a non delegatable originated contract"
+    ~pp:(fun ppf contract ->
+        Format.fprintf ppf "Contract %a is not delegatable"
+          Contract_repr.pp contract)
+    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
+    (function Non_delegatable_contract c -> Some c | _ -> None)
+    (fun c -> Non_delegatable_contract c) ;
+  register_error_kind
+    `Permanent
+    ~id:"delegate.no_deletion"
+    ~title:"Forbidden delegate deletion"
+    ~description:"Tried to unregister a delegate"
+    ~pp:(fun ppf delegate ->
+        Format.fprintf ppf "Delegate deletion is forbidden (%a)"
+          Signature.Public_key_hash.pp delegate)
+    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
+    (function No_deletion c -> Some c | _ -> None)
+    (fun c -> No_deletion c) ;
+  register_error_kind
+    `Temporary
+    ~id:"delegate.already_active"
+    ~title:"Delegate already active"
+    ~description:"Useless delegate reactivation"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf
+          "The delegate is still active, no need to refresh it")
+    Data_encoding.empty
+    (function Active_delegate -> Some () | _ -> None)
+    (fun () -> Active_delegate) ;
+  register_error_kind
+    `Temporary
+    ~id:"delegate.unchanged"
+    ~title:"Unchanged delegated"
+    ~description:"Contract already delegated to the given delegate"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf
+          "The contract is already delegated to the same delegate")
+    Data_encoding.empty
+    (function Current_delegate -> Some () | _ -> None)
+    (fun () -> Current_delegate) ;
+  register_error_kind
+    `Permanent
+    ~id:"delegate.empty_delegate_account"
+    ~title:"Empty delegate account"
+    ~description:"Cannot register a delegate when its implicit account is empty"
+    ~pp:(fun ppf delegate ->
+        Format.fprintf ppf
+          "Delegate registration is forbidden when the delegate
+           implicit account is empty (%a)"
+          Signature.Public_key_hash.pp delegate)
+    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
+    (function Empty_delegate_account c -> Some c | _ -> None)
+    (fun c -> Empty_delegate_account c) ;
+  register_error_kind
+    `Temporary
+    ~id:"delegate.balance_too_low_for_deposit"
+    ~title:"Balance too low for deposit"
+    ~description:"Cannot freeze deposit when the balance is too low"
+    ~pp:(fun ppf (delegate, balance, deposit) ->
+        Format.fprintf ppf
+          "Delegate %a has a too low balance (%a) to deposit %a"
+          Signature.Public_key_hash.pp delegate
+          Tez_repr.pp balance
+          Tez_repr.pp deposit)
+    Data_encoding.
+      (obj3
+         (req "delegate" Signature.Public_key_hash.encoding)
+         (req "balance" Tez_repr.encoding)
+         (req "deposit" Tez_repr.encoding))
+    (function Balance_too_low_for_deposit { delegate ; balance ; deposit } ->
+       Some (delegate, balance, deposit) | _ -> None)
+    (fun (delegate, balance, deposit) -> Balance_too_low_for_deposit { delegate ; balance ; deposit } )
+
+let is_delegatable c contract =
+  match Contract_repr.is_implicit contract with
+  | Some _ ->
+      return_false
+  | None ->
+      Storage.Contract.Delegatable.mem c contract >>= return
+
+let link c contract delegate balance =
+  Roll_storage.Delegate.add_amount c delegate balance >>=? fun c ->
+  match Contract_repr.is_originated contract with
+  | None -> return c
+  | Some h ->
+      Storage.Contract.Delegated.add
+        (c, Contract_repr.implicit_contract delegate) h >>= fun c ->
+      return c
+
+let unlink c contract balance =
+  Storage.Contract.Delegate.get_option c contract >>=? function
+  | None -> return c
+  | Some delegate ->
+      Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->
+      match Contract_repr.is_originated contract with
+      | None -> return c
+      | Some h ->
+          Storage.Contract.Delegated.del
+            (c, Contract_repr.implicit_contract delegate) h >>= fun c ->
+          return c
+
+let known c delegate =
+  Storage.Contract.Manager.get_option
+    c (Contract_repr.implicit_contract delegate) >>=? function
+  | None | Some (Manager_repr.Hash _) -> return_false
+  | Some (Manager_repr.Public_key _) -> return_true
+
+(* A delegate is registered if its "implicit account"
+   delegates to itself. *)
+let registered c delegate =
+  Storage.Contract.Delegate.mem
+    c (Contract_repr.implicit_contract delegate)
+
+let init ctxt contract delegate =
+  known ctxt delegate >>=? fun known_delegate ->
+  fail_unless
+    known_delegate
+    (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
+  registered ctxt delegate >>= fun is_registered ->
+  fail_unless
+    is_registered
+    (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
+  Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt ->
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  link ctxt contract delegate balance
+
+let get = Roll_storage.get_contract_delegate
+
+let set_base c is_delegatable contract delegate =
+  match delegate with
+  | None -> begin
+      match Contract_repr.is_implicit contract with
+      | Some pkh ->
+          fail (No_deletion pkh)
+      | None ->
+          is_delegatable c contract >>=? fun delegatable ->
+          if delegatable then
+            Storage.Contract.Balance.get c contract >>=? fun balance ->
+            unlink c contract balance >>=? fun c ->
+            Storage.Contract.Delegate.remove c contract >>= fun c ->
+            return c
+          else
+            fail (Non_delegatable_contract contract)
+    end
+  | Some delegate ->
+      known c delegate >>=? fun known_delegate ->
+      registered c delegate >>= fun registered_delegate ->
+      is_delegatable c contract >>=? fun delegatable ->
+      let self_delegation =
+        match Contract_repr.is_implicit contract with
+        | Some pkh -> Signature.Public_key_hash.equal pkh delegate
+        | None -> false in
+      if not known_delegate || not (registered_delegate || self_delegation) then
+        fail (Roll_storage.Unregistered_delegate delegate)
+      else if not (delegatable || self_delegation) then
+        fail (Non_delegatable_contract contract)
+      else
+        begin
+          Storage.Contract.Delegate.get_option c contract >>=? function
+          | Some current_delegate
+            when Signature.Public_key_hash.equal delegate current_delegate ->
+              if self_delegation then
+                Roll_storage.Delegate.is_inactive c delegate >>=? function
+                | true -> return_unit
+                | false -> fail Active_delegate
+              else
+                fail Current_delegate
+          | None | Some _ -> return_unit
+        end >>=? fun () ->
+        Storage.Contract.Balance.mem c contract >>= fun exists ->
+        fail_when
+          (self_delegation && not exists)
+          (Empty_delegate_account delegate) >>=? fun () ->
+        Storage.Contract.Balance.get c contract >>=? fun balance ->
+        unlink c contract balance >>=? fun c ->
+        Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
+        link c contract delegate balance >>=? fun c ->
+        begin
+          if self_delegation then
+            Storage.Delegates.add c delegate >>= fun c ->
+            Roll_storage.Delegate.set_active c delegate >>=? fun c ->
+            return c
+          else
+            return c
+        end >>=? fun c ->
+        return c
+
+let set c contract delegate =
+  set_base c is_delegatable contract delegate
+
+let set_from_script c contract delegate =
+  set_base c (fun _ _ -> return_true) contract delegate
+
+let remove ctxt contract =
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  unlink ctxt contract balance
+
+let delegated_contracts ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  Storage.Contract.Delegated.elements (ctxt, contract)
+
+let get_frozen_deposit ctxt contract cycle =
+  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle >>=? function
+  | None -> return Tez_repr.zero
+  | Some frozen -> return frozen
+
+let credit_frozen_deposit ctxt delegate cycle amount =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_deposit ctxt contract cycle >>=? fun old_amount ->
+  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  Storage.Contract.Frozen_deposits.init_set
+    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  return ctxt
+
+let freeze_deposit ctxt delegate amount =
+  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in
+  Roll_storage.Delegate.set_active ctxt delegate >>=? fun ctxt ->
+  let contract = Contract_repr.implicit_contract delegate in
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  Lwt.return
+    (record_trace (Balance_too_low_for_deposit { delegate; deposit = amount; balance })
+       Tez_repr.(balance -? amount)) >>=? fun new_balance ->
+  Storage.Contract.Balance.set ctxt contract new_balance >>=? fun ctxt ->
+  credit_frozen_deposit ctxt delegate cycle amount
+
+let get_frozen_fees ctxt contract cycle =
+  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle >>=? function
+  | None -> return Tez_repr.zero
+  | Some frozen -> return frozen
+
+let credit_frozen_fees ctxt delegate cycle amount =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->
+  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  Storage.Contract.Frozen_fees.init_set
+    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  return ctxt
+
+let freeze_fees ctxt delegate amount =
+  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in
+  Roll_storage.Delegate.add_amount ctxt delegate amount >>=? fun ctxt ->
+  credit_frozen_fees ctxt delegate cycle amount
+
+let burn_fees ctxt delegate cycle amount =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->
+  begin
+    match Tez_repr.(old_amount -? amount) with
+    | Ok new_amount ->
+        Roll_storage.Delegate.remove_amount
+          ctxt delegate amount >>=? fun ctxt ->
+        return (new_amount, ctxt)
+    | Error _ ->
+        Roll_storage.Delegate.remove_amount
+          ctxt delegate old_amount >>=? fun ctxt ->
+        return (Tez_repr.zero, ctxt)
+  end >>=? fun (new_amount, ctxt) ->
+  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  return ctxt
+
+
+let get_frozen_rewards ctxt contract cycle =
+  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle >>=? function
+  | None -> return Tez_repr.zero
+  | Some frozen -> return frozen
+
+let credit_frozen_rewards ctxt delegate cycle amount =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->
+  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  Storage.Contract.Frozen_rewards.init_set
+    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  return ctxt
+
+let freeze_rewards ctxt delegate amount =
+  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in
+  credit_frozen_rewards ctxt delegate cycle amount
+
+let burn_rewards ctxt delegate cycle amount =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->
+  let new_amount =
+    match Tez_repr.(old_amount -? amount) with
+    | Error _ -> Tez_repr.zero
+    | Ok new_amount -> new_amount in
+  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  return ctxt
+
+
+
+let unfreeze ctxt delegate cycle =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  get_frozen_fees ctxt contract cycle >>=? fun fees ->
+  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  Lwt.return Tez_repr.(deposit +? fees) >>=? fun unfrozen_amount ->
+  Lwt.return Tez_repr.(unfrozen_amount +? rewards) >>=? fun unfrozen_amount ->
+  Lwt.return Tez_repr.(balance +? unfrozen_amount) >>=? fun balance ->
+  Storage.Contract.Balance.set ctxt contract balance >>=? fun ctxt ->
+  Roll_storage.Delegate.add_amount ctxt delegate rewards >>=? fun ctxt ->
+  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->
+  return (ctxt, (cleanup_balance_updates
+                   [(Deposits (delegate, cycle), Debited deposit) ;
+                    (Fees (delegate, cycle), Debited fees) ;
+                    (Rewards (delegate, cycle), Debited rewards) ;
+                    (Contract (Contract_repr.implicit_contract delegate), Credited unfrozen_amount)]))
+
+let cycle_end ctxt last_cycle unrevealed =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  begin
+    match Cycle_repr.pred last_cycle with
+    | None -> return (ctxt,[])
+    | Some revealed_cycle ->
+        List.fold_left
+          (fun acc (u : Nonce_storage.unrevealed) ->
+             acc >>=? fun (ctxt, balance_updates) ->
+             burn_fees
+               ctxt u.delegate revealed_cycle u.fees >>=? fun ctxt ->
+             burn_rewards
+               ctxt u.delegate revealed_cycle u.rewards >>=? fun ctxt ->
+             let bus = [(Fees (u.delegate, revealed_cycle), Debited u.fees);
+                        (Rewards (u.delegate, revealed_cycle), Debited u.rewards)] in
+             return (ctxt, bus @ balance_updates))
+          (return (ctxt,[])) unrevealed
+  end >>=? fun (ctxt, balance_updates) ->
+  match Cycle_repr.sub last_cycle preserved with
+  | None -> return (ctxt, balance_updates, [])
+  | Some unfrozen_cycle ->
+      Storage.Delegates_with_frozen_balance.fold (ctxt, unfrozen_cycle)
+        ~init:(Ok (ctxt, balance_updates))
+        ~f:(fun delegate acc ->
+            Lwt.return acc >>=? fun (ctxt, bus) ->
+            unfreeze ctxt
+              delegate unfrozen_cycle >>=? fun (ctxt, balance_updates) ->
+            return (ctxt, balance_updates @ bus)) >>=? fun (ctxt, balance_updates) ->
+      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle) >>= fun ctxt ->
+      Storage.Active_delegates_with_rolls.fold ctxt
+        ~init:(Ok (ctxt, []))
+        ~f:(fun delegate acc ->
+            Lwt.return acc >>=? fun (ctxt, deactivated) ->
+            Storage.Contract.Delegate_desactivation.get ctxt
+              (Contract_repr.implicit_contract delegate) >>=? fun cycle ->
+            if Cycle_repr.(cycle <= last_cycle) then
+              Roll_storage.Delegate.set_inactive ctxt delegate >>=? fun ctxt ->
+              return (ctxt, delegate :: deactivated)
+            else
+              return (ctxt, deactivated)) >>=? fun (ctxt, deactivated) ->
+      return (ctxt, balance_updates, deactivated)
+
+let punish ctxt delegate cycle =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  get_frozen_fees ctxt contract cycle >>=? fun fees ->
+  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+  Roll_storage.Delegate.remove_amount ctxt delegate deposit >>=? fun ctxt ->
+  Roll_storage.Delegate.remove_amount ctxt delegate fees >>=? fun ctxt ->
+  (* Rewards are not accounted in the delegate's rolls yet... *)
+  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->
+  return (ctxt, { deposit ; fees ; rewards })
+
+
+let has_frozen_balance ctxt delegate cycle =
+  let contract = Contract_repr.implicit_contract delegate in
+  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  if Tez_repr.(deposit <> zero) then return_true
+  else
+    get_frozen_fees ctxt contract cycle >>=? fun fees ->
+    if Tez_repr.(fees <> zero) then return_true
+    else
+      get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+      return Tez_repr.(rewards <> zero)
+
+let frozen_balance_by_cycle_encoding =
+  let open Data_encoding in
+  conv
+    (Cycle_repr.Map.bindings)
+    (List.fold_left
+       (fun m (c, b) -> Cycle_repr.Map.add c b m)
+       Cycle_repr.Map.empty)
+    (list (merge_objs
+             (obj1 (req "cycle" Cycle_repr.encoding))
+             frozen_balance_encoding))
+
+let empty_frozen_balance =
+  { deposit = Tez_repr.zero ;
+    fees = Tez_repr.zero ;
+    rewards = Tez_repr.zero }
+
+let frozen_balance_by_cycle ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  let map = Cycle_repr.Map.empty in
+  Storage.Contract.Frozen_deposits.fold
+    (ctxt, contract) ~init:map
+    ~f:(fun cycle amount map ->
+        Lwt.return
+          (Cycle_repr.Map.add cycle
+             { empty_frozen_balance with deposit = amount } map)) >>= fun map ->
+  Storage.Contract.Frozen_fees.fold
+    (ctxt, contract) ~init:map
+    ~f:(fun cycle amount map ->
+        let balance =
+          match Cycle_repr.Map.find_opt cycle map with
+          | None -> empty_frozen_balance
+          | Some balance -> balance in
+        Lwt.return
+          (Cycle_repr.Map.add cycle
+             { balance with fees = amount } map)) >>= fun map ->
+  Storage.Contract.Frozen_rewards.fold
+    (ctxt, contract) ~init:map
+    ~f:(fun cycle amount map ->
+        let balance =
+          match Cycle_repr.Map.find_opt cycle map with
+          | None -> empty_frozen_balance
+          | Some balance -> balance in
+        Lwt.return
+          (Cycle_repr.Map.add cycle
+             { balance with rewards = amount } map)) >>= fun map ->
+  Lwt.return map
+
+let frozen_balance ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  let balance = Ok Tez_repr.zero in
+  Storage.Contract.Frozen_deposits.fold
+    (ctxt, contract) ~init:balance
+    ~f:(fun _cycle amount acc ->
+        Lwt.return acc >>=? fun acc ->
+        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  Storage.Contract.Frozen_fees.fold
+    (ctxt, contract) ~init:balance
+    ~f:(fun _cycle amount acc ->
+        Lwt.return acc >>=? fun acc ->
+        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  Storage.Contract.Frozen_rewards.fold
+    (ctxt, contract) ~init:balance
+    ~f:(fun _cycle amount acc ->
+        Lwt.return acc >>=? fun acc ->
+        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  Lwt.return balance
+
+let full_balance ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  frozen_balance ctxt delegate >>=? fun frozen_balance ->
+  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  Lwt.return Tez_repr.(frozen_balance +? balance)
+
+let deactivated = Roll_storage.Delegate.is_inactive
+
+let grace_period ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  Storage.Contract.Delegate_desactivation.get ctxt contract
+
+let staking_balance ctxt delegate =
+  let token_per_rolls = Constants_storage.tokens_per_roll ctxt in
+  Roll_storage.get_rolls ctxt delegate >>=? fun rolls ->
+  Roll_storage.get_change ctxt delegate >>=? fun change ->
+  let rolls = Int64.of_int (List.length rolls) in
+  Lwt.return Tez_repr.(token_per_rolls *? rolls) >>=? fun balance ->
+  Lwt.return Tez_repr.(balance +? change)
+
+let delegated_balance ctxt delegate =
+  let contract = Contract_repr.implicit_contract delegate in
+  staking_balance ctxt delegate >>=? fun staking_balance ->
+  Storage.Contract.Balance.get ctxt contract >>= fun self_staking_balance ->
+  Storage.Contract.Frozen_deposits.fold
+    (ctxt, contract) ~init:self_staking_balance
+    ~f:(fun _cycle amount acc ->
+        Lwt.return acc >>=? fun acc ->
+        Lwt.return (Tez_repr.(acc +? amount))) >>= fun self_staking_balance ->
+  Storage.Contract.Frozen_fees.fold
+    (ctxt, contract) ~init:self_staking_balance
+    ~f:(fun _cycle amount acc ->
+        Lwt.return acc >>=? fun acc ->
+        Lwt.return (Tez_repr.(acc +? amount))) >>=? fun self_staking_balance ->
+  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)
+
+let fold = Storage.Delegates.fold
+let list = Storage.Delegates.elements
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.mli
new file mode 100644
index 000000000..6f458403b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/delegate_storage.mli
@@ -0,0 +1,187 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Places where tezzies can be found in the ledger's state. *)
+type balance =
+  | Contract of Contract_repr.t
+  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
+  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
+  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t
+
+(** A credit or debit of tezzies to a balance. *)
+type balance_update =
+  | Debited of Tez_repr.t
+  | Credited of Tez_repr.t
+
+(** A list of balance updates. Duplicates may happen. *)
+type balance_updates = (balance * balance_update) list
+
+val balance_updates_encoding : balance_updates Data_encoding.t
+
+(** Remove zero-valued balances from a list of updates. *)
+val cleanup_balance_updates : balance_updates -> balance_updates
+
+type frozen_balance = {
+  deposit : Tez_repr.t ;
+  fees : Tez_repr.t ;
+  rewards : Tez_repr.t ;
+}
+
+(** Is the contract eligible to delegation ? *)
+val is_delegatable:
+  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
+(** Allow to register a delegate when creating an account. *)
+val init:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t ->
+  Raw_context.t tzresult Lwt.t
+
+(** Cleanup delegation when deleting a contract. *)
+val remove:
+  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+
+(** Reading the current delegate of a contract. *)
+val get:
+  Raw_context.t -> Contract_repr.t ->
+  Signature.Public_key_hash.t option tzresult Lwt.t
+
+val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t
+
+(** Updating the delegate of a contract.
+
+    When calling this function on an "implicit contract" this function
+    fails, unless when the registered delegate is the contract manager.
+    In the that case, the manager is now registered as a delegate. One
+    cannot unregister a delegate for now. The associate contract is
+    now 'undeletable'. *)
+val set:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
+  Raw_context.t tzresult Lwt.t
+
+(** Same as {!set} ignoring the [delegatable] flag. *)
+val set_from_script:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
+  Raw_context.t tzresult Lwt.t
+
+type error +=
+  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)
+  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
+  | Active_delegate (* `Temporary *)
+  | Current_delegate (* `Temporary *)
+  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
+  | Balance_too_low_for_deposit of
+      { delegate : Signature.Public_key_hash.t ;
+        deposit : Tez_repr.t ;
+        balance : Tez_repr.t } (* `Temporary *)
+
+(** Iterate on all registered delegates. *)
+val fold:
+  Raw_context.t ->
+  init:'a ->
+  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+(** List all registered delegates. *)
+val list: Raw_context.t -> Signature.Public_key_hash.t list Lwt.t
+
+(** Various functions to 'freeze' tokens.  A frozen 'deposit' keeps its
+    associated rolls. When frozen, 'fees' may trigger new rolls
+    allocation. Rewards won't trigger new rolls allocation until
+    unfrozen. *)
+val freeze_deposit:
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+val freeze_fees:
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+val freeze_rewards:
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t tzresult Lwt.t
+
+(** Trigger the context maintenance at the end of cycle 'n', i.e.:
+    unfreeze deposit/fees/rewards from 'n - preserved_cycle' ; punish the
+    provided unrevealed seeds (tipically seed from cycle 'n - 1').
+    Returns a list of account with the amount that was unfrozen for each
+    and the list of deactivated delegates. *)
+val cycle_end:
+  Raw_context.t -> Cycle_repr.t -> Nonce_storage.unrevealed list ->
+  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t
+
+(** Burn all then frozen deposit/fees/rewards for a delegate at a given
+    cycle. Returns the burned amounts. *)
+val punish:
+  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+  (Raw_context.t * frozen_balance) tzresult Lwt.t
+
+(** Has the given key some frozen tokens in its implicit contract? *)
+val has_frozen_balance:
+  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+  bool tzresult Lwt.t
+
+(** Returns the amount of frozen deposit, fees and rewards associated
+    to a given delegate. *)
+val frozen_balance:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Tez_repr.t tzresult Lwt.t
+
+val frozen_balance_encoding: frozen_balance Data_encoding.t
+val frozen_balance_by_cycle_encoding:
+  frozen_balance Cycle_repr.Map.t Data_encoding.t
+
+(** Returns the amount of frozen deposit, fees and rewards associated
+    to a given delegate, indexed by the cycle by which at the end the
+    balance will be unfrozen. *)
+val frozen_balance_by_cycle:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  frozen_balance Cycle_repr.Map.t Lwt.t
+
+(** Returns the full 'balance' of the implicit contract associated to
+    a given key, i.e. the sum of the spendable balance and of the
+    frozen balance. *)
+val full_balance:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Tez_repr.t tzresult Lwt.t
+
+val staking_balance:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Tez_repr.t tzresult Lwt.t
+
+(** Returns the list of contract that delegated towards a given delegate *)
+val delegated_contracts:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Contract_hash.t list Lwt.t
+
+val delegated_balance:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Tez_repr.t tzresult Lwt.t
+
+val deactivated:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  bool tzresult Lwt.t
+
+val grace_period:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Cycle_repr.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune b/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune
new file mode 120000
index 000000000..235c3740e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune
@@ -0,0 +1 @@
+../../lib_protocol_compiler/dune_protocol
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune.inc b/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune.inc
new file mode 100644
index 000000000..635268b87
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/dune.inc
@@ -0,0 +1,78 @@
+
+
+;
+;        /!\ /!\ Do not modify this file /!\ /!\
+;
+; but the original template in `tezos-protocol-compiler`
+;
+
+
+(rule
+ (targets environment.ml)
+ (action
+  (write-file %{targets}
+              "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"alpha\" end)()
+      module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
+")))
+
+(rule
+ (targets registerer.ml)
+ (deps tezos_embedded_protocol_environment_alpha.cmxa
+       (:src_dir TEZOS_PROTOCOL))
+ (action
+  (with-stdout-to %{targets}
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "alpha")))))
+
+
+(rule
+ (targets functor.ml)
+ (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml
+       (:src_dir TEZOS_PROTOCOL))
+ (action (with-stdout-to %{targets}
+                         (chdir %{workspace_root}
+                                (run %{bin:tezos-protocol-compiler.tezos-protocol-packer} %{src_dir})))))
+
+(library
+ (name tezos_protocol_alpha)
+ (public_name tezos-protocol-alpha)
+ (libraries tezos-protocol-environment-sigs)
+ (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
+        -warn-error "-a+8"
+        -safe-string -nopervasives)
+ (modules Functor))
+
+(library
+ (name tezos_embedded_protocol_environment_alpha)
+ (public_name tezos-embedded-protocol-alpha.environment)
+ (library_flags (:standard -linkall))
+ (libraries tezos-protocol-environment-shell)
+ (modules Environment))
+
+(library
+ (name tezos_embedded_raw_protocol_alpha)
+ (public_name tezos-embedded-protocol-alpha.raw)
+ (libraries tezos_embedded_protocol_environment_alpha)
+ (library_flags (:standard -linkall))
+ (flags (:standard -nopervasives -nostdlib -safe-string
+                   -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8
+                   -open Tezos_embedded_protocol_environment_alpha__Environment
+                   -open Pervasives
+                   -open Error_monad))
+ (modules Misc Storage_description State_hash Nonce_hash Script_expr_hash Contract_hash Blinded_public_key_hash Qty_repr Tez_repr Period_repr Time_repr Constants_repr Fitness_repr Raw_level_repr Voting_period_repr Cycle_repr Level_repr Seed_repr Gas_limit_repr Script_int_repr Script_timestamp_repr Michelson_v1_primitives Script_repr Contract_repr Roll_repr Vote_repr Block_header_repr Operation_repr Manager_repr Commitment_repr Parameters_repr Raw_context Storage_sigs Storage_functors Storage Constants_storage Level_storage Nonce_storage Seed_storage Roll_storage Delegate_storage Contract_storage Bootstrap_storage Fitness_storage Vote_storage Commitment_storage Init_storage Fees_storage Alpha_context Script_typed_ir Script_tc_errors Michelson_v1_gas Script_ir_annot Script_ir_translator Script_tc_errors_registration Script_interpreter Baking Amendment Apply_results Apply Services_registration Constants_services Contract_services Delegate_services Helpers_services Voting_services Alpha_services Main))
+
+(library
+ (name tezos_embedded_protocol_alpha)
+ (public_name tezos-embedded-protocol-alpha)
+ (library_flags (:standard -linkall))
+ (libraries tezos_embedded_raw_protocol_alpha
+            tezos-protocol-updater
+            tezos-protocol-environment-shell)
+ (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8))
+ (modules Registerer))
+
+(alias
+ (name runtest_sandbox)
+ (deps .tezos_protocol_alpha.objs/tezos_protocol_alpha.cmx))
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.ml
new file mode 100644
index 000000000..e713d96f1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.ml
@@ -0,0 +1,111 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Cannot_pay_storage_fee (* `Temporary *)
+type error += Operation_quota_exceeded (* `Temporary *)
+type error += Storage_limit_too_high (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Temporary
+    ~id:"contract.cannot_pay_storage_fee"
+    ~title:"Cannot pay storage fee"
+    ~description:"The storage fee is higher than the contract balance"
+    ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay storage storage fee")
+    Data_encoding.empty
+    (function Cannot_pay_storage_fee -> Some () | _ -> None)
+    (fun () -> Cannot_pay_storage_fee) ;
+  register_error_kind
+    `Temporary
+    ~id:"storage_exhausted.operation"
+    ~title: "Storage quota exceeded for the operation"
+    ~description:
+      "A script or one of its callee wrote more \
+       bytes than the operation said it would"
+    Data_encoding.empty
+    (function Operation_quota_exceeded -> Some () | _ -> None)
+    (fun () -> Operation_quota_exceeded) ;
+  register_error_kind
+    `Permanent
+    ~id:"storage_limit_too_high"
+    ~title: "Storage limit out of protocol hard bounds"
+    ~description:
+      "A transaction tried to exceed the hard limit on storage"
+    empty
+    (function Storage_limit_too_high -> Some () | _ -> None)
+    (fun () -> Storage_limit_too_high)
+
+let origination_burn c =
+  let origination_size = Constants_storage.origination_size c in
+  let cost_per_byte = Constants_storage.cost_per_byte c in
+  (* the origination burn, measured in bytes *)
+  Lwt.return
+    Tez_repr.(cost_per_byte *? (Int64.of_int origination_size)) >>=? fun to_be_paid ->
+  return (Raw_context.update_allocated_contracts_count c,
+          to_be_paid)
+
+let record_paid_storage_space c contract =
+  Contract_storage.used_storage_space c contract >>=? fun size ->
+  Contract_storage.set_paid_storage_space_and_return_fees_to_pay c contract size >>=? fun (to_be_paid, c) ->
+  let c = Raw_context.update_storage_space_to_pay c to_be_paid in
+  let cost_per_byte = Constants_storage.cost_per_byte c in
+  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
+  return (c, size, to_be_paid, to_burn)
+
+let burn_storage_fees c ~storage_limit ~payer =
+  let origination_size = Constants_storage.origination_size c in
+  let c, storage_space_to_pay, allocated_contracts =
+    Raw_context.clear_storage_space_to_pay c in
+  let storage_space_for_allocated_contracts =
+    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
+  let consumed =
+    Z.add storage_space_to_pay storage_space_for_allocated_contracts in
+  let remaining = Z.sub storage_limit consumed in
+  if Compare.Z.(remaining < Z.zero) then
+    fail Operation_quota_exceeded
+  else
+    let cost_per_byte = Constants_storage.cost_per_byte c in
+    Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 consumed))) >>=? fun to_burn ->
+    (* Burning the fees... *)
+    if Tez_repr.(to_burn = Tez_repr.zero) then
+      (* If the payer was was deleted by transfering all its balance, and no space was used,
+         burning zero would fail *)
+      return c
+    else
+      trace Cannot_pay_storage_fee
+        (Contract_storage.must_exist c payer >>=? fun () ->
+         Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->
+      return c
+
+let check_storage_limit c ~storage_limit =
+  if Compare.Z.(storage_limit > (Raw_context.constants c).hard_storage_limit_per_operation)
+  || Compare.Z.(storage_limit < Z.zero)then
+    error Storage_limit_too_high
+  else
+    ok ()
+
+let start_counting_storage_fees c =
+  Raw_context.init_storage_space_to_pay c
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.mli
new file mode 100644
index 000000000..f46f7df87
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fees_storage.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Cannot_pay_storage_fee (* `Temporary *)
+type error += Operation_quota_exceeded (* `Temporary *)
+type error += Storage_limit_too_high (* `Permanent *)
+
+(** Does not burn, only adds the burn to storage space to be paid *)
+val origination_burn:
+  Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
+
+(** The returned Tez quantity is for logging purpose only *)
+val record_paid_storage_space:
+  Raw_context.t -> Contract_repr.t ->
+  (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t
+
+val check_storage_limit:
+  Raw_context.t -> storage_limit:Z.t -> unit tzresult
+
+val start_counting_storage_fees :
+  Raw_context.t -> Raw_context.t
+
+val burn_storage_fees:
+  Raw_context.t -> storage_limit:Z.t -> payer:Contract_repr.t -> Raw_context.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_repr.ml
new file mode 100644
index 000000000..9e4e4e688
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_repr.ml
@@ -0,0 +1,61 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Invalid_fitness (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"invalid_fitness"
+    ~title:"Invalid fitness"
+    ~description:"Fitness representation should be exactly 8 bytes long."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid fitness")
+    Data_encoding.empty
+    (function Invalid_fitness -> Some () | _ -> None)
+    (fun () -> Invalid_fitness)
+
+let int64_to_bytes i =
+  let b = MBytes.create 8 in
+  MBytes.set_int64 b 0 i;
+  b
+
+let int64_of_bytes b =
+  if Compare.Int.(MBytes.length b <> 8) then
+    error Invalid_fitness
+  else
+    ok (MBytes.get_int64 b 0)
+
+let from_int64 fitness =
+  [ MBytes.of_string Constants_repr.version_number ;
+    int64_to_bytes fitness ]
+
+let to_int64 = function
+  | [ version ;
+      fitness ]
+    when Compare.String.
+           (MBytes.to_string version = Constants_repr.version_number) ->
+      int64_of_bytes fitness
+  | [] -> ok 0L
+  | _ -> error Invalid_fitness
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_storage.ml
new file mode 100644
index 000000000..e8853db8e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/fitness_storage.ml
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 current = Raw_context.current_fitness
+let increase ?(gap = 1) ctxt =
+  let fitness = current ctxt in
+  Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.ml
new file mode 100644
index 000000000..f44eb6c54
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.ml
@@ -0,0 +1,208 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t =
+  | Unaccounted
+  | Limited of { remaining : Z.t }
+
+type cost =
+  { allocations : Z.t ;
+    steps : Z.t ;
+    reads : Z.t ;
+    writes : Z.t  ;
+    bytes_read : Z.t ;
+    bytes_written : Z.t }
+
+let encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag 0)
+        ~title:"Limited"
+        z
+        (function Limited { remaining } -> Some remaining | _ -> None)
+        (fun remaining -> Limited { remaining }) ;
+      case (Tag 1)
+        ~title:"Unaccounted"
+        (constant "unaccounted")
+        (function Unaccounted -> Some () | _ -> None)
+        (fun () -> Unaccounted) ]
+
+let pp ppf = function
+  | Unaccounted ->
+      Format.fprintf ppf "unaccounted"
+  | Limited { remaining } ->
+      Format.fprintf ppf "%s units remaining" (Z.to_string remaining)
+
+let cost_encoding =
+  let open Data_encoding in
+  conv
+    (fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } ->
+       (allocations, steps, reads, writes, bytes_read, bytes_written))
+    (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
+       { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written })
+    (obj6
+       (req "allocations" z)
+       (req "steps" z)
+       (req "reads" z)
+       (req "writes" z)
+       (req "bytes_read" z)
+       (req "bytes_written" z))
+
+let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =
+  Format.fprintf ppf
+    "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
+    (Z.to_string steps)
+    (Z.to_string allocations)
+    (Z.to_string reads)
+    (Z.to_string bytes_read)
+    (Z.to_string writes)
+    (Z.to_string bytes_written)
+
+type error += Block_quota_exceeded (* `Temporary *)
+type error += Operation_quota_exceeded (* `Temporary *)
+
+let allocation_weight = Z.of_int 2
+let step_weight = Z.of_int 1
+let read_base_weight = Z.of_int 50
+let write_base_weight = Z.of_int 80
+let byte_read_weight = Z.of_int 10
+let byte_written_weight = Z.of_int 15
+
+let consume block_gas operation_gas cost = match operation_gas with
+  | Unaccounted -> ok (block_gas, Unaccounted)
+  | Limited { remaining } ->
+      let weighted_cost =
+        Z.add
+          (Z.add
+             (Z.mul allocation_weight cost.allocations)
+             (Z.mul step_weight cost.steps))
+          (Z.add
+             (Z.add
+                (Z.mul read_base_weight cost.reads)
+                (Z.mul write_base_weight cost.writes))
+             (Z.add
+                (Z.mul byte_read_weight cost.bytes_read)
+                (Z.mul byte_written_weight cost.bytes_written))) in
+      let remaining =
+        Z.sub remaining weighted_cost in
+      let block_remaining =
+        Z.sub block_gas weighted_cost in
+      if Compare.Z.(remaining < Z.zero)
+      then error Operation_quota_exceeded
+      else if Compare.Z.(block_remaining < Z.zero)
+      then error Block_quota_exceeded
+      else ok (block_remaining, Limited { remaining })
+
+let check_enough block_gas operation_gas cost =
+  consume block_gas operation_gas cost
+  >|? fun (_block_remainig, _remaining) -> ()
+
+let alloc_cost n =
+  { allocations = Z.of_int (n + 1) ;
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
+
+let alloc_bytes_cost n =
+  alloc_cost ((n + 7) / 8)
+
+let alloc_bits_cost n =
+  alloc_cost ((n + 63) / 64)
+
+let step_cost n =
+  { allocations = Z.zero ;
+    steps = Z.of_int n ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
+
+let free =
+  { allocations = Z.zero ;
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.zero ;
+    bytes_read = Z.zero ;
+    bytes_written = Z.zero }
+
+let read_bytes_cost n =
+  { allocations = Z.zero ;
+    steps = Z.zero ;
+    reads = Z.one ;
+    writes = Z.zero ;
+    bytes_read = n ;
+    bytes_written = Z.zero }
+
+let write_bytes_cost n =
+  { allocations = Z.zero ;
+    steps = Z.zero ;
+    reads = Z.zero ;
+    writes = Z.one ;
+    bytes_read = Z.zero ;
+    bytes_written = n }
+
+let ( +@ ) x y =
+  { allocations = Z.add x.allocations y.allocations ;
+    steps = Z.add x.steps y.steps ;
+    reads = Z.add x.reads y.reads ;
+    writes = Z.add x.writes y.writes ;
+    bytes_read = Z.add x.bytes_read y.bytes_read ;
+    bytes_written = Z.add x.bytes_written y.bytes_written }
+
+let ( *@ ) x y =
+  { allocations = Z.mul (Z.of_int x) y.allocations ;
+    steps = Z.mul (Z.of_int x) y.steps ;
+    reads = Z.mul (Z.of_int x) y.reads ;
+    writes = Z.mul (Z.of_int x) y.writes ;
+    bytes_read = Z.mul (Z.of_int x) y.bytes_read ;
+    bytes_written = Z.mul (Z.of_int x) y.bytes_written }
+
+let alloc_mbytes_cost n =
+  alloc_cost 12 +@ alloc_bytes_cost n
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Temporary
+    ~id:"gas_exhausted.operation"
+    ~title: "Gas quota exceeded for the operation"
+    ~description:
+      "A script or one of its callee took more \
+       time than the operation said it would"
+    empty
+    (function Operation_quota_exceeded -> Some () | _ -> None)
+    (fun () -> Operation_quota_exceeded) ;
+  register_error_kind
+    `Temporary
+    ~id:"gas_exhausted.block"
+    ~title: "Gas quota exceeded for the block"
+    ~description:
+      "The sum of gas consumed by all the operations in the block \
+       exceeds the hard gas limit per block"
+    empty
+    (function Block_quota_exceeded -> Some () | _ -> None)
+    (fun () -> Block_quota_exceeded) ;
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.mli
new file mode 100644
index 000000000..00db52353
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/gas_limit_repr.mli
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t =
+  | Unaccounted
+  | Limited of { remaining : Z.t }
+
+val encoding : t Data_encoding.encoding
+val pp : Format.formatter -> t -> unit
+
+type cost
+
+val cost_encoding : cost Data_encoding.encoding
+val pp_cost : Format.formatter -> cost -> unit
+
+type error += Block_quota_exceeded (* `Temporary *)
+type error += Operation_quota_exceeded (* `Temporary *)
+
+val consume : Z.t -> t -> cost -> (Z.t * t) tzresult
+val check_enough : Z.t -> t -> cost -> unit tzresult
+
+val free : cost
+val step_cost : int -> cost
+val alloc_cost : int -> cost
+val alloc_bytes_cost : int -> cost
+val alloc_mbytes_cost : int -> cost
+val alloc_bits_cost : int -> cost
+val read_bytes_cost : Z.t -> cost
+val write_bytes_cost : Z.t -> cost
+
+val ( *@ ) : int -> cost -> cost
+val ( +@ ) : cost -> cost -> cost
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.ml
new file mode 100644
index 000000000..12a8fcf99
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.ml
@@ -0,0 +1,616 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+type error += Cannot_parse_operation (* `Branch *)
+
+let () =
+  register_error_kind
+    `Branch
+    ~id:"operation.cannot_parse"
+    ~title:"Cannot parse operation"
+    ~description:"The operation is ill-formed \
+                  or for another protocol version"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The operation cannot be parsed")
+    Data_encoding.unit
+    (function Cannot_parse_operation -> Some () | _ -> None)
+    (fun () -> Cannot_parse_operation)
+
+let parse_operation (op: Operation.raw) =
+  match Data_encoding.Binary.of_bytes
+          Operation.protocol_data_encoding
+          op.proto with
+  | Some protocol_data ->
+      ok { shell = op.shell ; protocol_data }
+  | None -> error Cannot_parse_operation
+
+let path = RPC_path.(open_root / "helpers")
+
+module Scripts = struct
+
+  module S = struct
+
+    open Data_encoding
+
+    let path = RPC_path.(path / "scripts")
+
+    let run_code_input_encoding =
+      (obj4
+         (req "script" Script.expr_encoding)
+         (req "storage" Script.expr_encoding)
+         (req "input" Script.expr_encoding)
+         (req "amount" Tez.encoding))
+
+    let trace_encoding =
+      def "scripted.trace" @@
+      (list @@ obj3
+         (req "location" Script.location_encoding)
+         (req "gas" Gas.encoding)
+         (req "stack"
+            (list
+               (obj2
+                  (req "item" (Script.expr_encoding))
+                  (opt "annot" string)))))
+
+    let run_code =
+      RPC_service.post_service
+        ~description: "Run a piece of code in the current context"
+        ~query: RPC_query.empty
+        ~input: run_code_input_encoding
+        ~output: (obj3
+                    (req "storage" Script.expr_encoding)
+                    (req "operations" (list Operation.internal_operation_encoding))
+                    (opt "big_map_diff" Contract.big_map_diff_encoding))
+        RPC_path.(path / "run_code")
+
+    let trace_code =
+      RPC_service.post_service
+        ~description: "Run a piece of code in the current context, \
+                       keeping a trace"
+        ~query: RPC_query.empty
+        ~input: run_code_input_encoding
+        ~output: (obj4
+                    (req "storage" Script.expr_encoding)
+                    (req "operations" (list Operation.internal_operation_encoding))
+                    (req "trace" trace_encoding)
+                    (opt "big_map_diff" Contract.big_map_diff_encoding))
+        RPC_path.(path / "trace_code")
+
+    let typecheck_code =
+      RPC_service.post_service
+        ~description: "Typecheck a piece of code in the current context"
+        ~query: RPC_query.empty
+        ~input: (obj2
+                   (req "program" Script.expr_encoding)
+                   (opt "gas" z))
+        ~output: (obj2
+                    (req "type_map" Script_tc_errors_registration.type_map_enc)
+                    (req "gas" Gas.encoding))
+        RPC_path.(path / "typecheck_code")
+
+    let typecheck_data =
+      RPC_service.post_service
+        ~description: "Check that some data expression is well formed \
+                       and of a given type in the current context"
+        ~query: RPC_query.empty
+        ~input: (obj3
+                   (req "data" Script.expr_encoding)
+                   (req "type" Script.expr_encoding)
+                   (opt "gas" z))
+        ~output: (obj1 (req "gas" Gas.encoding))
+        RPC_path.(path / "typecheck_data")
+
+    let pack_data =
+      RPC_service.post_service
+        ~description: "Computes the serialized version of some data expression \
+                       using the same algorithm as script instruction PACK"
+
+        ~input: (obj3
+                   (req "data" Script.expr_encoding)
+                   (req "type" Script.expr_encoding)
+                   (opt "gas" z))
+        ~output: (obj2
+                    (req "packed" bytes)
+                    (req "gas" Gas.encoding))
+        ~query: RPC_query.empty
+        RPC_path.(path / "pack_data")
+
+    let run_operation =
+      RPC_service.post_service
+        ~description:
+          "Run an operation without signature checks"
+        ~query: RPC_query.empty
+        ~input: Operation.encoding
+        ~output: Apply_results.operation_data_and_metadata_encoding
+        RPC_path.(path / "run_operation")
+
+  end
+
+  let register () =
+    let open Services_registration in
+    let originate_dummy_contract ctxt script =
+      let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
+      Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, dummy_contract) ->
+      let balance = match Tez.of_mutez 4_000_000_000_000L with
+        | Some balance -> balance
+        | None -> assert false in
+      Contract.originate ctxt dummy_contract
+        ~balance
+        ~manager: Signature.Public_key_hash.zero
+        ~delegate: None
+        ~spendable: false
+        ~delegatable: false
+        ~script: (script, None) >>=? fun ctxt ->
+      return (ctxt, dummy_contract) in
+    register0 S.run_code begin fun ctxt ()
+      (code, storage, parameter, amount) ->
+      let storage = Script.lazy_expr storage in
+      let code = Script.lazy_expr code in
+      originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
+      let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in
+      Script_interpreter.execute
+        ctxt Readable
+        ~source:dummy_contract
+        ~payer:dummy_contract
+        ~self:(dummy_contract, { storage ; code })
+        ~amount ~parameter
+      >>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->
+      return (storage, operations, big_map_diff)
+    end ;
+    register0 S.trace_code begin fun ctxt ()
+      (code, storage, parameter, amount) ->
+      let storage = Script.lazy_expr storage in
+      let code = Script.lazy_expr code in
+      originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->
+      let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in
+      Script_interpreter.trace
+        ctxt Readable
+        ~source:dummy_contract
+        ~payer:dummy_contract
+        ~self:(dummy_contract, { storage ; code })
+        ~amount ~parameter
+      >>=? fun ({ Script_interpreter.storage ; operations ; big_map_diff ; _ }, trace) ->
+      return (storage, operations, trace, big_map_diff)
+    end ;
+    register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) ->
+      let ctxt = match maybe_gas with
+        | None -> Gas.set_unlimited ctxt
+        | Some gas -> Gas.set_limit ctxt gas in
+      Script_ir_translator.typecheck_code ctxt expr >>=? fun (res, ctxt) ->
+      return (res, Gas.level ctxt)
+    end ;
+    register0 S.typecheck_data begin fun ctxt () (data, ty, maybe_gas) ->
+      let ctxt = match maybe_gas with
+        | None -> Gas.set_unlimited ctxt
+        | Some gas -> Gas.set_limit ctxt gas in
+      Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt ->
+      return (Gas.level ctxt)
+    end ;
+    register0 S.pack_data begin fun ctxt () (expr, typ, maybe_gas) ->
+      let open Script_ir_translator in
+      let ctxt = match maybe_gas with
+        | None -> Gas.set_unlimited ctxt
+        | Some gas -> Gas.set_limit ctxt gas in
+      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ, ctxt) ->
+      parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
+      Script_ir_translator.pack_data ctxt typ data >>=? fun (bytes, ctxt) ->
+      return (bytes, Gas.level ctxt)
+    end ;
+    register0 S.run_operation begin fun ctxt ()
+      { shell ; protocol_data = Operation_data protocol_data } ->
+      (* this code is a duplicate of Apply without signature check *)
+      let partial_precheck_manager_contents
+          (type kind) ctxt (op : kind Kind.manager contents)
+        : context tzresult Lwt.t =
+        let Manager_operation { source ; fee ; counter ; operation ; gas_limit ; storage_limit } = op in
+        Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->
+        let ctxt = Gas.set_limit ctxt gas_limit in
+        Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->
+        Contract.must_be_allocated ctxt source >>=? fun () ->
+        Contract.check_counter_increment ctxt source counter >>=? fun () ->
+        begin
+          match operation with
+          | Reveal pk ->
+              Contract.reveal_manager_key ctxt source pk
+          | Transaction { parameters = Some arg ; _ } ->
+              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
+              let arg_bytes = Data_encoding.Binary.to_bytes_exn Script.lazy_expr_encoding arg in
+              let arg = match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding arg_bytes with
+                | Some arg -> arg
+                | None -> assert false in
+              (* Fail quickly if not enough gas for minimal deserialization cost *)
+              Lwt.return @@ record_trace Apply.Gas_quota_exceeded_init_deserialize @@
+              Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) >>=? fun () ->
+              (* Fail if not enough gas for complete deserialization cost *)
+              trace Apply.Gas_quota_exceeded_init_deserialize @@
+              Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt
+          | Origination { script = Some script ; _ } ->
+              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
+              let script_bytes = Data_encoding.Binary.to_bytes_exn Script.encoding script in
+              let script = match Data_encoding.Binary.of_bytes Script.encoding script_bytes with
+                | Some script -> script
+                | None -> assert false in
+              (* Fail quickly if not enough gas for minimal deserialization cost *)
+              Lwt.return @@ record_trace Apply.Gas_quota_exceeded_init_deserialize @@
+              (Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->
+               Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)) >>=? fun () ->
+              (* Fail if not enough gas for complete deserialization cost *)
+              trace Apply.Gas_quota_exceeded_init_deserialize @@
+              Script.force_decode ctxt script.code >>=? fun (_code, ctxt) ->
+              trace Apply.Gas_quota_exceeded_init_deserialize @@
+              Script.force_decode ctxt script.storage >>|? fun (_storage, ctxt) -> ctxt
+          | _ -> return ctxt
+        end >>=? fun ctxt ->
+        Contract.get_manager_key ctxt source >>=? fun _public_key ->
+        (* signature check unplugged from here *)
+        Contract.increment_counter ctxt source >>=? fun ctxt ->
+        Contract.spend ctxt source fee >>=? fun ctxt ->
+        return ctxt in
+      let rec partial_precheck_manager_contents_list
+        : type kind.
+          Alpha_context.t -> kind Kind.manager contents_list ->
+          context tzresult Lwt.t =
+        fun ctxt contents_list ->
+          match contents_list with
+          | Single (Manager_operation _ as op) ->
+              partial_precheck_manager_contents ctxt op
+          | Cons (Manager_operation _ as op, rest) ->
+              partial_precheck_manager_contents ctxt op >>=? fun ctxt ->
+              partial_precheck_manager_contents_list ctxt rest in
+      let return contents =
+        return (Operation_data protocol_data,
+                Apply_results.Operation_metadata { contents }) in
+      let operation : _ operation = { shell ; protocol_data } in
+      let hash = Operation.hash { shell ; protocol_data } in
+      let ctxt = Contract.init_origination_nonce ctxt hash in
+      let baker = Signature.Public_key_hash.zero in
+      match protocol_data.contents with
+      | Single (Manager_operation _) as op ->
+          partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
+          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->
+          return result
+      | Cons (Manager_operation _, _) as op ->
+          partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->
+          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->
+          return result
+      | _ ->
+          Apply.apply_contents_list
+            ctxt ~partial:true Chain_id.zero Optimized shell.branch baker operation
+            operation.protocol_data.contents >>=? fun (_ctxt, result) ->
+          return result
+
+    end
+
+  let run_code ctxt block code (storage, input, amount) =
+    RPC_context.make_call0 S.run_code ctxt
+      block () (code, storage, input, amount)
+
+  let trace_code ctxt block code (storage, input, amount) =
+    RPC_context.make_call0 S.trace_code ctxt
+      block () (code, storage, input, amount)
+
+  let typecheck_code ctxt block =
+    RPC_context.make_call0 S.typecheck_code ctxt block ()
+
+  let typecheck_data ctxt block =
+    RPC_context.make_call0 S.typecheck_data ctxt block ()
+
+  let pack_data ctxt block =
+    RPC_context.make_call0 S.pack_data ctxt block ()
+
+  let run_operation ctxt block =
+    RPC_context.make_call0 S.run_operation ctxt block ()
+
+end
+
+module Forge = struct
+
+  module S = struct
+
+    open Data_encoding
+
+    let path = RPC_path.(path / "forge")
+
+    let operations =
+      RPC_service.post_service
+        ~description:"Forge an operation"
+        ~query: RPC_query.empty
+        ~input: Operation.unsigned_encoding
+        ~output: bytes
+        RPC_path.(path / "operations" )
+
+    let empty_proof_of_work_nonce =
+      MBytes.of_string
+        (String.make Constants_repr.proof_of_work_nonce_size  '\000')
+
+    let protocol_data =
+      RPC_service.post_service
+        ~description: "Forge the protocol-specific part of a block header"
+        ~query: RPC_query.empty
+        ~input:
+          (obj3
+             (req "priority" uint16)
+             (opt "nonce_hash" Nonce_hash.encoding)
+             (dft "proof_of_work_nonce"
+                (Fixed.bytes
+                   Alpha_context.Constants.proof_of_work_nonce_size)
+                empty_proof_of_work_nonce))
+        ~output: (obj1 (req "protocol_data" bytes))
+        RPC_path.(path / "protocol_data")
+
+  end
+
+  let register () =
+    let open Services_registration in
+    register0_noctxt S.operations begin fun () (shell, proto) ->
+      return (Data_encoding.Binary.to_bytes_exn
+                Operation.unsigned_encoding (shell, proto))
+    end ;
+    register0_noctxt S.protocol_data begin fun ()
+      (priority, seed_nonce_hash, proof_of_work_nonce) ->
+      return (Data_encoding.Binary.to_bytes_exn
+                Block_header.contents_encoding
+                { priority ; seed_nonce_hash ; proof_of_work_nonce })
+    end
+
+  module Manager = struct
+
+    let operations ctxt
+        block ~branch ~source ?sourcePubKey ~counter ~fee
+        ~gas_limit ~storage_limit operations =
+      Contract_services.manager_key ctxt block source >>= function
+      | Error _ as e -> Lwt.return e
+      | Ok (_, revealed) ->
+          let ops =
+            List.map
+              (fun (Manager operation) ->
+                 Contents
+                   (Manager_operation { source ;
+                                        counter ; operation ; fee ;
+                                        gas_limit ; storage_limit }))
+              operations in
+          let ops =
+            match sourcePubKey, revealed with
+            | None, _ | _, Some _ ->  ops
+            | Some pk, None ->
+                let operation = Reveal pk in
+                Contents
+                  (Manager_operation { source ;
+                                       counter ; operation ; fee ;
+                                       gas_limit ; storage_limit }) :: ops in
+          RPC_context.make_call0 S.operations ctxt block
+            () ({ branch }, Operation.of_list ops)
+
+    let reveal ctxt
+        block ~branch ~source ~sourcePubKey ~counter ~fee () =
+      operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee
+        ~gas_limit:Z.zero ~storage_limit:Z.zero []
+
+    let transaction ctxt
+        block ~branch ~source ?sourcePubKey ~counter
+        ~amount ~destination ?parameters
+        ~gas_limit ~storage_limit ~fee ()=
+      let parameters = Option.map ~f:Script.lazy_expr parameters in
+      operations ctxt block ~branch ~source ?sourcePubKey ~counter
+        ~fee ~gas_limit ~storage_limit
+        [Manager (Transaction { amount ; parameters ; destination })]
+
+    let origination ctxt
+        block ~branch
+        ~source ?sourcePubKey ~counter
+        ~managerPubKey ~balance
+        ?(spendable = true)
+        ?(delegatable = true)
+        ?delegatePubKey ?script
+        ~gas_limit ~storage_limit ~fee () =
+      operations ctxt block ~branch ~source ?sourcePubKey ~counter
+        ~fee ~gas_limit ~storage_limit
+        [Manager (Origination { manager = managerPubKey ;
+                                delegate = delegatePubKey ;
+                                script ;
+                                spendable ;
+                                delegatable ;
+                                credit = balance ;
+                                preorigination = None })]
+
+    let delegation ctxt
+        block ~branch ~source ?sourcePubKey ~counter ~fee delegate =
+      operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
+        ~gas_limit:Z.zero ~storage_limit:Z.zero
+        [Manager (Delegation delegate)]
+
+  end
+
+  let operation ctxt
+      block ~branch operation =
+    RPC_context.make_call0 S.operations ctxt block
+      () ({ branch }, Contents_list (Single operation))
+
+  let endorsement ctxt
+      b ~branch ~level () =
+    operation ctxt b ~branch
+      (Endorsement { level })
+
+  let proposals ctxt
+      b ~branch ~source ~period ~proposals () =
+    operation ctxt b ~branch
+      (Proposals { source ; period ; proposals })
+
+  let ballot ctxt
+      b ~branch ~source ~period ~proposal ~ballot () =
+    operation ctxt b ~branch
+      (Ballot { source ; period ; proposal ; ballot })
+
+  let seed_nonce_revelation ctxt
+      block ~branch ~level ~nonce () =
+    operation ctxt block ~branch (Seed_nonce_revelation { level ; nonce })
+
+  let double_baking_evidence ctxt
+      block ~branch ~bh1 ~bh2 () =
+    operation ctxt block ~branch (Double_baking_evidence { bh1 ; bh2 })
+
+  let double_endorsement_evidence ctxt
+      block ~branch ~op1 ~op2 () =
+    operation ctxt block ~branch (Double_endorsement_evidence { op1 ; op2 })
+
+  let empty_proof_of_work_nonce =
+    MBytes.of_string
+      (String.make Constants_repr.proof_of_work_nonce_size  '\000')
+
+  let protocol_data ctxt
+      block
+      ~priority ?seed_nonce_hash
+      ?(proof_of_work_nonce = empty_proof_of_work_nonce)
+      () =
+    RPC_context.make_call0 S.protocol_data
+      ctxt block () (priority, seed_nonce_hash, proof_of_work_nonce)
+
+end
+
+module Parse = struct
+
+  module S = struct
+
+    open Data_encoding
+
+    let path = RPC_path.(path / "parse")
+
+    let operations =
+      RPC_service.post_service
+        ~description:"Parse operations"
+        ~query: RPC_query.empty
+        ~input:
+          (obj2
+             (req "operations" (list (dynamic_size Operation.raw_encoding)))
+             (opt "check_signature" bool))
+        ~output: (list (dynamic_size Operation.encoding))
+        RPC_path.(path / "operations" )
+
+    let block =
+      RPC_service.post_service
+        ~description:"Parse a block"
+        ~query: RPC_query.empty
+        ~input: Block_header.raw_encoding
+        ~output: Block_header.protocol_data_encoding
+        RPC_path.(path / "block" )
+
+  end
+
+  let parse_protocol_data protocol_data =
+    match
+      Data_encoding.Binary.of_bytes
+        Block_header.protocol_data_encoding
+        protocol_data
+    with
+    | None -> failwith "Cant_parse_protocol_data"
+    | Some protocol_data -> return protocol_data
+
+  let register () =
+    let open Services_registration in
+    register0 S.operations begin fun _ctxt () (operations, check) ->
+      map_s begin fun raw ->
+        Lwt.return (parse_operation raw) >>=? fun op ->
+        begin match check with
+          | Some true ->
+              return_unit (* FIXME *)
+          (* I.check_signature ctxt *)
+          (* op.protocol_data.signature op.shell op.protocol_data.contents *)
+          | Some false | None -> return_unit
+        end >>|? fun () -> op
+      end operations
+    end ;
+    register0_noctxt S.block begin fun () raw_block ->
+      parse_protocol_data raw_block.protocol_data
+    end
+
+  let operations ctxt block ?check operations =
+    RPC_context.make_call0
+      S.operations ctxt block () (operations, check)
+  let block ctxt block shell protocol_data =
+    RPC_context.make_call0
+      S.block ctxt block () ({ shell ; protocol_data } : Block_header.raw)
+
+end
+
+module S = struct
+
+  open Data_encoding
+
+  type level_query = {
+    offset: int32 ;
+  }
+  let level_query : level_query RPC_query.t =
+    let open RPC_query in
+    query (fun offset -> { offset })
+    |+ field "offset" RPC_arg.int32 0l (fun t -> t.offset)
+    |> seal
+
+  let current_level =
+    RPC_service.get_service
+      ~description:
+        "Returns the level of the interrogated block, or the one of a \
+         block located `offset` blocks after in the chain (or before \
+         when negative). For instance, the next block if `offset` is 1."
+      ~query: level_query
+      ~output: Level.encoding
+      RPC_path.(path / "current_level")
+
+  let levels_in_current_cycle =
+    RPC_service.get_service
+      ~description: "Levels of a cycle"
+      ~query: level_query
+      ~output: (obj2
+                  (req "first" Raw_level.encoding)
+                  (req "last" Raw_level.encoding))
+      RPC_path.(path / "levels_in_current_cycle")
+
+end
+
+let register () =
+  Scripts.register () ;
+  Forge.register () ;
+  Parse.register () ;
+  let open Services_registration in
+  register0 S.current_level begin fun ctxt q () ->
+    let level = Level.current ctxt in
+    return (Level.from_raw ctxt ~offset:q.offset level.level)
+  end ;
+  register0 S.levels_in_current_cycle begin fun ctxt q () ->
+    let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in
+    match levels with
+    | [] -> raise Not_found
+    | _ ->
+        let first = List.hd (List.rev levels) in
+        let last = List.hd levels in
+        return (first.level, last.level)
+  end
+
+let current_level ctxt ?(offset = 0l) block =
+  RPC_context.make_call0 S.current_level ctxt block { offset } ()
+
+let levels_in_current_cycle ctxt ?(offset = 0l) block =
+  RPC_context.make_call0 S.levels_in_current_cycle ctxt block { offset } ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.mli
new file mode 100644
index 000000000..17f28e212
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/helpers_services.mli
@@ -0,0 +1,210 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+type error += Cannot_parse_operation (* `Branch *)
+
+val current_level:
+  'a #RPC_context.simple ->
+  ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t
+
+val levels_in_current_cycle:
+  'a #RPC_context.simple ->
+  ?offset:int32 -> 'a -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
+
+module Scripts : sig
+
+  val run_code:
+    'a #RPC_context.simple ->
+    'a -> Script.expr -> (Script.expr * Script.expr * Tez.t) ->
+    (Script.expr *
+     packed_internal_operation list *
+     Contract.big_map_diff option) shell_tzresult Lwt.t
+
+  val trace_code:
+    'a #RPC_context.simple ->
+    'a -> Script.expr ->
+    (Script.expr * Script.expr * Tez.t) ->
+    (Script.expr *
+     packed_internal_operation list *
+     Script_interpreter.execution_trace *
+     Contract.big_map_diff option) shell_tzresult Lwt.t
+
+  val typecheck_code:
+    'a #RPC_context.simple ->
+    'a -> (Script.expr * Z.t option) ->
+    (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
+
+  val typecheck_data:
+    'a #RPC_context.simple ->
+    'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t
+
+  val pack_data:
+    'a #RPC_context.simple ->
+    'a -> Script.expr * Script.expr * Z.t option -> (MBytes.t * Gas.t) shell_tzresult Lwt.t
+
+  val run_operation:
+    'a #RPC_context.simple ->
+    'a -> packed_operation ->
+    (packed_protocol_data * Apply_results.packed_operation_metadata) shell_tzresult Lwt.t
+
+end
+
+module Forge : sig
+
+  module Manager : sig
+
+    val operations:
+      'a #RPC_context.simple -> 'a ->
+      branch:Block_hash.t ->
+      source:Contract.t ->
+      ?sourcePubKey:public_key ->
+      counter:counter ->
+      fee:Tez.t ->
+      gas_limit:Z.t ->
+      storage_limit:Z.t ->
+      packed_manager_operation list -> MBytes.t shell_tzresult Lwt.t
+
+    val reveal:
+      'a #RPC_context.simple -> 'a ->
+      branch:Block_hash.t ->
+      source:Contract.t ->
+      sourcePubKey:public_key ->
+      counter:counter ->
+      fee:Tez.t ->
+      unit -> MBytes.t shell_tzresult Lwt.t
+
+    val transaction:
+      'a #RPC_context.simple -> 'a ->
+      branch:Block_hash.t ->
+      source:Contract.t ->
+      ?sourcePubKey:public_key ->
+      counter:counter ->
+      amount:Tez.t ->
+      destination:Contract.t ->
+      ?parameters:Script.expr ->
+      gas_limit:Z.t ->
+      storage_limit:Z.t ->
+      fee:Tez.t ->
+      unit -> MBytes.t shell_tzresult Lwt.t
+
+    val origination:
+      'a #RPC_context.simple -> 'a ->
+      branch:Block_hash.t ->
+      source:Contract.t ->
+      ?sourcePubKey:public_key ->
+      counter:counter ->
+      managerPubKey:public_key_hash ->
+      balance:Tez.t ->
+      ?spendable:bool ->
+      ?delegatable:bool ->
+      ?delegatePubKey: public_key_hash ->
+      ?script:Script.t ->
+      gas_limit:Z.t ->
+      storage_limit:Z.t ->
+      fee:Tez.t->
+      unit -> MBytes.t shell_tzresult Lwt.t
+
+    val delegation:
+      'a #RPC_context.simple -> 'a ->
+      branch:Block_hash.t ->
+      source:Contract.t ->
+      ?sourcePubKey:public_key ->
+      counter:counter ->
+      fee:Tez.t ->
+      public_key_hash option ->
+      MBytes.t shell_tzresult Lwt.t
+
+  end
+
+  val endorsement:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    level:Raw_level.t ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val proposals:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    source:public_key_hash ->
+    period:Voting_period.t ->
+    proposals:Protocol_hash.t list ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val ballot:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    source:public_key_hash ->
+    period:Voting_period.t ->
+    proposal:Protocol_hash.t ->
+    ballot:Vote.ballot ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val seed_nonce_revelation:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    level:Raw_level.t ->
+    nonce:Nonce.t ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val double_baking_evidence:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    bh1: Block_header.t ->
+    bh2: Block_header.t ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val double_endorsement_evidence:
+    'a #RPC_context.simple -> 'a ->
+    branch:Block_hash.t ->
+    op1: Kind.endorsement operation ->
+    op2: Kind.endorsement operation ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+  val protocol_data:
+    'a #RPC_context.simple -> 'a ->
+    priority: int ->
+    ?seed_nonce_hash: Nonce_hash.t ->
+    ?proof_of_work_nonce: MBytes.t ->
+    unit -> MBytes.t shell_tzresult Lwt.t
+
+end
+
+module Parse : sig
+
+  val operations:
+    'a #RPC_context.simple -> 'a ->
+    ?check:bool -> Operation.raw list ->
+    Operation.packed list shell_tzresult Lwt.t
+
+  val block:
+    'a #RPC_context.simple -> 'a ->
+    Block_header.shell_header -> MBytes.t ->
+    Block_header.protocol_data shell_tzresult Lwt.t
+
+end
+
+val register: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/init_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/init_storage.ml
new file mode 100644
index 000000000..356f0eaa7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/init_storage.ml
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* This is the genesis protocol: initialise the state *)
+let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
+  Raw_context.prepare_first_block
+    ~level ~timestamp ~fitness ctxt >>=? fun (previous_protocol, ctxt) ->
+  match previous_protocol with
+  | Genesis param ->
+      Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->
+      Roll_storage.init ctxt >>=? fun ctxt ->
+      Seed_storage.init ctxt >>=? fun ctxt ->
+      Contract_storage.init ctxt >>=? fun ctxt ->
+      Bootstrap_storage.init ctxt
+        ~typecheck
+        ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
+        ?no_reward_cycles:param.no_reward_cycles
+        param.bootstrap_accounts
+        param.bootstrap_contracts >>=? fun ctxt ->
+      Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
+      Vote_storage.init ctxt >>=? fun ctxt ->
+      Storage.Last_block_priority.init ctxt 0 >>=? fun ctxt ->
+      return ctxt
+  | Alpha_previous ->
+      return ctxt
+
+let prepare ctxt ~level ~timestamp ~fitness =
+  Raw_context.prepare ~level ~timestamp ~fitness ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.ml
new file mode 100644
index 000000000..957e58883
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.ml
@@ -0,0 +1,148 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  level: Raw_level_repr.t ;
+  level_position: int32 ;
+  cycle: Cycle_repr.t ;
+  cycle_position: int32 ;
+  voting_period: Voting_period_repr.t ;
+  voting_period_position: int32 ;
+  expected_commitment: bool ;
+}
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare { level = l1 } { level = l2 } = Raw_level_repr.compare l1 l2
+  end)
+
+type level = t
+
+let pp ppf { level } = Raw_level_repr.pp ppf level
+
+let pp_full ppf l =
+  Format.fprintf ppf
+    "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
+    Raw_level_repr.pp l.level l.level_position
+    Cycle_repr.pp l.cycle l.cycle_position
+    Voting_period_repr.pp l.voting_period l.voting_period_position
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { level ; level_position ;
+           cycle ; cycle_position ;
+           voting_period; voting_period_position ;
+           expected_commitment } ->
+      (level, level_position,
+       cycle, cycle_position,
+       voting_period, voting_period_position,
+       expected_commitment))
+    (fun (level, level_position,
+          cycle, cycle_position,
+          voting_period, voting_period_position,
+          expected_commitment) ->
+      { level ; level_position ;
+        cycle ; cycle_position ;
+        voting_period ; voting_period_position ;
+        expected_commitment })
+    (obj7
+       (req "level"
+          ~description:
+            "The level of the block relative to genesis. This is also \
+             the Shell's notion of level"
+          Raw_level_repr.encoding)
+       (req "level_position"
+          ~description:
+            "The level of the block relative to the block that starts \
+             protocol alpha. This is specific to the protocol \
+             alpha. Other protocols might or might not include a \
+             similar notion."
+          int32)
+       (req "cycle"
+          ~description:
+            "The current cycle's number. Note that cycles are a \
+             protocol-specific notion. As a result, the cycle number starts at 0 \
+             with the first block of protocol alpha."
+          Cycle_repr.encoding)
+       (req "cycle_position"
+          ~description:
+            "The current level of the block relative to the first \
+             block of the current cycle."
+          int32)
+       (req "voting_period"
+          ~description:
+            "The current voting period's index. Note that cycles are a \
+             protocol-specific notion. As a result, the voting period \
+             index starts at 0 with the first block of protocol alpha."
+          Voting_period_repr.encoding)
+       (req "voting_period_position"
+          ~description:
+            "The current level of the block relative to the first \
+             block of the current voting period."
+          int32)
+       (req "expected_commitment"
+          ~description:
+            "Tells wether the baker of this block has to commit a seed \
+             nonce hash."
+          bool))
+
+let root first_level =
+  { level = first_level ;
+    level_position = 0l ;
+    cycle = Cycle_repr.root ;
+    cycle_position = 0l ;
+    voting_period = Voting_period_repr.root ;
+    voting_period_position = 0l ;
+    expected_commitment = false ;
+  }
+
+let from_raw
+    ~first_level ~blocks_per_cycle ~blocks_per_voting_period
+    ~blocks_per_commitment
+    level =
+  let raw_level = Raw_level_repr.to_int32 level in
+  let first_level = Raw_level_repr.to_int32 first_level in
+  let level_position =
+    Compare.Int32.max 0l (Int32.sub raw_level first_level) in
+  let cycle =
+    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in
+  let cycle_position = Int32.rem level_position blocks_per_cycle in
+  let voting_period =
+    Voting_period_repr.of_int32_exn
+      (Int32.div level_position blocks_per_voting_period) in
+  let voting_period_position =
+    Int32.rem level_position blocks_per_voting_period in
+  let expected_commitment =
+    Compare.Int32.(Int32.rem cycle_position blocks_per_commitment =
+                   Int32.pred blocks_per_commitment) in
+  { level ; level_position ;
+    cycle ; cycle_position ;
+    voting_period ; voting_period_position ;
+    expected_commitment }
+
+let diff { level = l1 ; _ } { level = l2 ; _ } =
+  Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.mli
new file mode 100644
index 000000000..d0ac31664
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_repr.mli
@@ -0,0 +1,69 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = private {
+  level: Raw_level_repr.t (** The level of the block relative to genesis. This
+                              is also the Shell's notion of level. *);
+  level_position: int32 (** The level of the block relative to the block that
+                            starts protocol alpha. This is specific to the
+                            protocol alpha. Other protocols might or might not
+                            include a similar notion. *);
+  cycle: Cycle_repr.t (** The current cycle's number. Note that cycles are a
+                          protocol-specific notion. As a result, the cycle
+                          number starts at 0 with the first block of protocol
+                          alpha. *);
+  cycle_position: int32 (** The current level of the block relative to the first
+                            block of the current cycle. *);
+  voting_period: Voting_period_repr.t ;
+  voting_period_position: int32 ;
+  expected_commitment: bool ;
+}
+
+(* Note that, the type `t` above must respect some invariants (hence the
+   `private` annotation). Notably:
+
+   level_position = cycle * blocks_per_cycle + cycle_position
+*)
+
+
+
+type level = t
+
+include Compare.S with type t := level
+
+val encoding: level Data_encoding.t
+val pp: Format.formatter -> level -> unit
+val pp_full: Format.formatter -> level -> unit
+
+val root: Raw_level_repr.t -> level
+
+val from_raw:
+  first_level:Raw_level_repr.t ->
+  blocks_per_cycle:int32 ->
+  blocks_per_voting_period:int32 ->
+  blocks_per_commitment:int32 ->
+  Raw_level_repr.t -> level
+
+val diff: level -> level -> int32
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.ml
new file mode 100644
index 000000000..956234416
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.ml
@@ -0,0 +1,112 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Level_repr
+
+let from_raw c ?offset l =
+  let l =
+    match offset with
+    | None -> l
+    | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in
+  let constants = Raw_context.constants c in
+  let first_level = Raw_context.first_level c in
+  Level_repr.from_raw
+    ~first_level
+    ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
+    ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
+    ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
+    l
+
+let root c =
+  Level_repr.root (Raw_context.first_level c)
+
+let succ c l = from_raw c (Raw_level_repr.succ l.level)
+let pred c l =
+  match Raw_level_repr.pred l.Level_repr.level with
+  | None -> None
+  | Some l -> Some (from_raw c l)
+
+let current ctxt = Raw_context.current_level ctxt
+
+let previous ctxt =
+  let l = current ctxt in
+  match pred ctxt l with
+  | None -> assert false (* We never validate the Genesis... *)
+  | Some p -> p
+
+let first_level_in_cycle ctxt c =
+  let constants = Raw_context.constants ctxt in
+  let first_level = Raw_context.first_level ctxt in
+  from_raw ctxt
+    (Raw_level_repr.of_int32_exn
+       (Int32.add
+          (Raw_level_repr.to_int32 first_level)
+          (Int32.mul
+             constants.Constants_repr.blocks_per_cycle
+             (Cycle_repr.to_int32 c))))
+
+let last_level_in_cycle ctxt c =
+  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
+  | None -> assert false
+  | Some x -> x
+
+let levels_in_cycle ctxt cycle =
+  let first = first_level_in_cycle ctxt cycle in
+  let rec loop n acc =
+    if Cycle_repr.(n.cycle = first.cycle)
+    then loop (succ ctxt n) (n :: acc)
+    else acc
+  in
+  loop first []
+
+let levels_in_current_cycle ctxt ?(offset = 0l) () =
+  let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
+  let cycle = Int32.add current_cycle offset in
+  if Compare.Int32.(cycle < 0l) then
+    []
+  else
+    let cycle = Cycle_repr.of_int32_exn cycle in
+    levels_in_cycle ctxt cycle
+
+let levels_with_commitments_in_cycle ctxt c =
+  let first = first_level_in_cycle ctxt c in
+  let rec loop n acc =
+    if Cycle_repr.(n.cycle = first.cycle)
+    then
+      if n.expected_commitment then
+        loop (succ ctxt n) (n :: acc)
+      else
+        loop (succ ctxt n) acc
+    else acc
+  in
+  loop first []
+
+
+let last_allowed_fork_level c =
+  let level = Raw_context.current_level c in
+  let preserved_cycles = Constants_storage.preserved_cycles c in
+  match Cycle_repr.sub level.cycle preserved_cycles with
+  | None -> Raw_level_repr.root
+  | Some cycle -> (first_level_in_cycle c cycle).level
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.mli
new file mode 100644
index 000000000..03b2c2991
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/level_storage.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 current: Raw_context.t -> Level_repr.t
+val previous: Raw_context.t -> Level_repr.t
+
+val root: Raw_context.t -> Level_repr.t
+
+val from_raw: Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
+val pred: Raw_context.t -> Level_repr.t -> Level_repr.t option
+val succ: Raw_context.t -> Level_repr.t -> Level_repr.t
+
+val first_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
+val last_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
+val levels_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t list
+val levels_in_current_cycle:
+  Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list
+
+val levels_with_commitments_in_cycle:
+  Raw_context.t -> Cycle_repr.t -> Level_repr.t list
+
+val last_allowed_fork_level: Raw_context.t -> Raw_level_repr.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.ml
new file mode 100644
index 000000000..caa665d55
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.ml
@@ -0,0 +1,307 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Protocol Signature Instance *)
+
+type block_header_data = Alpha_context.Block_header.protocol_data
+type block_header = Alpha_context.Block_header.t = {
+  shell: Block_header.shell_header ;
+  protocol_data: block_header_data ;
+}
+
+let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
+
+type block_header_metadata = Apply_results.block_metadata
+let block_header_metadata_encoding = Apply_results.block_metadata_encoding
+
+type operation_data = Alpha_context.packed_protocol_data =
+  | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data
+let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
+
+type operation_receipt = Apply_results.packed_operation_metadata =
+  | Operation_metadata : 'kind Apply_results.operation_metadata -> operation_receipt
+  | No_operation_metadata: operation_receipt
+let operation_receipt_encoding =
+  Apply_results.operation_metadata_encoding
+
+let operation_data_and_receipt_encoding =
+  Apply_results.operation_data_and_metadata_encoding
+
+type operation = Alpha_context.packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+
+let acceptable_passes = Alpha_context.Operation.acceptable_passes
+
+let max_block_length =
+  Alpha_context.Block_header.max_header_length
+
+let max_operation_data_length =
+  Alpha_context.Constants.max_operation_data_length
+
+let validation_passes =
+  let max_anonymous_operations =
+    Alpha_context.Constants.max_revelations_per_block +
+    (* allow 100 wallet activations or denunciations per block *) 100 in
+  Updater.[ { max_size = 32 * 1024 ; max_op = Some 32 } ; (* 32 endorsements *)
+            { max_size = 32 * 1024 ; max_op = None } ; (* 32k of voting operations *)
+            { max_size = max_anonymous_operations * 1024 ;
+              max_op = Some max_anonymous_operations } ;
+            { max_size = 512 * 1024 ; max_op = None } ] (* 512kB *)
+
+let rpc_services =
+  Alpha_services.register () ;
+  Services_registration.get_rpc_services ()
+
+type validation_mode =
+  | Application of {
+      block_header : Alpha_context.Block_header.t ;
+      baker : Alpha_context.public_key_hash ;
+    }
+  | Partial_application of {
+      block_header : Alpha_context.Block_header.t ;
+      baker : Alpha_context.public_key_hash ;
+    }
+  | Partial_construction of {
+      predecessor : Block_hash.t ;
+    }
+  | Full_construction of {
+      predecessor : Block_hash.t ;
+      protocol_data : Alpha_context.Block_header.contents ;
+      baker : Alpha_context.public_key_hash ;
+    }
+
+type validation_state =
+  { mode : validation_mode ;
+    chain_id : Chain_id.t ;
+    ctxt : Alpha_context.t ;
+    op_count : int ;
+  }
+
+let current_context { ctxt ; _ } =
+  return (Alpha_context.finalize ctxt).context
+
+let begin_partial_application
+    ~chain_id
+    ~ancestor_context:ctxt
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    (block_header : Alpha_context.Block_header.t) =
+  let level = block_header.shell.level in
+  let fitness = predecessor_fitness in
+  let timestamp = block_header.shell.timestamp in
+  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Apply.begin_application
+    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
+  let mode =
+    Partial_application
+      { block_header ; baker = Signature.Public_key.hash baker } in
+  return { mode ; chain_id ; ctxt ; op_count = 0 }
+
+let begin_application
+    ~chain_id
+    ~predecessor_context:ctxt
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    (block_header : Alpha_context.Block_header.t) =
+  let level = block_header.shell.level in
+  let fitness = predecessor_fitness in
+  let timestamp = block_header.shell.timestamp in
+  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Apply.begin_application
+    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
+  let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in
+  return { mode ; chain_id ; ctxt ; op_count = 0 }
+
+let begin_construction
+    ~chain_id
+    ~predecessor_context:ctxt
+    ~predecessor_timestamp:pred_timestamp
+    ~predecessor_level:pred_level
+    ~predecessor_fitness:pred_fitness
+    ~predecessor
+    ~timestamp
+    ?(protocol_data : block_header_data option)
+    () =
+  let level = Int32.succ pred_level in
+  let fitness = pred_fitness in
+  Alpha_context.prepare ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
+  begin
+    match protocol_data with
+    | None ->
+        Apply.begin_partial_construction ctxt >>=? fun ctxt ->
+        let mode = Partial_construction { predecessor } in
+        return (mode, ctxt)
+    | Some proto_header ->
+        Apply.begin_full_construction
+          ctxt pred_timestamp
+          proto_header.contents >>=? fun (ctxt, protocol_data, baker) ->
+        let mode =
+          let baker = Signature.Public_key.hash baker in
+          Full_construction { predecessor ; baker ; protocol_data } in
+        return (mode, ctxt)
+  end >>=? fun (mode, ctxt) ->
+  return { mode ; chain_id ; ctxt ; op_count = 0 }
+
+let apply_operation
+    ({ mode ; chain_id ; ctxt ; op_count ; _ } as data)
+    (operation : Alpha_context.packed_operation) =
+  match mode with
+  | Partial_application _ when
+      not (List.exists
+             (Compare.Int.equal 0)
+             (Alpha_context.Operation.acceptable_passes operation)) ->
+      (* Multipass validation only considers operations in pass 0. *)
+      let op_count = op_count + 1 in
+      return ({ data with ctxt ; op_count }, No_operation_metadata)
+  | _ ->
+      let { shell ; protocol_data = Operation_data protocol_data } = operation in
+      let operation : _ Alpha_context.operation = { shell ; protocol_data } in
+      let predecessor, baker =
+        match mode with
+        | Partial_application
+            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }
+        | Application
+            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }
+        | Full_construction { predecessor ; baker ; _ }
+          -> predecessor, baker
+        | Partial_construction { predecessor }
+          -> predecessor, Signature.Public_key_hash.zero
+      in
+      let partial =
+        match mode with
+        | Partial_construction _ -> true
+        | Application _
+        | Full_construction _
+        | Partial_application _ -> false in
+      Apply.apply_operation ~partial ctxt chain_id Optimized predecessor baker
+        (Alpha_context.Operation.hash operation)
+        operation >>=? fun (ctxt, result) ->
+      let op_count = op_count + 1 in
+      return ({ data with ctxt ; op_count }, Operation_metadata result)
+
+let finalize_block { mode ; ctxt ; op_count } =
+  match mode with
+  | Partial_construction _ ->
+      let level = Alpha_context.Level.current ctxt in
+      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+      let baker = Signature.Public_key_hash.zero in
+      Signature.Public_key_hash.Map.fold
+        (fun delegate deposit ctxt ->
+           ctxt >>=? fun ctxt ->
+           Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
+        (Alpha_context.get_deposits ctxt)
+        (return ctxt) >>=? fun ctxt ->
+      let ctxt = Alpha_context.finalize ctxt in
+      return (ctxt, Apply_results.{ baker ;
+                                    level ;
+                                    voting_period_kind ;
+                                    nonce_hash = None ;
+                                    consumed_gas = Z.zero ;
+                                    deactivated = [];
+                                    balance_updates = []})
+  | Partial_application { baker ; _ } ->
+      let level = Alpha_context. Level.current ctxt in
+      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+      let ctxt = Alpha_context.finalize ctxt in
+      return (ctxt, Apply_results.{ baker ;
+                                    level ;
+                                    voting_period_kind ;
+                                    nonce_hash = None ;
+                                    consumed_gas = Z.zero ;
+                                    deactivated = [];
+                                    balance_updates = []})
+  | Application
+      { baker ;  block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
+  | Full_construction { protocol_data ; baker ; _ } ->
+      Apply.finalize_application ctxt protocol_data baker >>=? fun (ctxt, receipt) ->
+      let level = Alpha_context.Level.current ctxt in
+      let priority = protocol_data.priority in
+      let raw_level = Alpha_context.Raw_level.to_int32 level.level in
+      let fitness = Alpha_context.Fitness.current ctxt in
+      let commit_message =
+        Format.asprintf
+          "lvl %ld, fit %Ld, prio %d, %d ops"
+          raw_level fitness priority op_count in
+      let ctxt = Alpha_context.finalize ~commit_message ctxt in
+      return (ctxt, receipt)
+
+let compare_operations op1 op2 =
+  let open Alpha_context in
+  let Operation_data op1 = op1.protocol_data in
+  let Operation_data op2 = op2.protocol_data in
+  match op1.contents, op2.contents with
+  | Single (Endorsement _), Single (Endorsement _) -> 0
+  | _, Single (Endorsement _) -> 1
+  | Single (Endorsement _), _ -> -1
+
+  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
+  | _, Single (Seed_nonce_revelation _) -> 1
+  | Single (Seed_nonce_revelation _), _ -> -1
+
+  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
+  | _, Single (Double_endorsement_evidence _) -> 1
+  | Single (Double_endorsement_evidence _), _ -> -1
+
+  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
+  | _, Single (Double_baking_evidence _) -> 1
+  | Single (Double_baking_evidence _), _ -> -1
+
+  | Single (Activate_account _), Single (Activate_account _) -> 0
+  | _, Single (Activate_account _) -> 1
+  | Single (Activate_account _), _ -> -1
+
+  | Single (Proposals _), Single (Proposals _) -> 0
+  | _, Single (Proposals _) -> 1
+  | Single (Proposals _), _ -> -1
+
+  | Single (Ballot _), Single (Ballot _) -> 0
+  | _, Single (Ballot _) -> 1
+  | Single (Ballot _), _ -> -1
+
+  (* Manager operations with smaller counter are pre-validated first. *)
+  | Single (Manager_operation op1), Single (Manager_operation op2) ->
+      Z.compare op1.counter op2.counter
+  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
+      Z.compare op1.counter op2.counter
+  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
+      Z.compare op1.counter op2.counter
+  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
+      Z.compare op1.counter op2.counter
+
+let init ctxt block_header =
+  let level = block_header.Block_header.level in
+  let fitness = block_header.fitness in
+  let timestamp = block_header.timestamp in
+  let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
+    Script_ir_translator.parse_script ctxt script >>=? fun (_ex_script, ctxt) ->
+    return ctxt
+  in
+  Alpha_context.prepare_first_block
+    ~typecheck
+    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  return (Alpha_context.finalize ctxt)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.mli
new file mode 100644
index 000000000..bde08a85e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/main.mli
@@ -0,0 +1,67 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Protocol Signature Instance *)
+
+type validation_mode =
+  | Application of {
+      block_header : Alpha_context.Block_header.t ;
+      baker : Alpha_context.public_key_hash ;
+    }
+  | Partial_application of {
+      block_header : Alpha_context.Block_header.t ;
+      baker : Alpha_context.public_key_hash ;
+    }
+  | Partial_construction of {
+      predecessor : Block_hash.t ;
+    }
+  | Full_construction of {
+      predecessor : Block_hash.t ;
+      protocol_data : Alpha_context.Block_header.contents ;
+      baker : Alpha_context.public_key_hash ;
+    }
+
+type validation_state =
+  { mode : validation_mode ;
+    chain_id : Chain_id.t ;
+    ctxt : Alpha_context.t ;
+    op_count : int ;
+  }
+
+type operation_data = Alpha_context.packed_protocol_data
+
+type operation = Alpha_context.packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+include Updater.PROTOCOL
+  with type block_header_data = Alpha_context.Block_header.protocol_data
+   and type block_header_metadata = Apply_results.block_metadata
+   and type block_header = Alpha_context.Block_header.t
+   and type operation_data := operation_data
+   and type operation_receipt = Apply_results.packed_operation_metadata
+   and type operation := operation
+   and type validation_state := validation_state
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.ml
new file mode 100644
index 000000000..8b7561aeb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.ml
@@ -0,0 +1,60 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)
+
+type manager_key =
+  | Hash of Signature.Public_key_hash.t
+  | Public_key of Signature.Public_key.t
+
+type t = manager_key
+
+open Data_encoding
+
+let hash_case tag =
+  case tag
+    ~title:"Public_key_hash"
+    Signature.Public_key_hash.encoding
+    (function
+      | Hash hash -> Some hash
+      | _ -> None)
+    (fun hash -> Hash hash)
+
+let pubkey_case tag =
+  case tag
+    ~title:"Public_key"
+    Signature.Public_key.encoding
+    (function
+      | Public_key hash -> Some hash
+      | _ -> None)
+    (fun hash -> Public_key hash)
+
+
+let encoding =
+  union [
+    hash_case (Tag 0) ;
+    pubkey_case (Tag 1) ;
+  ]
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.mli
new file mode 100644
index 000000000..d8970081a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/manager_repr.mli
@@ -0,0 +1,38 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)
+
+(** The public key of the manager of a contract is reveled only after the
+    first operation. At Origination time, the manager provides only the hash
+    of its public key that is stored in the contract. When the public key
+    is actually reveeld, the public key instead of the hash of the key *)
+type manager_key =
+  | Hash of Signature.Public_key_hash.t
+  | Public_key of Signature.Public_key.t
+
+type t = manager_key
+
+val encoding : t Data_encoding.encoding
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.ml
new file mode 100644
index 000000000..0e7e45617
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.ml
@@ -0,0 +1,436 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Gas
+
+module Cost_of = struct
+  let cycle = step_cost 1
+  let nop = free
+
+  let stack_op = step_cost 1
+
+  let bool_binop _ _ = step_cost 1
+  let bool_unop _ = step_cost 1
+
+  let pair = alloc_cost 2
+  let pair_access = step_cost 1
+
+  let cons = alloc_cost 2
+
+  let variant_no_data = alloc_cost 1
+
+  let branch = step_cost 2
+
+  let string length =
+    alloc_bytes_cost length
+
+  let bytes length =
+    alloc_mbytes_cost length
+
+  let zint z =
+    alloc_bits_cost (Z.numbits z)
+
+  let concat cost length ss =
+    let rec cum acc = function
+      | [] -> acc
+      | s :: ss -> cum (cost (length s) +@ acc) ss in
+    cum free ss
+
+  let concat_string ss = concat string String.length ss
+  let concat_bytes ss = concat bytes MBytes.length ss
+
+  let slice_string length = string length
+  let slice_bytes = alloc_cost 0
+
+  (* Cost per cycle of a loop, fold, etc *)
+  let loop_cycle = step_cost 2
+
+  let list_size = step_cost 1
+
+  let log2 =
+    let rec help acc = function
+      | 0 -> acc
+      | n -> help (acc + 1) (n / 2)
+    in help 1
+
+  let module_cost = alloc_cost 10
+
+  let map_access : type key value. (key, value) Script_typed_ir.map -> int
+    = fun (module Box) ->
+      log2 (snd Box.boxed)
+
+  let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
+    = fun (module Box) ->
+      let size = snd Box.boxed in
+      3 *@ alloc_cost size
+
+  let map_mem _key map = step_cost (map_access map)
+
+  let map_get = map_mem
+
+  let map_update _ _ map =
+    map_access map *@ alloc_cost 3
+
+  let map_size = step_cost 2
+
+  let big_map_mem _key _map = step_cost 50
+  let big_map_get _key _map = step_cost 50
+  let big_map_update _key _value _map = step_cost 10
+
+  let set_access : type elt. elt -> elt Script_typed_ir.set -> int
+    = fun _key (module Box) ->
+      log2 @@ Box.size
+
+  let set_mem key set = step_cost (set_access key set)
+
+  let set_update key _presence set =
+    set_access key set *@ alloc_cost 3
+
+  (* for LEFT, RIGHT, SOME *)
+  let wrap = alloc_cost 1
+
+  let mul n1 n2 =
+    let steps =
+      (Z.numbits (Script_int.to_zint n1))
+      * (Z.numbits (Script_int.to_zint n2)) in
+    let bits =
+      (Z.numbits (Script_int.to_zint n1))
+      + (Z.numbits (Script_int.to_zint n2)) in
+    step_cost steps +@ alloc_bits_cost bits
+
+  let div n1 n2 =
+    mul n1 n2 +@ alloc_cost 2
+
+  let add_sub_z n1 n2 =
+    let bits =
+      Compare.Int.max (Z.numbits n1) (Z.numbits n2) in
+    step_cost bits +@ alloc_cost bits
+
+  let add n1 n2 =
+    add_sub_z (Script_int.to_zint n1) (Script_int.to_zint n2)
+
+  let sub = add
+
+  let abs n =
+    alloc_bits_cost (Z.numbits @@ Script_int.to_zint n)
+
+  let neg = abs
+  let int _ = step_cost 1
+
+  let add_timestamp t n =
+    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)
+
+  let sub_timestamp t n =
+    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)
+
+  let diff_timestamps t1 t2 =
+    add_sub_z (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)
+
+  let empty_set = module_cost
+
+  let set_size = step_cost 2
+
+  let set_to_list : type item. item Script_typed_ir.set -> cost
+    = fun (module Box) ->
+      alloc_cost @@ Pervasives.(Box.size * 2)
+
+  let empty_map = module_cost
+
+  let int64_op = step_cost 1 +@ alloc_cost 1
+
+  let z_to_int64 = step_cost 2 +@ alloc_cost 1
+
+  let int64_to_z = step_cost 2 +@ alloc_cost 1
+
+  let bitwise_binop n1 n2 =
+    let bits = Compare.Int.max (Z.numbits (Script_int.to_zint n1)) (Z.numbits (Script_int.to_zint n2)) in
+    step_cost bits +@ alloc_bits_cost bits
+
+  let logor = bitwise_binop
+  let logand = bitwise_binop
+  let logxor = bitwise_binop
+  let lognot n =
+    let bits = Z.numbits @@ Script_int.to_zint n in
+    step_cost bits +@ alloc_cost bits
+
+  let unopt ~default = function
+    | None -> default
+    | Some x -> x
+
+  let max_int = 1073741823
+
+  let shift_left x y =
+    alloc_bits_cost
+      (Z.numbits (Script_int.to_zint x) +
+       (unopt (Script_int.to_int y) ~default:max_int))
+
+  let shift_right x y =
+    alloc_bits_cost
+      (Compare.Int.max 1
+         (Z.numbits (Script_int.to_zint x) -
+          unopt (Script_int.to_int y) ~default:max_int))
+
+  let exec = step_cost 1
+
+  let push = step_cost 1
+
+  let compare_res = step_cost 1
+
+  let unpack_failed bytes =
+    (* We cannot instrument failed deserialization,
+       so we take worst case fees: a set of size 1 bytes values. *)
+    let len = MBytes.length bytes in
+    (len *@ alloc_mbytes_cost 1) +@
+    (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+
+  let address = step_cost 1
+  let contract = Gas.read_bytes_cost Z.zero +@ step_cost 10000
+  let transfer = step_cost 10
+  let create_account = step_cost 10
+  let create_contract = step_cost 10
+  let implicit_account = step_cost 10
+  let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
+  let balance = step_cost 1 +@ read_bytes_cost (Z.of_int 8)
+  let now = step_cost 5
+  let check_signature = step_cost 1000
+  let hash_key = step_cost 3 +@ bytes 20
+  let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
+  let steps_to_quota = step_cost 1
+  let source = step_cost 1
+  let self = step_cost 1
+  let amount = step_cost 1
+  let compare_bool _ _ = step_cost 1
+  let compare_string s1 s2 =
+    step_cost ((7 + Compare.Int.max (String.length s1) (String.length s2)) / 8) +@ step_cost 1
+  let compare_bytes s1 s2 =
+    step_cost ((7 + Compare.Int.max (MBytes.length s1) (MBytes.length s2)) / 8) +@ step_cost 1
+  let compare_tez _ _ = step_cost 1
+  let compare_zint n1 n2 = step_cost ((7 + Compare.Int.max (Z.numbits n1) (Z.numbits n2)) / 8) +@ step_cost 1
+  let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2)
+  let compare_nat = compare_int
+  let compare_key_hash _ _ = alloc_bytes_cost 36
+  let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)
+  let compare_address _ _ = step_cost 20
+
+  let manager_operation = step_cost 10_000
+
+  module Typechecking = struct
+    let cycle = step_cost 1
+    let bool = free
+    let unit = free
+    let string = string
+    let bytes = bytes
+    let z = zint
+    let int_of_string str =
+      alloc_cost @@ (Pervasives.(/) (String.length str) 5)
+    let tez = step_cost 1 +@ alloc_cost 1
+    let string_timestamp = step_cost 3 +@ alloc_cost 3
+    let key = step_cost 3 +@ alloc_cost 3
+    let key_hash = step_cost 1 +@ alloc_cost 1
+    let signature = step_cost 1 +@ alloc_cost 1
+    let contract = step_cost 5
+    let get_script = step_cost 20 +@ alloc_cost 5
+    let contract_exists = step_cost 15 +@ alloc_cost 5
+    let pair = alloc_cost 2
+    let union = alloc_cost 1
+    let lambda = alloc_cost 5 +@ step_cost 3
+    let some = alloc_cost 1
+    let none = alloc_cost 0
+    let list_element = alloc_cost 2 +@ step_cost 1
+    let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)
+    let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)
+    let primitive_type = alloc_cost 1
+    let one_arg_type = alloc_cost 2
+    let two_arg_type = alloc_cost 3
+    let operation b = bytes b
+    let type_ nb_args = alloc_cost (nb_args + 1)
+
+    (* Cost of parsing instruction, is cost of allocation of
+       constructor + cost of contructor parameters + cost of
+       allocation on the stack type *)
+    let instr
+      : type b a. (b, a) Script_typed_ir.instr -> cost
+      = fun i ->
+        let open Script_typed_ir in
+        alloc_cost 1 +@ (* cost of allocation of constructor *)
+        match i with
+        | Drop -> alloc_cost 0
+        | Dup -> alloc_cost 1
+        | Swap -> alloc_cost 0
+        | Const _ -> alloc_cost 1
+        | Cons_pair -> alloc_cost 2
+        | Car -> alloc_cost 1
+        | Cdr -> alloc_cost 1
+        | Cons_some -> alloc_cost 2
+        | Cons_none _ -> alloc_cost 3
+        | If_none _ -> alloc_cost 2
+        | Left -> alloc_cost 3
+        | Right -> alloc_cost 3
+        | If_left _ -> alloc_cost 2
+        | Cons_list -> alloc_cost 1
+        | Nil -> alloc_cost 1
+        | If_cons _ -> alloc_cost 2
+        | List_map _ -> alloc_cost 5
+        | List_iter _ -> alloc_cost 4
+        | List_size -> alloc_cost 1
+        | Empty_set _ -> alloc_cost 1
+        | Set_iter _ -> alloc_cost 4
+        | Set_mem -> alloc_cost 1
+        | Set_update -> alloc_cost 1
+        | Set_size -> alloc_cost 1
+        | Empty_map _ -> alloc_cost 2
+        | Map_map _ -> alloc_cost 5
+        | Map_iter _ -> alloc_cost 4
+        | Map_mem -> alloc_cost 1
+        | Map_get -> alloc_cost 1
+        | Map_update -> alloc_cost 1
+        | Map_size -> alloc_cost 1
+        | Big_map_mem -> alloc_cost 1
+        | Big_map_get -> alloc_cost 1
+        | Big_map_update -> alloc_cost 1
+        | Concat_string -> alloc_cost 1
+        | Concat_string_pair -> alloc_cost 1
+        | Concat_bytes -> alloc_cost 1
+        | Concat_bytes_pair -> alloc_cost 1
+        | Slice_string -> alloc_cost 1
+        | Slice_bytes -> alloc_cost 1
+        | String_size -> alloc_cost 1
+        | Bytes_size -> alloc_cost 1
+        | Add_seconds_to_timestamp -> alloc_cost 1
+        | Add_timestamp_to_seconds -> alloc_cost 1
+        | Sub_timestamp_seconds -> alloc_cost 1
+        | Diff_timestamps -> alloc_cost 1
+        | Add_tez -> alloc_cost 1
+        | Sub_tez -> alloc_cost 1
+        | Mul_teznat -> alloc_cost 1
+        | Mul_nattez -> alloc_cost 1
+        | Ediv_teznat -> alloc_cost 1
+        | Ediv_tez -> alloc_cost 1
+        | Or -> alloc_cost 1
+        | And -> alloc_cost 1
+        | Xor -> alloc_cost 1
+        | Not -> alloc_cost 1
+        | Is_nat -> alloc_cost 1
+        | Neg_nat -> alloc_cost 1
+        | Neg_int -> alloc_cost 1
+        | Abs_int -> alloc_cost 1
+        | Int_nat -> alloc_cost 1
+        | Add_intint -> alloc_cost 1
+        | Add_intnat -> alloc_cost 1
+        | Add_natint -> alloc_cost 1
+        | Add_natnat -> alloc_cost 1
+        | Sub_int -> alloc_cost 1
+        | Mul_intint -> alloc_cost 1
+        | Mul_intnat -> alloc_cost 1
+        | Mul_natint -> alloc_cost 1
+        | Mul_natnat -> alloc_cost 1
+        | Ediv_intint -> alloc_cost 1
+        | Ediv_intnat -> alloc_cost 1
+        | Ediv_natint -> alloc_cost 1
+        | Ediv_natnat -> alloc_cost 1
+        | Lsl_nat -> alloc_cost 1
+        | Lsr_nat -> alloc_cost 1
+        | Or_nat -> alloc_cost 1
+        | And_nat -> alloc_cost 1
+        | And_int_nat -> alloc_cost 1
+        | Xor_nat -> alloc_cost 1
+        | Not_nat -> alloc_cost 1
+        | Not_int -> alloc_cost 1
+        | Seq _ -> alloc_cost 8
+        | If _ -> alloc_cost 8
+        | Loop _ -> alloc_cost 4
+        | Loop_left _ -> alloc_cost 5
+        | Dip _ -> alloc_cost 4
+        | Exec -> alloc_cost 1
+        | Lambda _ -> alloc_cost 2
+        | Failwith _ -> alloc_cost 1
+        | Nop -> alloc_cost 0
+        | Compare _ -> alloc_cost 1
+        | Eq -> alloc_cost 1
+        | Neq -> alloc_cost 1
+        | Lt -> alloc_cost 1
+        | Gt -> alloc_cost 1
+        | Le -> alloc_cost 1
+        | Ge -> alloc_cost 1
+        | Address -> alloc_cost 1
+        | Contract _ -> alloc_cost 2
+        | Transfer_tokens -> alloc_cost 1
+        | Create_account -> alloc_cost 2
+        | Implicit_account -> alloc_cost 1
+        | Create_contract _ -> alloc_cost 8
+        | Set_delegate -> alloc_cost 1
+        | Now -> alloc_cost 1
+        | Balance -> alloc_cost 1
+        | Check_signature -> alloc_cost 1
+        | Hash_key -> alloc_cost 1
+        | Pack _ -> alloc_cost 2
+        | Unpack _ -> alloc_cost 2
+        | Blake2b -> alloc_cost 1
+        | Sha256 -> alloc_cost 1
+        | Sha512 -> alloc_cost 1
+        | Steps_to_quota -> alloc_cost 1
+        | Source -> alloc_cost 1
+        | Sender -> alloc_cost 1
+        | Self _ -> alloc_cost 2
+        | Amount -> alloc_cost 1
+  end
+
+  module Unparse = struct
+    let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot
+    let seq_cost = Script.seq_node_cost_nonrec_of_length
+    let string_cost length = Script.string_node_cost_of_length length
+
+    let cycle = step_cost 1
+    let bool = prim_cost 0 []
+    let unit = prim_cost 0 []
+    (* We count the length of strings and bytes to prevent hidden
+       miscalculations due to non detectable expansion of sharing. *)
+    let string s = Script.string_node_cost s
+    let bytes s = Script.bytes_node_cost s
+    let z i = Script.int_node_cost i
+    let int i = Script.int_node_cost (Script_int.to_zint i)
+    let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)
+    let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
+    let operation bytes = Script.bytes_node_cost bytes
+    let key = string_cost 54
+    let key_hash = string_cost 36
+    let signature = string_cost 128
+    let contract = string_cost 36
+    let pair = prim_cost 2 []
+    let union = prim_cost 1 []
+    let some = prim_cost 1 []
+    let none = prim_cost 0 []
+    let list_element = alloc_cost 2
+    let set_element = alloc_cost 2
+    let map_element = alloc_cost 2
+    let one_arg_type = prim_cost 1
+    let two_arg_type = prim_cost 2
+
+    let set_to_list = set_to_list
+    let map_to_list = map_to_list
+  end
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.mli
new file mode 100644
index 000000000..cfb121cf9
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_gas.mli
@@ -0,0 +1,200 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+module Cost_of : sig
+  val cycle : Gas.cost
+  val loop_cycle : Gas.cost
+  val list_size : Gas.cost
+  val nop : Gas.cost
+  val stack_op : Gas.cost
+  val bool_binop : 'a -> 'b -> Gas.cost
+  val bool_unop : 'a -> Gas.cost
+  val pair : Gas.cost
+  val pair_access : Gas.cost
+  val cons : Gas.cost
+  val variant_no_data : Gas.cost
+  val branch : Gas.cost
+  val concat_string : string list -> Gas.cost
+  val concat_bytes : MBytes.t list -> Gas.cost
+  val slice_string : int -> Gas.cost
+  val slice_bytes : Gas.cost
+  val map_mem :
+    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost
+  val map_to_list :
+    ('b, 'c) Script_typed_ir.map -> Gas.cost
+  val map_get :
+    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost
+  val map_update :
+    'a -> 'b -> ('c, 'd) Script_typed_ir.map -> Gas.cost
+  val map_size : Gas.cost
+  val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
+  val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
+  val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost
+  val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+  val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
+  val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost
+  val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val abs : 'a Script_int.num -> Gas.cost
+  val neg : 'a Script_int.num -> Gas.cost
+  val int : 'a -> Gas.cost
+  val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+  val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+  val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
+  val empty_set : Gas.cost
+  val set_size : Gas.cost
+  val empty_map : Gas.cost
+  val int64_op : Gas.cost
+  val z_to_int64 : Gas.cost
+  val int64_to_z : Gas.cost
+  val bitwise_binop : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val lognot : 'a Script_int.num -> Gas.cost
+  val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val exec : Gas.cost
+  val push : Gas.cost
+  val compare_res : Gas.cost
+  val unpack_failed : MBytes.t -> Gas.cost
+  val address : Gas.cost
+  val contract : Gas.cost
+  val transfer : Gas.cost
+  val create_account : Gas.cost
+  val create_contract : Gas.cost
+  val implicit_account : Gas.cost
+  val set_delegate : Gas.cost
+  val balance : Gas.cost
+  val now : Gas.cost
+  val check_signature : Gas.cost
+  val hash_key : Gas.cost
+  val hash : MBytes.t -> int -> Gas.cost
+  val steps_to_quota : Gas.cost
+  val source : Gas.cost
+  val self : Gas.cost
+  val amount : Gas.cost
+  val wrap : Gas.cost
+  val compare_bool : 'a -> 'b -> Gas.cost
+  val compare_string : string -> string -> Gas.cost
+  val compare_bytes : MBytes.t -> MBytes.t -> Gas.cost
+  val compare_tez : 'a -> 'b -> Gas.cost
+  val compare_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+  val compare_key_hash : 'a -> 'b -> Gas.cost
+  val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
+  val compare_address : Contract.t -> Contract.t -> Gas.cost
+
+  val manager_operation : Gas.cost
+
+  module Typechecking : sig
+    val cycle : Gas.cost
+    val unit : Gas.cost
+    val bool : Gas.cost
+    val tez : Gas.cost
+    val z : Z.t -> Gas.cost
+    val string : int -> Gas.cost
+    val bytes : int -> Gas.cost
+    val int_of_string : string -> Gas.cost
+    val string_timestamp : Gas.cost
+    val key : Gas.cost
+    val key_hash : Gas.cost
+    val signature : Gas.cost
+
+    val contract : Gas.cost
+
+    (** Gas.Cost of getting the code for a contract *)
+    val get_script : Gas.cost
+
+    val contract_exists : Gas.cost
+
+    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
+    val pair : Gas.cost
+
+    val union : Gas.cost
+
+    val lambda : Gas.cost
+
+    val some : Gas.cost
+    val none : Gas.cost
+
+    val list_element : Gas.cost
+    val set_element : int -> Gas.cost
+    val map_element : int -> Gas.cost
+
+    val primitive_type : Gas.cost
+    val one_arg_type : Gas.cost
+    val two_arg_type : Gas.cost
+
+    val operation : int -> Gas.cost
+
+    (** Cost of parsing a type *)
+    val type_ : int -> Gas.cost
+
+    (** Cost of parsing an instruction *)
+    val instr : ('a, 'b) Script_typed_ir.instr -> Gas.cost
+  end
+
+  module Unparse : sig
+    val prim_cost : int -> Script.annot -> Gas.cost
+    val seq_cost : int -> Gas.cost
+    val cycle : Gas.cost
+    val unit : Gas.cost
+    val bool : Gas.cost
+    val z : Z.t -> Gas.cost
+    val int : 'a Script_int.num -> Gas.cost
+    val tez : Gas.cost
+    val string : string -> Gas.cost
+    val bytes : MBytes.t -> Gas.cost
+    val timestamp : Script_timestamp.t -> Gas.cost
+    val key : Gas.cost
+    val key_hash : Gas.cost
+    val signature : Gas.cost
+    val operation : MBytes.t -> Gas.cost
+
+    val contract : Gas.cost
+
+    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
+    val pair : Gas.cost
+
+    val union : Gas.cost
+
+    val some : Gas.cost
+    val none : Gas.cost
+
+    val list_element : Gas.cost
+    val set_element : Gas.cost
+    val map_element : Gas.cost
+
+    val one_arg_type : Script.annot -> Gas.cost
+    val two_arg_type : Script.annot -> Gas.cost
+    val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
+  end
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml
new file mode 100644
index 000000000..da4da1aa7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Micheline
+
+include Michelson_primitives
+
+type error += Unknown_primitive_name of string (* `Permanent *)
+type error += Invalid_case of string (* `Permanent *)
+type error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location (* `Permanent *)
+
+let prim_of_string x = match prim_of_string x with
+  | Ok x -> ok x
+  | Error (Unknown_primitive_name x) -> error (Unknown_primitive_name x)
+  | Error (Invalid_case x) -> error (Invalid_case x)
+  | Error (Invalid_primitive_name (a , b)) -> error (Invalid_primitive_name (a , b))
+
+let prims_of_strings x = match prims_of_strings x with
+  | Ok x -> ok x
+  | Error (Unknown_primitive_name x) -> error (Unknown_primitive_name x)
+  | Error (Invalid_case x) -> error (Invalid_case x)
+  | Error (Invalid_primitive_name (a , b)) -> error (Invalid_primitive_name (a , b))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli
new file mode 100644
index 000000000..de5abfb5b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli
@@ -0,0 +1,153 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Unknown_primitive_name of string (* `Permanent *)
+type error += Invalid_case of string (* `Permanent *)
+type error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location (* `Permanent *)
+
+type prim = Micheline.Michelson_primitives.prim =
+  | K_parameter
+  | K_storage
+  | K_code
+  | D_False
+  | D_Elt
+  | D_Left
+  | D_None
+  | D_Pair
+  | D_Right
+  | D_Some
+  | D_True
+  | D_Unit
+  | I_PACK
+  | I_UNPACK
+  | I_BLAKE2B
+  | I_SHA256
+  | I_SHA512
+  | I_ABS
+  | I_ADD
+  | I_AMOUNT
+  | I_AND
+  | I_BALANCE
+  | I_CAR
+  | I_CDR
+  | I_CHECK_SIGNATURE
+  | I_COMPARE
+  | I_CONCAT
+  | I_CONS
+  | I_CREATE_ACCOUNT
+  | I_CREATE_CONTRACT
+  | I_IMPLICIT_ACCOUNT
+  | I_DIP
+  | I_DROP
+  | I_DUP
+  | I_EDIV
+  | I_EMPTY_MAP
+  | I_EMPTY_SET
+  | I_EQ
+  | I_EXEC
+  | I_FAILWITH
+  | I_GE
+  | I_GET
+  | I_GT
+  | I_HASH_KEY
+  | I_IF
+  | I_IF_CONS
+  | I_IF_LEFT
+  | I_IF_NONE
+  | I_INT
+  | I_LAMBDA
+  | I_LE
+  | I_LEFT
+  | I_LOOP
+  | I_LSL
+  | I_LSR
+  | I_LT
+  | I_MAP
+  | I_MEM
+  | I_MUL
+  | I_NEG
+  | I_NEQ
+  | I_NIL
+  | I_NONE
+  | I_NOP
+  | I_NOT
+  | I_NOW
+  | I_OR
+  | I_PAIR
+  | I_PUSH
+  | I_RIGHT
+  | I_SIZE
+  | I_SOME
+  | I_SOURCE
+  | I_SENDER
+  | I_SELF
+  | I_SLICE
+  | I_STEPS_TO_QUOTA
+  | I_SUB
+  | I_SWAP
+  | I_TRANSFER_TOKENS
+  | I_SET_DELEGATE
+  | I_UNIT
+  | I_UPDATE
+  | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
+  | I_ADDRESS
+  | I_CONTRACT
+  | I_ISNAT
+  | I_CAST
+  | I_RENAME
+  | T_bool
+  | T_contract
+  | T_int
+  | T_key
+  | T_key_hash
+  | T_lambda
+  | T_list
+  | T_map
+  | T_big_map
+  | T_nat
+  | T_option
+  | T_or
+  | T_pair
+  | T_set
+  | T_signature
+  | T_string
+  | T_bytes
+  | T_mutez
+  | T_timestamp
+  | T_unit
+  | T_operation
+  | T_address
+
+val prim_encoding : prim Data_encoding.encoding
+
+val string_of_prim : prim -> string
+
+val prim_of_string : string -> prim tzresult
+
+val prims_of_strings : string Micheline.canonical -> prim Micheline.canonical tzresult
+
+val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.ml
new file mode 100644
index 000000000..26be1e0eb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.ml
@@ -0,0 +1,95 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type 'a lazyt = unit -> 'a
+type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t
+
+let rec (-->) i j = (* [i; i+1; ...; j] *)
+  if Compare.Int.(i > j)
+  then []
+  else i :: (succ i --> j)
+
+let rec (--->) i j = (* [i; i+1; ...; j] *)
+  if Compare.Int32.(i > j)
+  then []
+  else i :: (Int32.succ i ---> j)
+
+let split delim ?(limit = max_int) path =
+  let l = String.length path in
+  let rec do_slashes acc limit i =
+    if Compare.Int.(i >= l) then
+      List.rev acc
+    else if Compare.Char.(String.get path i = delim) then
+      do_slashes acc limit (i + 1)
+    else
+      do_split acc limit i
+  and do_split acc limit i =
+    if Compare.Int.(limit <= 0) then
+      if Compare.Int.(i = l) then
+        List.rev acc
+      else
+        List.rev (String.sub path i (l - i) :: acc)
+    else
+      do_component acc (pred limit) i i
+  and do_component acc limit i j =
+    if Compare.Int.(j >= l) then
+      if Compare.Int.(i = j) then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if Compare.Char.(String.get path j = delim) then
+      do_slashes (String.sub path i (j - i) :: acc) limit j
+    else
+      do_component acc limit i (j + 1) in
+  if Compare.Int.(limit > 0) then
+    do_slashes [] limit 0
+  else
+    [ path ]
+
+let pp_print_paragraph ppf description =
+  Format.fprintf ppf "@[%a@]"
+    Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
+    (split ' ' description)
+
+let take n l =
+  let rec loop acc n = function
+    | xs when Compare.Int.(n <= 0) -> Some (List.rev acc, xs)
+    | [] -> None
+    | x :: xs -> loop (x :: acc) (n-1) xs in
+  loop [] n l
+
+let remove_prefix ~prefix s =
+  let x = String.length prefix in
+  let n = String.length s in
+  if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then
+    Some (String.sub s x (n - x))
+  else
+    None
+
+let rec remove_elem_from_list nb = function
+  | [] -> []
+  | l when Compare.Int.(nb <= 0) -> l
+  | _ :: tl -> remove_elem_from_list (nb - 1) tl
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.mli
new file mode 100644
index 000000000..6e359e0b4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/misc.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** {2 Stuff} ****************************************************************)
+
+type 'a lazyt = unit -> 'a
+type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t
+
+(** Include bounds *)
+val (-->) : int -> int -> int list
+val (--->) : Int32.t -> Int32.t -> Int32.t list
+
+val pp_print_paragraph : Format.formatter -> string -> unit
+
+val take: int -> 'a list -> ('a list * 'a list) option
+
+(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
+val remove_prefix: prefix:string -> string -> string option
+
+(** [remove nb list] remove the first [nb] elements from the list [list]. *)
+val remove_elem_from_list: int -> 'a list -> 'a list
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_hash.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_hash.ml
new file mode 100644
index 000000000..931011a92
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_hash.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* 32 *)
+let nonce_hash = "\069\220\169" (* nce(53) *)
+
+include Blake2B.Make(Base58)(struct
+    let name = "cycle_nonce"
+    let title = "A nonce hash"
+    let b58check_prefix = nonce_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "nce" 53
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.ml
new file mode 100644
index 000000000..2a43e2d9c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.ml
@@ -0,0 +1,121 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Seed_repr.nonce
+type nonce = t
+let encoding = Seed_repr.nonce_encoding
+
+type error +=
+  | Too_late_revelation
+  | Too_early_revelation
+  | Previously_revealed_nonce
+  | Unexpected_nonce
+
+let () =
+  register_error_kind
+    `Branch
+    ~id:"nonce.too_late_revelation"
+    ~title:"Too late nonce revelation"
+    ~description:"Nonce revelation happens too late"
+    ~pp: (fun ppf () ->
+        Format.fprintf ppf "This nonce cannot be revealed anymore.")
+    Data_encoding.unit
+    (function Too_late_revelation -> Some () | _ -> None)
+    (fun () -> Too_late_revelation) ;
+  register_error_kind
+    `Temporary
+    ~id:"nonce.too_early_revelation"
+    ~title:"Too early nonce revelation"
+    ~description:"Nonce revelation happens before cycle end"
+    ~pp: (fun ppf () ->
+        Format.fprintf ppf "This nonce should not yet be revealed")
+    Data_encoding.unit
+    (function Too_early_revelation -> Some () | _ -> None)
+    (fun () -> Too_early_revelation) ;
+  register_error_kind
+    `Branch
+    ~id:"nonce.previously_revealed"
+    ~title:"Previously revealed nonce"
+    ~description:"Duplicated revelation for a nonce."
+    ~pp: (fun ppf () ->
+        Format.fprintf ppf "This nonce was previously revealed")
+    Data_encoding.unit
+    (function Previously_revealed_nonce -> Some () | _ -> None)
+    (fun () -> Previously_revealed_nonce) ;
+  register_error_kind
+    `Branch
+    ~id:"nonce.unexpected"
+    ~title:"Unexpected nonce"
+    ~description:"The provided nonce is inconsistent with the committed nonce hash."
+    ~pp: (fun ppf () ->
+        Format.fprintf ppf "This nonce revelation is invalid (inconsistent with the committed hash)")
+    Data_encoding.unit
+    (function Unexpected_nonce -> Some () | _ -> None)
+    (fun () -> Unexpected_nonce)
+
+(* checks that the level of a revelation is not too early or too late wrt to the
+   current context and that a nonce has not been already revealed for that level *)
+let get_unrevealed ctxt level =
+  let cur_level = Level_storage.current ctxt in
+  match Cycle_repr.pred cur_level.cycle with
+  | None -> fail Too_early_revelation (* no revelations during cycle 0 *)
+  | Some revealed_cycle ->
+      if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then
+        fail Too_early_revelation
+      else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then
+        fail Too_late_revelation
+      else
+        Storage.Seed.Nonce.get ctxt level >>=? function
+        | Revealed _ -> fail Previously_revealed_nonce
+        | Unrevealed status -> return status
+
+let record_hash ctxt unrevealed =
+  let level = Level_storage.current ctxt in
+  Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed)
+
+let reveal ctxt level nonce =
+  get_unrevealed ctxt level >>=? fun unrevealed ->
+  fail_unless
+    (Seed_repr.check_hash nonce unrevealed.nonce_hash)
+    Unexpected_nonce >>=? fun () ->
+  Storage.Seed.Nonce.set ctxt level (Revealed nonce) >>=? fun ctxt ->
+  return ctxt
+
+type unrevealed = Storage.Seed.unrevealed_nonce = {
+  nonce_hash: Nonce_hash.t ;
+  delegate: Signature.Public_key_hash.t ;
+  rewards: Tez_repr.t ;
+  fees: Tez_repr.t ;
+}
+
+type status = Storage.Seed.nonce_status =
+  | Unrevealed of unrevealed
+  | Revealed of Seed_repr.nonce
+
+let get = Storage.Seed.Nonce.get
+
+let of_bytes = Seed_repr.make_nonce
+let hash = Seed_repr.hash
+let check_hash = Seed_repr.check_hash
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.mli
new file mode 100644
index 000000000..026f9a4e2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/nonce_storage.mli
@@ -0,0 +1,57 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error +=
+  | Too_late_revelation
+  | Too_early_revelation
+  | Previously_revealed_nonce
+  | Unexpected_nonce
+
+type t = Seed_repr.nonce
+type nonce = t
+val encoding: nonce Data_encoding.t
+
+type unrevealed = Storage.Seed.unrevealed_nonce = {
+  nonce_hash: Nonce_hash.t ;
+  delegate: Signature.Public_key_hash.t ;
+  rewards: Tez_repr.t ;
+  fees: Tez_repr.t ;
+}
+
+type status =
+  | Unrevealed of unrevealed
+  | Revealed of Seed_repr.nonce
+
+val get: Raw_context.t -> Level_repr.t -> status tzresult Lwt.t
+
+val record_hash:
+  Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t
+
+val reveal:
+  Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t
+
+val of_bytes: MBytes.t -> nonce tzresult
+val hash: nonce -> Nonce_hash.t
+val check_hash: nonce -> Nonce_hash.t -> bool
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.ml
new file mode 100644
index 000000000..f6302e130
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.ml
@@ -0,0 +1,765 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Low level Repr. of Operations *)
+
+module Kind = struct
+  type seed_nonce_revelation = Seed_nonce_revelation_kind
+  type double_endorsement_evidence = Double_endorsement_evidence_kind
+  type double_baking_evidence = Double_baking_evidence_kind
+  type activate_account = Activate_account_kind
+  type endorsement = Endorsement_kind
+  type proposals = Proposals_kind
+  type ballot = Ballot_kind
+  type reveal = Reveal_kind
+  type transaction = Transaction_kind
+  type origination = Origination_kind
+  type delegation = Delegation_kind
+  type 'a manager =
+    | Reveal_manager_kind : reveal manager
+    | Transaction_manager_kind : transaction manager
+    | Origination_manager_kind : origination manager
+    | Delegation_manager_kind : delegation manager
+end
+
+type raw = Operation.t = {
+  shell: Operation.shell_header ;
+  proto: MBytes.t ;
+}
+
+let raw_encoding = Operation.encoding
+
+type 'kind operation = {
+  shell: Operation.shell_header ;
+  protocol_data: 'kind protocol_data ;
+}
+
+and 'kind protocol_data = {
+  contents: 'kind contents_list ;
+  signature: Signature.t option ;
+}
+
+and _ contents_list =
+  | Single : 'kind contents -> 'kind contents_list
+  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+    (('kind * 'rest) Kind.manager ) contents_list
+
+and _ contents =
+  | Endorsement : {
+      level: Raw_level_repr.t ;
+    } -> Kind.endorsement contents
+  | Seed_nonce_revelation : {
+      level: Raw_level_repr.t ;
+      nonce: Seed_repr.nonce ;
+    } -> Kind.seed_nonce_revelation contents
+  | Double_endorsement_evidence : {
+      op1: Kind.endorsement operation ;
+      op2: Kind.endorsement operation ;
+    } -> Kind.double_endorsement_evidence contents
+  | Double_baking_evidence : {
+      bh1: Block_header_repr.t ;
+      bh2: Block_header_repr.t ;
+    } -> Kind.double_baking_evidence contents
+  | Activate_account : {
+      id: Ed25519.Public_key_hash.t ;
+      activation_code: Blinded_public_key_hash.activation_code ;
+    } -> Kind.activate_account contents
+  | Proposals : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period_repr.t ;
+      proposals: Protocol_hash.t list ;
+    } -> Kind.proposals contents
+  | Ballot : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period_repr.t ;
+      proposal: Protocol_hash.t ;
+      ballot: Vote_repr.ballot ;
+    } -> Kind.ballot contents
+  | Manager_operation : {
+      source: Contract_repr.contract ;
+      fee: Tez_repr.tez ;
+      counter: counter ;
+      operation: 'kind manager_operation ;
+      gas_limit: Z.t;
+      storage_limit: Z.t;
+    } -> 'kind Kind.manager contents
+
+and _ manager_operation =
+  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
+  | Transaction : {
+      amount: Tez_repr.tez ;
+      parameters: Script_repr.lazy_expr option ;
+      destination: Contract_repr.contract ;
+    } -> Kind.transaction manager_operation
+  | Origination : {
+      manager: Signature.Public_key_hash.t ;
+      delegate: Signature.Public_key_hash.t option ;
+      script: Script_repr.t option ;
+      spendable: bool ;
+      delegatable: bool ;
+      credit: Tez_repr.tez ;
+      preorigination: Contract_repr.t option ;
+    } -> Kind.origination manager_operation
+  | Delegation :
+      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
+
+and counter = Z.t
+
+let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
+  function
+  | Reveal _ -> Kind.Reveal_manager_kind
+  | Transaction _ -> Kind.Transaction_manager_kind
+  | Origination _ -> Kind.Origination_manager_kind
+  | Delegation _ -> Kind.Delegation_manager_kind
+
+type 'kind internal_operation = {
+  source: Contract_repr.contract ;
+  operation: 'kind manager_operation ;
+  nonce: int ;
+}
+
+type packed_manager_operation =
+  | Manager : 'kind manager_operation -> packed_manager_operation
+
+type packed_contents =
+  | Contents : 'kind contents -> packed_contents
+
+type packed_contents_list =
+  | Contents_list : 'kind contents_list -> packed_contents_list
+
+type packed_protocol_data =
+  | Operation_data : 'kind protocol_data -> packed_protocol_data
+
+type packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: packed_protocol_data ;
+}
+
+let pack ({ shell ; protocol_data} : _ operation) : packed_operation = {
+  shell ;
+  protocol_data = Operation_data protocol_data ;
+}
+
+type packed_internal_operation =
+  | Internal_operation : 'kind internal_operation -> packed_internal_operation
+
+let rec to_list = function
+  | Contents_list (Single o) -> [Contents o]
+  | Contents_list (Cons (o, os)) ->
+      Contents o :: to_list (Contents_list os)
+
+let rec of_list = function
+  | [] -> assert false
+  | [Contents o] -> Contents_list (Single o)
+  | (Contents o) :: os ->
+      let Contents_list os = of_list os in
+      match o, os with
+      | Manager_operation _, Single (Manager_operation _) ->
+          Contents_list (Cons (o, os))
+      | Manager_operation _, Cons _ ->
+          Contents_list (Cons (o, os))
+      | _ ->
+          Pervasives.failwith "Operation list of length > 1 \
+                               should only contains manager operations."
+
+module Encoding = struct
+
+  open Data_encoding
+
+  let case tag name args proj inj =
+    let open Data_encoding in
+    case tag
+      ~title:(String.capitalize_ascii name)
+      (merge_objs
+         (obj1 (req "kind" (constant name)))
+         args)
+      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
+      (fun ((), x) -> inj x)
+
+  module Manager_operations = struct
+
+    type 'kind case =
+        MCase : { tag: int ;
+                  name: string ;
+                  encoding: 'a Data_encoding.t ;
+                  select: packed_manager_operation -> 'kind manager_operation option ;
+                  proj: 'kind manager_operation -> 'a ;
+                  inj: 'a -> 'kind manager_operation } -> 'kind case
+
+    let reveal_case =
+      MCase {
+        tag = 0 ;
+        name = "reveal" ;
+        encoding =
+          (obj1
+             (req "public_key" Signature.Public_key.encoding)) ;
+        select =
+          (function
+            | Manager (Reveal _ as op) -> Some op
+            | _ -> None) ;
+        proj =
+          (function Reveal pkh -> pkh) ;
+        inj =
+          (fun pkh -> Reveal pkh)
+      }
+
+    let transaction_case =
+      MCase {
+        tag = 1 ;
+        name = "transaction" ;
+        encoding =
+          (obj3
+             (req "amount" Tez_repr.encoding)
+             (req "destination" Contract_repr.encoding)
+             (opt "parameters" Script_repr.lazy_expr_encoding)) ;
+        select =
+          (function
+            | Manager (Transaction _ as op) -> Some op
+            | _ -> None) ;
+        proj =
+          (function
+            | Transaction { amount ; destination ; parameters } ->
+                (amount, destination, parameters)) ;
+        inj =
+          (fun (amount, destination, parameters) ->
+             Transaction { amount ; destination ; parameters })
+      }
+
+    let origination_case =
+      MCase {
+        tag = 2 ;
+        name = "origination" ;
+        encoding =
+          (obj6
+             (req "managerPubkey" Signature.Public_key_hash.encoding)
+             (req "balance" Tez_repr.encoding)
+             (dft "spendable" bool true)
+             (dft "delegatable" bool true)
+             (opt "delegate" Signature.Public_key_hash.encoding)
+             (opt "script" Script_repr.encoding)) ;
+        select =
+          (function
+            | Manager (Origination _ as op) -> Some op
+            | _ -> None) ;
+        proj =
+          (function
+            | Origination { manager ; credit ; spendable ;
+                            delegatable ; delegate ; script ;
+                            preorigination = _
+                            (* the hash is only used internally
+                               when originating from smart
+                               contracts, don't serialize it *) } ->
+                (manager, credit, spendable,
+                 delegatable, delegate, script)) ;
+        inj =
+          (fun (manager, credit, spendable, delegatable, delegate, script) ->
+             Origination
+               {manager ; credit ; spendable ; delegatable ;
+                delegate ; script ; preorigination = None })
+      }
+
+    let delegation_case =
+      MCase {
+        tag = 3 ;
+        name = "delegation" ;
+        encoding =
+          (obj1
+             (opt "delegate" Signature.Public_key_hash.encoding)) ;
+        select =
+          (function
+            | Manager (Delegation _ as op) -> Some op
+            | _ -> None) ;
+        proj =
+          (function Delegation key -> key) ;
+        inj =
+          (fun key -> Delegation key)
+      }
+
+    let encoding =
+      let make (MCase { tag ; name ; encoding ; select ; proj ; inj }) =
+        case (Tag tag) name encoding
+          (fun o -> match select o with None -> None | Some o -> Some (proj o))
+          (fun x -> Manager (inj x)) in
+      union ~tag_size:`Uint8 [
+        make reveal_case ;
+        make transaction_case ;
+        make origination_case ;
+        make delegation_case ;
+      ]
+
+  end
+
+  type 'b case =
+      Case : { tag: int ;
+               name: string ;
+               encoding: 'a Data_encoding.t ;
+               select: packed_contents -> 'b contents option ;
+               proj: 'b contents -> 'a ;
+               inj: 'a -> 'b contents } -> 'b case
+
+  let endorsement_encoding =
+    obj1
+      (req "level" Raw_level_repr.encoding)
+
+  let endorsement_case =
+    Case {
+      tag = 0 ;
+      name = "endorsement" ;
+      encoding = endorsement_encoding ;
+      select =
+        (function
+          | Contents (Endorsement _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Endorsement { level }) -> level) ;
+      inj =
+        (fun level -> Endorsement { level })
+    }
+
+  let endorsement_encoding =
+    let make (Case { tag ; name ; encoding ; select = _ ; proj ; inj }) =
+      case (Tag tag) name encoding
+        (fun o -> Some (proj o))
+        (fun x -> inj x) in
+    let to_list : Kind.endorsement contents_list -> _ = function
+      | Single o -> o in
+    let of_list : Kind.endorsement contents -> _ = function
+      | o -> Single o in
+    def "inlined.endorsement" @@
+    conv
+      (fun ({ shell ; protocol_data = { contents ; signature } } : _ operation)->
+         (shell, (contents, signature)))
+      (fun (shell, (contents, signature)) ->
+         ({ shell ; protocol_data = { contents ; signature }} : _ operation))
+      (merge_objs
+         Operation.shell_header_encoding
+         (obj2
+            (req "operations"
+               (conv to_list of_list  @@
+                def "inlined.endorsement.contents" @@
+                union [
+                  make endorsement_case ;
+                ]))
+            (varopt "signature" Signature.encoding)))
+
+  let seed_nonce_revelation_case =
+    Case {
+      tag = 1;
+      name = "seed_nonce_revelation" ;
+      encoding =
+        (obj2
+           (req "level" Raw_level_repr.encoding)
+           (req "nonce" Seed_repr.nonce_encoding)) ;
+      select =
+        (function
+          | Contents (Seed_nonce_revelation _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Seed_nonce_revelation { level ; nonce }) -> (level, nonce)) ;
+      inj =
+        (fun (level, nonce) -> Seed_nonce_revelation { level ; nonce })
+    }
+
+  let double_endorsement_evidence_case : Kind.double_endorsement_evidence case =
+    Case {
+      tag = 2 ;
+      name = "double_endorsement_evidence" ;
+      encoding =
+        (obj2
+           (req "op1" (dynamic_size endorsement_encoding))
+           (req "op2" (dynamic_size endorsement_encoding))) ;
+      select =
+        (function
+          | Contents (Double_endorsement_evidence _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Double_endorsement_evidence { op1 ; op2 }) -> (op1, op2)) ;
+      inj =
+        (fun (op1, op2) -> (Double_endorsement_evidence { op1 ; op2 }))
+    }
+
+  let double_baking_evidence_case =
+    Case {
+      tag = 3 ;
+      name = "double_baking_evidence" ;
+      encoding =
+        (obj2
+           (req "bh1" (dynamic_size Block_header_repr.encoding))
+           (req "bh2" (dynamic_size Block_header_repr.encoding))) ;
+      select =
+        (function
+          | Contents (Double_baking_evidence _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Double_baking_evidence { bh1 ; bh2 }) -> (bh1, bh2)) ;
+      inj =
+        (fun (bh1, bh2) -> Double_baking_evidence { bh1 ; bh2 }) ;
+    }
+
+  let activate_account_case =
+    Case {
+      tag = 4 ;
+      name = "activate_account" ;
+      encoding =
+        (obj2
+           (req "pkh" Ed25519.Public_key_hash.encoding)
+           (req "secret" Blinded_public_key_hash.activation_code_encoding)) ;
+      select =
+        (function
+          | Contents (Activate_account _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Activate_account { id ; activation_code }) -> (id, activation_code)) ;
+      inj =
+        (fun (id, activation_code) -> Activate_account { id ; activation_code })
+    }
+
+  let proposals_case =
+    Case {
+      tag = 5 ;
+      name = "proposals" ;
+      encoding =
+        (obj3
+           (req "source" Signature.Public_key_hash.encoding)
+           (req "period" Voting_period_repr.encoding)
+           (req "proposals" (list Protocol_hash.encoding))) ;
+      select =
+        (function
+          | Contents (Proposals _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (fun (Proposals { source ; period ; proposals }) ->
+           (source, period, proposals)) ;
+      inj =
+        (fun (source, period, proposals) ->
+           Proposals { source ; period ; proposals }) ;
+    }
+
+  let ballot_case =
+    Case {
+      tag = 6 ;
+      name = "ballot" ;
+      encoding =
+        (obj4
+           (req "source" Signature.Public_key_hash.encoding)
+           (req "period" Voting_period_repr.encoding)
+           (req "proposal" Protocol_hash.encoding)
+           (req "ballot" Vote_repr.ballot_encoding)) ;
+      select =
+        (function
+          | Contents (Ballot _ as op) -> Some op
+          | _ -> None) ;
+      proj =
+        (function
+            (Ballot { source ; period ; proposal ; ballot }) ->
+              (source, period, proposal, ballot)) ;
+      inj =
+        (fun (source, period, proposal, ballot) ->
+           Ballot { source ; period ; proposal ; ballot }) ;
+    }
+
+  let manager_encoding =
+    (obj5
+       (req "source" Contract_repr.encoding)
+       (req "fee" Tez_repr.encoding)
+       (req "counter" (check_size 10 n))
+       (req "gas_limit" (check_size 10 n))
+       (req "storage_limit" (check_size 10 n)))
+
+  let extract
+      (type kind)
+      (Manager_operation { source ; fee ; counter ;
+                           gas_limit ; storage_limit ; operation = _ } : kind Kind.manager contents) =
+    (source, fee, counter, gas_limit, storage_limit)
+
+  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =
+    Manager_operation { source ; fee ; counter ;
+                        gas_limit ; storage_limit ; operation }
+
+  let make_manager_case tag
+      (type kind)
+      (Manager_operations.MCase mcase : kind Manager_operations.case) =
+    Case {
+      tag ;
+      name = mcase.name ;
+      encoding =
+        merge_objs
+          manager_encoding
+          mcase.encoding ;
+      select =
+        (function
+          | Contents (Manager_operation ({ operation ; _ } as op)) -> begin
+              match mcase.select (Manager operation) with
+              | None -> None
+              | Some operation ->
+                  Some (Manager_operation { op with operation })
+            end
+          | _ -> None) ;
+      proj =
+        (function
+          | Manager_operation { operation ; _ } as op ->
+              (extract op, mcase.proj operation )) ;
+      inj =
+        (fun (op, contents) ->
+           (rebuild op (mcase.inj contents)))
+    }
+
+  let reveal_case = make_manager_case 7 Manager_operations.reveal_case
+  let transaction_case = make_manager_case 8 Manager_operations.transaction_case
+  let origination_case = make_manager_case 9 Manager_operations.origination_case
+  let delegation_case = make_manager_case 10 Manager_operations.delegation_case
+
+  let contents_encoding =
+    let make (Case { tag ; name ; encoding ; select ; proj ; inj }) =
+      case (Tag tag) name encoding
+        (fun o -> match select o with None -> None | Some o -> Some (proj o))
+        (fun x -> Contents (inj x)) in
+    def "operation.alpha.contents" @@
+    union [
+      make endorsement_case ;
+      make seed_nonce_revelation_case ;
+      make double_endorsement_evidence_case ;
+      make double_baking_evidence_case ;
+      make activate_account_case ;
+      make proposals_case ;
+      make ballot_case ;
+      make reveal_case ;
+      make transaction_case ;
+      make origination_case ;
+      make delegation_case ;
+    ]
+
+  let contents_list_encoding =
+    conv to_list of_list (Variable.list contents_encoding)
+
+  let optional_signature_encoding =
+    conv
+      (function Some s -> s | None -> Signature.zero)
+      (fun s -> if Signature.equal s Signature.zero then None else Some s)
+      Signature.encoding
+
+  let protocol_data_encoding =
+    def "operation.alpha.contents_and_signature" @@
+    conv
+      (fun (Operation_data { contents ; signature }) ->
+         (Contents_list contents, signature))
+      (fun (Contents_list contents, signature) ->
+         Operation_data { contents ; signature })
+      (obj2
+         (req "contents" contents_list_encoding)
+         (req "signature" optional_signature_encoding))
+
+  let operation_encoding =
+    conv
+      (fun ({ shell ; protocol_data }) ->
+         (shell, protocol_data))
+      (fun (shell, protocol_data) ->
+         { shell ; protocol_data })
+      (merge_objs
+         Operation.shell_header_encoding
+         protocol_data_encoding)
+
+  let unsigned_operation_encoding =
+    def "operation.alpha.unsigned_operation" @@
+    merge_objs
+      Operation.shell_header_encoding
+      (obj1 (req "contents" contents_list_encoding))
+
+  let internal_operation_encoding =
+    def "operation.alpha.internal_operation" @@
+    conv
+      (fun (Internal_operation { source ; operation ; nonce }) ->
+         ((source, nonce), Manager operation))
+      (fun ((source, nonce), Manager operation) ->
+         Internal_operation { source ; operation ; nonce })
+      (merge_objs
+         (obj2
+            (req "source" Contract_repr.encoding)
+            (req "nonce" uint16))
+         Manager_operations.encoding)
+
+end
+
+let encoding = Encoding.operation_encoding
+let contents_encoding = Encoding.contents_encoding
+let contents_list_encoding = Encoding.contents_list_encoding
+let protocol_data_encoding = Encoding.protocol_data_encoding
+let unsigned_operation_encoding = Encoding.unsigned_operation_encoding
+let internal_operation_encoding = Encoding.internal_operation_encoding
+
+let raw ({ shell ; protocol_data } : _ operation) =
+  let proto =
+    Data_encoding.Binary.to_bytes_exn
+      protocol_data_encoding
+      (Operation_data protocol_data) in
+  { Operation.shell ; proto }
+
+let acceptable_passes (op : packed_operation) =
+  let Operation_data protocol_data = op.protocol_data in
+  match protocol_data.contents with
+
+  | Single (Endorsement _) -> [0]
+
+  | Single (Proposals _ ) -> [1]
+  | Single (Ballot _ ) -> [1]
+
+  | Single (Seed_nonce_revelation _) -> [2]
+  | Single (Double_endorsement_evidence _) -> [2]
+  | Single (Double_baking_evidence _) -> [2]
+  | Single (Activate_account _) -> [2]
+
+  | Single (Manager_operation _) -> [3]
+  | Cons _ -> [3]
+
+type error += Invalid_signature (* `Permanent *)
+type error += Missing_signature (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"operation.invalid_signature"
+    ~title:"Invalid operation signature"
+    ~description:"The operation signature is ill-formed \
+                  or has been made with the wrong public key"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The operation signature is invalid")
+    Data_encoding.unit
+    (function Invalid_signature -> Some () | _ -> None)
+    (fun () -> Invalid_signature) ;
+  register_error_kind
+    `Permanent
+    ~id:"operation.missing_signature"
+    ~title:"Missing operation signature"
+    ~description:"The operation is of a kind that must be signed, \
+                  but the signature is missing"
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "The operation requires a signature")
+    Data_encoding.unit
+    (function Missing_signature -> Some () | _ -> None)
+    (fun () -> Missing_signature)
+
+let check_signature_sync (type kind) key chain_id ({ shell ; protocol_data } : kind operation) =
+  let check ~watermark contents signature =
+    let unsigned_operation =
+      Data_encoding.Binary.to_bytes_exn
+        unsigned_operation_encoding (shell, contents) in
+    if Signature.check ~watermark key signature unsigned_operation then
+      Ok ()
+    else
+      Error [Invalid_signature] in
+  match protocol_data.contents, protocol_data.signature with
+  | Single _, None ->
+      Error [Missing_signature]
+  | Cons _, None ->
+      Error [Missing_signature]
+  | Single (Endorsement _) as contents, Some signature ->
+      check ~watermark:(Endorsement chain_id) (Contents_list contents) signature
+  | Single _ as contents, Some signature ->
+      check ~watermark:Generic_operation (Contents_list contents) signature
+  | Cons _ as contents, Some signature ->
+      check ~watermark:Generic_operation (Contents_list contents) signature
+
+let check_signature pk chain_id op =
+  Lwt.return (check_signature_sync pk chain_id op)
+
+let hash_raw = Operation.hash
+let hash (o : _ operation) =
+  let proto =
+    Data_encoding.Binary.to_bytes_exn
+      protocol_data_encoding
+      (Operation_data o.protocol_data) in
+  Operation.hash { shell = o.shell ; proto }
+let hash_packed (o : packed_operation) =
+  let proto =
+    Data_encoding.Binary.to_bytes_exn
+      protocol_data_encoding
+      o.protocol_data in
+  Operation.hash { shell = o.shell ; proto }
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+
+let equal_manager_operation_kind
+  : type a b. a manager_operation -> b manager_operation -> (a, b) eq option
+  = fun op1 op2 ->
+    match op1, op2 with
+    | Reveal _, Reveal _ -> Some Eq
+    | Reveal _, _ -> None
+    | Transaction _, Transaction _ -> Some Eq
+    | Transaction _, _ -> None
+    | Origination _, Origination _ -> Some Eq
+    | Origination _, _ -> None
+    | Delegation _, Delegation _ -> Some Eq
+    | Delegation _, _ -> None
+
+let equal_contents_kind
+  : type a b. a contents -> b contents -> (a, b) eq option
+  = fun op1 op2 ->
+    match op1, op2 with
+    | Endorsement _, Endorsement _ -> Some Eq
+    | Endorsement _, _ -> None
+    | Seed_nonce_revelation _, Seed_nonce_revelation _ -> Some Eq
+    | Seed_nonce_revelation _, _ -> None
+    | Double_endorsement_evidence _, Double_endorsement_evidence _ -> Some Eq
+    | Double_endorsement_evidence _, _ -> None
+    | Double_baking_evidence _, Double_baking_evidence _ -> Some Eq
+    | Double_baking_evidence _, _ -> None
+    | Activate_account _, Activate_account _ -> Some Eq
+    | Activate_account _, _ -> None
+    | Proposals _, Proposals _ -> Some Eq
+    | Proposals _, _ -> None
+    | Ballot _, Ballot _ -> Some Eq
+    | Ballot _, _ -> None
+    | Manager_operation op1, Manager_operation op2 -> begin
+        match equal_manager_operation_kind op1.operation op2.operation with
+        | None -> None
+        | Some Eq -> Some Eq
+      end
+    | Manager_operation _, _ -> None
+
+let rec equal_contents_kind_list
+  : type a b. a contents_list -> b contents_list -> (a, b) eq option
+  = fun op1 op2 ->
+    match op1, op2 with
+    | Single op1, Single op2 ->
+        equal_contents_kind op1 op2
+    | Single _, Cons _ -> None
+    | Cons _, Single _ -> None
+    | Cons (op1, ops1), Cons (op2, ops2) -> begin
+        match equal_contents_kind op1 op2 with
+        | None -> None
+        | Some Eq ->
+            match equal_contents_kind_list ops1 ops2 with
+            | None -> None
+            | Some Eq -> Some Eq
+      end
+
+let equal
+  : type a b. a operation -> b operation -> (a, b) eq option
+  = fun op1 op2 ->
+    if not (Operation_hash.equal (hash op1) (hash op2)) then
+      None
+    else
+      equal_contents_kind_list
+        op1.protocol_data.contents op2.protocol_data.contents
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.mli
new file mode 100644
index 000000000..fe1dcb754
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/operation_repr.mli
@@ -0,0 +1,232 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Low level Repr. of Operations *)
+
+module Kind : sig
+  type seed_nonce_revelation = Seed_nonce_revelation_kind
+  type double_endorsement_evidence = Double_endorsement_evidence_kind
+  type double_baking_evidence = Double_baking_evidence_kind
+  type activate_account = Activate_account_kind
+  type endorsement = Endorsement_kind
+  type proposals = Proposals_kind
+  type ballot = Ballot_kind
+  type reveal = Reveal_kind
+  type transaction = Transaction_kind
+  type origination = Origination_kind
+  type delegation = Delegation_kind
+  type 'a manager =
+    | Reveal_manager_kind : reveal manager
+    | Transaction_manager_kind : transaction manager
+    | Origination_manager_kind : origination manager
+    | Delegation_manager_kind : delegation manager
+
+end
+
+type raw = Operation.t = {
+  shell: Operation.shell_header ;
+  proto: MBytes.t ;
+}
+
+val raw_encoding: raw Data_encoding.t
+
+type 'kind operation = {
+  shell: Operation.shell_header ;
+  protocol_data: 'kind protocol_data ;
+}
+
+and 'kind protocol_data = {
+  contents: 'kind contents_list ;
+  signature: Signature.t option ;
+}
+
+and _ contents_list =
+  | Single : 'kind contents -> 'kind contents_list
+  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+    (('kind * 'rest) Kind.manager ) contents_list
+
+and _ contents =
+  | Endorsement : {
+      level: Raw_level_repr.t ;
+    } -> Kind.endorsement contents
+  | Seed_nonce_revelation : {
+      level: Raw_level_repr.t ;
+      nonce: Seed_repr.nonce ;
+    } -> Kind.seed_nonce_revelation contents
+  | Double_endorsement_evidence : {
+      op1: Kind.endorsement operation ;
+      op2: Kind.endorsement operation ;
+    } -> Kind.double_endorsement_evidence contents
+  | Double_baking_evidence : {
+      bh1: Block_header_repr.t ;
+      bh2: Block_header_repr.t ;
+    } -> Kind.double_baking_evidence contents
+  | Activate_account : {
+      id: Ed25519.Public_key_hash.t ;
+      activation_code: Blinded_public_key_hash.activation_code ;
+    } -> Kind.activate_account contents
+  | Proposals : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period_repr.t ;
+      proposals: Protocol_hash.t list ;
+    } -> Kind.proposals contents
+  | Ballot : {
+      source: Signature.Public_key_hash.t ;
+      period: Voting_period_repr.t ;
+      proposal: Protocol_hash.t ;
+      ballot: Vote_repr.ballot ;
+    } -> Kind.ballot contents
+  | Manager_operation : {
+      source: Contract_repr.contract ;
+      fee: Tez_repr.tez ;
+      counter: counter ;
+      operation: 'kind manager_operation ;
+      gas_limit: Z.t;
+      storage_limit: Z.t;
+    } -> 'kind Kind.manager contents
+
+and _ manager_operation =
+  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
+  | Transaction : {
+      amount: Tez_repr.tez ;
+      parameters: Script_repr.lazy_expr option ;
+      destination: Contract_repr.contract ;
+    } -> Kind.transaction manager_operation
+  | Origination : {
+      manager: Signature.Public_key_hash.t ;
+      delegate: Signature.Public_key_hash.t option ;
+      script: Script_repr.t option ;
+      spendable: bool ;
+      delegatable: bool ;
+      credit: Tez_repr.tez ;
+      preorigination: Contract_repr.t option ;
+    } -> Kind.origination manager_operation
+  | Delegation :
+      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
+
+and counter = Z.t
+
+type 'kind internal_operation = {
+  source: Contract_repr.contract ;
+  operation: 'kind manager_operation ;
+  nonce: int ;
+}
+
+type packed_manager_operation =
+  | Manager : 'kind manager_operation -> packed_manager_operation
+
+type packed_contents =
+  | Contents : 'kind contents -> packed_contents
+
+type packed_contents_list =
+  | Contents_list : 'kind contents_list -> packed_contents_list
+
+val of_list: packed_contents list -> packed_contents_list
+val to_list: packed_contents_list -> packed_contents list
+
+type packed_protocol_data =
+  | Operation_data : 'kind protocol_data -> packed_protocol_data
+
+type packed_operation = {
+  shell: Operation.shell_header ;
+  protocol_data: packed_protocol_data ;
+}
+
+val pack: 'kind operation -> packed_operation
+
+type packed_internal_operation =
+  | Internal_operation : 'kind internal_operation -> packed_internal_operation
+
+val manager_kind: 'kind manager_operation -> 'kind Kind.manager
+
+val encoding: packed_operation Data_encoding.t
+val contents_encoding: packed_contents Data_encoding.t
+val contents_list_encoding: packed_contents_list Data_encoding.t
+val protocol_data_encoding: packed_protocol_data Data_encoding.t
+val unsigned_operation_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
+
+val raw: _ operation -> raw
+
+val hash_raw: raw -> Operation_hash.t
+val hash: _ operation -> Operation_hash.t
+val hash_packed: packed_operation -> Operation_hash.t
+
+val acceptable_passes: packed_operation -> int list
+
+type error += Missing_signature (* `Permanent *)
+type error += Invalid_signature (* `Permanent *)
+
+val check_signature:
+  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult Lwt.t
+val check_signature_sync:
+  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult
+
+
+val internal_operation_encoding:
+  packed_internal_operation Data_encoding.t
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+val equal: 'a operation -> 'b operation -> ('a, 'b) eq option
+
+module Encoding : sig
+
+  type 'b case =
+      Case : { tag: int ;
+               name: string ;
+               encoding: 'a Data_encoding.t ;
+               select: packed_contents -> 'b contents option ;
+               proj: 'b contents -> 'a ;
+               inj: 'a -> 'b contents } -> 'b case
+
+  val endorsement_case: Kind.endorsement case
+  val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
+  val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
+  val double_baking_evidence_case: Kind.double_baking_evidence case
+  val activate_account_case: Kind.activate_account case
+  val proposals_case: Kind.proposals case
+  val ballot_case: Kind.ballot case
+  val reveal_case: Kind.reveal Kind.manager case
+  val transaction_case: Kind.transaction Kind.manager case
+  val origination_case: Kind.origination Kind.manager case
+  val delegation_case: Kind.delegation Kind.manager case
+
+  module Manager_operations : sig
+
+    type 'b case =
+        MCase : { tag: int ;
+                  name: string ;
+                  encoding: 'a Data_encoding.t ;
+                  select: packed_manager_operation -> 'kind manager_operation option ;
+                  proj: 'kind manager_operation -> 'a ;
+                  inj: 'a -> 'kind manager_operation } -> 'kind case
+
+    val reveal_case: Kind.reveal case
+    val transaction_case: Kind.transaction case
+    val origination_case: Kind.origination case
+    val delegation_case: Kind.delegation case
+
+  end
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.ml
new file mode 100644
index 000000000..78d46ca45
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.ml
@@ -0,0 +1,290 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type bootstrap_account = {
+  public_key_hash : Signature.Public_key_hash.t ;
+  public_key : Signature.Public_key.t option ;
+  amount : Tez_repr.t ;
+}
+
+type bootstrap_contract = {
+  delegate : Signature.Public_key_hash.t ;
+  amount : Tez_repr.t ;
+  script : Script_repr.t ;
+}
+
+type t = {
+  bootstrap_accounts : bootstrap_account list ;
+  bootstrap_contracts : bootstrap_contract list ;
+  commitments : Commitment_repr.t list ;
+  constants : Constants_repr.parametric ;
+  security_deposit_ramp_up_cycles : int option ;
+  no_reward_cycles : int option ;
+}
+
+let bootstrap_account_encoding =
+  let open Data_encoding in
+  union
+    [ case (Tag 0) ~title:"Public_key_known"
+        (tup2
+           Signature.Public_key.encoding
+           Tez_repr.encoding)
+        (function
+          | { public_key_hash ; public_key = Some public_key ; amount } ->
+              assert (Signature.Public_key_hash.equal
+                        (Signature.Public_key.hash public_key)
+                        public_key_hash) ;
+              Some (public_key, amount)
+          | { public_key = None }  -> None)
+        (fun (public_key, amount) ->
+           { public_key = Some public_key ;
+             public_key_hash = Signature.Public_key.hash public_key ;
+             amount }) ;
+      case (Tag 1) ~title:"Public_key_unknown"
+        (tup2
+           Signature.Public_key_hash.encoding
+           Tez_repr.encoding)
+        (function
+          | { public_key_hash ; public_key = None ; amount } ->
+              Some (public_key_hash, amount)
+          | { public_key = Some _ }  -> None)
+        (fun (public_key_hash, amount) ->
+           { public_key = None ;
+             public_key_hash ;
+             amount }) ]
+
+let bootstrap_contract_encoding =
+  let open Data_encoding in
+  conv
+    (fun { delegate ; amount ; script } -> (delegate, amount, script))
+    (fun (delegate, amount, script) -> { delegate ; amount ; script })
+    (obj3
+       (req "delegate" Signature.Public_key_hash.encoding)
+       (req "amount" Tez_repr.encoding)
+       (req "script" Script_repr.encoding))
+
+(* This encoding is used to read configuration files (e.g. sandbox.json)
+   where some fields can be missing, in that case they are replaced by
+   the default. *)
+let constants_encoding =
+  let open Data_encoding in
+  conv
+    (fun (c : Constants_repr.parametric) ->
+       let module Compare_time_between_blocks = Compare.List (Period_repr) in
+       let module Compare_keys = Compare.List (Ed25519.Public_key) in
+       let opt (=) def v = if def = v then None else Some v in
+       let default = Constants_repr.default in
+       let preserved_cycles =
+         opt Compare.Int.(=)
+           default.preserved_cycles c.preserved_cycles
+       and blocks_per_cycle =
+         opt Compare.Int32.(=)
+           default.blocks_per_cycle c.blocks_per_cycle
+       and blocks_per_commitment =
+         opt Compare.Int32.(=)
+           default.blocks_per_commitment c.blocks_per_commitment
+       and blocks_per_roll_snapshot =
+         opt Compare.Int32.(=)
+           default.blocks_per_roll_snapshot c.blocks_per_roll_snapshot
+       and blocks_per_voting_period =
+         opt Compare.Int32.(=)
+           default.blocks_per_voting_period c.blocks_per_voting_period
+       and time_between_blocks =
+         opt Compare_time_between_blocks.(=)
+           default.time_between_blocks c.time_between_blocks
+       and endorsers_per_block =
+         opt Compare.Int.(=)
+           default.endorsers_per_block c.endorsers_per_block
+       and hard_gas_limit_per_operation =
+         opt Compare.Z.(=)
+           default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation
+       and hard_gas_limit_per_block =
+         opt Compare.Z.(=)
+           default.hard_gas_limit_per_block c.hard_gas_limit_per_block
+       and proof_of_work_threshold =
+         opt Compare.Int64.(=)
+           default.proof_of_work_threshold c.proof_of_work_threshold
+       and tokens_per_roll =
+         opt Tez_repr.(=)
+           default.tokens_per_roll c.tokens_per_roll
+       and michelson_maximum_type_size =
+         opt Compare.Int.(=)
+           default.michelson_maximum_type_size c.michelson_maximum_type_size
+       and seed_nonce_revelation_tip =
+         opt Tez_repr.(=)
+           default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
+       and origination_size =
+         opt Compare.Int.(=)
+           default.origination_size c.origination_size
+       and block_security_deposit =
+         opt Tez_repr.(=)
+           default.block_security_deposit c.block_security_deposit
+       and endorsement_security_deposit =
+         opt Tez_repr.(=)
+           default.endorsement_security_deposit c.endorsement_security_deposit
+       and block_reward =
+         opt Tez_repr.(=)
+           default.block_reward c.block_reward
+       and endorsement_reward =
+         opt Tez_repr.(=)
+           default.endorsement_reward c.endorsement_reward
+       and cost_per_byte =
+         opt Tez_repr.(=)
+           default.cost_per_byte c.cost_per_byte
+       and hard_storage_limit_per_operation =
+         opt Compare.Z.(=)
+           default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation
+       in
+       (( 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))))
+    (fun (( 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))) ->
+      let unopt def = function None -> def | Some v -> v in
+      let default = Constants_repr.default in
+      { Constants_repr.preserved_cycles =
+          unopt default.preserved_cycles preserved_cycles ;
+        blocks_per_cycle =
+          unopt default.blocks_per_cycle blocks_per_cycle ;
+        blocks_per_commitment =
+          unopt default.blocks_per_commitment blocks_per_commitment ;
+        blocks_per_roll_snapshot =
+          unopt default.blocks_per_roll_snapshot blocks_per_roll_snapshot ;
+        blocks_per_voting_period =
+          unopt default.blocks_per_voting_period blocks_per_voting_period ;
+        time_between_blocks =
+          unopt default.time_between_blocks @@
+          time_between_blocks ;
+        endorsers_per_block =
+          unopt default.endorsers_per_block endorsers_per_block ;
+        hard_gas_limit_per_operation =
+          unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;
+        hard_gas_limit_per_block =
+          unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;
+        proof_of_work_threshold =
+          unopt default.proof_of_work_threshold proof_of_work_threshold ;
+        tokens_per_roll =
+          unopt default.tokens_per_roll tokens_per_roll ;
+        michelson_maximum_type_size =
+          unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
+        seed_nonce_revelation_tip =
+          unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
+        origination_size =
+          unopt default.origination_size origination_size ;
+        block_security_deposit =
+          unopt default.block_security_deposit block_security_deposit ;
+        endorsement_security_deposit =
+          unopt default.endorsement_security_deposit endorsement_security_deposit ;
+        block_reward =
+          unopt default.block_reward block_reward ;
+        endorsement_reward =
+          unopt default.endorsement_reward endorsement_reward ;
+        cost_per_byte =
+          unopt default.cost_per_byte cost_per_byte ;
+        hard_storage_limit_per_operation =
+          unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ;
+      } )
+    (merge_objs
+       (obj9
+          (opt "preserved_cycles" uint8)
+          (opt "blocks_per_cycle" int32)
+          (opt "blocks_per_commitment" int32)
+          (opt "blocks_per_roll_snapshot" int32)
+          (opt "blocks_per_voting_period" int32)
+          (opt "time_between_blocks" (list Period_repr.encoding))
+          (opt "endorsers_per_block" uint16)
+          (opt "hard_gas_limit_per_operation" z)
+          (opt "hard_gas_limit_per_block" z))
+       (merge_objs
+          (obj8
+             (opt "proof_of_work_threshold" int64)
+             (opt "tokens_per_roll" Tez_repr.encoding)
+             (opt "michelson_maximum_type_size" uint16)
+             (opt "seed_nonce_revelation_tip" Tez_repr.encoding)
+             (opt "origination_size" int31)
+             (opt "block_security_deposit" Tez_repr.encoding)
+             (opt "endorsement_security_deposit" Tez_repr.encoding)
+             (opt "block_reward" Tez_repr.encoding))
+          (obj3
+             (opt "endorsement_reward" Tez_repr.encoding)
+             (opt "cost_per_byte" Tez_repr.encoding)
+             (opt "hard_storage_limit_per_operation" z))))
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;
+           security_deposit_ramp_up_cycles ; no_reward_cycles } ->
+      ((bootstrap_accounts, bootstrap_contracts, commitments,
+        security_deposit_ramp_up_cycles, no_reward_cycles),
+       constants))
+    (fun ( (bootstrap_accounts, bootstrap_contracts, commitments,
+            security_deposit_ramp_up_cycles, no_reward_cycles),
+           constants) ->
+      { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;
+        security_deposit_ramp_up_cycles ; no_reward_cycles })
+    (merge_objs
+       (obj5
+          (req "bootstrap_accounts" (list bootstrap_account_encoding))
+          (dft "bootstrap_contracts" (list bootstrap_contract_encoding) [])
+          (dft "commitments" (list Commitment_repr.encoding) [])
+          (opt "security_deposit_ramp_up_cycles" int31)
+          (opt "no_reward_cycles" int31))
+       constants_encoding)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.mli
new file mode 100644
index 000000000..458182195
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/parameters_repr.mli
@@ -0,0 +1,48 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type bootstrap_account = {
+  public_key_hash : Signature.Public_key_hash.t ;
+  public_key : Signature.Public_key.t option ;
+  amount : Tez_repr.t ;
+}
+
+type bootstrap_contract = {
+  delegate : Signature.Public_key_hash.t ;
+  amount : Tez_repr.t ;
+  script : Script_repr.t ;
+}
+
+type t = {
+  bootstrap_accounts : bootstrap_account list ;
+  bootstrap_contracts : bootstrap_contract list ;
+  commitments : Commitment_repr.t list ;
+  constants : Constants_repr.parametric ;
+  security_deposit_ramp_up_cycles : int option ;
+  no_reward_cycles : int option ;
+}
+
+val encoding: t Data_encoding.t
+val constants_encoding: Constants_repr.parametric Data_encoding.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.ml
new file mode 100644
index 000000000..f1a97d561
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.ml
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Int64.t
+type period = t
+include (Compare.Int64 : Compare.S with type t := t)
+let encoding = Data_encoding.int64
+
+let pp ppf v = Format.fprintf ppf "%Ld" v
+
+type error += (* `Permanent *)
+  | Malformed_period
+  | Invalid_arg
+
+let () =
+  let open Data_encoding in
+  (* Malformed period *)
+  register_error_kind
+    `Permanent
+    ~id:"malformed_period"
+    ~title:"Malformed period"
+    ~description:"Period is negative."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Malformed period")
+    empty
+    (function Malformed_period -> Some () | _ -> None)
+    (fun () -> Malformed_period) ;
+  (* Invalid arg *)
+  register_error_kind
+    `Permanent
+    ~id:"invalid_arg"
+    ~title:"Invalid arg"
+    ~description:"Negative multiple of periods are not allowed."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid arg")
+    empty
+    (function Invalid_arg -> Some () | _ -> None)
+    (fun () -> Invalid_arg)
+
+let of_seconds t =
+  if Compare.Int64.(t >= 0L)
+  then ok t
+  else error Malformed_period
+let to_seconds t = t
+let of_seconds_exn t =
+  match of_seconds t with
+  | Ok t -> t
+  | _ -> invalid_arg "Period.of_seconds_exn"
+
+let mult i p =
+  (* TODO check overflow *)
+  if Compare.Int32.(i < 0l)
+  then error Invalid_arg
+  else ok (Int64.mul (Int64.of_int32 i) p)
+
+let one_second = of_seconds_exn 1L
+let one_minute = of_seconds_exn 60L
+let one_hour = of_seconds_exn 3600L
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.mli
new file mode 100644
index 000000000..555b704df
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/period_repr.mli
@@ -0,0 +1,46 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+type period = t
+include Compare.S with type t := t
+val encoding : period Data_encoding.t
+val pp: Format.formatter -> period -> unit
+
+
+val to_seconds : period -> int64
+
+(** [of_second period] fails if period is not positive *)
+val of_seconds : int64 -> period tzresult
+
+(** [of_second period] fails if period is not positive.
+    It should only be used at toplevel for constants. *)
+val of_seconds_exn : int64 -> period
+
+val mult : int32 -> period -> period tzresult
+
+val one_second : period
+val one_minute : period
+val one_hour : period
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/qty_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/qty_repr.ml
new file mode 100644
index 000000000..02fc79723
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/qty_repr.ml
@@ -0,0 +1,313 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module type QTY = sig
+  val id : string
+end
+
+module type S = sig
+  type qty
+
+  type error +=
+    | Addition_overflow of qty * qty (* `Temporary *)
+    | Subtraction_underflow of qty * qty (* `Temporary *)
+    | Multiplication_overflow of qty * int64 (* `Temporary *)
+    | Negative_multiplicator of qty * int64 (* `Temporary *)
+    | Invalid_divisor of qty * int64 (* `Temporary *)
+
+  val id : string
+  val zero : qty
+  val one_mutez : qty
+  val one_cent : qty
+  val fifty_cents : qty
+  val one : qty
+
+  val ( -? ) : qty -> qty -> qty tzresult
+  val ( +? ) : qty -> qty -> qty tzresult
+  val ( *? ) : qty -> int64 -> qty tzresult
+  val ( /? ) : qty -> int64 -> qty tzresult
+
+  val to_mutez : qty -> int64
+
+  (** [of_mutez n] (micro tez) is None if n is negative *)
+  val of_mutez : int64 -> qty option
+
+  (** [of_mutez_exn n] fails if n is negative.
+      It should only be used at toplevel for constants. *)
+  val of_mutez_exn : int64 -> qty
+
+  (** It should only be used at toplevel for constants. *)
+  val add_exn : qty -> qty -> qty
+
+  (** It should only be used at toplevel for constants. *)
+  val mul_exn : qty -> int -> qty
+
+  val encoding : qty Data_encoding.t
+
+  val to_int64 : qty -> int64
+
+  include Compare.S with type t := qty
+
+  val pp: Format.formatter -> qty -> unit
+
+  val of_string: string -> qty option
+  val to_string: qty -> string
+
+end
+
+module Make (T: QTY) : S = struct
+
+  type qty = int64 (* invariant: positive *)
+
+  type error +=
+    | Addition_overflow of qty * qty (* `Temporary *)
+    | Subtraction_underflow of qty * qty (* `Temporary *)
+    | Multiplication_overflow of qty * int64 (* `Temporary *)
+    | Negative_multiplicator of qty * int64 (* `Temporary *)
+    | Invalid_divisor of qty * int64 (* `Temporary *)
+
+  include Compare.Int64
+  let zero = 0L
+  (* all other constant are defined from the value of one micro tez *)
+  let one_mutez = 1L
+  let one_cent = Int64.mul one_mutez 10_000L
+  let fifty_cents = Int64.mul one_cent 50L
+  (* 1 tez = 100 cents = 1_000_000 mutez *)
+  let one = Int64.mul one_cent 100L
+  let id = T.id
+
+  let of_string s =
+    let triplets = function
+      | hd :: tl ->
+          let len = String.length hd in
+          Compare.Int.(
+            len <= 3 && len > 0 &&
+            List.for_all (fun s -> String.length s = 3) tl
+          )
+      | [] -> false in
+    let integers s = triplets (String.split_on_char ',' s) in
+    let decimals s =
+      let l = String.split_on_char ',' s in
+      if Compare.Int.(List.length l > 2) then
+        false
+      else
+        triplets (List.rev l) in
+    let parse left right =
+      let remove_commas s = String.concat "" (String.split_on_char ',' s) in
+      let pad_to_six s =
+        let len = String.length s in
+        String.init 6 (fun i -> if Compare.Int.(i < len) then String.get s i else '0') in
+      try
+        Some (Int64.of_string (remove_commas left ^ pad_to_six (remove_commas right)))
+      with _ -> None in
+    match String.split_on_char '.' s with
+    | [ left ; right ] ->
+        if String.contains s ',' then
+          if integers left && decimals right then
+            parse left right
+          else
+            None
+        else if Compare.Int.(String.length right > 0)
+             && Compare.Int.(String.length right <= 6) then
+          parse left right
+        else None
+    | [ left ] ->
+        if not (String.contains s ',') || integers left then
+          parse left ""
+        else None
+    | _ -> None
+
+  let pp ppf amount =
+    let mult_int = 1_000_000L in
+    let rec left ppf amount =
+      let d, r = Int64.(div amount 1000L), Int64.(rem amount 1000L) in
+      if d > 0L then
+        Format.fprintf ppf "%a%03Ld" left d r
+      else
+        Format.fprintf ppf "%Ld" r in
+    let right ppf amount =
+      let triplet ppf v =
+        if Compare.Int.(v mod 10 > 0) then
+          Format.fprintf ppf "%03d" v
+        else if Compare.Int.(v mod 100 > 0) then
+          Format.fprintf ppf "%02d" (v / 10)
+        else
+          Format.fprintf ppf "%d" (v / 100) in
+      let hi, lo = amount / 1000, amount mod 1000 in
+      if Compare.Int.(lo = 0) then
+        Format.fprintf ppf "%a" triplet hi
+      else
+        Format.fprintf ppf "%03d%a" hi triplet lo in
+    let ints, decs =
+      Int64.(div amount mult_int),
+      Int64.(to_int (rem amount mult_int)) in
+    Format.fprintf ppf "%a" left ints ;
+    if Compare.Int.(decs > 0) then
+      Format.fprintf ppf ".%a" right decs
+
+  let to_string t =
+    Format.asprintf "%a" pp t
+
+  let (-) t1 t2 =
+    if t2 <= t1
+    then Some (Int64.sub t1 t2)
+    else None
+
+  let ( -? ) t1 t2 =
+    match t1 - t2 with
+    | None -> error (Subtraction_underflow (t1, t2))
+    | Some v -> ok v
+
+  let ( +? ) t1 t2 =
+    let t = Int64.add t1 t2 in
+    if t < t1
+    then error (Addition_overflow (t1, t2))
+    else ok t
+
+  let ( *? ) t m =
+    let open Compare.Int64 in
+    let open Int64 in
+    let rec step cur pow acc =
+      if cur = 0L then
+        ok acc
+      else
+        pow +? pow >>? fun npow ->
+        if logand cur 1L = 1L then
+          acc +? pow >>? fun nacc ->
+          step (shift_right_logical cur 1) npow nacc
+        else
+          step (shift_right_logical cur 1) npow acc in
+    if m < 0L then
+      error (Negative_multiplicator (t, m))
+    else
+      match step m t 0L with
+      | Ok res -> Ok res
+      | Error ([ Addition_overflow _ ] as errs) ->
+          Error (Multiplication_overflow (t, m) :: errs)
+      | Error errs -> Error errs
+
+  let ( /? ) t d =
+    if d <= 0L then
+      error (Invalid_divisor (t, d))
+    else
+      ok (Int64.div t d)
+
+  let add_exn t1 t2 =
+    let t = Int64.add t1 t2 in
+    if t <= 0L
+    then invalid_arg "add_exn"
+    else t
+
+  let mul_exn t m =
+    match t *? Int64.(of_int m) with
+    | Ok v -> v
+    | Error _ -> invalid_arg "mul_exn"
+
+  let of_mutez t =
+    if t < 0L then None
+    else Some t
+
+  let of_mutez_exn x =
+    match of_mutez x with
+    | None -> invalid_arg "Qty.of_mutez"
+    | Some v -> v
+
+  let to_int64 t = t
+  let to_mutez t = t
+
+  let encoding =
+    let open Data_encoding in
+    (check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n))
+
+  let () =
+    let open Data_encoding in
+    register_error_kind
+      `Temporary
+      ~id:(T.id ^ ".addition_overflow")
+      ~title:("Overflowing " ^ T.id ^ " addition")
+      ~pp: (fun ppf (opa, opb) ->
+          Format.fprintf ppf "Overflowing addition of %a %s and %a %s"
+            pp opa T.id pp opb T.id)
+      ~description:
+        ("An addition of two " ^ T.id ^ " amounts overflowed")
+      (obj1 (req "amounts" (tup2 encoding encoding)))
+      (function Addition_overflow (a, b) -> Some (a, b) | _ -> None)
+      (fun (a, b) -> Addition_overflow (a, b)) ;
+    register_error_kind
+      `Temporary
+      ~id:(T.id ^ ".subtraction_underflow")
+      ~title:("Underflowing " ^ T.id ^ " subtraction")
+      ~pp: (fun ppf (opa, opb) ->
+          Format.fprintf ppf "Underflowing subtraction of %a %s and %a %s"
+            pp opa T.id pp opb T.id)
+      ~description:
+        ("An subtraction of two " ^ T.id ^ " amounts underflowed")
+      (obj1 (req "amounts" (tup2 encoding encoding)))
+      (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None)
+      (fun (a, b) -> Subtraction_underflow (a, b)) ;
+    register_error_kind
+      `Temporary
+      ~id:(T.id ^ ".multiplication_overflow")
+      ~title:("Overflowing " ^ T.id ^ " multiplication")
+      ~pp: (fun ppf (opa, opb) ->
+          Format.fprintf ppf "Overflowing multiplication of %a %s and %Ld"
+            pp opa T.id opb)
+      ~description:
+        ("A multiplication of a " ^ T.id ^ " amount by an integer overflowed")
+      (obj2
+         (req "amount" encoding)
+         (req "multiplicator" int64))
+      (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None)
+      (fun (a, b) -> Multiplication_overflow (a, b)) ;
+    register_error_kind
+      `Temporary
+      ~id:(T.id ^ ".negative_multiplicator")
+      ~title:("Negative " ^ T.id ^ " multiplicator")
+      ~pp: (fun ppf (opa, opb) ->
+          Format.fprintf ppf "Multiplication of %a %s by negative integer %Ld"
+            pp opa T.id opb)
+      ~description:
+        ("Multiplication of a " ^ T.id ^ " amount by a negative integer")
+      (obj2
+         (req "amount" encoding)
+         (req "multiplicator" int64))
+      (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None)
+      (fun (a, b) -> Negative_multiplicator (a, b)) ;
+    register_error_kind
+      `Temporary
+      ~id:(T.id ^ ".invalid_divisor")
+      ~title:("Invalid " ^ T.id ^ " divisor")
+      ~pp: (fun ppf (opa, opb) ->
+          Format.fprintf ppf "Division of %a %s by non positive integer %Ld"
+            pp opa T.id opb)
+      ~description:
+        ("Multiplication of a " ^ T.id ^ " amount by a non positive integer")
+      (obj2
+         (req "amount" encoding)
+         (req "divisor" int64))
+      (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)
+      (fun (a, b) -> Invalid_divisor (a, b))
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.ml
new file mode 100644
index 000000000..51b0a8dac
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.ml
@@ -0,0 +1,650 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Int_set = Set.Make (Compare.Int)
+
+type t = {
+  context: Context.t ;
+  constants: Constants_repr.parametric ;
+  first_level: Raw_level_repr.t ;
+  level: Level_repr.t ;
+  timestamp: Time.t ;
+  fitness: Int64.t ;
+  deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
+  allowed_endorsements:
+    (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ;
+  fees: Tez_repr.t ;
+  rewards: Tez_repr.t ;
+  block_gas: Z.t ;
+  operation_gas: Gas_limit_repr.t ;
+  storage_space_to_pay: Z.t option ;
+  allocated_contracts: int option ;
+  origination_nonce: Contract_repr.origination_nonce option ;
+  internal_nonce: int ;
+  internal_nonces_used: Int_set.t ;
+}
+
+type context = t
+type root_context = t
+
+let current_level ctxt = ctxt.level
+let current_timestamp ctxt = ctxt.timestamp
+let set_current_timestamp ctxt timestamp = { ctxt with timestamp }
+let current_fitness ctxt = ctxt.fitness
+let first_level ctxt = ctxt.first_level
+let constants ctxt = ctxt.constants
+let recover ctxt = ctxt.context
+
+let record_endorsement ctxt k =
+  match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with
+  | None -> assert false
+  | Some (_, _, true) -> assert false (* right already used *)
+  | Some (d, s, false) ->
+      { ctxt with
+        allowed_endorsements =
+          Signature.Public_key_hash.Map.add k (d,s,true) ctxt.allowed_endorsements }
+
+let init_endorsements ctxt allowed_endorsements =
+  if Signature.Public_key_hash.Map.is_empty allowed_endorsements
+  then assert false (* can't initialize to empty *)
+  else begin
+    if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements
+    then { ctxt with allowed_endorsements }
+    else assert false (* can't initialize twice *)
+  end
+
+let allowed_endorsements ctxt =
+  ctxt.allowed_endorsements
+
+type error += Too_many_internal_operations (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"too_many_internal_operations"
+    ~title: "Too many internal operations"
+    ~description:
+      "A transaction exceeded the hard limit \
+       of internal operations it can emit"
+    empty
+    (function Too_many_internal_operations -> Some () | _ -> None)
+    (fun () -> Too_many_internal_operations)
+
+let fresh_internal_nonce ctxt =
+  if Compare.Int.(ctxt.internal_nonce >= 65_535) then
+    error Too_many_internal_operations
+  else
+    ok ({ ctxt with internal_nonce = ctxt.internal_nonce + 1 }, ctxt.internal_nonce)
+let reset_internal_nonce ctxt =
+  { ctxt with internal_nonces_used = Int_set.empty ; internal_nonce = 0 }
+let record_internal_nonce ctxt k =
+  { ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used }
+let internal_nonce_already_recorded ctxt k =
+  Int_set.mem k ctxt.internal_nonces_used
+
+let set_current_fitness ctxt fitness = { ctxt with fitness }
+
+let add_fees ctxt fees =
+  Lwt.return Tez_repr.(ctxt.fees +? fees) >>=? fun fees ->
+  return { ctxt with fees}
+
+let add_rewards ctxt rewards =
+  Lwt.return Tez_repr.(ctxt.rewards +? rewards) >>=? fun rewards ->
+  return { ctxt with rewards}
+
+let add_deposit ctxt delegate deposit =
+  let previous =
+    match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with
+    | Some tz -> tz
+    | None -> Tez_repr.zero in
+  Lwt.return Tez_repr.(previous +? deposit) >>=? fun deposit ->
+  let deposits =
+    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits in
+  return { ctxt with deposits }
+
+let get_deposits ctxt = ctxt.deposits
+let get_rewards ctxt = ctxt.rewards
+let get_fees ctxt = ctxt.fees
+
+type error += Undefined_operation_nonce (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"undefined_operation_nonce"
+    ~title: "Ill timed access to the origination nonce"
+    ~description:
+      "An origination was attemped out of the scope of a manager operation"
+    empty
+    (function Undefined_operation_nonce -> Some () | _ -> None)
+    (fun () -> Undefined_operation_nonce)
+
+let init_origination_nonce ctxt operation_hash =
+  let origination_nonce =
+    Some (Contract_repr.initial_origination_nonce operation_hash) in
+  { ctxt with origination_nonce }
+
+let origination_nonce ctxt =
+  match ctxt.origination_nonce with
+  | None -> error Undefined_operation_nonce
+  | Some origination_nonce -> ok origination_nonce
+
+let increment_origination_nonce ctxt =
+  match ctxt.origination_nonce with
+  | None -> error Undefined_operation_nonce
+  | Some cur_origination_nonce ->
+      let origination_nonce =
+        Some (Contract_repr.incr_origination_nonce cur_origination_nonce) in
+      ok ({ ctxt with origination_nonce }, cur_origination_nonce)
+
+let unset_origination_nonce ctxt =
+  { ctxt with origination_nonce = None }
+
+type error += Gas_limit_too_high (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  register_error_kind
+    `Permanent
+    ~id:"gas_limit_too_high"
+    ~title: "Gas limit out of protocol hard bounds"
+    ~description:
+      "A transaction tried to exceed the hard limit on gas"
+    empty
+    (function Gas_limit_too_high -> Some () | _ -> None)
+    (fun () -> Gas_limit_too_high)
+
+let check_gas_limit ctxt remaining =
+  if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)
+  || Compare.Z.(remaining < Z.zero) then
+    error Gas_limit_too_high
+  else
+    ok ()
+let set_gas_limit ctxt remaining =
+  { ctxt with operation_gas = Limited { remaining } }
+let set_gas_unlimited ctxt =
+  { ctxt with operation_gas = Unaccounted }
+let consume_gas ctxt cost =
+  Gas_limit_repr.consume ctxt.block_gas ctxt.operation_gas cost >>? fun (block_gas, operation_gas) ->
+  ok { ctxt with block_gas ; operation_gas }
+let check_enough_gas ctxt cost =
+  Gas_limit_repr.check_enough ctxt.block_gas ctxt.operation_gas cost
+let gas_level ctxt = ctxt.operation_gas
+let block_gas_level ctxt = ctxt.block_gas
+let gas_consumed ~since ~until =
+  match gas_level since, gas_level until with
+  | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
+  | _, _ -> Z.zero
+
+let init_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay with
+  | Some _ ->
+      assert false
+  | None ->
+      { ctxt with storage_space_to_pay = Some Z.zero ; allocated_contracts = Some 0 }
+
+let update_storage_space_to_pay ctxt n =
+  match ctxt.storage_space_to_pay with
+  | None ->
+      assert false
+  | Some storage_space_to_pay ->
+      { ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay) }
+
+let update_allocated_contracts_count ctxt =
+  match ctxt.allocated_contracts with
+  | None ->
+      assert false
+  | Some allocated_contracts ->
+      { ctxt with allocated_contracts = Some (succ allocated_contracts) }
+
+let clear_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay, ctxt.allocated_contracts with
+  | None, _ | _, None ->
+      assert false
+  | Some storage_space_to_pay, Some allocated_contracts ->
+      { ctxt with storage_space_to_pay = None ;
+                  allocated_contracts = None},
+      storage_space_to_pay,
+      allocated_contracts
+
+type storage_error =
+  | Incompatible_protocol_version of string
+  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
+  | Existing_key of string list
+  | Corrupted_data of string list
+
+let storage_error_encoding =
+  let open Data_encoding in
+  union [
+    case (Tag 0)
+      ~title:"Incompatible_protocol_version"
+      (obj1 (req "incompatible_protocol_version" string))
+      (function Incompatible_protocol_version arg -> Some arg | _ -> None)
+      (fun arg -> Incompatible_protocol_version arg) ;
+    case (Tag 1)
+      ~title:"Missing_key"
+      (obj2
+         (req "missing_key" (list string))
+         (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ])))
+      (function Missing_key (key, f) -> Some (key, f) | _ -> None)
+      (fun (key, f) -> Missing_key (key, f)) ;
+    case (Tag 2)
+      ~title:"Existing_key"
+      (obj1 (req "existing_key" (list string)))
+      (function Existing_key key -> Some key | _ -> None)
+      (fun key -> Existing_key key) ;
+    case (Tag 3)
+      ~title:"Corrupted_data"
+      (obj1 (req "corrupted_data" (list string)))
+      (function Corrupted_data key -> Some key | _ -> None)
+      (fun key -> Corrupted_data key) ;
+  ]
+
+let pp_storage_error ppf = function
+  | Incompatible_protocol_version version ->
+      Format.fprintf ppf
+        "Found a context with an unexpected version '%s'."
+        version
+  | Missing_key (key, `Get) ->
+      Format.fprintf ppf
+        "Missing key '%s'."
+        (String.concat "/" key)
+  | Missing_key (key, `Set) ->
+      Format.fprintf ppf
+        "Cannot set undefined key '%s'."
+        (String.concat "/" key)
+  | Missing_key (key, `Del) ->
+      Format.fprintf ppf
+        "Cannot delete undefined key '%s'."
+        (String.concat "/" key)
+  | Missing_key (key, `Copy) ->
+      Format.fprintf ppf
+        "Cannot copy undefined key '%s'."
+        (String.concat "/" key)
+  | Existing_key key ->
+      Format.fprintf ppf
+        "Cannot initialize defined key '%s'."
+        (String.concat "/" key)
+  | Corrupted_data key ->
+      Format.fprintf ppf
+        "Failed to parse the data at '%s'."
+        (String.concat "/" key)
+
+type error += Storage_error of storage_error
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"context.storage_error"
+    ~title: "Storage error (fatal internal error)"
+    ~description:
+      "An error that should never happen unless something \
+       has been deleted or corrupted in the database."
+    ~pp:(fun ppf err ->
+        Format.fprintf ppf
+          "@[<v 2>Storage error:@ %a@]"
+          pp_storage_error err)
+    storage_error_encoding
+    (function Storage_error err -> Some err | _ -> None)
+    (fun err -> Storage_error err)
+
+let storage_error err = fail (Storage_error err)
+
+(* Initialization *********************************************************)
+
+(* This key should always be populated for every version of the
+   protocol.  It's absence meaning that the context is empty. *)
+let version_key = ["version"]
+let version_value = "alpha_current"
+
+let version = "v1"
+let first_level_key = [ version ; "first_level" ]
+let constants_key = [ version ; "constants" ]
+let protocol_param_key = [ "protocol_parameters" ]
+
+let get_first_level ctxt =
+  Context.get ctxt first_level_key >>= function
+  | None -> storage_error (Missing_key (first_level_key, `Get))
+  | Some bytes ->
+      match
+        Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes
+      with
+      | None -> storage_error (Corrupted_data first_level_key)
+      | Some level -> return level
+
+let set_first_level ctxt level =
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level in
+  Context.set ctxt first_level_key bytes >>= fun ctxt ->
+  return ctxt
+
+type error += Failed_to_parse_parameter of MBytes.t
+type error += Failed_to_decode_parameter of Data_encoding.json * string
+
+let () =
+  register_error_kind
+    `Temporary
+    ~id:"context.failed_to_parse_parameter"
+    ~title: "Failed to parse parameter"
+    ~description:
+      "The protocol parameters are not valid JSON."
+    ~pp:begin fun ppf bytes ->
+      Format.fprintf ppf
+        "@[<v 2>Cannot parse the protocol parameter:@ %s@]"
+        (MBytes.to_string bytes)
+    end
+    Data_encoding.(obj1 (req "contents" bytes))
+    (function Failed_to_parse_parameter data -> Some data | _ -> None)
+    (fun data -> Failed_to_parse_parameter data) ;
+  register_error_kind
+    `Temporary
+    ~id:"context.failed_to_decode_parameter"
+    ~title: "Failed to decode parameter"
+    ~description:
+      "Unexpected JSON object."
+    ~pp:begin fun ppf (json, msg) ->
+      Format.fprintf ppf
+        "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]"
+        msg
+        Data_encoding.Json.pp json
+    end
+    Data_encoding.(obj2
+                     (req "contents" json)
+                     (req "error" string))
+    (function
+      | Failed_to_decode_parameter (json, msg) -> Some (json, msg)
+      | _ -> None)
+    (fun (json, msg) -> Failed_to_decode_parameter (json, msg))
+
+let get_proto_param ctxt =
+  Context.get ctxt protocol_param_key >>= function
+  | None ->
+      failwith "Missing protocol parameters."
+  | Some bytes ->
+      match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
+      | None -> fail (Failed_to_parse_parameter bytes)
+      | Some json -> begin
+          Context.del ctxt protocol_param_key >>= fun ctxt ->
+          match Data_encoding.Json.destruct Parameters_repr.encoding json with
+          | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
+              Format.kasprintf
+                failwith "Invalid protocol_parameters: %a %a"
+                (fun ppf -> Data_encoding.Json.print_error ppf) exn
+                Data_encoding.Json.pp json
+          | param -> return (param, ctxt)
+        end
+
+let set_constants ctxt constants =
+  let bytes =
+    Data_encoding.Binary.to_bytes_exn
+      Parameters_repr.constants_encoding constants in
+  Context.set ctxt constants_key bytes
+
+let get_constants ctxt =
+  Context.get ctxt constants_key >>= function
+  | None ->
+      failwith "Internal error: cannot read constants in context."
+  | Some bytes ->
+      match
+        Data_encoding.Binary.of_bytes Parameters_repr.constants_encoding bytes
+      with
+      | None ->
+          failwith "Internal error: cannot parse constants in context."
+      | Some constants -> return constants
+
+let patch_constants ctxt f =
+  let constants = f ctxt.constants in
+  set_constants ctxt.context constants >>= fun context ->
+  Lwt.return { ctxt with context ; constants }
+
+let check_inited ctxt =
+  Context.get ctxt version_key >>= function
+  | None ->
+      failwith "Internal error: un-initialized context."
+  | Some bytes ->
+      let s = MBytes.to_string bytes in
+      if Compare.String.(s = version_value) then
+        return_unit
+      else
+        storage_error (Incompatible_protocol_version s)
+
+let prepare ~level ~timestamp ~fitness ctxt =
+  Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->
+  Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->
+  check_inited ctxt >>=? fun () ->
+  get_constants ctxt >>=? fun constants ->
+  get_first_level ctxt >>=? fun first_level ->
+  let level =
+    Level_repr.from_raw
+      ~first_level
+      ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
+      ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
+      ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
+      level in
+  return {
+    context = ctxt ; constants ; level ;
+    timestamp ; fitness ; first_level ;
+    allowed_endorsements = Signature.Public_key_hash.Map.empty ;
+    fees = Tez_repr.zero ;
+    rewards = Tez_repr.zero ;
+    deposits = Signature.Public_key_hash.Map.empty ;
+    operation_gas = Unaccounted ;
+    storage_space_to_pay = None ;
+    allocated_contracts = None ;
+    block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
+    origination_nonce = None ;
+    internal_nonce = 0 ;
+    internal_nonces_used = Int_set.empty ;
+  }
+
+type 'a previous_protocol =
+  | Genesis of 'a
+  | Alpha_previous
+
+let check_first_block ctxt =
+  Context.get ctxt version_key >>= function
+  | None ->
+      failwith "Internal error: un-initialized context in check_first_block."
+  | Some bytes ->
+      let s = MBytes.to_string bytes in
+      if Compare.String.(s = version_value) then
+        failwith "Internal error: previously initialized context."
+      else if Compare.String.(s = "genesis") then
+        return (Genesis ())
+      else if Compare.String.(s = "alpha_previous") then
+        return Alpha_previous
+      else
+        storage_error (Incompatible_protocol_version s)
+
+let prepare_first_block ~level ~timestamp ~fitness ctxt =
+  check_first_block ctxt >>=? fun previous_protocol ->
+  begin
+    match previous_protocol with
+    | Genesis () ->
+        Lwt.return (Raw_level_repr.of_int32 level) >>=? fun first_level ->
+        get_proto_param ctxt >>=? fun (param, ctxt) ->
+        set_first_level ctxt first_level >>=? fun ctxt ->
+        set_constants ctxt param.constants >>= fun ctxt ->
+        return (Genesis param, ctxt)
+    | Alpha_previous ->
+        return (Alpha_previous, ctxt)
+  end >>=? fun (previous_proto, ctxt) ->
+  Context.set ctxt version_key
+    (MBytes.of_string version_value) >>= fun ctxt ->
+  prepare ctxt ~level ~timestamp ~fitness >>=? fun ctxt ->
+  return (previous_proto, ctxt)
+
+let activate ({ context = c ; _ } as s) h =
+  Updater.activate c h >>= fun c -> Lwt.return { s with context = c }
+
+let fork_test_chain ({ context = c ; _ } as s) protocol expiration =
+  Updater.fork_test_chain c ~protocol ~expiration >>= fun c ->
+  Lwt.return { s with context = c }
+
+let register_resolvers enc resolve =
+  let resolve context str =
+    let faked_context = {
+      context ;
+      constants = Constants_repr.default ;
+      first_level = Raw_level_repr.root ;
+      level =  Level_repr.root Raw_level_repr.root ;
+      timestamp = Time.of_seconds 0L ;
+      fitness = 0L ;
+      allowed_endorsements = Signature.Public_key_hash.Map.empty ;
+      storage_space_to_pay = None ;
+      allocated_contracts = None ;
+      fees = Tez_repr.zero ;
+      rewards = Tez_repr.zero ;
+      deposits = Signature.Public_key_hash.Map.empty ;
+      block_gas = Constants_repr.default.hard_gas_limit_per_block ;
+      operation_gas = Unaccounted ;
+      origination_nonce = None ;
+      internal_nonce = 0 ;
+      internal_nonces_used = Int_set.empty ;
+    } in
+    resolve faked_context str in
+  Context.register_resolver enc  resolve
+
+(* Generic context ********************************************************)
+
+type key = string list
+
+type value = MBytes.t
+
+module type T = sig
+
+  type t
+  type context = t
+
+  val mem: context -> key -> bool Lwt.t
+  val dir_mem: context -> key -> bool Lwt.t
+  val get: context -> key -> value tzresult Lwt.t
+  val get_option: context -> key -> value option Lwt.t
+  val init: context -> key -> value -> context tzresult Lwt.t
+  val set: context -> key -> value -> context tzresult Lwt.t
+  val init_set: context -> key -> value -> context Lwt.t
+  val set_option: context -> key -> value option -> context Lwt.t
+  val delete: context -> key -> context tzresult Lwt.t
+  val remove: context -> key -> context Lwt.t
+  val remove_rec: context -> key -> context Lwt.t
+  val copy: context -> from:key -> to_:key -> context tzresult Lwt.t
+
+  val fold:
+    context -> key -> init:'a ->
+    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+    'a Lwt.t
+
+  val keys: context -> key -> key list Lwt.t
+
+  val fold_keys:
+    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  val project: context -> root_context
+
+  val absolute_key: context -> key -> key
+
+  val consume_gas: context -> Gas_limit_repr.cost -> context tzresult
+
+  val check_enough_gas: context -> Gas_limit_repr.cost -> unit tzresult
+
+  val description: context Storage_description.t
+
+end
+
+let mem ctxt k = Context.mem ctxt.context k
+let dir_mem ctxt k = Context.dir_mem ctxt.context k
+
+let get ctxt k =
+  Context.get ctxt.context k >>= function
+  | None -> storage_error (Missing_key (k, `Get))
+  | Some v -> return v
+
+let get_option ctxt k =
+  Context.get ctxt.context k
+
+(* Verify that the k is present before modifying *)
+let set ctxt k v =
+  Context.mem ctxt.context k >>= function
+  | false -> storage_error (Missing_key (k, `Set))
+  | true ->
+      Context.set ctxt.context k v >>= fun context ->
+      return { ctxt with context }
+
+(* Verify that the k is not present before inserting *)
+let init ctxt k v =
+  Context.mem ctxt.context k >>= function
+  | true -> storage_error (Existing_key k)
+  | false ->
+      Context.set ctxt.context k v >>= fun context ->
+      return { ctxt with context }
+
+(* Does not verify that the key is present or not *)
+let init_set ctxt k v =
+  Context.set ctxt.context k v >>= fun context ->
+  Lwt.return { ctxt with context }
+
+(* Verify that the key is present before deleting *)
+let delete ctxt k =
+  Context.mem ctxt.context k >>= function
+  | false -> storage_error (Missing_key (k, `Del))
+  | true ->
+      Context.del ctxt.context k >>= fun context ->
+      return { ctxt with context }
+
+(* Do not verify before deleting *)
+let remove ctxt k =
+  Context.del ctxt.context k >>= fun context ->
+  Lwt.return { ctxt with context }
+
+let set_option ctxt k = function
+  | None -> remove ctxt k
+  | Some v -> init_set ctxt k v
+
+let remove_rec ctxt k =
+  Context.remove_rec ctxt.context k >>= fun context ->
+  Lwt.return { ctxt with context }
+
+let copy ctxt ~from ~to_ =
+  Context.copy ctxt.context ~from ~to_ >>= function
+  | None -> storage_error (Missing_key (from, `Copy))
+  | Some context ->
+      return { ctxt with context }
+
+let fold ctxt k ~init ~f =
+  Context.fold ctxt.context k ~init ~f
+
+let keys ctxt k =
+  Context.keys ctxt.context k
+
+let fold_keys ctxt k ~init ~f =
+  Context.fold_keys ctxt.context k ~init ~f
+
+let project x = x
+
+let absolute_key _ k = k
+
+let description = Storage_description.create ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.mli
new file mode 100644
index 000000000..f656f0eda
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_context.mli
@@ -0,0 +1,254 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** {1 Errors} ****************************************************************)
+
+type error += Too_many_internal_operations (* `Permanent *)
+
+(** An internal storage error that should not happen *)
+type storage_error =
+  | Incompatible_protocol_version of string
+  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
+  | Existing_key of string list
+  | Corrupted_data of string list
+
+type error += Storage_error of storage_error
+type error += Failed_to_parse_parameter of MBytes.t
+type error += Failed_to_decode_parameter of Data_encoding.json * string
+
+val storage_error: storage_error -> 'a tzresult Lwt.t
+
+(** {1 Abstract Context} **************************************************)
+
+(** Abstract view of the context.
+    Includes a handle to the functional key-value database
+    ({!Context.t}) along with some in-memory values (gas, etc.). *)
+type t
+type context = t
+type root_context = t
+
+(** Retrieves the state of the database and gives its abstract view.
+    It also returns wether this is the first block validated
+    with this version of the protocol. *)
+val prepare:
+  level: Int32.t ->
+  timestamp: Time.t ->
+  fitness: Fitness.t ->
+  Context.t -> context tzresult Lwt.t
+
+type 'a previous_protocol =
+  | Genesis of 'a
+  | Alpha_previous
+
+val prepare_first_block:
+  level:int32 ->
+  timestamp:Time.t ->
+  fitness:Fitness.t ->
+  Context.t -> (Parameters_repr.t previous_protocol * context) tzresult Lwt.t
+
+val activate: context -> Protocol_hash.t -> t Lwt.t
+val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t
+
+val register_resolvers:
+  'a Base58.encoding -> (context -> string -> 'a list Lwt.t) -> unit
+
+(** Returns the state of the database resulting of operations on its
+    abstract view *)
+val recover: context -> Context.t
+
+val current_level: context -> Level_repr.t
+val current_timestamp: context -> Time.t
+val set_current_timestamp: context -> Time.t -> context
+
+val current_fitness: context -> Int64.t
+val set_current_fitness: context -> Int64.t -> t
+
+val constants: context -> Constants_repr.parametric
+val patch_constants:
+  context ->
+  (Constants_repr.parametric -> Constants_repr.parametric) ->
+  context Lwt.t
+val first_level: context -> Raw_level_repr.t
+
+(** Increment the current block fee stash that will be credited to baker's
+    frozen_fees account at finalize_application *)
+val add_fees: context -> Tez_repr.t -> context tzresult Lwt.t
+
+(** Increment the current block reward stash that will be credited to baker's
+    frozen_fees account at finalize_application *)
+val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
+
+(** Increment the current block deposit stash for a specific delegate. All the
+    delegates' frozen_deposit accounts are credited at finalize_application *)
+val add_deposit:
+  context -> Signature.Public_key_hash.t -> Tez_repr.t -> context tzresult Lwt.t
+
+val get_fees: context -> Tez_repr.t
+val get_rewards: context -> Tez_repr.t
+val get_deposits: context -> Tez_repr.t Signature.Public_key_hash.Map.t
+
+type error += Gas_limit_too_high (* `Permanent *)
+
+val check_gas_limit: t -> Z.t -> unit tzresult
+val set_gas_limit: t -> Z.t -> t
+val set_gas_unlimited: t -> t
+val gas_level: t -> Gas_limit_repr.t
+val gas_consumed: since: t -> until: t -> Z.t
+val block_gas_level: t -> Z.t
+
+val init_storage_space_to_pay: t -> t
+val update_storage_space_to_pay: t -> Z.t -> t
+val update_allocated_contracts_count: t -> t
+val clear_storage_space_to_pay: t -> t * Z.t * int
+
+type error += Undefined_operation_nonce (* `Permanent *)
+
+val init_origination_nonce: t -> Operation_hash.t -> t
+val origination_nonce: t -> Contract_repr.origination_nonce tzresult
+val increment_origination_nonce: t -> (t * Contract_repr.origination_nonce) tzresult
+val unset_origination_nonce: t -> t
+
+(** {1 Generic accessors} *************************************************)
+
+type key = string list
+
+type value = MBytes.t
+
+(** All context manipulation functions. This signature is included
+    as-is for direct context accesses, and used in {!Storage_functors}
+    to provide restricted views to the context. *)
+module type T = sig
+
+  type t
+  type context = t
+
+  (** Tells if the key is already defined as a value. *)
+  val mem: context -> key -> bool Lwt.t
+
+  (** Tells if the key is already defined as a directory. *)
+  val dir_mem: context -> key -> bool Lwt.t
+
+  (** Retrieve the value from the storage bucket ; returns a
+      {!Storage_error Missing_key} if the key is not set. *)
+  val get: context -> key -> value tzresult Lwt.t
+
+  (** Retrieves the value from the storage bucket ; returns [None] if
+      the data is not initialized. *)
+  val get_option: context -> key -> value option Lwt.t
+
+  (** Allocates the storage bucket and initializes it ; returns a
+      {!Storage_error Existing_key} if the bucket exists. *)
+  val init: context -> key -> value -> context tzresult Lwt.t
+
+  (** Updates the content of the bucket ; returns a {!Storage_error
+      Missing_key} if the value does not exists. *)
+  val set: context -> key -> value -> context tzresult Lwt.t
+
+  (** Allocates the data and initializes it with a value ; just
+      updates it if the bucket exists. *)
+  val init_set: context -> key -> value -> context Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      it with [v] ; just updates it if the bucket exists. When the
+      valus is [None], delete the storage bucket when the value ; does
+      nothing if the bucket does not exists. *)
+  val set_option: context -> key -> value option -> context Lwt.t
+
+  (** Delete the storage bucket ; returns a {!Storage_error
+      Missing_key} if the bucket does not exists. *)
+  val delete: context -> key -> context tzresult Lwt.t
+
+  (** Removes the storage bucket and its contents ; does nothing if the
+      bucket does not exists. *)
+  val remove: context -> key -> context Lwt.t
+
+  (** Recursively removes all the storage buckets and contents ; does
+      nothing if no bucket exists. *)
+  val remove_rec: context -> key -> context Lwt.t
+
+  val copy: context -> from:key -> to_:key -> context tzresult Lwt.t
+
+  (** Iterator on all the items of a given directory. *)
+  val fold:
+    context -> key -> init:'a ->
+    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->
+    'a Lwt.t
+
+  (** Recursively list all subkeys of a given key. *)
+  val keys: context -> key -> key list Lwt.t
+
+  (** Recursive iterator on all the subkeys of a given key. *)
+  val fold_keys:
+    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  (** Internally used in {!Storage_functors} to escape from a view. *)
+  val project: context -> root_context
+
+  (** Internally used in {!Storage_functors} to retrieve a full key
+      from partial key relative a view. *)
+  val absolute_key: context -> key -> key
+
+  (** Internally used in {!Storage_functors} to consume gas from
+      within a view. *)
+  val consume_gas: context -> Gas_limit_repr.cost -> context tzresult
+
+  (** Check if consume_gas will fail *)
+  val check_enough_gas: context -> Gas_limit_repr.cost -> unit tzresult
+
+  val description: context Storage_description.t
+
+end
+
+include T with type t := t and type context := context
+
+(** Initialize the local nonce used for preventing a script to
+    duplicate an internal operation to replay it. *)
+val reset_internal_nonce: context -> context
+
+(** Increments the internal operation nonce. *)
+val fresh_internal_nonce: context -> (context * int) tzresult
+
+(** Mark an internal operation nonce as taken. *)
+val record_internal_nonce: context -> int -> context
+
+(** Check is the internal operation nonce has been taken. *)
+val internal_nonce_already_recorded: context -> int -> bool
+
+(** Returns a map where to each endorser's pkh is associated the list of its
+    endorsing slots (in decreasing order) for a given level. *)
+val allowed_endorsements:
+  context ->
+  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t
+
+(** Initializes the map of allowed endorsements, this function must only be
+    called once. *)
+val init_endorsements:
+  context ->
+  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
+  context
+
+(** Marks an endorsment in the map as used. *)
+val record_endorsement:
+  context -> Signature.Public_key_hash.t -> context
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.ml
new file mode 100644
index 000000000..8af1b4543
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.ml
@@ -0,0 +1,90 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = int32
+type raw_level = t
+include (Compare.Int32 : Compare.S with type t := t)
+let encoding = Data_encoding.int32
+let pp ppf level = Format.fprintf ppf "%ld" level
+let rpc_arg =
+  let construct raw_level = Int32.to_string raw_level in
+  let destruct str =
+    match Int32.of_string str with
+    | exception _ -> Error "Cannot parse level"
+    | raw_level -> Ok raw_level in
+  RPC_arg.make
+    ~descr:"A level integer"
+    ~name: "block_level"
+    ~construct
+    ~destruct
+    ()
+
+let root = 0l
+let succ = Int32.succ
+let pred l =
+  if l = 0l
+  then None
+  else Some (Int32.pred l)
+
+let diff = Int32.sub
+
+let to_int32 l = l
+let of_int32_exn l =
+  if Compare.Int32.(l >= 0l)
+  then l
+  else invalid_arg "Level_repr.of_int32"
+
+type error += Unexpected_level of Int32.t (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"unexpected_level"
+    ~title:"Unexpected level"
+    ~description:"Level must be non-negative."
+    ~pp:(fun ppf l ->
+        Format.fprintf ppf "The level is %s but should be non-negative." (Int32.to_string l))
+    Data_encoding.(obj1 (req "level" int32))
+    (function Unexpected_level l -> Some l | _ -> None)
+    (fun l -> Unexpected_level l)
+
+let of_int32 l =
+  try Ok (of_int32_exn l)
+  with _ -> Error [Unexpected_level l]
+
+module Index = struct
+  type t = raw_level
+  let path_length = 1
+  let to_path level l = Int32.to_string level :: l
+  let of_path = function
+    | [s] -> begin
+        try Some (Int32.of_string s)
+        with _ -> None
+      end
+    | _ -> None
+  let rpc_arg = rpc_arg
+  let encoding = encoding
+  let compare = compare
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.mli
new file mode 100644
index 000000000..d7171dcf3
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/raw_level_repr.mli
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The shell's notion of a level: an integer indicating the number of blocks
+    since genesis: genesis is 0, all other blocks have increasing levels from
+    there. *)
+type t
+type raw_level = t
+val encoding: raw_level Data_encoding.t
+val rpc_arg: raw_level RPC_arg.arg
+val pp: Format.formatter -> raw_level -> unit
+include Compare.S with type t := raw_level
+
+val to_int32: raw_level -> int32
+val of_int32_exn: int32 -> raw_level
+val of_int32: int32 -> raw_level tzresult
+
+val diff: raw_level -> raw_level -> int32
+
+val root: raw_level
+
+val succ: raw_level -> raw_level
+val pred: raw_level -> raw_level option
+
+module Index : Storage_description.INDEX with type t = raw_level
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.ml
new file mode 100644
index 000000000..65e3d8e73
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.ml
@@ -0,0 +1,61 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Compare.Int32
+type roll = t
+
+let encoding = Data_encoding.int32
+
+let first = 0l
+let succ i = Int32.succ i
+
+let random sequence ~bound =
+  Seed_repr.take_int32 sequence bound
+
+let rpc_arg =
+  RPC_arg.like
+    RPC_arg.int32
+    "roll"
+
+let to_int32 v = v
+
+
+module Index = struct
+  type t = roll
+  let path_length = 3
+  let to_path roll l =
+    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff)) ::
+    (Int32.to_string @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)) ::
+    Int32.to_string roll :: l
+  let of_path = function
+    | _ :: _ :: s :: _ -> begin
+        try Some (Int32.of_string s)
+        with _ -> None
+      end
+    | _ -> None
+  let rpc_arg = rpc_arg
+  let encoding = encoding
+  let compare = compare
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.mli
new file mode 100644
index 000000000..000e1c7c4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_repr.mli
@@ -0,0 +1,42 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = private int32
+type roll = t
+
+val encoding: roll Data_encoding.t
+val rpc_arg: roll RPC_arg.t
+
+val random:
+  Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence
+
+val first: roll
+val succ: roll -> roll
+
+val to_int32: roll -> Int32.t
+
+val (=): roll -> roll -> bool
+
+module Index : Storage_description.INDEX with type t = roll
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.ml
new file mode 100644
index 000000000..0f1075f16
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.ml
@@ -0,0 +1,482 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Misc
+
+type error +=
+  | Consume_roll_change (* `Permanent *)
+  | No_roll_for_delegate (* `Permanent *)
+  | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)
+  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)
+
+let () =
+  let open Data_encoding in
+  (* Consume roll change *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.consume_roll_change"
+    ~title:"Consume roll change"
+    ~description:"Change is not enough to consume a roll."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Not enough change to consume a roll.")
+    empty
+    (function Consume_roll_change -> Some () | _ -> None)
+    (fun () -> Consume_roll_change) ;
+  (* No roll for delegate *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.no_roll_for_delegate"
+    ~title:"No roll for delegate"
+    ~description:"Delegate has no roll."
+    ~pp:(fun ppf () -> Format.fprintf ppf "Delegate has no roll.")
+    empty
+    (function No_roll_for_delegate -> Some () | _ -> None)
+    (fun () -> No_roll_for_delegate) ;
+  (* No roll snapshot for cycle *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.no_roll_snapshot_for_cycle"
+    ~title:"No roll snapshot for cycle"
+    ~description:"A snapshot of the rolls distribution does not exist for this cycle."
+    ~pp:(fun ppf c ->
+        Format.fprintf ppf
+          "A snapshot of the rolls distribution does not exist for cycle %a" Cycle_repr.pp c)
+    (obj1 (req "cycle" Cycle_repr.encoding))
+    (function No_roll_snapshot_for_cycle c-> Some c | _ -> None)
+    (fun c -> No_roll_snapshot_for_cycle c) ;
+  (* Unregistered delegate *)
+  register_error_kind
+    `Permanent
+    ~id:"contract.manager.unregistered_delegate"
+    ~title:"Unregistered delegate"
+    ~description:"A contract cannot be delegated to an unregistered delegate"
+    ~pp:(fun ppf k->
+        Format.fprintf ppf "The provided public key (with hash %a) is \
+                           \ not registered as valid delegate key."
+          Signature.Public_key_hash.pp k)
+    (obj1 (req "hash" Signature.Public_key_hash.encoding))
+    (function Unregistered_delegate k -> Some k | _ -> None)
+    (fun k -> Unregistered_delegate k)
+
+let get_contract_delegate c contract =
+  Storage.Contract.Delegate.get_option c contract
+
+let delegate_pubkey ctxt delegate =
+  Storage.Contract.Manager.get_option ctxt
+    (Contract_repr.implicit_contract delegate) >>=? function
+  | None | Some (Manager_repr.Hash _) ->
+      fail (Unregistered_delegate delegate)
+  | Some (Manager_repr.Public_key pk) ->
+      return pk
+
+let clear_cycle c cycle =
+  Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+  Storage.Roll.Snapshot_for_cycle.delete c cycle >>=? fun c ->
+  Storage.Roll.Last_for_snapshot.delete (c, cycle) index >>=? fun c ->
+  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c ->
+  return c
+
+let fold ctxt ~f init =
+  Storage.Roll.Next.get ctxt >>=? fun last ->
+  let rec loop ctxt roll acc =
+    acc >>=? fun acc ->
+    if Roll_repr.(roll = last) then
+      return acc
+    else
+      Storage.Roll.Owner.get_option ctxt roll >>=? function
+      | None ->
+          loop ctxt (Roll_repr.succ roll) (return acc)
+      | Some delegate ->
+          loop ctxt (Roll_repr.succ roll) (f roll delegate acc) in
+  loop ctxt Roll_repr.first (return init)
+
+let snapshot_rolls_for_cycle ctxt cycle =
+  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun index ->
+  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1) >>=? fun ctxt ->
+  Storage.Roll.Owner.snapshot ctxt (cycle, index) >>=? fun ctxt ->
+  Storage.Roll.Next.get ctxt >>=? fun last ->
+  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last >>=? fun ctxt ->
+  return ctxt
+
+let freeze_rolls_for_cycle ctxt cycle =
+  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun max_index ->
+  Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed ->
+  let rd = Seed_repr.initialize_new seed [MBytes.of_string "roll_snapshot"] in
+  let seq = Seed_repr.sequence rd 0l in
+  let selected_index =
+    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int in
+  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index >>=? fun ctxt ->
+  fold_left_s
+    (fun ctxt index ->
+       if Compare.Int.(index = selected_index) then
+         return ctxt
+       else
+         Storage.Roll.Owner.delete_snapshot ctxt (cycle, index) >>= fun ctxt ->
+         Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index >>=? fun ctxt ->
+         return ctxt
+    )
+    ctxt
+    Misc.(0 --> (max_index - 1)) >>=? fun ctxt ->
+  return ctxt
+
+(* Roll selection *)
+
+module Random = struct
+
+  let int32_to_bytes i =
+    let b = MBytes.create 4 in
+    MBytes.set_int32 b 0 i;
+    b
+
+  let level_random seed use level =
+    let position = level.Level_repr.cycle_position in
+    Seed_repr.initialize_new seed
+      [MBytes.of_string ("level "^use^":");
+       int32_to_bytes position]
+
+  let owner c kind level offset =
+    let cycle = level.Level_repr.cycle in
+    Seed_storage.for_cycle c cycle >>=? fun random_seed ->
+    let rd = level_random random_seed kind level in
+    let sequence = Seed_repr.sequence rd (Int32.of_int offset) in
+    Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+    Storage.Roll.Last_for_snapshot.get (c, cycle) index >>=? fun bound ->
+    let rec loop sequence =
+      let roll, sequence = Roll_repr.random sequence ~bound in
+      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll) >>=? function
+      | None ->
+          loop sequence
+      | Some delegate ->
+          return delegate in
+    Storage.Roll.Owner.snapshot_exists c (cycle, index) >>= fun snapshot_exists ->
+    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->
+    loop sequence
+
+end
+
+let baking_rights_owner c level ~priority =
+  Random.owner c "baking" level priority
+
+let endorsement_rights_owner c level ~slot =
+  Random.owner c "endorsement" level slot
+
+let traverse_rolls ctxt head =
+  let rec loop acc roll =
+    Storage.Roll.Successor.get_option ctxt roll >>=? function
+    | None -> return (List.rev acc)
+    | Some next -> loop (next :: acc) next in
+  loop [head] head
+
+let get_rolls ctxt delegate =
+  Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
+  | None -> return_nil
+  | Some head_roll -> traverse_rolls ctxt head_roll
+
+let get_change c delegate =
+  Storage.Roll.Delegate_change.get_option c delegate >>=? function
+  | None -> return Tez_repr.zero
+  | Some change -> return change
+
+module Delegate = struct
+
+  let fresh_roll c =
+    Storage.Roll.Next.get c >>=? fun roll ->
+    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c ->
+    return (roll, c)
+
+  let get_limbo_roll c =
+    Storage.Roll.Limbo.get_option c >>=? function
+    | None ->
+        fresh_roll c >>=? fun (roll, c) ->
+        Storage.Roll.Limbo.init c roll >>=? fun c ->
+        return (roll, c)
+    | Some roll ->
+        return (roll, c)
+
+  let consume_roll_change c delegate =
+    let tokens_per_roll = Constants_storage.tokens_per_roll c in
+    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    trace Consume_roll_change
+      (Lwt.return Tez_repr.(change -? tokens_per_roll)) >>=? fun new_change ->
+    Storage.Roll.Delegate_change.set c delegate new_change
+
+  let recover_roll_change c delegate =
+    let tokens_per_roll = Constants_storage.tokens_per_roll c in
+    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun new_change ->
+    Storage.Roll.Delegate_change.set c delegate new_change
+
+  let pop_roll_from_delegate c delegate =
+    recover_roll_change c delegate >>=? fun c ->
+    (* beginning:
+       delegate : roll -> successor_roll -> ...
+       limbo : limbo_head -> ...
+    *)
+    Storage.Roll.Limbo.get_option c >>=? fun limbo_head ->
+    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? function
+    | None -> fail No_roll_for_delegate
+    | Some roll ->
+        Storage.Roll.Owner.delete c roll >>=? fun c ->
+        Storage.Roll.Successor.get_option c roll >>=? fun successor_roll ->
+        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll >>= fun c ->
+        (* delegate : successor_roll -> ...
+           roll ------^
+           limbo : limbo_head -> ... *)
+        Storage.Roll.Successor.set_option c roll limbo_head >>= fun c ->
+        (* delegate : successor_roll -> ...
+           roll ------v
+           limbo : limbo_head -> ... *)
+        Storage.Roll.Limbo.init_set c roll >>= fun c ->
+        (* delegate : successor_roll -> ...
+           limbo : roll -> limbo_head -> ... *)
+        return (roll, c)
+
+  let create_roll_in_delegate c delegate delegate_pk =
+    consume_roll_change c delegate >>=? fun c ->
+
+    (* beginning:
+       delegate : delegate_head -> ...
+       limbo : roll -> limbo_successor -> ...
+    *)
+    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun delegate_head ->
+    get_limbo_roll c >>=? fun (roll, c) ->
+    Storage.Roll.Owner.init c roll delegate_pk >>=? fun c ->
+    Storage.Roll.Successor.get_option c roll >>=? fun limbo_successor ->
+    Storage.Roll.Limbo.set_option c limbo_successor >>= fun c ->
+    (* delegate : delegate_head -> ...
+       roll ------v
+       limbo : limbo_successor -> ... *)
+    Storage.Roll.Successor.set_option c roll delegate_head >>= fun c ->
+    (* delegate : delegate_head -> ...
+       roll ------^
+       limbo : limbo_successor -> ... *)
+    Storage.Roll.Delegate_roll_list.init_set c delegate roll >>= fun c ->
+    (* delegate : roll -> delegate_head -> ...
+       limbo : limbo_successor -> ... *)
+    return c
+
+  let ensure_inited c delegate =
+    Storage.Roll.Delegate_change.mem c delegate >>= function
+    | true -> return c
+    | false ->
+        Storage.Roll.Delegate_change.init c delegate Tez_repr.zero
+
+  let is_inactive c delegate =
+    Storage.Contract.Inactive_delegate.mem c
+      (Contract_repr.implicit_contract delegate) >>= fun inactive ->
+    if inactive then
+      return inactive
+    else
+      Storage.Contract.Delegate_desactivation.get_option c
+        (Contract_repr.implicit_contract delegate) >>=? function
+      | Some last_active_cycle ->
+          let { Level_repr.cycle = current_cycle } = Raw_context.current_level c in
+          return Cycle_repr.(last_active_cycle < current_cycle)
+      | None ->
+          (* This case is only when called from `set_active`, when creating
+             a contract. *)
+          return false
+
+  let add_amount c delegate amount =
+    ensure_inited c delegate >>=? fun c ->
+    let tokens_per_roll = Constants_storage.tokens_per_roll c in
+    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    Lwt.return Tez_repr.(amount +? change) >>=? fun change ->
+    Storage.Roll.Delegate_change.set c delegate change >>=? fun c ->
+    delegate_pubkey c delegate >>=? fun delegate_pk ->
+    let rec loop c change =
+      if Tez_repr.(change < tokens_per_roll) then
+        return c
+      else
+        Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->
+        create_roll_in_delegate c delegate delegate_pk >>=? fun c ->
+        loop c change in
+    is_inactive c delegate >>=? fun inactive ->
+    if inactive then
+      return c
+    else
+      loop c change >>=? fun c ->
+      Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun rolls ->
+      match rolls with
+      | None ->
+          return c
+      | Some _ ->
+          Storage.Active_delegates_with_rolls.add c delegate >>= fun c ->
+          return c
+
+  let remove_amount c delegate amount =
+    let tokens_per_roll = Constants_storage.tokens_per_roll c in
+    let rec loop c change =
+      if Tez_repr.(amount <= change)
+      then return (c, change)
+      else
+        pop_roll_from_delegate c delegate >>=? fun (_, c) ->
+        Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->
+        loop c change in
+    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    is_inactive c delegate >>=? fun inactive ->
+    begin
+      if inactive then
+        return (c, change)
+      else
+        loop c change >>=? fun (c, change) ->
+        Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun rolls ->
+        match rolls with
+        | None ->
+            Storage.Active_delegates_with_rolls.del c delegate >>= fun c ->
+            return (c, change)
+        | Some _ ->
+            return (c, change)
+    end >>=? fun (c, change) ->
+    Lwt.return Tez_repr.(change -? amount) >>=? fun change ->
+    Storage.Roll.Delegate_change.set c delegate change
+
+  let set_inactive ctxt delegate =
+    ensure_inited ctxt delegate >>=? fun ctxt ->
+    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
+    Storage.Roll.Delegate_change.get ctxt delegate >>=? fun change ->
+    Storage.Contract.Inactive_delegate.add ctxt
+      (Contract_repr.implicit_contract delegate) >>= fun ctxt ->
+    Storage.Active_delegates_with_rolls.del ctxt delegate >>= fun ctxt ->
+    let rec loop ctxt change =
+      Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
+      | None -> return (ctxt, change)
+      | Some _roll ->
+          pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) ->
+          Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->
+          loop ctxt change in
+    loop ctxt change >>=? fun (ctxt, change) ->
+    Storage.Roll.Delegate_change.set ctxt delegate change >>=? fun ctxt ->
+    return ctxt
+
+  let set_active ctxt delegate =
+    is_inactive ctxt delegate >>=? fun inactive ->
+    let current_cycle = (Raw_context.current_level ctxt).cycle in
+    let preserved_cycles = Constants_storage.preserved_cycles ctxt in
+    (* When the delegate is new or inactive, she will become active in
+       `1+preserved_cycles`, and we allow `preserved_cycles` for the
+       delegate to start baking. When the delegate is active, we only
+       give her at least `preserved_cycles` after the current cycle
+       before to be deactivated.  *)
+    Storage.Contract.Delegate_desactivation.get_option ctxt
+      (Contract_repr.implicit_contract delegate) >>=? fun current_expiration ->
+    let expiration = match current_expiration with
+      | None ->
+          Cycle_repr.add current_cycle (1+2*preserved_cycles)
+      | Some current_expiration ->
+          let delay =
+            if inactive then (1+2*preserved_cycles) else 1+preserved_cycles in
+          let updated =
+            Cycle_repr.add current_cycle delay in
+          Cycle_repr.max current_expiration updated in
+    Storage.Contract.Delegate_desactivation.init_set ctxt
+      (Contract_repr.implicit_contract delegate)
+      expiration >>= fun ctxt ->
+    if not inactive then
+      return ctxt
+    else begin
+      ensure_inited ctxt delegate >>=? fun ctxt ->
+      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
+      Storage.Roll.Delegate_change.get ctxt delegate >>=? fun change ->
+      Storage.Contract.Inactive_delegate.del ctxt
+        (Contract_repr.implicit_contract delegate) >>= fun ctxt ->
+      delegate_pubkey ctxt delegate >>=? fun delegate_pk ->
+      let rec loop ctxt change =
+        if Tez_repr.(change < tokens_per_roll) then
+          return ctxt
+        else
+          Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->
+          create_roll_in_delegate ctxt delegate delegate_pk >>=? fun ctxt ->
+          loop ctxt change in
+      loop ctxt change >>=? fun ctxt ->
+      Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? fun rolls ->
+      match rolls with
+      | None ->
+          return ctxt
+      | Some _ ->
+          Storage.Active_delegates_with_rolls.add ctxt delegate >>= fun ctxt ->
+          return ctxt
+    end
+
+end
+
+module Contract = struct
+
+  let add_amount c contract amount =
+    get_contract_delegate c contract >>=? function
+    | None -> return c
+    | Some delegate ->
+        Delegate.add_amount c delegate amount
+
+  let remove_amount c contract amount =
+    get_contract_delegate c contract >>=? function
+    | None -> return c
+    | Some delegate ->
+        Delegate.remove_amount c delegate amount
+
+end
+
+let init ctxt =
+  Storage.Roll.Next.init ctxt Roll_repr.first
+
+let init_first_cycles ctxt =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  (* Precompute rolls for cycle (0 --> preserved_cycles) *)
+  List.fold_left
+    (fun ctxt c ->
+       ctxt >>=? fun ctxt ->
+       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
+       Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+       snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->
+       freeze_rolls_for_cycle ctxt cycle)
+    (return ctxt) (0 --> preserved) >>=? fun ctxt ->
+  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in
+  (* Precomputed a snapshot for cycle (preserved_cycles + 1) *)
+  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+  snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->
+  (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *)
+  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in
+  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+  return ctxt
+
+let snapshot_rolls ctxt =
+  let current_level = Raw_context.current_level ctxt in
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  let cycle = Cycle_repr.add current_level.cycle (preserved+2) in
+  snapshot_rolls_for_cycle ctxt cycle
+
+let cycle_end ctxt last_cycle =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  begin
+    match Cycle_repr.sub last_cycle preserved with
+    | None -> return ctxt
+    | Some cleared_cycle ->
+        clear_cycle ctxt cleared_cycle
+  end >>=? fun ctxt ->
+  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved+1) in
+  freeze_rolls_for_cycle ctxt frozen_roll_cycle >>=? fun ctxt ->
+  Storage.Roll.Snapshot_for_cycle.init
+    ctxt (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) 0 >>=? fun ctxt ->
+  return ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.mli
new file mode 100644
index 000000000..b2c066f77
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/roll_storage.mli
@@ -0,0 +1,101 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(**
+
+   Basic roll manipulation.
+
+   If storage related to roll (a.k.a. `Storage.Roll`) are not used
+   outside of this module, this interface enforces the invariant that a
+   roll is always either in the limbo list or in a contract list.
+
+*)
+
+type error +=
+  | Consume_roll_change
+  | No_roll_for_delegate
+  | No_roll_snapshot_for_cycle of Cycle_repr.t
+  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)
+
+val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
+val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
+val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+
+val fold :
+  Raw_context.t ->
+  f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
+  'a -> 'a tzresult Lwt.t
+
+val baking_rights_owner :
+  Raw_context.t -> Level_repr.t -> priority:int ->
+  Signature.Public_key.t tzresult Lwt.t
+
+val endorsement_rights_owner :
+  Raw_context.t -> Level_repr.t -> slot:int ->
+  Signature.Public_key.t tzresult Lwt.t
+
+module Delegate : sig
+
+  val is_inactive :
+    Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
+
+  val add_amount :
+    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+
+  val remove_amount :
+    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+
+  val set_inactive : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
+
+  val set_active : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
+
+end
+
+module Contract : sig
+
+  val add_amount :
+    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+
+  val remove_amount :
+    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+
+end
+
+val delegate_pubkey:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  Signature.Public_key.t tzresult Lwt.t
+
+val get_rolls:
+  Raw_context.t -> Signature.Public_key_hash.t -> Roll_repr.t list tzresult Lwt.t
+val get_change:
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
+
+(**/**)
+
+val get_contract_delegate:
+  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_expr_hash.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_expr_hash.ml
new file mode 100644
index 000000000..a21e77fc8
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_expr_hash.ml
@@ -0,0 +1,36 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 script_expr_hash = "\013\044\064\027" (* expr(54) *)
+
+include Blake2B.Make(Base58)(struct
+    let name = "script_expr"
+    let title = "A script expression ID"
+    let b58check_prefix = script_expr_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "expr" 54
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.ml
new file mode 100644
index 000000000..7e96549e4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.ml
@@ -0,0 +1,87 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type n = Natural_tag
+type z = Integer_tag
+type 't num = Z.t
+
+let compare x y = Z.compare x y
+
+let zero = Z.zero
+let zero_n = Z.zero
+
+let to_string x = Z.to_string x
+let of_string s = try Some (Z.of_string s) with _ -> None
+
+let to_int64 x = try Some (Z.to_int64 x) with _ -> None
+let of_int64 n = Z.of_int64 n
+
+let to_int x = try Some (Z.to_int x) with _ -> None
+let of_int n = Z.of_int n
+
+let of_zint x = x
+let to_zint x = x
+
+let add x y = Z.add x y
+let sub x y = Z.sub x y
+let mul x y = Z.mul x y
+
+let ediv x y =
+  try
+    let (q, r) = Z.ediv_rem x y in
+    Some (q, r)
+  with _ -> None
+
+let add_n = add
+let mul_n = mul
+let ediv_n = ediv
+
+let abs x = Z.abs x
+let is_nat x =
+  if Compare.Z.(x < Z.zero) then None else Some x
+let neg x = Z.neg x
+let int x = x
+
+let shift_left x y =
+  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then
+    None
+  else
+    let y = Z.to_int y in
+    Some (Z.shift_left x y)
+
+let shift_right x y =
+  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then
+    None
+  else
+    let y = Z.to_int y in
+    Some (Z.shift_right x y)
+
+let shift_left_n = shift_left
+let shift_right_n = shift_right
+
+let logor x y = Z.logor x y
+let logxor x y = Z.logxor x y
+let logand x y = Z.logand x y
+let lognot x = Z.lognot x
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.mli
new file mode 100644
index 000000000..592e3a410
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_int_repr.mli
@@ -0,0 +1,143 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The types for arbitraty precision integers in Michelson.
+    The type variable ['t] is always [n] or [z],
+    [n num] and [z num] are incompatible.
+
+    This is internally a [Z.t].
+    This module mostly adds signedness preservation guarantees. *)
+type 't num
+
+(** Flag for natural numbers. *)
+and n = Natural_tag
+
+(** Flag for relative numbers. *)
+and z = Integer_tag
+
+(** Natural zero. *)
+val zero_n : n num
+
+(** Relative zero. *)
+val zero : z num
+
+(** Compare two numbers as if they were *)
+val compare : 'a num -> 'a num -> int
+
+(** Conversion to an OCaml [string] in decimal notation. *)
+val to_string : _ num -> string
+
+(** Conversion from an OCaml [string].
+    Returns [None] in case of an invalid notation.
+    Supports [+] and [-] sign modifiers, and [0x], [0o] and [0b] base modifiers. *)
+val of_string : string -> z num option
+
+(** Conversion to an OCaml [int64], returns [None] on overflow. *)
+val to_int64 : _ num -> int64 option
+
+(** Conversion from an OCaml [int]. *)
+val of_int64 : int64 -> z num
+
+(** Conversion to an OCaml [int], returns [None] on overflow. *)
+val to_int : _ num -> int option
+
+(** Conversion from an OCaml [int64]. *)
+val of_int : int -> z num
+
+(** Conversion from a Zarith integer ([Z.t]). *)
+val of_zint : Z.t -> z num
+
+(** Conversion to a Zarith integer ([Z.t]). *)
+val to_zint : 'a num -> Z.t
+
+(** Addition between naturals. *)
+val add_n : n num -> n num -> n num
+
+(** Multiplication between naturals. *)
+val mul_n : n num -> n num -> n num
+
+(** Euclidean division between naturals.
+    [ediv_n n d] returns [None] if divisor is zero,
+    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < d]] otherwise. *)
+val ediv_n:  n num -> n num -> (n num * n num) option
+
+(** Sign agnostic addition.
+    Use {!add_n} when working with naturals to preserve the sign. *)
+val add : _ num -> _ num -> z num
+
+(** Sign agnostic subtraction.
+    Use {!sub_n} when working with naturals to preserve the sign. *)
+val sub : _ num -> _ num -> z num
+
+(** Sign agnostic multiplication.
+    Use {!mul_n} when working with naturals to preserve the sign. *)
+val mul : _ num -> _ num -> z num
+
+(** Sign agnostic euclidean division.
+    [ediv n d] returns [None] if divisor is zero,
+    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < |d|]] otherwise.
+    Use {!ediv_n} when working with naturals to preserve the sign. *)
+val ediv:  _ num -> _ num -> (z num * n num) option
+
+(** Compute the absolute value of a relative, turning it into a natural. *)
+val abs : z num -> n num
+
+(** Partial identity over [N]. *)
+val is_nat : z num -> n num option
+
+(** Negates a number. *)
+val neg : _ num -> z num
+
+(** Turns a natural into a relative, not changing its value. *)
+val int : n num -> z num
+
+(** Reverses each bit in the representation of the number.
+    Also applies to the sign. *)
+val lognot : _ num -> z num
+
+(** Shifts the natural to the left of a number of bits between 0 and 256.
+    Returns [None] if the amount is too high. *)
+val shift_left_n : n num -> n num -> n num option
+
+(** Shifts the natural to the right of a number of bits between 0 and 256.
+    Returns [None] if the amount is too high. *)
+val shift_right_n : n num -> n num -> n num option
+
+(** Shifts the number to the left of a number of bits between 0 and 256.
+    Returns [None] if the amount is too high. *)
+val shift_left : 'a num -> n num -> 'a num option
+
+(** Shifts the number to the right of a number of bits between 0 and 256.
+    Returns [None] if the amount is too high. *)
+val shift_right : 'a num -> n num -> 'a num option
+
+(** Applies a boolean or operation to each bit. *)
+val logor : 'a num -> 'a num -> 'a num
+
+(** Applies a boolean and operation to each bit. *)
+val logand : _ num -> n num -> n num
+
+(** Applies a boolean xor operation to each bit. *)
+val logxor : n num -> n num -> n num
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.ml
new file mode 100644
index 000000000..3d20eebc4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -0,0 +1,905 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script
+open Script_typed_ir
+open Script_ir_translator
+
+(* ---- Run-time errors -----------------------------------------------------*)
+
+type execution_trace =
+  (Script.location * Gas.t * (Script.expr * string option) list) list
+
+type error += Reject of Script.location * Script.expr * execution_trace option
+type error += Overflow of Script.location * execution_trace option
+type error += Runtime_contract_error : Contract.t * Script.expr -> error
+type error += Bad_contract_parameter of Contract.t (* `Permanent *)
+type error += Cannot_serialize_log
+type error += Cannot_serialize_failure
+type error += Cannot_serialize_storage
+
+let () =
+  let open Data_encoding in
+  let trace_encoding =
+    (list @@ obj3
+       (req "location" Script.location_encoding)
+       (req "gas" Gas.encoding)
+       (req "stack"
+          (list
+             (obj2
+                (req "item" (Script.expr_encoding))
+                (opt "annot" string))))) in
+  (* Reject *)
+  register_error_kind
+    `Temporary
+    ~id:"scriptRejectedRuntimeError"
+    ~title: "Script failed (runtime script error)"
+    ~description: "A FAILWITH instruction was reached"
+    (obj3
+       (req "location" Script.location_encoding)
+       (req "with" Script.expr_encoding)
+       (opt "trace" trace_encoding))
+    (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None)
+    (fun (loc, v, trace) -> Reject (loc, v, trace));
+  (* Overflow *)
+  register_error_kind
+    `Temporary
+    ~id:"scriptOverflowRuntimeError"
+    ~title: "Script failed (overflow error)"
+    ~description: "A FAIL instruction was reached due to the detection of an overflow"
+    (obj2
+       (req "location" Script.location_encoding)
+       (opt "trace" trace_encoding))
+    (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None)
+    (fun (loc, trace) -> Overflow (loc, trace));
+  (* Runtime contract error *)
+  register_error_kind
+    `Temporary
+    ~id:"scriptRuntimeError"
+    ~title: "Script runtime error"
+    ~description: "Toplevel error for all runtime script errors"
+    (obj2
+       (req "contractHandle" Contract.encoding)
+       (req "contractCode" Script.expr_encoding))
+    (function
+      | Runtime_contract_error (contract, expr) ->
+          Some (contract, expr)
+      | _ -> None)
+    (fun (contract, expr) ->
+       Runtime_contract_error (contract, expr)) ;
+  (* Bad contract parameter *)
+  register_error_kind
+    `Permanent
+    ~id:"badContractParameter"
+    ~title:"Contract supplied an invalid parameter"
+    ~description:"Either no parameter was supplied to a contract with \
+                  a non-unit parameter type, a non-unit parameter was \
+                  passed to an account, or a parameter was supplied of \
+                  the wrong type"
+    Data_encoding.(obj1 (req "contract" Contract.encoding))
+    (function Bad_contract_parameter c -> Some c | _ -> None)
+    (fun c -> Bad_contract_parameter c) ;
+  (* Cannot serialize log *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeLog"
+    ~title:"Not enough gas to serialize execution trace"
+    ~description:"Execution trace with stacks was to big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_log -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_log) ;
+  (* Cannot serialize failure *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeFailure"
+    ~title:"Not enough gas to serialize argument of FAILWITH"
+    ~description:"Argument of FAILWITH was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_failure -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_failure) ;
+  (* Cannot serialize storage *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeStorage"
+    ~title:"Not enough gas to serialize execution storage"
+    ~description:"The returned storage was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_storage -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_storage)
+
+(* ---- interpreter ---------------------------------------------------------*)
+
+type 'tys stack =
+  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
+  | Empty : end_of_stack 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)
+
+module Interp_costs = Michelson_v1_gas.Cost_of
+
+type ex_descr_stack = Ex_descr_stack : (('a, 'b) descr * 'a stack) -> ex_descr_stack
+
+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)
+
+(* ---- contract handling ---------------------------------------------------*)
+
+and execute ?log ctxt mode ~source ~payer ~self script amount arg :
+  (Script.expr * packed_internal_operation list * context *
+   Script_typed_ir.ex_big_map option) tzresult Lwt.t =
+  parse_script ctxt script
+  >>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->
+  trace
+    (Bad_contract_parameter self)
+    (parse_data ctxt arg_type arg) >>=? fun (arg, ctxt) ->
+  Script.force_decode ctxt script.code >>=? fun (script_code, ctxt) ->
+  trace
+    (Runtime_contract_error (self, script_code))
+    (interp ?log ctxt ~source ~payer ~self amount code (arg, storage))
+  >>=? fun ((ops, sto), ctxt) ->
+  trace Cannot_serialize_storage
+    (unparse_data ctxt mode storage_type sto) >>=? fun (storage, ctxt) ->
+  return (Micheline.strip_locations storage, ops, ctxt,
+          Script_ir_translator.extract_big_map storage_type sto)
+
+type execution_result =
+  { ctxt : context ;
+    storage : Script.expr ;
+    big_map_diff : Contract.big_map_diff option ;
+    operations : packed_internal_operation list }
+
+let trace ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =
+  let log = ref [] in
+  execute ~log ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)
+  >>=? fun (storage, operations, ctxt, big_map) ->
+  begin match big_map with
+    | None -> return (None, ctxt)
+    | Some big_map ->
+        Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->
+        return (Some big_map_diff, ctxt)
+  end >>=? fun (big_map_diff, ctxt) ->
+  let trace = List.rev !log in
+  return ({ ctxt ; storage ; big_map_diff ; operations }, trace)
+
+let execute ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =
+  execute ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)
+  >>=? fun (storage, operations, ctxt, big_map) ->
+  begin match big_map with
+    | None -> return (None, ctxt)
+    | Some big_map ->
+        Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->
+        return (Some big_map_diff, ctxt)
+  end >>=? fun (big_map_diff, ctxt) ->
+  return { ctxt ; storage ; big_map_diff ; operations }
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.mli
new file mode 100644
index 000000000..8218a965b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_interpreter.mli
@@ -0,0 +1,87 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+type execution_trace =
+  (Script.location * Gas.t * (Script.expr * string option) list) list
+
+type error += Reject of Script.location * Script.expr * execution_trace option
+type error += Overflow of Script.location * execution_trace option
+type error += Runtime_contract_error : Contract.t * Script.expr -> error
+type error += Bad_contract_parameter of Contract.t (* `Permanent *)
+type error += Cannot_serialize_log
+type error += Cannot_serialize_failure
+type error += Cannot_serialize_storage
+
+type execution_result =
+  { ctxt : context ;
+    storage : Script.expr ;
+    big_map_diff : Contract.big_map_diff option ;
+    operations : packed_internal_operation list }
+
+val execute:
+  Alpha_context.t ->
+  Script_ir_translator.unparsing_mode ->
+  source: Contract.t ->
+  payer: Contract.t ->
+  self: (Contract.t * Script.t) ->
+  parameter: Script.expr ->
+  amount: Tez.t ->
+  execution_result tzresult Lwt.t
+
+val trace:
+  Alpha_context.t ->
+  Script_ir_translator.unparsing_mode ->
+  source: Contract.t ->
+  payer: Contract.t ->
+  self: (Contract.t * Script.t) ->
+  parameter: Script.expr ->
+  amount: Tez.t ->
+  (execution_result * execution_trace) tzresult Lwt.t
+
+val interp:
+  (?log: execution_trace ref ->
+   context ->
+   source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->
+   ('p, 'r) Script_typed_ir.lambda -> 'p ->
+   ('r * context) tzresult Lwt.t)
+
+type 'tys stack =
+  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
+  | Empty : Script_typed_ir.end_of_stack stack
+
+type ex_descr_stack = Ex_descr_stack : (('a, 'b) Script_typed_ir.descr * 'a stack) -> ex_descr_stack
+
+val step:
+  ?log:execution_trace ref ->
+  context ->
+  source:Contract.t ->
+  self:Contract.t ->
+  payer:Contract.t ->
+  ?visitor: (ex_descr_stack -> unit) ->
+  Tez.t -> ('b, 'a) Script_typed_ir.descr
+  -> 'b stack
+  -> ('a stack * context) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.ml
new file mode 100644
index 000000000..57c0af937
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.ml
@@ -0,0 +1,413 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Micheline
+open Script_tc_errors
+open Script_typed_ir
+
+let default_now_annot = Some (`Var_annot "now")
+let default_amount_annot = Some (`Var_annot "amount")
+let default_balance_annot = Some (`Var_annot "balance")
+let default_steps_annot = Some (`Var_annot "steps")
+let default_source_annot = Some (`Var_annot "source")
+let default_sender_annot = Some (`Var_annot "sender")
+let default_self_annot = Some (`Var_annot "self")
+let default_arg_annot = Some (`Var_annot "arg")
+let default_param_annot = Some (`Var_annot "parameter")
+let default_storage_annot = Some (`Var_annot "storage")
+
+let default_car_annot = Some (`Field_annot "car")
+let default_cdr_annot = Some (`Field_annot "cdr")
+let default_contract_annot = Some (`Field_annot "contract")
+let default_addr_annot = Some (`Field_annot "address")
+let default_manager_annot = Some (`Field_annot "manager")
+let default_pack_annot = Some (`Field_annot "packed")
+let default_unpack_annot = Some (`Field_annot "unpacked")
+let default_slice_annot = Some (`Field_annot "slice")
+
+let default_elt_annot = Some (`Field_annot "elt")
+let default_key_annot = Some (`Field_annot "key")
+let default_hd_annot = Some (`Field_annot "hd")
+let default_tl_annot = Some (`Field_annot "tl")
+let default_some_annot = Some (`Field_annot "some")
+let default_left_annot = Some (`Field_annot "left")
+let default_right_annot = Some (`Field_annot "right")
+let default_binding_annot = Some (`Field_annot "bnd")
+
+let unparse_type_annot : type_annot option -> string list = function
+  | None -> []
+  | Some `Type_annot a -> [ ":" ^ a ]
+
+let unparse_var_annot : var_annot option -> string list = function
+  | None -> []
+  | Some `Var_annot a -> [ "@" ^ a ]
+
+let unparse_field_annot : field_annot option -> string list = function
+  | None -> []
+  | Some `Field_annot a -> [ "%" ^ a ]
+
+let field_to_var_annot : field_annot option -> var_annot option =
+  function
+  | None -> None
+  | Some (`Field_annot s) -> Some (`Var_annot s)
+
+let type_to_var_annot : type_annot option -> var_annot option =
+  function
+  | None -> None
+  | Some (`Type_annot s) -> Some (`Var_annot s)
+
+let var_to_field_annot : var_annot option -> field_annot option =
+  function
+  | None -> None
+  | Some (`Var_annot s) -> Some (`Field_annot s)
+
+let default_annot ~default = function
+  | None -> default
+  | annot -> annot
+
+let gen_access_annot
+  : var_annot option -> ?default:field_annot option -> field_annot option -> var_annot option
+  = fun value_annot ?(default=None) field_annot ->
+    match value_annot, field_annot, default with
+    | None, None, _ | Some _, None, None | None, Some `Field_annot "", _ -> None
+    | None, Some `Field_annot f, _ ->
+        Some (`Var_annot f)
+    | Some `Var_annot v, (None | Some `Field_annot ""), Some `Field_annot f ->
+        Some (`Var_annot (String.concat "." [v; f]))
+    | Some `Var_annot v, Some `Field_annot f, _ ->
+        Some (`Var_annot (String.concat "." [v; f]))
+
+let merge_type_annot
+  : type_annot option -> type_annot option -> type_annot option tzresult
+  = fun annot1 annot2 ->
+    match annot1, annot2 with
+    | None, None
+    | Some _, None
+    | None, Some _ -> ok None
+    | Some `Type_annot a1, Some `Type_annot a2 ->
+        if String.equal a1 a2
+        then ok annot1
+        else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2))
+
+let merge_field_annot
+  : field_annot option -> field_annot option -> field_annot option tzresult
+  = fun annot1 annot2 ->
+    match annot1, annot2 with
+    | None, None
+    | Some _, None
+    | None, Some _ -> ok None
+    | Some `Field_annot a1, Some `Field_annot a2 ->
+        if String.equal a1 a2
+        then ok annot1
+        else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2))
+
+let merge_var_annot
+  : var_annot option -> var_annot option -> var_annot option
+  = fun annot1 annot2 ->
+    match annot1, annot2 with
+    | None, None
+    | Some _, None
+    | None, Some _ -> None
+    | Some `Var_annot a1, Some `Var_annot a2 ->
+        if String.equal a1 a2 then annot1 else None
+
+let error_unexpected_annot loc annot =
+  match annot with
+  | [] -> ok ()
+  | _ :: _ -> error (Unexpected_annotation loc)
+
+let fail_unexpected_annot loc annot =
+  Lwt.return (error_unexpected_annot loc annot)
+
+let parse_annots loc ?(allow_special_var = false) ?(allow_special_field = false) l =
+  (* allow emtpty annotations as wildcards but otherwise only accept
+     annotations that start with [a-zA-Z_] *)
+  let sub_or_wildcard ~specials wrap s acc =
+    let len = String.length s in
+    if Compare.Int.(len = 1) then ok @@ wrap None :: acc
+    else match s.[1] with
+      | 'a' .. 'z' | 'A' .. 'Z' | '_' ->
+          ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc
+      | '@' when Compare.Int.(len = 2) && List.mem '@' specials ->
+          ok @@ wrap (Some "@") :: acc
+      | '%' when List.mem '%' specials ->
+          if Compare.Int.(len = 2)
+          then ok @@ wrap (Some "%") :: acc
+          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%')
+          then ok @@ wrap (Some "%%") :: acc
+          else error (Unexpected_annotation loc)
+      | _ -> error (Unexpected_annotation loc) in
+  List.fold_left (fun acc s ->
+      acc >>? fun acc ->
+      if Compare.Int.(String.length s = 0) then
+        error (Unexpected_annotation loc)
+      else match s.[0] with
+        | ':' -> sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc
+        | '@' ->
+            sub_or_wildcard
+              ~specials:(if allow_special_var then ['%'] else [])
+              (fun a -> `Var_annot a) s acc
+        | '%' -> sub_or_wildcard
+                   ~specials:(if allow_special_field then ['@'] else [])
+                   (fun a -> `Field_annot a) s acc
+        | _ -> error (Unexpected_annotation loc)
+    ) (ok []) l
+  >|? List.rev
+
+let opt_var_of_var_opt = function
+  | `Var_annot None -> None
+  | `Var_annot Some a -> Some (`Var_annot a)
+
+let opt_field_of_field_opt = function
+  | `Field_annot None -> None
+  | `Field_annot Some a -> Some (`Field_annot a)
+
+let opt_type_of_type_opt = function
+  | `Type_annot None -> None
+  | `Type_annot Some a -> Some (`Type_annot a)
+
+let classify_annot loc l
+  : (var_annot option list * type_annot option list * field_annot option list) tzresult
+  =
+  try
+    let _, rv, _, rt, _, rf =
+      List.fold_left
+        (fun (in_v, rv, in_t, rt, in_f, rf) a ->
+           match a, in_v, rv, in_t, rt, in_f, rf with
+           | (`Var_annot _ as a), true, _, _, _, _, _
+           | (`Var_annot _ as a), false, [], _, _, _, _ ->
+               true, opt_var_of_var_opt a :: rv,
+               false, rt,
+               false, rf
+           | (`Type_annot _ as a), _, _, true, _, _, _
+           | (`Type_annot _ as a), _, _, false, [], _, _ ->
+               false, rv,
+               true, opt_type_of_type_opt a :: rt,
+               false, rf
+           | (`Field_annot _ as a), _, _, _, _, true, _
+           | (`Field_annot _ as a), _, _, _, _, false, [] ->
+               false, rv,
+               false, rt,
+               true, opt_field_of_field_opt a :: rf
+           | _ -> raise Exit
+        ) (false, [], false, [], false, []) l in
+    ok (List.rev rv, List.rev rt, List.rev rf)
+  with Exit -> error (Ungrouped_annotations loc)
+
+let get_one_annot loc = function
+  | [] -> ok None
+  | [ a ] -> ok a
+  | _ -> error (Unexpected_annotation loc)
+
+let get_two_annot loc = function
+  | [] -> ok (None, None)
+  | [ a ] -> ok (a, None)
+  | [ a; b ] -> ok (a, b)
+  | _ -> error (Unexpected_annotation loc)
+
+let parse_type_annot
+  : int -> string list -> type_annot option tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc vars >>? fun () ->
+    error_unexpected_annot loc fields >>? fun () ->
+    get_one_annot loc types
+
+let parse_type_field_annot
+  : int -> string list -> (type_annot option * field_annot option) tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc vars >>? fun () ->
+    get_one_annot loc types >>? fun t ->
+    get_one_annot loc fields >|? fun f ->
+    (t, f)
+
+let parse_composed_type_annot
+  : int -> string list -> (type_annot option * field_annot option * field_annot option) tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc vars >>? fun () ->
+    get_one_annot loc types >>? fun t ->
+    get_two_annot loc fields >|? fun (f1, f2) ->
+    (t, f1, f2)
+
+let check_const_type_annot
+  : int -> string list -> type_annot option -> field_annot option list -> unit tzresult Lwt.t
+  = fun loc annot expected_name expected_fields ->
+    Lwt.return
+      (parse_composed_type_annot loc annot >>? fun (ty_name, field1, field2) ->
+       merge_type_annot expected_name ty_name >>? fun _ ->
+       match expected_fields, field1, field2 with
+       | [], Some _, _ | [], _, Some _ | [_], Some _, Some _ ->
+           (* Too many annotations *)
+           error (Unexpected_annotation loc)
+       | _ :: _ :: _ :: _, _, _ | [_], None, Some _ ->
+           error (Unexpected_annotation loc)
+       | [], None, None -> ok ()
+       | [ f1; f2 ], _,  _ ->
+           merge_field_annot f1 field1 >>? fun _ ->
+           merge_field_annot f2 field2 >|? fun _ -> ()
+       | [ f1 ], _,  None ->
+           merge_field_annot f1 field1 >|? fun _ -> ()
+      )
+
+let parse_field_annot
+  : int -> string list -> field_annot option tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc vars >>? fun () ->
+    error_unexpected_annot loc types >>? fun () ->
+    get_one_annot loc fields
+
+let extract_field_annot
+  : Script.node -> (Script.node * field_annot option) tzresult
+  = function
+    | Prim (loc, prim, args, annot) ->
+        let field_annots, annot = List.partition (fun s ->
+            Compare.Int.(String.length s > 0) &&
+            Compare.Char.(s.[0] = '%')
+          ) annot in
+        parse_field_annot loc field_annots >|? fun field_annot ->
+        Prim (loc, prim, args, annot), field_annot
+    | expr -> ok (expr, None)
+
+let check_correct_field
+  : field_annot option -> field_annot option -> unit tzresult
+  = fun f1 f2 ->
+    match f1, f2 with
+    | None, _ | _, None -> ok ()
+    | Some `Field_annot s1, Some `Field_annot s2 ->
+        if String.equal s1 s2 then ok ()
+        else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2))
+
+
+let parse_var_annot
+  : int -> ?default:var_annot option -> string list ->
+    var_annot option tzresult
+  = fun loc ?default annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc types >>? fun () ->
+    error_unexpected_annot loc fields >>? fun () ->
+    get_one_annot loc vars >|? function
+    | Some _ as a -> a
+    | None -> match default with
+      | Some a -> a
+      | None -> None
+
+let split_last_dot = function
+  | None -> None, None
+  | Some `Field_annot s ->
+      match String.rindex_opt s '.' with
+      | None -> None, Some (`Field_annot s)
+      | Some i ->
+          let s1 = String.sub s 0 i in
+          let s2 = String.sub s (i + 1) (String.length s - i - 1) in
+          let f =
+            if Compare.String.equal s2 "car"
+            || Compare.String.equal s2 "cdr" then
+              None
+            else
+              Some (`Field_annot s2) in
+          Some (`Var_annot s1), f
+
+let common_prefix v1 v2 =
+  match v1, v2 with
+  | Some (`Var_annot s1), Some (`Var_annot s2) when Compare.String.equal s1 s2 -> v1
+  | Some _, None -> v1
+  | None, Some _ -> v2
+  | _, _ -> None
+
+let parse_constr_annot
+  : int ->
+    ?if_special_first:field_annot option ->
+    ?if_special_second:field_annot option ->
+    string list ->
+    (var_annot option * type_annot option * field_annot option * field_annot option) tzresult
+  = fun loc ?if_special_first ?if_special_second annot ->
+    parse_annots ~allow_special_field:true loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    get_one_annot loc vars >>? fun v ->
+    get_one_annot loc types >>? fun t ->
+    get_two_annot loc fields >>? fun (f1, f2) ->
+    begin match if_special_first, f1 with
+      | Some special_var, Some `Field_annot "@" ->
+          ok (split_last_dot special_var)
+      | None, Some `Field_annot "@" -> error (Unexpected_annotation loc)
+      | _, _ -> ok (v, f1)
+    end >>? fun (v1, f1) ->
+    begin match if_special_second, f2 with
+      | Some special_var, Some `Field_annot "@" ->
+          ok (split_last_dot special_var)
+      | None, Some `Field_annot "@" -> error (Unexpected_annotation loc)
+      | _, _ -> ok (v, f2)
+    end >|? fun (v2, f2) ->
+    let v = match v with
+      | None -> common_prefix v1 v2
+      | Some _ -> v in
+    (v, t, f1, f2)
+
+let parse_two_var_annot
+  : int -> string list -> (var_annot option * var_annot option) tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc types >>? fun () ->
+    error_unexpected_annot loc fields >>? fun () ->
+    get_two_annot loc vars
+
+let parse_destr_annot
+  : int -> string list -> default_accessor:field_annot option ->
+  field_name:field_annot option ->
+  pair_annot:var_annot option -> value_annot:var_annot option ->
+  (var_annot option * field_annot option) tzresult
+  = fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->
+    parse_annots loc ~allow_special_var:true annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc types >>? fun () ->
+    get_one_annot loc vars >>? fun v ->
+    get_one_annot loc fields >|? fun f ->
+    let default = gen_access_annot pair_annot field_name ~default:default_accessor in
+    let v = match v with
+      | Some `Var_annot "%" -> field_to_var_annot field_name
+      | Some `Var_annot "%%" -> default
+      | Some _ -> v
+      | None -> value_annot in
+    (v, f)
+
+let parse_var_type_annot
+  : int -> string list -> (var_annot option * type_annot option) tzresult
+  = fun loc annot ->
+    parse_annots loc annot >>?
+    classify_annot loc >>? fun (vars, types, fields) ->
+    error_unexpected_annot loc fields >>? fun () ->
+    get_one_annot loc vars >>? fun v ->
+    get_one_annot loc types >|? fun t ->
+    (v, t)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.mli
new file mode 100644
index 000000000..0ad19733a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_annot.mli
@@ -0,0 +1,161 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script_typed_ir
+
+(** Default annotations *)
+
+val default_now_annot : var_annot option
+val default_amount_annot : var_annot option
+val default_balance_annot : var_annot option
+val default_steps_annot : var_annot option
+val default_source_annot : var_annot option
+val default_sender_annot : var_annot option
+val default_self_annot : var_annot option
+val default_arg_annot : var_annot option
+val default_param_annot : var_annot option
+val default_storage_annot : var_annot option
+
+val default_car_annot : field_annot option
+val default_cdr_annot : field_annot option
+val default_contract_annot : field_annot option
+val default_addr_annot : field_annot option
+val default_manager_annot : field_annot option
+val default_pack_annot : field_annot option
+val default_unpack_annot : field_annot option
+val default_slice_annot : field_annot option
+
+val default_elt_annot : field_annot option
+val default_key_annot : field_annot option
+val default_hd_annot : field_annot option
+val default_tl_annot : field_annot option
+val default_some_annot : field_annot option
+val default_left_annot : field_annot option
+val default_right_annot : field_annot option
+val default_binding_annot : field_annot option
+
+(** Unparse annotations to their string representation *)
+
+val unparse_type_annot : type_annot option -> string list
+val unparse_var_annot : var_annot option -> string list
+val unparse_field_annot : field_annot option -> string list
+
+(** Convertions functions between different annotation kinds *)
+
+val field_to_var_annot : field_annot option -> var_annot option
+val type_to_var_annot : type_annot option -> var_annot option
+val var_to_field_annot : var_annot option -> field_annot option
+
+(** Replace an annotation by its default value if it is [None] *)
+val default_annot : default:'a option -> 'a option -> 'a option
+
+(** Generate annotation for field accesses, of the form @var.field1.field2 *)
+val gen_access_annot :
+  var_annot option ->
+  ?default:field_annot option -> field_annot option -> var_annot option
+
+(** Merge type annotations.
+    @returns an error {!Inconsistent_type_annotations} if they are both present
+    and different *)
+val merge_type_annot :
+  type_annot option -> type_annot option -> type_annot option tzresult
+
+(** Merge field annotations.
+    @returns an error {!Inconsistent_type_annotations} if they are both present
+    and different *)
+val merge_field_annot :
+  field_annot option -> field_annot option -> field_annot option tzresult
+
+(** Merge variable annotations, does not fail ([None] if different). *)
+val merge_var_annot :
+  var_annot option -> var_annot option -> var_annot option
+
+(** @returns an error {!Unexpected_annotation} in the monad the list is not empty. *)
+val error_unexpected_annot : int -> 'a list -> unit tzresult
+
+(** Same as {!error_unexpected_annot} in Lwt. *)
+val fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t
+
+(** Parse a type annotation only. *)
+val parse_type_annot : int -> string list -> type_annot option tzresult
+
+(** Parse a field annotation only. *)
+val parse_field_annot :
+  int -> string list -> field_annot option tzresult
+
+(** Parse an annotation for composed types, of the form
+    [:ty_name %field] in any order. *)
+val parse_type_field_annot :
+  int -> string list -> (type_annot option * field_annot option) tzresult
+
+(** Parse an annotation for composed types, of the form
+    [:ty_name %field1 %field2] in any order. *)
+val parse_composed_type_annot :
+  int -> string list ->
+  (type_annot option * field_annot option * field_annot option) tzresult
+
+(** Check that type annotations on constants are consistent *)
+val check_const_type_annot :
+  int -> string list -> type_annot option -> field_annot option list ->
+  unit tzresult Lwt.t
+
+(** Extract and remove a field annotation from a node *)
+val extract_field_annot :
+  Script.node -> (Script.node * field_annot option) tzresult
+
+(** Check that field annotations match, used for field accesses. *)
+val check_correct_field :
+  field_annot option -> field_annot option -> unit tzresult
+
+(** Instruction annotations parsing *)
+
+(** Parse a variable annotation, replaced by a default value if [None]. *)
+val parse_var_annot :
+  int ->
+  ?default:var_annot option ->
+  string list -> var_annot option tzresult
+
+val parse_constr_annot :
+  int ->
+  ?if_special_first:field_annot option ->
+  ?if_special_second:field_annot option ->
+  string list ->
+  (var_annot option * type_annot option *
+   field_annot option * field_annot option) tzresult
+
+val parse_two_var_annot :
+  int -> string list -> (var_annot option * var_annot option) tzresult
+
+val parse_destr_annot :
+  int -> string list ->
+  default_accessor:field_annot option ->
+  field_name:field_annot option ->
+  pair_annot:var_annot option ->
+  value_annot:var_annot option ->
+  (var_annot option * field_annot option) tzresult
+
+val parse_var_type_annot :
+  int -> string list -> (var_annot option * type_annot option) tzresult
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.ml
new file mode 100644
index 000000000..ad7f899e0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -0,0 +1,3272 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Micheline
+open Script
+open Script_typed_ir
+open Script_tc_errors
+open Script_ir_annot
+
+module Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking
+module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse
+
+type ex_comparable_ty = Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty
+type ex_ty = Ex_ty : 'a ty -> ex_ty
+type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty
+type ex_typed_value = Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+type tc_context =
+  | Lambda : tc_context
+  | Dip : 'a stack_ty * tc_context -> tc_context
+  | Toplevel : { storage_type : 'sto ty ; param_type : 'param ty } -> tc_context
+
+type unparsing_mode = Optimized | Readable
+
+type type_logger =
+  int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot)  list -> unit
+
+let add_dip ty annot prev =
+  match prev with
+  | Lambda | Toplevel _ -> Dip (Item_t (ty, Empty_t, annot), prev)
+  | Dip (stack, _) -> Dip (Item_t (ty, stack, annot), prev)
+
+(* ---- Type size accounting ------------------------------------------------*)
+
+(* TODO include annot in size ? *)
+let comparable_type_size : type t. t comparable_ty -> int = fun ty ->
+  (* No wildcard to force the update when comparable_ty chages. *)
+  match ty with
+  | Int_key _ -> 1
+  | Nat_key _ -> 1
+  | String_key _ -> 1
+  | Bytes_key _ -> 1
+  | Mutez_key _ -> 1
+  | Bool_key _ -> 1
+  | Key_hash_key _ -> 1
+  | Timestamp_key _ -> 1
+  | Address_key _ -> 1
+
+(* TODO include annot in size ? *)
+let rec type_size : type t. t ty -> int =
+  fun ty -> match ty with
+    | Unit_t _ -> 1
+    | Int_t _ -> 1
+    | Nat_t _ -> 1
+    | Signature_t _ -> 1
+    | Bytes_t _ -> 1
+    | String_t _ -> 1
+    | Mutez_t _ -> 1
+    | Key_hash_t _ -> 1
+    | Key_t _ -> 1
+    | Timestamp_t _ -> 1
+    | Address_t _ -> 1
+    | Bool_t _ -> 1
+    | Operation_t _ -> 1
+    | Pair_t ((l, _, _), (r, _, _), _) ->
+        1 + type_size l + type_size r
+    | Union_t ((l, _), (r, _), _) ->
+        1 + type_size l + type_size r
+    | Lambda_t (arg, ret, _) ->
+        1 + type_size arg + type_size ret
+    | Option_t ((t,_), _, _) ->
+        1 + type_size t
+    | List_t (t, _) ->
+        1 + type_size t
+    | Set_t (k, _) ->
+        1 + comparable_type_size k
+    | Map_t (k, v, _) ->
+        1 + comparable_type_size k + type_size v
+    | Big_map_t (k, v, _) ->
+        1 + comparable_type_size k + type_size v
+    | Contract_t (arg, _) ->
+        1 + type_size arg
+
+let rec type_size_of_stack_head
+  : type st. st stack_ty -> up_to:int -> int
+  = fun stack ~up_to ->
+    match stack with
+    | Empty_t -> 0
+    | Item_t (head, tail, _annot) ->
+        if Compare.Int.(up_to > 0) then
+          Compare.Int.max (type_size head)
+            (type_size_of_stack_head tail ~up_to:(up_to - 1))
+        else
+          0
+
+(* This is the depth of the stack to inspect for sizes overflow. We
+   only need to check the produced types that can be larger than the
+   arguments. That's why Swap is 0 for instance as no type grows.
+   Constant sized types are not checked: it is assumed they are lower
+   than the bound (otherwise every program would be rejected). *)
+let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
+  | Drop -> 0
+  | Dup -> 0
+  | Swap -> 0
+  | Const _ -> 1
+  | Cons_pair -> 1
+  | Car -> 0
+  | Cdr -> 0
+  | Cons_some -> 1
+  | Cons_none _ -> 1
+  | If_none _ -> 0
+  | Left -> 0
+  | Right -> 0
+  | If_left _ -> 0
+  | Cons_list -> 1
+  | Nil -> 1
+  | If_cons _ -> 0
+  | List_map _ -> 1
+  | List_size -> 0
+  | List_iter _ -> 1
+  | Empty_set _ -> 1
+  | Set_iter _ -> 0
+  | Set_mem -> 0
+  | Set_update -> 0
+  | Set_size -> 0
+  | Empty_map _ -> 1
+  | Map_map _ -> 1
+  | Map_iter _ -> 1
+  | Map_mem -> 0
+  | Map_get -> 0
+  | Map_update -> 0
+  | Map_size -> 0
+  | Big_map_get -> 0
+  | Big_map_update -> 0
+  | Big_map_mem -> 0
+  | Concat_string -> 0
+  | Concat_string_pair -> 0
+  | Slice_string -> 0
+  | String_size -> 0
+  | Concat_bytes -> 0
+  | Concat_bytes_pair -> 0
+  | Slice_bytes -> 0
+  | Bytes_size -> 0
+  | Add_seconds_to_timestamp -> 0
+  | Add_timestamp_to_seconds -> 0
+  | Sub_timestamp_seconds -> 0
+  | Diff_timestamps -> 0
+  | Add_tez -> 0
+  | Sub_tez -> 0
+  | Mul_teznat -> 0
+  | Mul_nattez -> 0
+  | Ediv_teznat -> 0
+  | Ediv_tez -> 0
+  | Or -> 0
+  | And -> 0
+  | Xor -> 0
+  | Not -> 0
+  | Is_nat -> 0
+  | Neg_nat -> 0
+  | Neg_int -> 0
+  | Abs_int -> 0
+  | Int_nat -> 0
+  | Add_intint -> 0
+  | Add_intnat -> 0
+  | Add_natint -> 0
+  | Add_natnat -> 0
+  | Sub_int -> 0
+  | Mul_intint -> 0
+  | Mul_intnat -> 0
+  | Mul_natint -> 0
+  | Mul_natnat -> 0
+  | Ediv_intint -> 0
+  | Ediv_intnat -> 0
+  | Ediv_natint -> 0
+  | Ediv_natnat -> 0
+  | Lsl_nat -> 0
+  | Lsr_nat -> 0
+  | Or_nat -> 0
+  | And_nat -> 0
+  | And_int_nat -> 0
+  | Xor_nat -> 0
+  | Not_nat -> 0
+  | Not_int -> 0
+  | Seq _ -> 0
+  | If _ -> 0
+  | Loop _ -> 0
+  | Loop_left _ -> 0
+  | Dip _ -> 0
+  | Exec -> 0
+  | Lambda _ -> 1
+  | Failwith _ -> 1
+  | Nop -> 0
+  | Compare _ -> 1
+  | Eq -> 0
+  | Neq -> 0
+  | Lt -> 0
+  | Gt -> 0
+  | Le -> 0
+  | Ge -> 0
+  | Address -> 0
+  | Contract _ -> 1
+  | Transfer_tokens -> 1
+  | Create_account -> 0
+  | Implicit_account -> 0
+  | Create_contract _ -> 1
+  | Now -> 0
+  | Balance -> 0
+  | Check_signature -> 0
+  | Hash_key -> 0
+  | Blake2b -> 0
+  | Sha256 -> 0
+  | Sha512 -> 0
+  | Steps_to_quota -> 0
+  | Source -> 0
+  | Sender -> 0
+  | Self _ -> 1
+  | Amount -> 0
+  | Set_delegate -> 0
+  | Pack _ -> 0
+  | Unpack _ -> 1
+
+(* ---- Error helpers -------------------------------------------------------*)
+
+let location = function
+  | Prim (loc, _, _, _)
+  | Int (loc, _)
+  | String (loc, _)
+  | Bytes (loc, _)
+  | Seq (loc, _) -> loc
+
+let kind = function
+  | Int _ -> Int_kind
+  | String _ -> String_kind
+  | Bytes _ -> Bytes_kind
+  | Prim _ -> Prim_kind
+  | Seq _ -> Seq_kind
+
+let namespace = function
+  | K_parameter
+  | K_storage
+  | K_code -> Keyword_namespace
+  | D_False
+  | D_Elt
+  | D_Left
+  | D_None
+  | D_Pair
+  | D_Right
+  | D_Some
+  | D_True
+  | D_Unit -> Constant_namespace
+  | I_PACK
+  | I_UNPACK
+  | I_BLAKE2B
+  | I_SHA256
+  | I_SHA512
+  | I_ABS
+  | I_ADD
+  | I_AMOUNT
+  | I_AND
+  | I_BALANCE
+  | I_CAR
+  | I_CDR
+  | I_CHECK_SIGNATURE
+  | I_COMPARE
+  | I_CONCAT
+  | I_CONS
+  | I_CREATE_ACCOUNT
+  | I_CREATE_CONTRACT
+  | I_IMPLICIT_ACCOUNT
+  | I_DIP
+  | I_DROP
+  | I_DUP
+  | I_EDIV
+  | I_EMPTY_MAP
+  | I_EMPTY_SET
+  | I_EQ
+  | I_EXEC
+  | I_FAILWITH
+  | I_GE
+  | I_GET
+  | I_GT
+  | I_HASH_KEY
+  | I_IF
+  | I_IF_CONS
+  | I_IF_LEFT
+  | I_IF_NONE
+  | I_INT
+  | I_LAMBDA
+  | I_LE
+  | I_LEFT
+  | I_LOOP
+  | I_LSL
+  | I_LSR
+  | I_LT
+  | I_MAP
+  | I_MEM
+  | I_MUL
+  | I_NEG
+  | I_NEQ
+  | I_NIL
+  | I_NONE
+  | I_NOT
+  | I_NOP
+  | I_NOW
+  | I_OR
+  | I_PAIR
+  | I_PUSH
+  | I_RIGHT
+  | I_SIZE
+  | I_SOME
+  | I_SOURCE
+  | I_SENDER
+  | I_SELF
+  | I_SLICE
+  | I_STEPS_TO_QUOTA
+  | I_SUB
+  | I_SWAP
+  | I_TRANSFER_TOKENS
+  | I_SET_DELEGATE
+  | I_UNIT
+  | I_UPDATE
+  | I_XOR
+  | I_ITER
+  | I_LOOP_LEFT
+  | I_ADDRESS
+  | I_CONTRACT
+  | I_ISNAT
+  | I_CAST
+  | I_RENAME -> Instr_namespace
+  | T_bool
+  | T_contract
+  | T_int
+  | T_key
+  | T_key_hash
+  | T_lambda
+  | T_list
+  | T_map
+  | T_big_map
+  | T_nat
+  | T_option
+  | T_or
+  | T_pair
+  | T_set
+  | T_signature
+  | T_string
+  | T_bytes
+  | T_mutez
+  | T_timestamp
+  | T_unit
+  | T_operation
+  | T_address -> Type_namespace
+
+
+let unexpected expr exp_kinds exp_ns exp_prims =
+  match expr with
+  | Int (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Int_kind)
+  | String (loc, _ ) -> Invalid_kind (loc, Prim_kind :: exp_kinds, String_kind)
+  | Bytes (loc, _ ) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Bytes_kind)
+  | Seq (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Seq_kind)
+  | Prim (loc, name, _, _) ->
+      match namespace name, exp_ns with
+      | Type_namespace, Type_namespace
+      | Instr_namespace, Instr_namespace
+      | Constant_namespace, Constant_namespace ->
+          Invalid_primitive (loc, exp_prims, name)
+      | ns, _ ->
+          Invalid_namespace (loc, name, exp_ns, ns)
+
+let check_kind kinds expr =
+  let kind = kind expr in
+  if List.mem kind kinds then
+    return_unit
+  else
+    let loc = location expr in
+    fail (Invalid_kind (loc, kinds, kind))
+
+(* ---- Sets and Maps -------------------------------------------------------*)
+
+let compare_comparable
+  : type a. a comparable_ty -> a -> a -> int
+  = fun kind x y -> match kind with
+    | String_key _ -> Compare.String.compare x y
+    | Bool_key _ -> Compare.Bool.compare x y
+    | Mutez_key _ -> Tez.compare x y
+    | Key_hash_key _ -> Signature.Public_key_hash.compare x y
+    | Int_key _ ->
+        let res = (Script_int.compare x y) in
+        if Compare.Int.(res = 0) then 0
+        else if Compare.Int.(res > 0) then 1
+        else -1
+    | Nat_key _ ->
+        let res = (Script_int.compare x y) in
+        if Compare.Int.(res = 0) then 0
+        else if Compare.Int.(res > 0) then 1
+        else -1
+    | Timestamp_key _ -> Script_timestamp.compare x y
+    | Address_key _ -> Contract.compare x y
+    | Bytes_key _ -> MBytes.compare x y
+
+let empty_set
+  : type a. a comparable_ty -> a set
+  = fun ty ->
+    let module OPS = Set.Make (struct
+        type t = a
+        let compare = compare_comparable ty
+      end) in
+    (module struct
+      type elt = a
+      module OPS = OPS
+      let boxed = OPS.empty
+      let size = 0
+    end)
+
+let set_update
+  : type a. a -> bool -> a set -> a set
+  = fun v b (module Box) ->
+    (module struct
+      type elt = a
+      module OPS = Box.OPS
+      let boxed =
+        if b
+        then Box.OPS.add v Box.boxed
+        else Box.OPS.remove v Box.boxed
+      let size =
+        let mem = Box.OPS.mem v Box.boxed in
+        if mem
+        then if b then Box.size else Box.size - 1
+        else if b then Box.size + 1 else Box.size
+    end)
+
+let set_mem
+  : type elt. elt -> elt set -> bool
+  = fun v (module Box) ->
+    Box.OPS.mem v Box.boxed
+
+let set_fold
+  : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc
+  = fun f (module Box) ->
+    Box.OPS.fold f Box.boxed
+
+let set_size
+  : type elt. elt set -> Script_int.n Script_int.num =
+  fun (module Box) ->
+    Script_int.(abs (of_int Box.size))
+
+let map_key_ty
+  : type a b. (a, b) map -> a comparable_ty
+  = fun (module Box) -> Box.key_ty
+
+let empty_map
+  : type a b. a comparable_ty -> (a, b) map
+  = fun ty ->
+    let module OPS = Map.Make (struct
+        type t = a
+        let compare = compare_comparable ty
+      end) in
+    (module struct
+      type key = a
+      type value = b
+      let key_ty = ty
+      module OPS = OPS
+      let boxed = (OPS.empty, 0)
+    end)
+
+let map_get
+  : type key value. key -> (key, value) map -> value option
+  = fun k (module Box) ->
+    Box.OPS.find_opt k (fst Box.boxed)
+
+let map_update
+  : type a b. a -> b option -> (a, b) map -> (a, b) map
+  = fun k v (module Box) ->
+    (module struct
+      type key = a
+      type value = b
+      let key_ty = Box.key_ty
+      module OPS = Box.OPS
+      let boxed =
+        let (map, size) = Box.boxed in
+        let contains = Box.OPS.mem k map in
+        match v with
+        | Some v -> (Box.OPS.add k v map, size + if contains then 0 else 1)
+        | None -> (Box.OPS.remove k map, size - if contains then 1 else 0)
+    end)
+
+let map_set
+  : type a b. a -> b -> (a, b) map -> (a, b) map
+  = fun k v (module Box) ->
+    (module struct
+      type key = a
+      type value = b
+      let key_ty = Box.key_ty
+      module OPS = Box.OPS
+      let boxed =
+        let (map, size) = Box.boxed in
+        (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1)
+    end)
+
+let map_mem
+  : type key value. key -> (key, value) map -> bool
+  = fun k (module Box) ->
+    Box.OPS.mem k (fst Box.boxed)
+
+let map_fold
+  : type key value acc. (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc
+  = fun f (module Box) ->
+    Box.OPS.fold f (fst Box.boxed)
+
+let map_size
+  : type key value. (key, value) map -> Script_int.n Script_int.num =
+  fun (module Box) ->
+    Script_int.(abs (of_int (snd Box.boxed)))
+
+(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*)
+
+let ty_of_comparable_ty
+  : type a. a comparable_ty -> a ty
+  = function
+    | Int_key tname -> Int_t tname
+    | Nat_key tname -> Nat_t tname
+    | String_key tname -> String_t tname
+    | Bytes_key tname -> Bytes_t tname
+    | Mutez_key tname -> Mutez_t tname
+    | Bool_key tname -> Bool_t tname
+    | Key_hash_key tname -> Key_hash_t tname
+    | Timestamp_key tname -> Timestamp_t tname
+    | Address_key tname -> Address_t tname
+
+let unparse_comparable_ty
+  : type a. a comparable_ty -> Script.node
+  = function
+    | Int_key tname -> Prim (-1, T_int, [], unparse_type_annot tname)
+    | Nat_key tname -> Prim (-1, T_nat, [], unparse_type_annot tname)
+    | String_key tname -> Prim (-1, T_string, [], unparse_type_annot tname)
+    | Bytes_key tname -> Prim (-1, T_bytes, [], unparse_type_annot tname)
+    | Mutez_key tname -> Prim (-1, T_mutez, [], unparse_type_annot tname)
+    | Bool_key tname -> Prim (-1, T_bool, [], unparse_type_annot tname)
+    | Key_hash_key tname -> Prim (-1, T_key_hash, [], unparse_type_annot tname)
+    | Timestamp_key tname -> Prim (-1, T_timestamp, [], unparse_type_annot tname)
+    | Address_key tname -> Prim (-1, T_address, [], unparse_type_annot tname)
+
+let add_field_annot a var = function
+  | Prim (loc, prim, args, annots) ->
+      Prim (loc, prim, args, annots @ unparse_field_annot a @ unparse_var_annot var )
+  | expr -> expr
+
+let rec unparse_ty_no_lwt
+  : type a. context -> a ty -> (Script.node * context) tzresult
+  = fun ctxt ty ->
+    Gas.consume ctxt Unparse_costs.cycle >>? fun ctxt ->
+    let return ctxt (name, args, annot) =
+      let result = Prim (-1, name, args, annot) in
+      Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot) >>? fun ctxt ->
+      ok (result, ctxt) in
+    match ty with
+    | Unit_t tname -> return ctxt (T_unit, [], unparse_type_annot tname)
+    | Int_t tname -> return ctxt (T_int, [], unparse_type_annot tname)
+    | Nat_t tname -> return ctxt (T_nat, [], unparse_type_annot tname)
+    | String_t tname -> return ctxt (T_string, [], unparse_type_annot tname)
+    | Bytes_t tname -> return ctxt (T_bytes, [], unparse_type_annot tname)
+    | Mutez_t tname -> return ctxt (T_mutez, [], unparse_type_annot tname)
+    | Bool_t tname -> return ctxt (T_bool, [], unparse_type_annot tname)
+    | Key_hash_t tname -> return ctxt (T_key_hash, [], unparse_type_annot tname)
+    | Key_t tname -> return ctxt (T_key, [], unparse_type_annot tname)
+    | Timestamp_t tname -> return ctxt (T_timestamp, [], unparse_type_annot tname)
+    | Address_t tname -> return ctxt (T_address, [], unparse_type_annot tname)
+    | Signature_t tname -> return ctxt (T_signature, [], unparse_type_annot tname)
+    | Operation_t tname -> return ctxt (T_operation, [], unparse_type_annot tname)
+    | Contract_t (ut, tname) ->
+        unparse_ty_no_lwt ctxt ut >>? fun (t, ctxt) ->
+        return ctxt (T_contract, [ t ], unparse_type_annot tname)
+    | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), tname) ->
+        let annot = unparse_type_annot tname in
+        unparse_ty_no_lwt ctxt utl >>? fun (utl, ctxt) ->
+        let tl = add_field_annot l_field l_var utl in
+        unparse_ty_no_lwt ctxt utr >>? fun (utr, ctxt) ->
+        let tr = add_field_annot r_field r_var utr in
+        return ctxt (T_pair, [ tl; tr ], annot)
+    | Union_t ((utl, l_field), (utr, r_field), tname) ->
+        let annot = unparse_type_annot tname in
+        unparse_ty_no_lwt ctxt utl >>? fun (utl, ctxt) ->
+        let tl = add_field_annot l_field None utl in
+        unparse_ty_no_lwt ctxt utr >>? fun (utr, ctxt) ->
+        let tr = add_field_annot r_field None utr in
+        return ctxt (T_or, [ tl; tr ], annot)
+    | Lambda_t (uta, utr, tname) ->
+        unparse_ty_no_lwt ctxt uta >>? fun (ta, ctxt) ->
+        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->
+        return ctxt (T_lambda, [ ta; tr ], unparse_type_annot tname)
+    | Option_t ((ut, some_field), _none_field, tname) ->
+        let annot = unparse_type_annot tname in
+        unparse_ty_no_lwt ctxt ut >>? fun (ut, ctxt) ->
+        let t = add_field_annot some_field None ut in
+        return ctxt (T_option, [ t ], annot)
+    | List_t (ut, tname) ->
+        unparse_ty_no_lwt ctxt ut >>? fun (t, ctxt) ->
+        return ctxt (T_list, [ t ], unparse_type_annot tname)
+    | Set_t (ut, tname) ->
+        let t = unparse_comparable_ty ut in
+        return ctxt (T_set, [ t ], unparse_type_annot tname)
+    | Map_t (uta, utr, tname) ->
+        let ta = unparse_comparable_ty uta in
+        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->
+        return ctxt (T_map, [ ta; tr ], unparse_type_annot tname)
+    | Big_map_t (uta, utr, tname) ->
+        let ta = unparse_comparable_ty uta in
+        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->
+        return ctxt (T_big_map, [ ta; tr ], unparse_type_annot tname)
+
+let unparse_ty ctxt ty = Lwt.return (unparse_ty_no_lwt ctxt ty)
+
+let rec strip_var_annots = function
+  | Int _ | String _ | Bytes _ as atom -> atom
+  | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args)
+  | Prim (loc, name, args, annots) ->
+      let not_var_annot s = Compare.Char.(String.get s 0 <> '@') in
+      let annots = List.filter not_var_annot annots in
+      Prim (loc, name, List.map strip_var_annots args, annots)
+
+let serialize_ty_for_error ctxt ty =
+  unparse_ty_no_lwt ctxt ty |>
+  record_trace Cannot_serialize_error >|? fun (ty, ctxt) ->
+  strip_locations (strip_var_annots ty), ctxt
+
+let rec unparse_stack
+  : type a. context -> a stack_ty -> ((Script.expr * Script.annot) list * context) tzresult Lwt.t
+  = fun ctxt -> function
+    | Empty_t -> return ([], ctxt)
+    | Item_t (ty, rest, annot) ->
+        unparse_ty ctxt ty >>=? fun (uty, ctxt) ->
+        unparse_stack ctxt rest >>=? fun (urest, ctxt) ->
+        return ((strip_locations uty, unparse_var_annot annot) :: urest, ctxt)
+
+let serialize_stack_for_error ctxt stack_ty =
+  trace Cannot_serialize_error (unparse_stack ctxt stack_ty)
+
+let name_of_ty
+  : type a. a ty -> type_annot option
+  = function
+    | Unit_t tname -> tname
+    | Int_t tname -> tname
+    | Nat_t tname -> tname
+    | String_t tname -> tname
+    | Bytes_t tname -> tname
+    | Mutez_t tname -> tname
+    | Bool_t tname -> tname
+    | Key_hash_t tname -> tname
+    | Key_t tname -> tname
+    | Timestamp_t tname -> tname
+    | Address_t tname -> tname
+    | Signature_t tname -> tname
+    | Operation_t tname -> tname
+    | Contract_t (_, tname) -> tname
+    | Pair_t (_, _, tname) -> tname
+    | Union_t (_, _, tname) -> tname
+    | Lambda_t (_, _, tname) -> tname
+    | Option_t (_, _, tname) -> tname
+    | List_t (_, tname) -> tname
+    | Set_t (_, tname) -> tname
+    | Map_t (_, _, tname) -> tname
+    | Big_map_t (_, _, tname) -> tname
+
+(* ---- Equality witnesses --------------------------------------------------*)
+
+type ('ta, 'tb) eq = Eq : ('same, 'same) eq
+
+let comparable_ty_eq
+  : type ta tb.
+    context ->
+    ta comparable_ty -> tb comparable_ty ->
+    (ta comparable_ty, tb comparable_ty) eq tzresult
+  = fun ctxt ta tb -> match ta, tb with
+    | Int_key _, Int_key _ -> Ok Eq
+    | Nat_key _, Nat_key _ -> Ok Eq
+    | String_key _, String_key _ -> Ok Eq
+    | Bytes_key _, Bytes_key _ -> Ok Eq
+    | Mutez_key _, Mutez_key _ -> Ok Eq
+    | Bool_key _, Bool_key _ -> Ok Eq
+    | Key_hash_key _, Key_hash_key _ -> Ok Eq
+    | Timestamp_key _, Timestamp_key _ -> Ok Eq
+    | Address_key _, Address_key _ -> Ok Eq
+    | _, _ ->
+        serialize_ty_for_error ctxt (ty_of_comparable_ty ta) >>? fun (ta, ctxt) ->
+        serialize_ty_for_error ctxt (ty_of_comparable_ty tb) >>? fun (tb, _ctxt) ->
+        error (Inconsistent_types (ta, tb))
+
+let record_inconsistent ctxt ta tb =
+  record_trace_eval (fun () ->
+      serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->
+      serialize_ty_for_error ctxt tb >|? fun (tb, _ctxt) ->
+      Inconsistent_types (ta, tb))
+
+let record_inconsistent_type_annotations ctxt loc ta tb =
+  record_trace_eval (fun () ->
+      serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->
+      serialize_ty_for_error ctxt tb >|? fun (tb, _ctxt) ->
+      Inconsistent_type_annotations (loc, ta, tb))
+
+let rec ty_eq
+  : type ta tb. context -> ta ty -> tb ty -> ((ta ty, tb ty) eq * context) tzresult
+  = fun ctxt ta tb ->
+    let ok (eq : (ta ty, tb ty) eq) ctxt nb_args :
+      ((ta ty, tb ty) eq * context) tzresult =
+      Gas.consume ctxt (Typecheck_costs.type_ (2 * nb_args)) >>? fun ctxt ->
+      Ok (eq, ctxt) in
+    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+    match ta, tb with
+    | Unit_t _, Unit_t _ -> ok Eq ctxt 0
+    | Int_t _, Int_t _ -> ok Eq ctxt 0
+    | Nat_t _, Nat_t _ -> ok Eq ctxt 0
+    | Key_t _, Key_t _ -> ok Eq ctxt 0
+    | Key_hash_t _, Key_hash_t _ -> ok Eq ctxt 0
+    | String_t _, String_t _ -> ok Eq ctxt 0
+    | Bytes_t _, Bytes_t _ -> ok Eq ctxt 0
+    | Signature_t _, Signature_t _ -> ok Eq ctxt 0
+    | Mutez_t _, Mutez_t _ -> ok Eq ctxt 0
+    | Timestamp_t _, Timestamp_t _ -> ok Eq ctxt 0
+    | Address_t _, Address_t _ -> ok Eq ctxt 0
+    | Bool_t _, Bool_t _ -> ok Eq ctxt 0
+    | Operation_t _, Operation_t _ -> ok Eq ctxt 0
+    | Map_t (tal, tar, _), Map_t (tbl, tbr, _) ->
+        (comparable_ty_eq ctxt tal tbl >>? fun Eq ->
+         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 2)) |>
+        record_inconsistent ctxt ta tb
+    | Big_map_t (tal, tar, _), Big_map_t (tbl, tbr, _) ->
+        (comparable_ty_eq ctxt tal tbl >>? fun Eq ->
+         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 2)) |>
+        record_inconsistent ctxt ta tb
+    | Set_t (ea, _), Set_t (eb, _) ->
+        (comparable_ty_eq ctxt ea eb >>? fun Eq ->
+         (ok Eq ctxt 1)) |>
+        record_inconsistent ctxt ta tb
+    | Pair_t ((tal, _, _), (tar, _, _), _),
+      Pair_t ((tbl, _, _), (tbr, _, _), _) ->
+        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->
+         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 2)) |>
+        record_inconsistent ctxt ta tb
+    | Union_t ((tal, _), (tar, _), _), Union_t ((tbl, _), (tbr, _), _) ->
+        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->
+         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 2)) |>
+        record_inconsistent ctxt ta tb
+    | Lambda_t (tal, tar, _), Lambda_t (tbl, tbr, _) ->
+        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->
+         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 2)) |>
+        record_inconsistent ctxt ta tb
+    | Contract_t (tal, _), Contract_t (tbl, _) ->
+        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 1)) |>
+        record_inconsistent ctxt ta tb
+    | Option_t ((tva, _), _, _), Option_t ((tvb, _), _, _) ->
+        (ty_eq ctxt tva tvb >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 1)) |>
+        record_inconsistent ctxt ta tb
+    | List_t (tva, _), List_t (tvb, _) ->
+        (ty_eq ctxt tva tvb >>? fun (Eq, ctxt) ->
+         (ok Eq ctxt 1)) |>
+        record_inconsistent ctxt ta tb
+    | _, _ ->
+        serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->
+        serialize_ty_for_error ctxt tb >>? fun (tb, _ctxt) ->
+        error (Inconsistent_types (ta, tb))
+
+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
+
+let merge_comparable_types
+  : type ta. ta comparable_ty -> ta comparable_ty -> ta comparable_ty tzresult
+  = fun ta tb ->
+    match ta, tb with
+    | Int_key annot_a, Int_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Int_key annot
+    | Nat_key annot_a, Nat_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Nat_key annot
+    | String_key annot_a, String_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        String_key annot
+    | Bytes_key annot_a, Bytes_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Bytes_key annot
+    | Mutez_key annot_a, Mutez_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Mutez_key annot
+    | Bool_key annot_a, Bool_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Bool_key annot
+    | Key_hash_key annot_a, Key_hash_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Key_hash_key annot
+    | Timestamp_key annot_a, Timestamp_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Timestamp_key annot
+    | Address_key annot_a, Address_key annot_b ->
+        merge_type_annot annot_a annot_b >|? fun annot ->
+        Address_key annot
+    | _, _ -> assert false (* FIXME: fix injectivity of some types *)
+
+let rec strip_annotations = function
+  | (Int (_,_) as i) -> i
+  | (String (_,_) as s) -> s
+  | (Bytes (_,_) as s) -> s
+  | Prim (loc, prim, args, _) -> Prim (loc, prim, List.map strip_annotations args, [])
+  | Seq (loc, items) -> Seq (loc, List.map strip_annotations items)
+
+let merge_types :
+  type b. context -> Script.location -> b ty -> b ty -> (b ty * context) tzresult =
+  let rec help : type a. context -> a ty -> a ty -> (a ty * context) tzresult
+    = fun ctxt ty1 ty2 ->
+      match ty1, ty2 with
+      | Unit_t tn1, Unit_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Unit_t tname, ctxt
+      | Int_t tn1, Int_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Int_t tname, ctxt
+      | Nat_t tn1, Nat_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Nat_t tname, ctxt
+      | Key_t tn1, Key_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Key_t tname, ctxt
+      | Key_hash_t tn1, Key_hash_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Key_hash_t tname, ctxt
+      | String_t tn1, String_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          String_t tname, ctxt
+      | Bytes_t tn1, Bytes_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Bytes_t tname, ctxt
+      | Signature_t tn1, Signature_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Signature_t tname, ctxt
+      | Mutez_t tn1, Mutez_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Mutez_t tname, ctxt
+      | Timestamp_t tn1, Timestamp_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Timestamp_t tname, ctxt
+      | Address_t tn1, Address_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Address_t tname, ctxt
+      | Bool_t tn1, Bool_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Bool_t tname, ctxt
+      | Operation_t tn1, Operation_t tn2 ->
+          merge_type_annot tn1 tn2 >|? fun tname ->
+          Operation_t tname, ctxt
+      | Map_t (tal, tar, tn1), Map_t (tbl, tbr, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          help ctxt tar tbr >>? fun (value, ctxt) ->
+          ty_eq ctxt tar value >>? fun (Eq, ctxt) ->
+          merge_comparable_types tal tbl >|? fun tk ->
+          Map_t (tk, value, tname), ctxt
+      | Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          help ctxt tar tbr >>? fun (value, ctxt) ->
+          ty_eq ctxt tar value >>? fun (Eq, ctxt) ->
+          merge_comparable_types tal tbl >|? fun tk ->
+          Big_map_t (tk, value, tname), ctxt
+      | Set_t (ea, tn1), Set_t (eb, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          merge_comparable_types ea eb >|? fun e ->
+          Set_t (e, tname), ctxt
+      | Pair_t ((tal, l_field1, l_var1), (tar, r_field1, r_var1), tn1),
+        Pair_t ((tbl, l_field2, l_var2), (tbr, r_field2, r_var2), tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          merge_field_annot l_field1 l_field2 >>? fun l_field ->
+          merge_field_annot r_field1 r_field2 >>? fun r_field ->
+          let l_var = merge_var_annot l_var1 l_var2 in
+          let r_var = merge_var_annot r_var1 r_var2 in
+          help ctxt tal tbl >>? fun (left_ty, ctxt) ->
+          help ctxt tar tbr >|? fun (right_ty, ctxt) ->
+          Pair_t ((left_ty, l_field, l_var), (right_ty, r_field, r_var), tname),
+          ctxt
+      | Union_t ((tal, tal_annot), (tar, tar_annot), tn1),
+        Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          merge_field_annot tal_annot tbl_annot >>? fun left_annot ->
+          merge_field_annot tar_annot tbr_annot >>? fun right_annot ->
+          help ctxt tal tbl >>? fun (left_ty, ctxt) ->
+          help ctxt tar tbr >|? fun (right_ty, ctxt) ->
+          Union_t ((left_ty, left_annot), (right_ty, right_annot), tname),
+          ctxt
+      | Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          help ctxt tal tbl >>? fun (left_ty, ctxt) ->
+          help ctxt tar tbr >|? fun (right_ty, ctxt) ->
+          Lambda_t (left_ty, right_ty, tname), ctxt
+      | Contract_t (tal, tn1), Contract_t (tbl, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          help ctxt tal tbl >|? fun (arg_ty, ctxt) ->
+          Contract_t (arg_ty, tname), ctxt
+      | Option_t ((tva, some_annot_a), none_annot_a, tn1),
+        Option_t ((tvb, some_annot_b), none_annot_b, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          merge_field_annot some_annot_a some_annot_b >>? fun some_annot ->
+          merge_field_annot none_annot_a none_annot_b >>? fun none_annot ->
+          help ctxt tva tvb >|? fun (ty, ctxt) ->
+          Option_t ((ty, some_annot), none_annot, tname), ctxt
+      | List_t (tva, tn1), List_t (tvb, tn2) ->
+          merge_type_annot tn1 tn2 >>? fun tname ->
+          help ctxt tva tvb >|? fun (ty, ctxt) ->
+          List_t (ty, tname), ctxt
+      | _, _ -> assert false
+  in (fun ctxt loc ty1 ty2 ->
+      record_inconsistent_type_annotations ctxt loc ty1 ty2
+        (help ctxt ty1 ty2))
+
+let merge_stacks
+  : type ta. Script.location -> context -> ta stack_ty -> ta stack_ty ->
+    (ta stack_ty * context) tzresult
+  = fun loc ->
+    let rec help : type a. context -> a stack_ty -> a stack_ty ->
+      (a stack_ty * context) tzresult
+      = fun ctxt stack1 stack2 ->
+        match stack1, stack2 with
+        | Empty_t, Empty_t -> ok (Empty_t, ctxt)
+        | Item_t (ty1, rest1, annot1),
+          Item_t (ty2, rest2, annot2) ->
+            let annot = merge_var_annot annot1 annot2 in
+            merge_types ctxt loc ty1 ty2 >>? fun (ty, ctxt) ->
+            help ctxt rest1 rest2 >|? fun (rest, ctxt) ->
+            Item_t (ty, rest, annot), ctxt
+    in help
+
+(* ---- Type checker results -------------------------------------------------*)
+
+type 'bef judgement =
+  | Typed : ('bef, 'aft) descr -> 'bef judgement
+  | Failed : { descr : 'aft. 'aft stack_ty -> ('bef, 'aft) descr } -> 'bef judgement
+
+(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*)
+
+type ('t, 'f, 'b) branch =
+  { branch : 'r. ('t, 'r) descr -> ('f, 'r) descr -> ('b, 'r) descr } [@@unboxed]
+
+
+let merge_branches
+  : type bef a b. context -> int -> a judgement -> b judgement ->
+    (a, b, bef) branch ->
+    (bef judgement * context) tzresult Lwt.t
+  = fun ctxt loc btr bfr { branch } ->
+    match btr, bfr with
+    | Typed ({ aft = aftbt ; _ } as dbt), Typed ({ aft = aftbf ; _ } as dbf) ->
+        let unmatched_branches () =
+          serialize_stack_for_error ctxt aftbt >>=? fun (aftbt, ctxt) ->
+          serialize_stack_for_error ctxt aftbf >>|? fun (aftbf, _ctxt) ->
+          Unmatched_branches (loc, aftbt, aftbf) in
+        trace_eval unmatched_branches
+          (Lwt.return (stack_ty_eq ctxt 1 aftbt aftbf) >>=? fun (Eq, ctxt) ->
+           Lwt.return (merge_stacks loc ctxt aftbt aftbf) >>=? fun (merged_stack, ctxt) ->
+           return (
+             Typed (branch {dbt with aft=merged_stack} {dbf with aft=merged_stack}),
+             ctxt))
+    | Failed { descr = descrt }, Failed { descr = descrf } ->
+        let descr ret =
+          branch (descrt ret) (descrf ret) in
+        return (Failed { descr }, ctxt)
+    | Typed dbt, Failed { descr = descrf } ->
+        return (Typed (branch dbt (descrf dbt.aft)), ctxt)
+    | Failed { descr = descrt }, Typed dbf ->
+        return (Typed (branch (descrt dbf.aft) dbf), ctxt)
+
+let rec parse_comparable_ty
+  : context -> Script.node -> (ex_comparable_ty * context) tzresult
+  = fun ctxt ty ->
+    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+    Gas.consume ctxt (Typecheck_costs.type_ 0) >>? fun ctxt ->
+    match ty with
+    | Prim (loc, T_int, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Int_key tname ), ctxt
+    | Prim (loc, T_nat, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Nat_key tname ), ctxt
+    | Prim (loc, T_string, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( String_key tname ), ctxt
+    | Prim (loc, T_bytes, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Bytes_key tname ), ctxt
+    | Prim (loc, T_mutez, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Mutez_key tname ), ctxt
+    | Prim (loc, T_bool, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Bool_key tname ), ctxt
+    | Prim (loc, T_key_hash, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Key_hash_key tname ), ctxt
+    | Prim (loc, T_timestamp, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Timestamp_key tname ), ctxt
+    | Prim (loc, T_address, [], annot) ->
+        parse_type_annot loc annot >|? fun tname ->
+        Ex_comparable_ty ( Address_key tname ), ctxt
+    | Prim (loc, (T_int | T_nat
+                 | T_string | T_mutez | T_bool
+                 | T_key | T_address | T_timestamp as prim), l, _) ->
+        error (Invalid_arity (loc, prim, 0, List.length l))
+    | Prim (loc, (T_pair | T_or | T_set | T_map
+                 | T_list | T_option  | T_lambda
+                 | T_unit | T_signature  | T_contract), _, _) ->
+        error (Comparable_type_expected (loc, Micheline.strip_locations ty))
+    | expr ->
+        error @@ unexpected expr [] Type_namespace
+          [ T_int ; T_nat ;
+            T_string ; T_mutez ; T_bool ;
+            T_key ; T_key_hash ; T_timestamp ]
+
+and parse_ty :
+  context ->
+  allow_big_map: bool ->
+  allow_operation: bool ->
+  Script.node -> (ex_ty * context) tzresult
+  = fun ctxt ~allow_big_map ~allow_operation node ->
+    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+    match node with
+    | Prim (loc, T_unit, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Unit_t ty_name), ctxt
+    | Prim (loc, T_int, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Int_t ty_name), ctxt
+    | Prim (loc, T_nat, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Nat_t ty_name), ctxt
+    | Prim (loc, T_string, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (String_t ty_name), ctxt
+    | Prim (loc, T_bytes, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Bytes_t ty_name), ctxt
+    | Prim (loc, T_mutez, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Mutez_t ty_name), ctxt
+    | Prim (loc, T_bool, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Bool_t ty_name), ctxt
+    | Prim (loc, T_key, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Key_t ty_name), ctxt
+    | Prim (loc, T_key_hash, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Key_hash_t ty_name), ctxt
+    | Prim (loc, T_timestamp, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Timestamp_t ty_name), ctxt
+    | Prim (loc, T_address, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Address_t ty_name), ctxt
+    | Prim (loc, T_signature, [], annot) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+        Ex_ty (Signature_t ty_name), ctxt
+    | Prim (loc, T_operation, [], annot) ->
+        if allow_operation then
+          parse_type_annot loc annot >>? fun ty_name ->
+          Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->
+          Ex_ty (Operation_t ty_name), ctxt
+        else
+          error (Unexpected_operation loc)
+    | Prim (loc, T_contract, [ utl ], annot) ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false utl >>? fun (Ex_ty tl, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->
+        Ex_ty (Contract_t (tl, ty_name)), ctxt
+    | Prim (loc, T_pair, [ utl; utr ], annot) ->
+        extract_field_annot utl >>? fun (utl, left_field) ->
+        extract_field_annot utr >>? fun (utr, right_field) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation utl >>? fun (Ex_ty tl, ctxt) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        Ex_ty (Pair_t ((tl, left_field, None), (tr, right_field, None), ty_name)), ctxt
+    | Prim (loc, T_or, [ utl; utr ], annot) ->
+        extract_field_annot utl >>? fun (utl, left_constr) ->
+        extract_field_annot utr >>? fun (utr, right_constr) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation utl >>? fun (Ex_ty tl, ctxt) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        Ex_ty (Union_t ((tl, left_constr), (tr, right_constr), ty_name)), ctxt
+    | Prim (loc, T_lambda, [ uta; utr ], annot) ->
+        parse_ty ctxt ~allow_big_map:true ~allow_operation:true uta >>? fun (Ex_ty ta, ctxt) ->
+        parse_ty ctxt ~allow_big_map:true ~allow_operation:true utr >>? fun (Ex_ty tr, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        Ex_ty (Lambda_t (ta, tr, ty_name)), ctxt
+    | Prim (loc, T_option, [ ut ], annot) ->
+        extract_field_annot ut >>? fun (ut, some_constr) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation ut >>? fun (Ex_ty t, ctxt) ->
+        parse_composed_type_annot loc annot >>? fun (ty_name, none_constr, _) ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        Ex_ty (Option_t ((t, some_constr), none_constr, ty_name)), ctxt
+    | Prim (loc, T_list, [ ut ], annot) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation ut >>? fun (Ex_ty t, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->
+        Ex_ty (List_t (t, ty_name)), ctxt
+    | Prim (loc, T_set, [ ut ], annot) ->
+        parse_comparable_ty ctxt ut >>? fun (Ex_comparable_ty t, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->
+        Ex_ty (Set_t (t, ty_name)), ctxt
+    | Prim (loc, T_map, [ uta; utr ], annot) ->
+        parse_comparable_ty ctxt uta >>? fun (Ex_comparable_ty ta, ctxt) ->
+        parse_ty ctxt ~allow_big_map ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->
+        parse_type_annot loc annot >>? fun ty_name ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        Ex_ty (Map_t (ta, tr, ty_name)), ctxt
+    | Prim (loc, T_big_map, args, annot)
+      when allow_big_map ->
+        parse_big_map_ty ctxt loc args annot >>? fun (big_map_ty, ctxt) ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        big_map_ty, ctxt
+    | Prim (loc, T_big_map, _, _) ->
+        error (Unexpected_big_map loc)
+    | Prim (loc, (T_unit | T_signature
+                 | T_int | T_nat
+                 | T_string | T_bytes | T_mutez | T_bool
+                 | T_key | T_key_hash
+                 | T_timestamp | T_address as prim), l, _) ->
+        error (Invalid_arity (loc, prim, 0, List.length l))
+    | Prim (loc, (T_set | T_list | T_option as prim), l, _) ->
+        error (Invalid_arity (loc, prim, 1, List.length l))
+    | Prim (loc, (T_pair | T_or | T_map | T_lambda | T_contract as prim), l, _) ->
+        error (Invalid_arity (loc, prim, 2, List.length l))
+    | expr ->
+        error @@ unexpected expr [] Type_namespace
+          [ T_pair ; T_or ; T_set ; T_map ;
+            T_list ; T_option  ; T_lambda ;
+            T_unit ; T_signature  ; T_contract ;
+            T_int ; T_nat ; T_operation ;
+            T_string ; T_bytes ; T_mutez ; T_bool ;
+            T_key ; T_key_hash ; T_timestamp ]
+
+and parse_big_map_ty ctxt big_map_loc args map_annot =
+  Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+  begin match args with
+    | [ key_ty ; value_ty ] ->
+        parse_comparable_ty ctxt key_ty >>? fun (Ex_comparable_ty key_ty, ctxt) ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false value_ty
+        >>? fun (Ex_ty value_ty, ctxt) ->
+        parse_type_annot big_map_loc map_annot >|? fun map_name ->
+        let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in
+        Ex_ty big_map_ty, ctxt
+    | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)
+  end
+
+and parse_storage_ty :
+  context -> Script.node -> (ex_ty * context) tzresult
+  = fun ctxt node ->
+    match node with
+    | Prim (loc, T_pair,
+            [ Prim (big_map_loc, T_big_map, args, map_annot) ; remaining_storage ],
+            storage_annot) ->
+        Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+        parse_big_map_ty ctxt big_map_loc args map_annot >>? fun (Ex_ty big_map_ty, ctxt) ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false remaining_storage
+        >>? fun (Ex_ty remaining_storage, ctxt) ->
+        parse_composed_type_annot loc storage_annot
+        >>? fun (ty_name, map_field, storage_field) ->
+        Gas.consume ctxt (Typecheck_costs.type_ 5) >|? fun ctxt ->
+        Ex_ty (Pair_t ((big_map_ty, map_field, None),
+                       (remaining_storage, storage_field, None),
+                       ty_name)),
+        ctxt
+    | _ ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false node
+
+let check_no_big_map_or_operation loc root =
+  let rec check : type t. t ty -> unit tzresult = function
+    | Big_map_t _ -> error (Unexpected_big_map loc)
+    | Operation_t _ -> error (Unexpected_operation loc)
+    | Unit_t _ -> ok ()
+    | Int_t _ -> ok ()
+    | Nat_t _ -> ok ()
+    | Signature_t _ -> ok ()
+    | String_t _ -> ok ()
+    | Bytes_t _ -> ok ()
+    | Mutez_t _ -> ok ()
+    | Key_hash_t _ -> ok ()
+    | Key_t _ -> ok ()
+    | Timestamp_t _ -> ok ()
+    | Address_t _ -> ok ()
+    | Bool_t _ -> ok ()
+    | Pair_t ((l_ty, _, _), (r_ty, _, _), _) ->
+        check l_ty >>? fun () -> check r_ty
+    | Union_t ((l_ty, _), (r_ty, _), _) ->
+        check l_ty >>? fun () -> check r_ty
+    | Option_t ((v_ty, _), _, _) -> check v_ty
+    | List_t (elt_ty, _) -> check elt_ty
+    | Set_t (_, _) -> ok ()
+    | Map_t (_, elt_ty, _) -> check elt_ty
+    | Lambda_t (_l_ty, _r_ty, _) -> ok ()
+    | Contract_t (_, _) -> ok () in
+  check root
+
+type ex_script = Ex_script : ('a, 'c) script -> ex_script
+
+(* Lwt versions *)
+let parse_var_annot loc ?default annot =
+  Lwt.return (parse_var_annot loc ?default annot)
+let parse_constr_annot loc ?if_special_first ?if_special_second annot =
+  Lwt.return (parse_constr_annot loc ?if_special_first ?if_special_second annot)
+let parse_two_var_annot loc annot =
+  Lwt.return (parse_two_var_annot loc annot)
+let parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot =
+  Lwt.return (parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot)
+let parse_var_type_annot loc annot =
+  Lwt.return (parse_var_type_annot loc annot)
+
+let rec parse_data
+  : type a.
+    ?type_logger: type_logger ->
+    context -> a ty -> Script.node -> (a * context) tzresult Lwt.t
+  = fun  ?type_logger ctxt ty script_data ->
+    Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt ->
+    let error () =
+      Lwt.return (serialize_ty_for_error ctxt ty) >>|? fun (ty, _ctxt) ->
+      Invalid_constant (location script_data, strip_locations script_data, ty) in
+    let traced body =
+      trace_eval error body in
+    let parse_items ?type_logger loc ctxt expr key_type value_type items item_wrapper =
+      let length = List.length items in
+      fold_left_s
+        (fun (last_value, map, ctxt) item ->
+           Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length)) >>=? fun ctxt ->
+           match item with
+           | Prim (_, D_Elt, [ k; v ], _) ->
+               parse_comparable_data ?type_logger ctxt key_type k >>=? fun (k, ctxt) ->
+               parse_data ?type_logger ctxt value_type v >>=? fun (v, ctxt) ->
+               begin match last_value with
+                 | Some value ->
+                     if Compare.Int.(0 <= (compare_comparable key_type value k))
+                     then
+                       if Compare.Int.(0 = (compare_comparable key_type value k))
+                       then fail (Duplicate_map_keys (loc, strip_locations expr))
+                       else fail (Unordered_map_keys (loc, strip_locations expr))
+                     else return_unit
+                 | None -> return_unit
+               end >>=? fun () ->
+               return (Some k, map_update k (Some (item_wrapper v)) map, ctxt)
+           | Prim (loc, D_Elt, l, _) ->
+               fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)
+           | Prim (loc, name, _, _) ->
+               fail @@ Invalid_primitive (loc, [ D_Elt ], name)
+           | Int _ | String _ | Bytes _ | Seq _ ->
+               error () >>=? fail)
+        (None, empty_map key_type, ctxt) items |> traced >>|? fun (_, items, ctxt) ->
+      (items, ctxt) in
+    match ty, script_data with
+    (* Unit *)
+    | Unit_t ty_name, Prim (loc, D_Unit, [], annot) ->
+        check_const_type_annot loc annot ty_name [] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.unit) >>|? fun ctxt ->
+        ((() : a), ctxt)
+    | Unit_t _, Prim (loc, D_Unit, l, _) ->
+        traced (fail (Invalid_arity (loc, D_Unit, 0, List.length l)))
+    | Unit_t _, expr ->
+        traced (fail (unexpected expr [] Constant_namespace [ D_Unit ]))
+    (* Booleans *)
+    | Bool_t ty_name, Prim (loc, D_True, [], annot) ->
+        check_const_type_annot loc annot ty_name [] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.bool) >>|? fun ctxt ->
+        (true, ctxt)
+    | Bool_t ty_name, Prim (loc, D_False, [], annot) ->
+        check_const_type_annot loc annot ty_name [] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.bool) >>|? fun ctxt ->
+        (false, ctxt)
+    | Bool_t _, Prim (loc, (D_True | D_False as c), l, _) ->
+        traced (fail (Invalid_arity (loc, c, 0, List.length l)))
+    | Bool_t _, expr ->
+        traced (fail (unexpected expr [] Constant_namespace [ D_True ; D_False ]))
+    (* Strings *)
+    | String_t _, String (_, v) ->
+        Lwt.return (Gas.consume ctxt (Typecheck_costs.string (String.length v))) >>=? fun ctxt ->
+        let rec check_printable_ascii i =
+          if Compare.Int.(i < 0) then true
+          else match String.get v i with
+            | '\n' | '\x20'..'\x7E' -> check_printable_ascii (i - 1)
+            | _ -> false in
+        if check_printable_ascii (String.length v - 1) then
+          return (v, ctxt)
+        else
+          error () >>=? fail
+    | String_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))
+    (* Byte sequences *)
+    | Bytes_t _, Bytes (_, v) ->
+        Lwt.return (Gas.consume ctxt (Typecheck_costs.string (MBytes.length v))) >>=? fun ctxt ->
+        return (v, ctxt)
+    | Bytes_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr)))
+    (* Integers *)
+    | Int_t _, Int (_, v) ->
+        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->
+        return (Script_int.of_zint v, ctxt)
+    | Nat_t _, Int (_, v) ->
+        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->
+        let v = Script_int.of_zint v in
+        if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
+          return (Script_int.abs v, ctxt)
+        else
+          error () >>=? fail
+    | Int_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
+    | Nat_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
+    (* Tez amounts *)
+    | Mutez_t _, Int (_, v) ->
+        Lwt.return (
+          Gas.consume ctxt Typecheck_costs.tez >>? fun ctxt ->
+          Gas.consume ctxt Michelson_v1_gas.Cost_of.z_to_int64
+        ) >>=? fun ctxt ->
+        begin try
+            match Tez.of_mutez (Z.to_int64 v) with
+            | None -> raise Exit
+            | Some tez -> return (tez, ctxt)
+          with _ ->
+            error () >>=? fail
+        end
+    | Mutez_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))
+    (* Timestamps *)
+    | Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->
+        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->
+        return (Script_timestamp.of_zint v, ctxt)
+    | Timestamp_t _, String (_, s) (* As unparsed with [Redable]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt ->
+        begin match Script_timestamp.of_string s with
+          | Some v -> return (v, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Timestamp_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr)))
+    (* IDs *)
+    | Key_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)
+        Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt ->
+        begin match Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes with
+          | Some k -> return (k, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Key_t _, String (_, s) -> (* As unparsed with [Readable]. *)
+        Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt ->
+        begin match Signature.Public_key.of_b58check_opt s with
+          | Some k -> return (k, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Key_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
+    | Key_hash_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)
+        Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt ->
+        begin
+          match Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes with
+          | Some k -> return (k, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Key_hash_t _, String (_, s) (* As unparsed with [Readable]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt ->
+        begin match Signature.Public_key_hash.of_b58check_opt s with
+          | Some k -> return (k, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Key_hash_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
+    (* Signatures *)
+    | Signature_t _, Bytes (_, bytes) (* As unparsed with [Optimized]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt ->
+        begin match Data_encoding.Binary.of_bytes Signature.encoding bytes with
+          | Some k -> return (k, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Signature_t _, String (_, s) (* As unparsed with [Readable]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt ->
+        begin match Signature.of_b58check_opt s with
+          | Some s -> return (s, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Signature_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
+    (* Operations *)
+    | Operation_t _, _ ->
+        (* operations cannot appear in parameters or storage,
+           the protocol should never parse the bytes of an operation *)
+        assert false
+    (* Addresses *)
+    | Address_t _, Bytes (_, bytes) (* As unparsed with [O[ptimized]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
+        begin
+          match Data_encoding.Binary.of_bytes Contract.encoding bytes with
+          | Some c -> return (c, ctxt)
+          | None -> error () >>=? fail
+        end
+    | Address_t _, String (_, s) (* As unparsed with [Readable]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
+        traced (Lwt.return (Contract.of_b58check s)) >>=? fun c ->
+        return (c, ctxt)
+    | Address_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
+    (* Contracts *)
+    | Contract_t (ty, _), Bytes (loc, bytes) (* As unparsed with [Optimized]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
+        begin
+          match Data_encoding.Binary.of_bytes Contract.encoding bytes with
+          | Some c ->
+              traced (parse_contract ctxt loc ty c) >>=? fun (ctxt, _) ->
+              return ((ty, c), ctxt)
+          | None -> error () >>=? fail
+        end
+    | Contract_t (ty, _), String (loc, s) (* As unparsed with [Readable]. *) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->
+        traced @@
+        Lwt.return (Contract.of_b58check s) >>=? fun c ->
+        parse_contract ctxt loc ty c >>=? fun (ctxt, _) ->
+        return ((ty, c), ctxt)
+    | Contract_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))
+    (* Pairs *)
+    | Pair_t ((ta, af, _), (tb, bf, _), ty_name), Prim (loc, D_Pair, [ va; vb ], annot) ->
+        check_const_type_annot loc annot ty_name [af; bf] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.pair) >>=? fun ctxt ->
+        traced @@
+        parse_data ?type_logger ctxt ta va >>=? fun (va, ctxt) ->
+        parse_data ?type_logger ctxt tb vb >>=? fun (vb, ctxt) ->
+        return ((va, vb), ctxt)
+    | Pair_t _, Prim (loc, D_Pair, l, _) ->
+        fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)
+    | Pair_t _, expr ->
+        traced (fail (unexpected expr [] Constant_namespace [ D_Pair ]))
+    (* Unions *)
+    | Union_t ((tl, lconstr), _, ty_name), Prim (loc, D_Left, [ v ], annot) ->
+        check_const_type_annot loc annot ty_name [lconstr]>>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt ->
+        traced @@
+        parse_data ?type_logger ctxt tl v >>=? fun (v, ctxt) ->
+        return (L v, ctxt)
+    | Union_t _, Prim (loc, D_Left, l, _) ->
+        fail @@ Invalid_arity (loc, D_Left, 1, List.length l)
+    | Union_t (_, (tr, rconstr), ty_name), Prim (loc, D_Right, [ v ], annot) ->
+        check_const_type_annot loc annot ty_name [rconstr] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt ->
+        traced @@
+        parse_data ?type_logger ctxt tr v >>=? fun (v, ctxt) ->
+        return (R v, ctxt)
+    | Union_t _, Prim (loc, D_Right, l, _) ->
+        fail @@ Invalid_arity (loc, D_Right, 1, List.length l)
+    | Union_t _, expr ->
+        traced (fail (unexpected expr [] Constant_namespace [ D_Left ; D_Right ]))
+    (* Lambdas *)
+    | Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr) ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.lambda) >>=? fun ctxt ->
+        traced @@
+        parse_returning Lambda ?type_logger ctxt (ta, Some (`Var_annot "@arg")) tr script_instr
+    | Lambda_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+    (* Options *)
+    | Option_t ((t, some_constr), _, ty_name), Prim (loc, D_Some, [ v ], annot) ->
+        check_const_type_annot loc annot ty_name [some_constr] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.some) >>=? fun ctxt ->
+        traced @@
+        parse_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->
+        return (Some v, ctxt)
+    | Option_t _, Prim (loc, D_Some, l, _) ->
+        fail @@ Invalid_arity (loc, D_Some, 1, List.length l)
+    | Option_t (_, none_constr, ty_name), Prim (loc, D_None, [], annot) ->
+        check_const_type_annot loc annot ty_name [none_constr] >>=? fun () ->
+        Lwt.return (Gas.consume ctxt Typecheck_costs.none) >>=? fun ctxt ->
+        return (None, ctxt)
+    | Option_t _, Prim (loc, D_None, l, _) ->
+        fail @@ Invalid_arity (loc, D_None, 0, List.length l)
+    | Option_t _, expr ->
+        traced (fail (unexpected expr [] Constant_namespace [ D_Some ; D_None ]))
+    (* Lists *)
+    | List_t (t, _ty_name), Seq (_loc, items) ->
+        traced @@
+        fold_right_s
+          (fun v (rest, ctxt) ->
+             Lwt.return (Gas.consume ctxt Typecheck_costs.list_element) >>=? fun ctxt ->
+             parse_data ?type_logger ctxt  t v >>=? fun (v, ctxt) ->
+             return ((v :: rest), ctxt))
+          items ([], ctxt)
+    | List_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+    (* Sets *)
+    | Set_t (t, _ty_name), (Seq (loc, vs) as expr) ->
+        let length = List.length vs in
+        traced @@
+        fold_left_s
+          (fun (last_value, set, ctxt) v ->
+             Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length)) >>=? fun ctxt ->
+             parse_comparable_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->
+             begin match last_value with
+               | Some value ->
+                   if Compare.Int.(0 <= (compare_comparable t value v))
+                   then
+                     if Compare.Int.(0 = (compare_comparable t value v))
+                     then fail (Duplicate_set_values (loc, strip_locations expr))
+                     else fail (Unordered_set_values (loc, strip_locations expr))
+                   else return_unit
+               | None -> return_unit
+             end >>=? fun () ->
+             Lwt.return (Gas.consume ctxt (Michelson_v1_gas.Cost_of.set_update v false set)) >>=? fun ctxt ->
+             return (Some v, set_update v true set, ctxt))
+          (None, empty_set t, ctxt) vs >>|? fun (_, set, ctxt) ->
+        (set, ctxt)
+    | Set_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+    (* Maps *)
+    | Map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr) ->
+        parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x)
+    | Map_t _, expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+    | Big_map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr) ->
+        parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x) >>|? fun (diff, ctxt) ->
+        ({ diff ; key_type = ty_of_comparable_ty tk ; value_type = tv }, ctxt)
+    | Big_map_t (_tk, _tv, _), expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+
+and parse_comparable_data
+  : type a.
+    ?type_logger:type_logger ->
+    context -> a comparable_ty -> Script.node -> (a * context) tzresult Lwt.t
+  = fun ?type_logger ctxt ty script_data ->
+    parse_data ?type_logger ctxt (ty_of_comparable_ty ty) script_data
+
+and parse_returning
+  : type arg ret.
+    ?type_logger: type_logger ->
+    tc_context -> context ->
+    arg ty * var_annot option -> ret ty -> Script.node ->
+    ((arg, ret) lambda * context) tzresult Lwt.t =
+  fun ?type_logger tc_context ctxt (arg, arg_annot) ret script_instr ->
+    parse_instr ?type_logger tc_context ctxt
+      script_instr (Item_t (arg, Empty_t, arg_annot)) >>=? function
+    | (Typed ({ loc ; aft = (Item_t (ty, Empty_t, _) as stack_ty) ; _ } as descr), ctxt) ->
+        trace_eval
+          (fun () ->
+             Lwt.return (serialize_ty_for_error ctxt ret) >>=? fun (ret, ctxt) ->
+             serialize_stack_for_error ctxt stack_ty >>|? fun (stack_ty, _ctxt) ->
+             Bad_return (loc, stack_ty, ret))
+          (Lwt.return (ty_eq ctxt ty ret) >>=? fun (Eq, ctxt) ->
+           Lwt.return (merge_types ctxt loc ty ret) >>=? fun (_ret, ctxt) ->
+           return ((Lam (descr, strip_locations script_instr) : (arg, ret) lambda), ctxt))
+    | (Typed { loc ; aft = stack_ty ; _ }, ctxt) ->
+        Lwt.return (serialize_ty_for_error ctxt ret) >>=? fun (ret, ctxt) ->
+        serialize_stack_for_error ctxt stack_ty >>=? fun (stack_ty, _ctxt) ->
+        fail (Bad_return (loc, stack_ty, ret))
+    | (Failed { descr }, ctxt) ->
+        return ((Lam (descr (Item_t (ret, Empty_t, None)), strip_locations script_instr)
+                 : (arg, ret) lambda), ctxt)
+
+and parse_instr
+  : type bef.
+    ?type_logger: type_logger ->
+    tc_context -> context ->
+    Script.node -> bef stack_ty -> (bef judgement * context) tzresult Lwt.t =
+  fun ?type_logger tc_context ctxt script_instr stack_ty ->
+    let check_item check loc name n m =
+      trace_eval (fun () ->
+          serialize_stack_for_error ctxt stack_ty >>|? fun (stack_ty, _ctxt) ->
+          Bad_stack (loc, name, m, stack_ty)) @@
+      trace (Bad_stack_item n) @@
+      Lwt.return check in
+    let check_item_ty ctxt exp got loc n =
+      check_item (ty_eq ctxt exp got) loc n in
+    let log_stack ctxt loc stack_ty aft =
+      match type_logger, script_instr with
+      | None, _
+      | Some _, (Seq (-1, _) | Int _ | String _ | Bytes _) -> return ()
+      | Some log, (Prim _ | Seq _) ->
+          (* Unparsing for logging done in an unlimited context as this
+             is used only by the client and not the protocol *)
+          let ctxt = Gas.set_unlimited ctxt in
+          unparse_stack ctxt stack_ty >>=? fun (stack_ty, _) ->
+          unparse_stack ctxt aft >>=? fun (aft, _) ->
+          log loc stack_ty aft;
+          return ()
+    in
+    let return :
+      context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = fun ctxt judgement ->
+      match judgement with
+      | Typed { instr ; loc ; aft ; _ } ->
+          let maximum_type_size = Constants.michelson_maximum_type_size ctxt in
+          let type_size =
+            type_size_of_stack_head aft
+              ~up_to:(number_of_generated_growing_types instr) in
+          if Compare.Int.(type_size > maximum_type_size) then
+            fail (Type_too_large (loc, type_size, maximum_type_size))
+          else
+            return (judgement, ctxt)
+      | Failed _ ->
+          return (judgement, ctxt) in
+    let typed ctxt loc instr aft =
+      log_stack ctxt loc stack_ty aft >>=? fun () ->
+      Lwt.return @@ Gas.consume ctxt (Typecheck_costs.instr instr) >>=? fun ctxt ->
+      return ctxt (Typed { loc ; instr ; bef = stack_ty ; aft }) in
+    Lwt.return @@ Gas.consume ctxt Typecheck_costs.cycle >>=? fun ctxt ->
+    match script_instr, stack_ty with
+    (* stack ops *)
+    | Prim (loc, I_DROP, [], annot),
+      Item_t (_, rest, _) ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        typed ctxt loc Drop
+          rest
+    | Prim (loc, I_DUP, [], annot),
+      Item_t (v, rest, stack_annot) ->
+        parse_var_annot loc annot ~default:stack_annot >>=? fun annot ->
+        typed ctxt loc Dup
+          (Item_t (v, Item_t (v, rest, stack_annot), annot))
+    | Prim (loc, I_SWAP, [], annot),
+      Item_t (v,  Item_t (w, rest, stack_annot), cur_top_annot) ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        typed ctxt loc Swap
+          (Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot))
+    | Prim (loc, I_PUSH, [ t ; d ], annot),
+      stack ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false t >>=? fun (Ex_ty t, ctxt) ->
+        parse_data ?type_logger ctxt t d >>=? fun (v, ctxt) ->
+        typed ctxt loc (Const v) (Item_t (t, stack, annot))
+    | Prim (loc, I_UNIT, [], annot),
+      stack ->
+        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->
+        typed ctxt loc (Const ()) (Item_t (Unit_t ty_name, stack, annot))
+    (* options *)
+    | Prim (loc, I_SOME, [], annot),
+      Item_t (t, rest, stack_annot) ->
+        parse_constr_annot loc annot
+          ~if_special_first:(var_to_field_annot stack_annot)
+        >>=? fun (annot, ty_name, some_field, none_field) ->
+        typed ctxt loc Cons_some
+          (Item_t (Option_t ((t, some_field), none_field, ty_name), rest, annot))
+    | Prim (loc, I_NONE, [ t ], annot),
+      stack ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true t >>=? fun (Ex_ty t, ctxt) ->
+        parse_constr_annot loc annot >>=? fun (annot, ty_name, some_field, none_field) ->
+        typed ctxt loc (Cons_none t)
+          (Item_t (Option_t ((t, some_field), none_field, ty_name), stack, annot))
+    | Prim (loc, I_IF_NONE, [ bt ; bf ], annot),
+      (Item_t (Option_t ((t, some_field), _none_field, _), rest, option_annot) as bef) ->
+        check_kind [ Seq_kind ] bt >>=? fun () ->
+        check_kind [ Seq_kind ] bf >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let annot = gen_access_annot option_annot some_field ~default:default_some_annot in
+        parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) ->
+        parse_instr ?type_logger tc_context ctxt bf (Item_t (t, rest, annot)) >>=? fun (bfr, ctxt) ->
+        let branch ibt ibf =
+          { loc ; instr = If_none (ibt, ibf) ; bef ; aft = ibt.aft } in
+        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->
+        return ctxt judgement
+    (* pairs *)
+    | Prim (loc, I_PAIR, [], annot),
+      Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ->
+        parse_constr_annot loc annot
+          ~if_special_first:(var_to_field_annot fst_annot)
+          ~if_special_second:(var_to_field_annot snd_annot)
+        >>=? fun (annot, ty_name, l_field, r_field) ->
+        typed ctxt loc Cons_pair
+          (Item_t (Pair_t((a, l_field, fst_annot), (b, r_field, snd_annot), ty_name), rest, annot))
+    | Prim (loc, I_CAR, [], annot),
+      Item_t (Pair_t ((a, expected_field_annot, a_annot), _, _), rest, pair_annot) ->
+        parse_destr_annot loc annot
+          ~pair_annot
+          ~value_annot:a_annot
+          ~field_name:expected_field_annot
+          ~default_accessor:default_car_annot
+        >>=? fun (annot, field_annot) ->
+        Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () ->
+        typed ctxt loc Car (Item_t (a, rest, annot))
+    | Prim (loc, I_CDR, [], annot),
+      Item_t (Pair_t (_, (b, expected_field_annot, b_annot), _), rest, pair_annot) ->
+        parse_destr_annot loc annot
+          ~pair_annot
+          ~value_annot:b_annot
+          ~field_name:expected_field_annot
+          ~default_accessor:default_cdr_annot
+        >>=? fun (annot, field_annot) ->
+        Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () ->
+        typed ctxt loc Cdr (Item_t (b, rest, annot))
+    (* unions *)
+    | Prim (loc, I_LEFT, [ tr ], annot),
+      Item_t (tl, rest, stack_annot) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true tr >>=? fun (Ex_ty tr, ctxt) ->
+        parse_constr_annot loc annot
+          ~if_special_first:(var_to_field_annot stack_annot)
+        >>=? fun (annot, tname, l_field, r_field) ->
+        typed ctxt loc Left (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot))
+    | Prim (loc, I_RIGHT, [ tl ], annot),
+      Item_t (tr, rest, stack_annot) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true tl >>=? fun (Ex_ty tl, ctxt) ->
+        parse_constr_annot loc annot
+          ~if_special_second:(var_to_field_annot stack_annot)
+        >>=? fun (annot, tname, l_field, r_field) ->
+        typed ctxt loc Right (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot))
+    | Prim (loc, I_IF_LEFT, [ bt ; bf ], annot),
+      (Item_t (Union_t ((tl, l_field), (tr, r_field), _), rest, union_annot) as bef) ->
+        check_kind [ Seq_kind ] bt >>=? fun () ->
+        check_kind [ Seq_kind ] bf >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let left_annot = gen_access_annot union_annot l_field ~default:default_left_annot in
+        let right_annot = gen_access_annot union_annot r_field ~default:default_right_annot in
+        parse_instr ?type_logger tc_context ctxt bt (Item_t (tl, rest, left_annot)) >>=? fun (btr, ctxt) ->
+        parse_instr ?type_logger tc_context ctxt bf (Item_t (tr, rest, right_annot)) >>=? fun (bfr, ctxt) ->
+        let branch ibt ibf =
+          { loc ; instr = If_left (ibt, ibf) ; bef ; aft = ibt.aft } in
+        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->
+        return ctxt judgement
+    (* lists *)
+    | Prim (loc, I_NIL, [ t ], annot),
+      stack ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true t >>=? fun (Ex_ty t, ctxt) ->
+        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->
+        typed ctxt loc Nil (Item_t (List_t (t, ty_name), stack, annot))
+    | Prim (loc, I_CONS, [], annot),
+      Item_t (tv, Item_t (List_t (t, ty_name), rest, _), _) ->
+        check_item_ty ctxt tv t loc I_CONS 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Cons_list (Item_t (List_t (t, ty_name), rest, annot))
+    | Prim (loc, I_IF_CONS, [ bt ; bf ], annot),
+      (Item_t (List_t (t, ty_name), rest, list_annot) as bef) ->
+        check_kind [ Seq_kind ] bt >>=? fun () ->
+        check_kind [ Seq_kind ] bf >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let hd_annot = gen_access_annot list_annot default_hd_annot in
+        let tl_annot = gen_access_annot list_annot default_tl_annot in
+        parse_instr ?type_logger tc_context ctxt bt
+          (Item_t (t, Item_t (List_t (t, ty_name), rest, tl_annot), hd_annot))
+        >>=? fun (btr, ctxt) ->
+        parse_instr ?type_logger tc_context ctxt bf
+          rest >>=? fun (bfr, ctxt) ->
+        let branch ibt ibf =
+          { loc ; instr = If_cons (ibt, ibf) ; bef ; aft = ibt.aft } in
+        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->
+        return ctxt judgement
+    | Prim (loc, I_SIZE, [], annot),
+      Item_t (List_t _, rest, _) ->
+        parse_var_type_annot loc annot >>=? fun (annot, tname) ->
+        typed ctxt loc List_size (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_MAP, [ body ], annot),
+      (Item_t (List_t (elt, _), starting_rest, list_annot)) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        parse_var_type_annot loc annot
+        >>=? fun (ret_annot, list_ty_name) ->
+        let elt_annot = gen_access_annot list_annot default_elt_annot in
+        parse_instr ?type_logger tc_context ctxt
+          body (Item_t (elt, starting_rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) ->
+              let invalid_map_body () =
+                serialize_stack_for_error ctxt ibody.aft >>|? fun (aft, _ctxt) ->
+                Invalid_map_body (loc, aft) in
+              trace_eval invalid_map_body
+                (Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt rest starting_rest >>=? fun (rest, ctxt) ->
+                 typed ctxt loc (List_map ibody)
+                   (Item_t (List_t (ret, list_ty_name), rest, ret_annot)))
+          | Typed { aft ; _ } ->
+              serialize_stack_for_error ctxt aft >>=? fun (aft, _ctxt) ->
+              fail (Invalid_map_body (loc, aft))
+          | Failed _ -> fail (Invalid_map_block_fail loc)
+        end
+    | Prim (loc, I_ITER, [ body ], annot),
+      Item_t (List_t (elt, _), rest, list_annot) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let elt_annot = gen_access_annot list_annot default_elt_annot in
+        parse_instr ?type_logger tc_context ctxt
+          body (Item_t (elt, rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ({ aft ; _ } as ibody) ->
+              let invalid_iter_body () =
+                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->
+                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->
+                Invalid_iter_body (loc, rest, aft) in
+              trace_eval invalid_iter_body
+                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->
+                 typed ctxt loc (List_iter ibody) rest)
+          | Failed { descr } ->
+              typed ctxt loc (List_iter (descr rest)) rest
+        end
+    (* sets *)
+    | Prim (loc, I_EMPTY_SET, [ t ], annot),
+      rest ->
+        Lwt.return @@ parse_comparable_ty ctxt t >>=? fun (Ex_comparable_ty t, ctxt) ->
+        parse_var_type_annot loc annot >>=? fun (annot, tname) ->
+        typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), rest, annot))
+    | Prim (loc, I_ITER, [ body ], annot),
+      Item_t (Set_t (comp_elt, _), rest, set_annot) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let elt_annot = gen_access_annot set_annot default_elt_annot in
+        let elt = ty_of_comparable_ty comp_elt in
+        parse_instr ?type_logger tc_context ctxt
+          body (Item_t (elt, rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ({ aft ; _ } as ibody) ->
+              let invalid_iter_body () =
+                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->
+                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->
+                Invalid_iter_body (loc, rest, aft) in
+              trace_eval invalid_iter_body
+                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->
+                 typed ctxt loc (Set_iter ibody) rest)
+          | Failed { descr } ->
+              typed ctxt loc (Set_iter (descr rest)) rest
+        end
+    | Prim (loc, I_MEM, [], annot),
+      Item_t (v, Item_t (Set_t (elt, _), rest, _), _) ->
+        let elt = ty_of_comparable_ty elt in
+        parse_var_type_annot loc annot >>=? fun (annot, tname) ->
+        check_item_ty ctxt elt v loc I_MEM 1 2 >>=? fun (Eq, ctxt) ->
+        typed ctxt loc Set_mem (Item_t (Bool_t tname, rest, annot))
+    | Prim (loc, I_UPDATE, [], annot),
+      Item_t (v, Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _), _) ->
+        let ty = ty_of_comparable_ty elt in
+        parse_var_annot loc annot ~default:set_annot >>=? fun annot ->
+        check_item_ty ctxt ty v loc I_UPDATE 1 3 >>=? fun (Eq, ctxt) ->
+        typed ctxt loc Set_update (Item_t (Set_t (elt, tname), rest, annot))
+    | Prim (loc, I_SIZE, [], annot),
+      Item_t (Set_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Set_size (Item_t (Nat_t None, rest, annot))
+    (* maps *)
+    | Prim (loc, I_EMPTY_MAP, [ tk ; tv ], annot),
+      stack ->
+        Lwt.return @@ parse_comparable_ty ctxt tk >>=? fun (Ex_comparable_ty tk, ctxt) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true tv >>=? fun (Ex_ty tv, ctxt) ->
+        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->
+        typed ctxt loc (Empty_map (tk, tv)) (Item_t (Map_t (tk, tv, ty_name), stack, annot))
+    | Prim (loc, I_MAP, [ body ], annot),
+      Item_t (Map_t (ck, elt, _), starting_rest, _map_annot) ->
+        let k = ty_of_comparable_ty ck in
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        parse_var_type_annot loc annot >>=? fun (ret_annot, ty_name) ->
+        let k_name = field_to_var_annot default_key_annot in
+        let e_name = field_to_var_annot default_elt_annot in
+        parse_instr ?type_logger tc_context ctxt
+          body (Item_t (Pair_t ((k, None, k_name), (elt, None, e_name), None),
+                        starting_rest, None)) >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) ->
+              let invalid_map_body () =
+                serialize_stack_for_error ctxt ibody.aft >>|? fun (aft, _ctxt) ->
+                Invalid_map_body (loc, aft) in
+              trace_eval invalid_map_body
+                (Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt rest starting_rest >>=? fun (rest, ctxt) ->
+                 typed ctxt loc (Map_map ibody)
+                   (Item_t (Map_t (ck, ret, ty_name), rest, ret_annot)))
+          | Typed { aft ; _ } ->
+              serialize_stack_for_error ctxt aft >>=? fun (aft, _ctxt) ->
+              fail (Invalid_map_body (loc, aft))
+          | Failed _ -> fail (Invalid_map_block_fail loc)
+        end
+    | Prim (loc, I_ITER, [ body ], annot),
+      Item_t (Map_t (comp_elt, element_ty, _), rest, _map_annot) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let k_name = field_to_var_annot default_key_annot in
+        let e_name = field_to_var_annot default_elt_annot in
+        let key = ty_of_comparable_ty comp_elt in
+        parse_instr ?type_logger tc_context ctxt body
+          (Item_t (Pair_t ((key, None, k_name), (element_ty, None, e_name), None),
+                   rest, None))
+        >>=? begin fun (judgement, ctxt) -> match judgement with
+          | Typed ({ aft ; _ } as ibody) ->
+              let invalid_iter_body () =
+                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->
+                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->
+                Invalid_iter_body (loc, rest, aft) in
+              trace_eval invalid_iter_body
+                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->
+                 typed ctxt loc (Map_iter ibody) rest)
+          | Failed { descr } ->
+              typed ctxt loc (Map_iter (descr rest)) rest
+        end
+    | Prim (loc, I_MEM, [], annot),
+      Item_t (vk, Item_t (Map_t (ck, _, _), rest, _), _) ->
+        let k = ty_of_comparable_ty ck in
+        check_item_ty ctxt vk k loc I_MEM 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Map_mem (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_GET, [], annot),
+      Item_t (vk, Item_t (Map_t (ck, elt, _), rest, _), _) ->
+        let k = ty_of_comparable_ty ck in
+        check_item_ty ctxt vk k loc I_GET 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Map_get (Item_t (Option_t ((elt, None), None, None), rest, annot))
+    | Prim (loc, I_UPDATE, [], annot),
+      Item_t (vk, Item_t (Option_t ((vv, _), _, _),
+                          Item_t (Map_t (ck, v, map_name), rest, map_annot), _), _) ->
+        let k = ty_of_comparable_ty ck in
+        check_item_ty ctxt vk k loc I_UPDATE 1 3 >>=? fun (Eq, ctxt) ->
+        check_item_ty ctxt vv v loc I_UPDATE 2 3 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot ~default:map_annot >>=? fun annot ->
+        typed ctxt loc Map_update (Item_t (Map_t (ck, v, map_name), rest, annot))
+    | Prim (loc, I_SIZE, [], annot),
+      Item_t (Map_t (_, _, _), rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Map_size (Item_t (Nat_t None, rest, annot))
+    (* big_map *)
+    | Prim (loc, I_MEM, [], annot),
+      Item_t (set_key, Item_t (Big_map_t (map_key, _, _), rest, _), _) ->
+        let k = ty_of_comparable_ty map_key in
+        check_item_ty ctxt set_key k loc I_MEM 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Big_map_mem (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_GET, [], annot),
+      Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest, _), _) ->
+        let k = ty_of_comparable_ty ck in
+        check_item_ty ctxt vk k loc I_GET 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Big_map_get (Item_t (Option_t ((elt, None), None, None), rest, annot))
+    | Prim (loc, I_UPDATE, [], annot),
+      Item_t (set_key,
+              Item_t (Option_t ((set_value, _), _, _),
+                      Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot), _), _) ->
+        let k = ty_of_comparable_ty map_key in
+        check_item_ty ctxt set_key k loc I_UPDATE 1 3 >>=? fun (Eq, ctxt) ->
+        check_item_ty ctxt set_value map_value loc I_UPDATE 2 3 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot ~default:map_annot >>=? fun annot ->
+        typed ctxt loc Big_map_update (Item_t (Big_map_t (map_key, map_value, map_name), rest, annot))
+    (* control *)
+    | Seq (loc, []),
+      stack ->
+        typed ctxt loc Nop stack
+    | Seq (loc, [ single ]),
+      stack ->
+        parse_instr ?type_logger tc_context ctxt single
+          stack >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ({ aft ; _ } as instr) ->
+              let nop = { bef = aft ; loc = loc ; aft ; instr = Nop } in
+              typed ctxt loc (Seq (instr, nop)) aft
+          | Failed { descr ; _ } ->
+              let descr aft =
+                let nop = { bef = aft ; loc = loc ; aft ; instr = Nop } in
+                let descr = descr aft in
+                { descr with instr = Seq (descr, nop) } in
+              return ctxt (Failed { descr })
+        end
+    | Seq (loc, hd :: tl),
+      stack ->
+        parse_instr ?type_logger tc_context ctxt hd
+          stack >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Failed _ ->
+              fail (Fail_not_in_tail_position (Micheline.location hd))
+          | Typed ({ aft = middle ; _ } as ihd) ->
+              parse_instr ?type_logger tc_context ctxt (Seq (-1, tl))
+                middle >>=? fun (judgement, ctxt) ->
+              match judgement with
+              | Failed { descr } ->
+                  let descr ret =
+                    { loc ; instr = Seq (ihd, descr ret) ;
+                      bef = stack ; aft = ret } in
+                  return ctxt (Failed { descr })
+              | Typed itl ->
+                  typed ctxt loc (Seq (ihd, itl)) itl.aft
+        end
+    | Prim (loc, I_IF, [ bt ; bf ], annot),
+      (Item_t (Bool_t _, rest, _) as bef) ->
+        check_kind [ Seq_kind ] bt >>=? fun () ->
+        check_kind [ Seq_kind ] bf >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) ->
+        parse_instr ?type_logger tc_context ctxt bf rest >>=? fun (bfr, ctxt) ->
+        let branch ibt ibf =
+          { loc ; instr = If (ibt, ibf) ; bef ; aft = ibt.aft } in
+        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->
+        return ctxt judgement
+    | Prim (loc, I_LOOP, [ body ], annot),
+      (Item_t (Bool_t _, rest, _stack_annot) as stack) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        parse_instr ?type_logger tc_context ctxt body
+          rest >>=? begin fun (judgement, ctxt) ->
+          match judgement with
+          | Typed ibody ->
+              let unmatched_branches () =
+                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->
+                serialize_stack_for_error ctxt stack >>|? fun (stack, _ctxt) ->
+                Unmatched_branches (loc, aft, stack) in
+              trace_eval unmatched_branches
+                (Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt ibody.aft stack >>=? fun (_stack, ctxt) ->
+                 typed ctxt loc (Loop ibody) rest)
+          | Failed { descr } ->
+              let ibody = descr stack in
+              typed ctxt loc (Loop ibody) rest
+        end
+    | Prim (loc, I_LOOP_LEFT, [ body ], annot),
+      (Item_t (Union_t ((tl, l_field), (tr, _), _), rest, union_annot) as stack) ->
+        check_kind [ Seq_kind ] body >>=? fun () ->
+        parse_var_annot loc annot >>=? fun annot ->
+        let l_annot = gen_access_annot union_annot l_field ~default:default_left_annot in
+        parse_instr ?type_logger tc_context ctxt body
+          (Item_t (tl, rest, l_annot)) >>=? begin fun (judgement, ctxt) -> match judgement with
+          | Typed ibody ->
+              let unmatched_branches () =
+                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->
+                serialize_stack_for_error ctxt stack >>|? fun (stack, _ctxt) ->
+                Unmatched_branches (loc, aft, stack) in
+              trace_eval unmatched_branches
+                (Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack >>=? fun (Eq, ctxt) ->
+                 Lwt.return @@ merge_stacks loc ctxt ibody.aft stack >>=? fun (_stack, ctxt) ->
+                 typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)))
+          | Failed { descr } ->
+              let ibody = descr stack in
+              typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot))
+        end
+    | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], annot),
+      stack ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true arg
+        >>=? fun (Ex_ty arg, ctxt) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true ret
+        >>=? fun (Ex_ty ret, ctxt) ->
+        check_kind [ Seq_kind ] code >>=? fun () ->
+        parse_var_annot loc annot >>=? fun annot ->
+        parse_returning Lambda ?type_logger ctxt
+          (arg, default_arg_annot) ret code >>=? fun (lambda, ctxt) ->
+        typed ctxt loc (Lambda lambda) (Item_t (Lambda_t (arg, ret, None), stack, annot))
+    | Prim (loc, I_EXEC, [], annot),
+      Item_t (arg, Item_t (Lambda_t (param, ret, _), rest, _), _) ->
+        check_item_ty ctxt arg param loc I_EXEC 1 2 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Exec (Item_t (ret, rest, annot))
+    | Prim (loc, I_DIP, [ code ], annot),
+      Item_t (v, rest, stack_annot) ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        check_kind [ Seq_kind ] code >>=? fun () ->
+        parse_instr ?type_logger (add_dip v stack_annot tc_context) ctxt code
+          rest >>=? begin fun (judgement, ctxt) -> match judgement with
+          | Typed descr ->
+              typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot))
+          | Failed _ ->
+              fail (Fail_not_in_tail_position loc)
+        end
+    | Prim (loc, I_FAILWITH, [], annot),
+      Item_t (v, _rest, _) ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        let descr aft = { loc ; instr = Failwith v ; bef = stack_ty ; aft } in
+        log_stack ctxt loc stack_ty Empty_t >>=? fun () ->
+        return ctxt (Failed { descr })
+    (* timestamp operations *)
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Add_timestamp_to_seconds
+          (Item_t (Timestamp_t tname, rest, annot))
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Int_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Add_seconds_to_timestamp
+          (Item_t (Timestamp_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Sub_timestamp_seconds
+          (Item_t (Timestamp_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Diff_timestamps
+          (Item_t (Int_t tname, rest, annot))
+    (* string operations *)
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Concat_string_pair
+          (Item_t (String_t tname, rest, annot))
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (List_t (String_t tname, _), rest, list_annot) ->
+        parse_var_annot ~default:list_annot loc annot >>=? fun annot ->
+        typed ctxt loc Concat_string
+          (Item_t (String_t tname, rest, annot))
+    | Prim (loc, I_SLICE, [], annot),
+      Item_t (Nat_t _, Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _), _) ->
+        parse_var_annot
+          ~default:(gen_access_annot string_annot default_slice_annot)
+          loc annot >>=? fun annot ->
+        typed ctxt loc Slice_string
+          (Item_t (Option_t ((String_t tname, None), None, None), rest, annot))
+    | Prim (loc, I_SIZE, [], annot),
+      Item_t (String_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc String_size (Item_t (Nat_t None, rest, annot))
+    (* bytes operations *)
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Concat_bytes_pair
+          (Item_t (Bytes_t tname, rest, annot))
+    | Prim (loc, I_CONCAT, [], annot),
+      Item_t (List_t (Bytes_t tname, _), rest, list_annot) ->
+        parse_var_annot ~default:list_annot loc annot >>=? fun annot ->
+        typed ctxt loc Concat_bytes
+          (Item_t (Bytes_t tname, rest, annot))
+    | Prim (loc, I_SLICE, [], annot),
+      Item_t (Nat_t _, Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _), _) ->
+        parse_var_annot
+          ~default:(gen_access_annot bytes_annot default_slice_annot)
+          loc annot >>=? fun annot ->
+        typed ctxt loc Slice_bytes
+          (Item_t (Option_t ((Bytes_t tname, None), None, None), rest, annot))
+    | Prim (loc, I_SIZE, [], annot),
+      Item_t (Bytes_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Bytes_size (Item_t (Nat_t None, rest, annot))
+    (* currency operations *)
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Add_tez
+          (Item_t (Mutez_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Sub_tez
+          (Item_t (Mutez_t tname, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) -> (* no type name check *)
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Mul_teznat
+          (Item_t (Mutez_t tname, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) -> (* no type name check *)
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Mul_nattez
+          (Item_t (Mutez_t tname, rest, annot))
+    (* boolean operations *)
+    | Prim (loc, I_OR, [], annot),
+      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Or
+          (Item_t (Bool_t tname, rest, annot))
+    | Prim (loc, I_AND, [], annot),
+      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc And
+          (Item_t (Bool_t tname, rest, annot))
+    | Prim (loc, I_XOR, [], annot),
+      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Xor
+          (Item_t (Bool_t tname, rest, annot))
+    | Prim (loc, I_NOT, [], annot),
+      Item_t (Bool_t tname, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Not
+          (Item_t (Bool_t tname, rest, annot))
+    (* integer operations *)
+    | Prim (loc, I_ABS, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Abs_int
+          (Item_t (Nat_t None, rest, annot))
+    | Prim (loc, I_ISNAT, [], annot),
+      Item_t (Int_t _, rest, int_annot) ->
+        parse_var_annot loc annot ~default:int_annot >>=? fun annot ->
+        typed ctxt loc Is_nat
+          (Item_t (Option_t ((Nat_t None, None), None, None), rest, annot))
+    | Prim (loc, I_INT, [], annot),
+      Item_t (Nat_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Int_nat
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_NEG, [], annot),
+      Item_t (Int_t tname, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Neg_int
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_NEG, [], annot),
+      Item_t (Nat_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Neg_nat
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Add_intint
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Add_intnat
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Add_natint
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_ADD, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Add_natnat
+          (Item_t (Nat_t  tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Sub_int
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Sub_int
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Sub_int
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_SUB, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun _tname ->
+        typed ctxt loc Sub_int
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Mul_intint
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Mul_intnat
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Mul_natint
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_MUL, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Mul_natnat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Ediv_teznat
+          (Item_t (Option_t
+                     ((Pair_t ((Mutez_t tname, None, None),
+                               (Mutez_t tname, None, None), None), None),
+                      None, None), rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Ediv_tez
+          (Item_t (Option_t ((Pair_t ((Nat_t None, None, None),
+                                      (Mutez_t tname, None, None), None), None),
+                             None, None), rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Ediv_intint
+          (Item_t (Option_t
+                     ((Pair_t ((Int_t tname, None, None),
+                               (Nat_t None, None, None), None), None),
+                      None, None), rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Ediv_intnat
+          (Item_t (Option_t
+                     ((Pair_t ((Int_t tname, None, None),
+                               (Nat_t None, None, None), None), None),
+                      None, None), rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Nat_t tname, Item_t (Int_t _, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Ediv_natint
+          (Item_t (Option_t ((Pair_t ((Int_t None, None, None),
+                                      (Nat_t tname, None, None), None), None),
+                             None, None), rest, annot))
+    | Prim (loc, I_EDIV, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Ediv_natnat
+          (Item_t (Option_t ((Pair_t ((Nat_t tname, None, None),
+                                      (Nat_t tname, None, None), None), None),
+                             None, None), rest, annot))
+    | Prim (loc, I_LSL, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Lsl_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_LSR, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Lsr_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_OR, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Or_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_AND, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc And_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_AND, [], annot),
+      Item_t (Int_t _, Item_t (Nat_t tname, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc And_int_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_XOR, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc Xor_nat
+          (Item_t (Nat_t tname, rest, annot))
+    | Prim (loc, I_NOT, [], annot),
+      Item_t (Int_t tname, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Not_int
+          (Item_t (Int_t tname, rest, annot))
+    | Prim (loc, I_NOT, [], annot),
+      Item_t (Nat_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Not_nat
+          (Item_t (Int_t None, rest, annot))
+    (* comparison *)
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Int_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Nat_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Bool_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (String_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Mutez_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Key_hash_t tn1, Item_t (Key_hash_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Key_hash_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Timestamp_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Address_t tn1, Item_t (Address_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Address_key tname))
+          (Item_t (Int_t None, rest, annot))
+    | Prim (loc, I_COMPARE, [], annot),
+      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->
+        typed ctxt loc (Compare (Bytes_key tname))
+          (Item_t (Int_t None, rest, annot))
+    (* comparators *)
+    | Prim (loc, I_EQ, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Eq
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_NEQ, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Neq
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_LT, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Lt
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_GT, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Gt
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_LE, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Le
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_GE, [], annot),
+      Item_t (Int_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Ge
+          (Item_t (Bool_t None, rest, annot))
+    (* annotations *)
+    | Prim (loc, I_CAST, [ cast_t ], annot),
+      Item_t (t, stack, item_annot) ->
+        parse_var_annot loc annot ~default:item_annot >>=? fun annot ->
+        (Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true cast_t)
+        >>=? fun (Ex_ty cast_t, ctxt) ->
+        Lwt.return @@ ty_eq ctxt cast_t t >>=? fun (Eq, ctxt) ->
+        Lwt.return @@ merge_types ctxt loc cast_t t >>=? fun (_, ctxt) ->
+        typed ctxt loc Nop (Item_t (cast_t, stack, annot))
+    | Prim (loc, I_RENAME, [], annot),
+      Item_t (t, stack, _) ->
+        parse_var_annot loc annot >>=? fun annot -> (* can erase annot *)
+        typed ctxt loc Nop (Item_t (t, stack, annot))
+    (* packing *)
+    | Prim (loc, I_PACK, [], annot),
+      Item_t (t, rest, unpacked_annot) ->
+        Lwt.return (check_no_big_map_or_operation loc t) >>=? fun () ->
+        parse_var_annot loc annot ~default:(gen_access_annot unpacked_annot default_pack_annot)
+        >>=? fun annot ->
+        typed ctxt loc (Pack t)
+          (Item_t (Bytes_t None, rest, annot))
+    | Prim (loc, I_UNPACK, [ ty ], annot),
+      Item_t (Bytes_t _, rest, packed_annot) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty >>=? fun (Ex_ty t, ctxt) ->
+        let stack_annot = gen_access_annot packed_annot default_unpack_annot in
+        parse_constr_annot loc annot
+          ~if_special_first:(var_to_field_annot stack_annot)
+        >>=? fun (annot, ty_name, some_field, none_field) ->
+        typed ctxt loc (Unpack t)
+          (Item_t (Option_t ((t, some_field), none_field, ty_name), rest, annot))
+    (* protocol *)
+    | Prim (loc, I_ADDRESS, [], annot),
+      Item_t (Contract_t _, rest, contract_annot) ->
+        parse_var_annot loc annot ~default:(gen_access_annot contract_annot default_addr_annot)
+        >>=? fun annot ->
+        typed ctxt loc Address
+          (Item_t (Address_t None, rest, annot))
+    | Prim (loc, I_CONTRACT, [ ty ], annot),
+      Item_t (Address_t _, rest, addr_annot) ->
+        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty >>=? fun (Ex_ty t, ctxt) ->
+        parse_var_annot loc annot ~default:(gen_access_annot addr_annot default_contract_annot)
+        >>=? fun annot ->
+        typed ctxt loc (Contract t)
+          (Item_t (Option_t ((Contract_t (t, None), None), None, None), rest, annot))
+    | Prim (loc, I_TRANSFER_TOKENS, [], annot),
+      Item_t (p, Item_t
+                (Mutez_t _, Item_t
+                   (Contract_t (cp, _), rest, _), _), _) ->
+        check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4 >>=? fun (Eq, ctxt) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Transfer_tokens (Item_t (Operation_t None, rest, annot))
+    | Prim (loc, I_SET_DELEGATE, [], annot),
+      Item_t (Option_t ((Key_hash_t _, _), _, _), rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Set_delegate (Item_t (Operation_t None, rest, annot))
+    | Prim (loc, I_CREATE_ACCOUNT, [], annot),
+      Item_t
+        (Key_hash_t _, Item_t
+           (Option_t ((Key_hash_t _, _), _, _), Item_t
+              (Bool_t _, Item_t
+                 (Mutez_t _, rest, _), _), _), _) ->
+        parse_two_var_annot loc annot >>=? fun (op_annot, addr_annot) ->
+        typed ctxt loc Create_account
+          (Item_t (Operation_t None, Item_t (Address_t None, rest, addr_annot), op_annot))
+    | Prim (loc, I_IMPLICIT_ACCOUNT, [], annot),
+      Item_t (Key_hash_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Implicit_account
+          (Item_t (Contract_t (Unit_t None, None), rest, annot))
+    | Prim (loc, I_CREATE_CONTRACT, [ (Seq _ as code)], annot),
+      Item_t
+        (Key_hash_t _, Item_t
+           (Option_t ((Key_hash_t _, _), _, _), Item_t
+              (Bool_t _, Item_t
+                 (Bool_t _, Item_t
+                    (Mutez_t _, Item_t
+                       (ginit, rest, _), _), _), _), _), _) ->
+        parse_two_var_annot loc annot >>=? fun (op_annot, addr_annot) ->
+        let cannonical_code = fst @@ Micheline.extract_locations code in
+        Lwt.return @@ parse_toplevel cannonical_code >>=? fun (arg_type, storage_type, code_field) ->
+        trace
+          (Ill_formed_type (Some "parameter", cannonical_code, location arg_type))
+          (Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type)
+        >>=? fun (Ex_ty arg_type, ctxt) ->
+        trace
+          (Ill_formed_type (Some "storage", cannonical_code, location storage_type))
+          (Lwt.return @@ parse_storage_ty ctxt storage_type)
+        >>=? fun (Ex_ty storage_type, ctxt) ->
+        let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))
+            ~default:default_param_annot in
+        let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))
+            ~default:default_storage_annot in
+        let arg_type_full = Pair_t ((arg_type, None, arg_annot),
+                                    (storage_type, None, storage_annot), None) in
+        let ret_type_full =
+          Pair_t ((List_t (Operation_t None, None), None, None),
+                  (storage_type, None, None), None) in
+        trace
+          (Ill_typed_contract (cannonical_code, []))
+          (parse_returning (Toplevel { storage_type ; param_type = arg_type })
+             ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=?
+        fun (Lam ({ bef = Item_t (arg, Empty_t, _) ;
+                    aft = Item_t (ret, Empty_t, _) ; _ }, _) as lambda, ctxt) ->
+        Lwt.return @@ ty_eq ctxt arg arg_type_full >>=? fun (Eq, ctxt) ->
+        Lwt.return @@ merge_types ctxt loc arg arg_type_full >>=? fun (_, ctxt) ->
+        Lwt.return @@ ty_eq ctxt ret ret_type_full >>=? fun (Eq, ctxt) ->
+        Lwt.return @@ merge_types ctxt loc ret ret_type_full >>=? fun (_, ctxt) ->
+        Lwt.return @@ ty_eq ctxt storage_type ginit >>=? fun (Eq, ctxt) ->
+        Lwt.return @@ merge_types ctxt loc storage_type ginit >>=? fun (_, ctxt) ->
+        typed ctxt loc (Create_contract (storage_type, arg_type, lambda))
+          (Item_t (Operation_t None, Item_t (Address_t None, rest, addr_annot), op_annot))
+    | Prim (loc, I_NOW, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_now_annot >>=? fun annot ->
+        typed ctxt loc Now (Item_t (Timestamp_t None, stack, annot))
+    | Prim (loc, I_AMOUNT, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_amount_annot >>=? fun annot ->
+        typed ctxt loc Amount
+          (Item_t (Mutez_t None, stack, annot))
+    | Prim (loc, I_BALANCE, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_balance_annot >>=? fun annot ->
+        typed ctxt loc Balance
+          (Item_t (Mutez_t None, stack, annot))
+    | Prim (loc, I_HASH_KEY, [], annot),
+      Item_t (Key_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Hash_key
+          (Item_t (Key_hash_t None, rest, annot))
+    | Prim (loc, I_CHECK_SIGNATURE, [], annot),
+      Item_t (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Check_signature
+          (Item_t (Bool_t None, rest, annot))
+    | Prim (loc, I_BLAKE2B, [], annot),
+      Item_t (Bytes_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Blake2b
+          (Item_t (Bytes_t None, rest, annot))
+    | Prim (loc, I_SHA256, [], annot),
+      Item_t (Bytes_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Sha256
+          (Item_t (Bytes_t None, rest, annot))
+    | Prim (loc, I_SHA512, [], annot),
+      Item_t (Bytes_t _, rest, _) ->
+        parse_var_annot loc annot >>=? fun annot ->
+        typed ctxt loc Sha512
+          (Item_t (Bytes_t None, rest, annot))
+    | Prim (loc, I_STEPS_TO_QUOTA, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_steps_annot >>=? fun annot ->
+        typed ctxt loc Steps_to_quota
+          (Item_t (Nat_t None, stack, annot))
+    | Prim (loc, I_SOURCE, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_source_annot >>=? fun annot ->
+        typed ctxt loc Source
+          (Item_t (Address_t None, stack, annot))
+    | Prim (loc, I_SENDER, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_sender_annot >>=? fun annot ->
+        typed ctxt loc Sender
+          (Item_t (Address_t None, stack, annot))
+    | Prim (loc, I_SELF, [], annot),
+      stack ->
+        parse_var_annot loc annot ~default:default_self_annot >>=? fun annot ->
+        let rec get_toplevel_type : tc_context -> (bef judgement * context) tzresult Lwt.t = function
+          | Lambda -> fail (Self_in_lambda loc)
+          | Dip (_, prev) -> get_toplevel_type prev
+          | Toplevel { param_type ; _ } ->
+              typed ctxt loc (Self param_type)
+                (Item_t (Contract_t (param_type, None), stack, annot)) in
+        get_toplevel_type tc_context
+    (* Primitive parsing errors *)
+    | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT
+                 | I_PAIR | I_CAR | I_CDR | I_CONS | I_CONCAT | I_SLICE
+                 | I_MEM | I_UPDATE | I_MAP
+                 | I_GET | I_EXEC | I_FAILWITH | I_SIZE
+                 | I_ADD | I_SUB
+                 | I_MUL | I_EDIV | I_OR | I_AND | I_XOR
+                 | I_NOT
+                 | I_ABS | I_NEG | I_LSL | I_LSR
+                 | I_COMPARE | I_EQ | I_NEQ
+                 | I_LT | I_GT | I_LE | I_GE
+                 | I_TRANSFER_TOKENS | I_CREATE_ACCOUNT
+                 | I_CREATE_CONTRACT | I_SET_DELEGATE | I_NOW
+                 | I_IMPLICIT_ACCOUNT | I_AMOUNT | I_BALANCE
+                 | I_CHECK_SIGNATURE | I_HASH_KEY | I_SOURCE | I_SENDER
+                 | I_BLAKE2B | I_SHA256 | I_SHA512 | I_STEPS_TO_QUOTA | I_ADDRESS
+                 as name), (_ :: _ as l), _), _ ->
+        fail (Invalid_arity (loc, name, 0, List.length l))
+    | Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER
+                 | I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT | I_CONTRACT
+                 as name), ([]
+                           | _ :: _ :: _ as l), _), _ ->
+        fail (Invalid_arity (loc, name, 1, List.length l))
+    | Prim (loc, (I_PUSH | I_IF_NONE | I_IF_LEFT | I_IF_CONS
+                 | I_EMPTY_MAP | I_IF
+                 as name), ([] | [ _ ]
+                           | _ :: _ :: _ :: _ as l), _), _ ->
+        fail (Invalid_arity (loc, name, 2, List.length l))
+    | Prim (loc, I_LAMBDA, ([] | [ _ ]
+                           | _ :: _ :: _ :: _ :: _ as l), _), _ ->
+        fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))
+    (* Stack errors *)
+    | Prim (loc, (I_ADD | I_SUB | I_MUL | I_EDIV
+                 | I_AND | I_OR | I_XOR | I_LSL | I_LSR
+                 | I_COMPARE as name), [], _),
+      Item_t (ta, Item_t (tb, _, _), _) ->
+        Lwt.return @@ serialize_ty_for_error ctxt ta >>=? fun (ta, ctxt) ->
+        Lwt.return @@ serialize_ty_for_error ctxt tb >>=? fun (tb, _ctxt) ->
+        fail (Undefined_binop (loc, name, ta, tb))
+    | Prim (loc, (I_NEG | I_ABS | I_NOT | I_CONCAT | I_SIZE
+                 | I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE as name),
+            [], _),
+      Item_t (t, _, _) ->
+        Lwt.return @@ serialize_ty_for_error ctxt t >>=? fun (t, _ctxt) ->
+        fail (Undefined_unop (loc, name, t))
+    | Prim (loc, (I_UPDATE | I_SLICE as name), [], _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, name, 3, stack))
+    | Prim (loc, I_CREATE_CONTRACT, [], _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))
+    | Prim (loc, I_CREATE_ACCOUNT, [], _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack))
+    | Prim (loc, I_TRANSFER_TOKENS, [], _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack))
+    | Prim (loc, (I_DROP | I_DUP | I_CAR | I_CDR | I_SOME
+                 | I_BLAKE2B | I_SHA256 | I_SHA512 | I_DIP
+                 | I_IF_NONE | I_LEFT | I_RIGHT | I_IF_LEFT | I_IF
+                 | I_LOOP | I_IF_CONS | I_IMPLICIT_ACCOUNT
+                 | I_NEG | I_ABS | I_INT | I_NOT | I_HASH_KEY
+                 | I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE as name), _, _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, name, 1, stack))
+    | Prim (loc, (I_SWAP | I_PAIR | I_CONS
+                 | I_GET | I_MEM | I_EXEC
+                 | I_CHECK_SIGNATURE | I_ADD | I_SUB | I_MUL
+                 | I_EDIV | I_AND | I_OR | I_XOR
+                 | I_LSL | I_LSR as name), _, _),
+      stack ->
+        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->
+        fail (Bad_stack (loc, name, 2, stack))
+    (* Generic parsing errors *)
+    | expr, _ ->
+        fail @@ unexpected expr [ Seq_kind ] Instr_namespace
+          [ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ;
+            I_PAIR ; I_CAR ; I_CDR ; I_CONS ;
+            I_MEM ; I_UPDATE ; I_MAP ; I_ITER ;
+            I_GET ; I_EXEC ; I_FAILWITH ; I_SIZE ;
+            I_CONCAT ; I_ADD ; I_SUB ;
+            I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ;
+            I_NOT ;
+            I_ABS ; I_INT; I_NEG ; I_LSL ; I_LSR ;
+            I_COMPARE ; I_EQ ; I_NEQ ;
+            I_LT ; I_GT ; I_LE ; I_GE ;
+            I_TRANSFER_TOKENS ; I_CREATE_ACCOUNT ;
+            I_CREATE_CONTRACT ; I_NOW ; I_AMOUNT ; I_BALANCE ;
+            I_IMPLICIT_ACCOUNT ; I_CHECK_SIGNATURE ;
+            I_BLAKE2B ; I_SHA256 ; I_SHA512 ; I_HASH_KEY ;
+            I_STEPS_TO_QUOTA ;
+            I_PUSH ; I_NONE ; I_LEFT ; I_RIGHT ; I_NIL ;
+            I_EMPTY_SET ; I_DIP ; I_LOOP ;
+            I_IF_NONE ; I_IF_LEFT ; I_IF_CONS ;
+            I_EMPTY_MAP ; I_IF ; I_SOURCE ; I_SENDER ; I_SELF ; I_LAMBDA ]
+
+and parse_contract
+  : type arg. context -> Script.location -> arg ty -> Contract.t ->
+    (context * arg typed_contract) tzresult Lwt.t
+  = fun ctxt loc arg contract ->
+    Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists >>=? fun ctxt ->
+    Contract.exists ctxt contract >>=? function
+    | false -> fail (Invalid_contract (loc, contract))
+    | true ->
+        Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script >>=? fun ctxt ->
+        trace
+          (Invalid_contract (loc, contract)) @@
+        Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with
+        | None ->
+            Lwt.return
+              (ty_eq ctxt arg (Unit_t None) >>? fun (Eq, ctxt) ->
+               let contract : arg typed_contract = (arg, contract) in
+               ok (ctxt, contract))
+        | Some { code ; _ } ->
+            Script.force_decode ctxt code >>=? fun (code, ctxt) ->
+            Lwt.return
+              (parse_toplevel code >>? fun (arg_type, _, _) ->
+               parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type >>? fun (Ex_ty targ, ctxt) ->
+               ty_eq ctxt targ arg >>? fun (Eq, ctxt) ->
+               merge_types ctxt loc targ arg >>? fun (arg, ctxt) ->
+               let contract : arg typed_contract = (arg, contract) in
+               ok (ctxt, contract))
+
+(* Same as the one above, but does not fail when the contact is missing or
+   if the expected type doesn't match the actual one. In that case None is
+   returned and some overapproximation of the typechecking gas is consumed.
+   This can still fail on gas exhaustion. *)
+and parse_contract_for_script
+  : type arg. context -> Script.location -> arg ty -> Contract.t ->
+    (context * arg typed_contract option) tzresult Lwt.t
+  = fun ctxt loc arg contract ->
+    Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists >>=? fun ctxt ->
+    Contract.exists ctxt contract >>=? function
+    | false -> return (ctxt, None)
+    | true ->
+        Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script >>=? fun ctxt ->
+        trace
+          (Invalid_contract (loc, contract)) @@
+        Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with (* can only fail because of gas *)
+        | None ->
+            Lwt.return
+              (match ty_eq ctxt arg (Unit_t None) with
+               | Ok (Eq, ctxt) ->
+                   let contract : arg typed_contract = (arg, contract) in
+                   ok (ctxt, Some contract)
+               | Error _ ->
+                   Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+                   ok (ctxt, None))
+        | Some { code ; _ } ->
+            Script.force_decode ctxt code >>=? fun (code, ctxt) -> (* can only fail because of gas *)
+            Lwt.return
+              (match parse_toplevel code with
+               | Error _ -> error (Invalid_contract (loc, contract))
+               | Ok (arg_type, _, _) ->
+                   match parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type with
+                   | Error _ ->
+                       error (Invalid_contract (loc, contract))
+                   | Ok (Ex_ty targ, ctxt) ->
+                       match
+                         (ty_eq ctxt targ arg >>? fun (Eq, ctxt) ->
+                          merge_types ctxt loc targ arg >>? fun (arg, ctxt) ->
+                          let contract : arg typed_contract = (arg, contract) in
+                          ok (ctxt, Some contract))
+                       with
+                       | Ok res -> ok res
+                       | Error _ ->
+                           (* overapproximation by checking if targ = targ,
+                              can only fail because of gas *)
+                           ty_eq ctxt targ targ >>? fun (Eq, ctxt) ->
+                           merge_types ctxt loc targ targ >>? fun (_, ctxt) ->
+                           ok (ctxt, None))
+
+and parse_toplevel
+  : Script.expr -> (Script.node * Script.node * Script.node) tzresult
+  = fun toplevel ->
+    record_trace (Ill_typed_contract (toplevel, [])) @@
+    match root toplevel with
+    | Int (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], Int_kind))
+    | String (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], String_kind))
+    | Bytes (loc, _) -> error (Invalid_kind (loc, [ Seq_kind ], Bytes_kind))
+    | Prim (loc, _, _, _) -> error (Invalid_kind (loc, [ Seq_kind ], Prim_kind))
+    | Seq (_, fields) ->
+        let rec find_fields p s c fields =
+          match fields with
+          | [] -> ok (p, s, c)
+          | Int (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Int_kind))
+          | String (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], String_kind))
+          | Bytes (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Bytes_kind))
+          | Seq (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Seq_kind))
+          | Prim (loc, K_parameter, [ arg ], _) :: rest ->
+              begin match p with
+                | None -> find_fields (Some arg) s c rest
+                | Some _ -> error (Duplicate_field (loc, K_parameter))
+              end
+          | Prim (loc, K_storage, [ arg ], _) :: rest ->
+              begin match s with
+                | None -> find_fields p (Some arg) c rest
+                | Some _ -> error (Duplicate_field (loc, K_storage))
+              end
+          | Prim (loc, K_code, [ arg ], _) :: rest ->
+              begin match c with
+                | None -> find_fields p s (Some arg) rest
+                | Some _ -> error (Duplicate_field (loc, K_code))
+              end
+          | Prim (loc, (K_parameter | K_storage | K_code as name), args, _) :: _ ->
+              error (Invalid_arity (loc, name, 1, List.length args))
+          | Prim (loc, name, _, _) :: _ ->
+              let allowed = [ K_parameter ; K_storage ; K_code ] in
+              error (Invalid_primitive (loc, allowed, name))
+        in
+        find_fields None None None fields >>? function
+        | (None, _, _) -> error (Missing_field K_parameter)
+        | (Some _, None, _) -> error (Missing_field K_storage)
+        | (Some _, Some _, None) -> error (Missing_field K_code)
+        | (Some p, Some s, Some c) -> ok (p, s, c)
+
+let parse_script
+  : ?type_logger: type_logger ->
+    context -> Script.t -> (ex_script * context) tzresult Lwt.t
+  = fun ?type_logger ctxt { code ; storage } ->
+    Script.force_decode ctxt code >>=? fun (code, ctxt) ->
+    Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->
+    Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) ->
+    trace
+      (Ill_formed_type (Some "parameter", code, location arg_type))
+      (Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type))
+    >>=? fun (Ex_ty arg_type, ctxt) ->
+    trace
+      (Ill_formed_type (Some "storage", code, location storage_type))
+      (Lwt.return (parse_storage_ty ctxt storage_type))
+    >>=? fun (Ex_ty storage_type, ctxt) ->
+    let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))
+        ~default:default_param_annot in
+    let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))
+        ~default:default_storage_annot in
+    let arg_type_full = Pair_t ((arg_type, None, arg_annot),
+                                (storage_type, None, storage_annot), None) in
+    let ret_type_full =
+      Pair_t ((List_t (Operation_t None, None), None, None),
+              (storage_type, None, None), None) in
+    trace_eval
+      (fun () ->
+         Lwt.return @@ serialize_ty_for_error ctxt storage_type >>|? fun (storage_type, _ctxt) ->
+         Ill_typed_data (None, storage, storage_type))
+      (parse_data ?type_logger ctxt storage_type (root storage)) >>=? fun (storage, ctxt) ->
+    trace
+      (Ill_typed_contract (code, []))
+      (parse_returning (Toplevel { storage_type ; param_type = arg_type })
+         ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=? fun (code, ctxt) ->
+    return (Ex_script { code ; arg_type ; storage ; storage_type }, ctxt)
+
+let typecheck_code
+  : context -> Script.expr -> (type_map * context) tzresult Lwt.t
+  = fun ctxt code ->
+    Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) ->
+    let type_map = ref [] in
+    (* TODO: annotation checking *)
+    trace
+      (Ill_formed_type (Some "parameter", code, location arg_type))
+      (Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type))
+    >>=? fun (Ex_ty arg_type, ctxt) ->
+    trace
+      (Ill_formed_type (Some "storage", code, location storage_type))
+      (Lwt.return (parse_storage_ty ctxt storage_type))
+    >>=? fun (Ex_ty storage_type, ctxt) ->
+    let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))
+        ~default:default_param_annot in
+    let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))
+        ~default:default_storage_annot in
+    let arg_type_full = Pair_t ((arg_type, None, arg_annot),
+                                (storage_type, None, storage_annot), None) in
+    let ret_type_full =
+      Pair_t ((List_t (Operation_t None, None), None, None),
+              (storage_type, None, None), None) in
+    let result =
+      parse_returning
+        (Toplevel { storage_type ; param_type = arg_type })
+        ctxt
+        ~type_logger: (fun loc bef aft -> type_map := (loc, (bef, aft)) :: !type_map)
+        (arg_type_full, None) ret_type_full code_field in
+    trace
+      (Ill_typed_contract (code, !type_map))
+      result >>=? fun (Lam _, ctxt) ->
+    return (!type_map, ctxt)
+
+let typecheck_data
+  : ?type_logger: type_logger ->
+    context -> Script.expr * Script.expr -> context tzresult Lwt.t
+  = fun ?type_logger ctxt (data, exp_ty) ->
+    trace
+      (Ill_formed_type (None, exp_ty, 0))
+      (Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false (root exp_ty))
+    >>=? fun (Ex_ty exp_ty, ctxt) ->
+    trace_eval
+      (fun () ->
+         Lwt.return @@ serialize_ty_for_error ctxt exp_ty >>|? fun (exp_ty, _ctxt) ->
+         Ill_typed_data (None, data, exp_ty))
+      (parse_data ?type_logger ctxt exp_ty (root data)) >>=? fun (_, ctxt) ->
+    return ctxt
+
+(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)
+
+let rec unparse_data
+  : 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 ->
+    mapper (Ex_typed_value (ty, a)) >>=? function
+    | Some s -> return (s, ctxt)
+    | None -> (
+        let unparse_same ctxt ty a = unparse_data ctxt ~mapper mode ty a in
+        Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->
+        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 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_same ctxt tl l >>=? fun (l, ctxt) ->
+            unparse_same ctxt 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_same ctxt 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_same ctxt 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_same ctxt 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_same ctxt 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_same ctxt 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_same ctxt kt k >>=? fun (key, ctxt) ->
+                 unparse_same ctxt 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, vt, _), map ->
+            if false then (
+              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 ->
+                   match v with
+                   | None -> return (l, ctxt)
+                   | Some v -> (
+                       unparse_same ctxt kt k >>=? fun (key, ctxt) ->
+                       unparse_same ctxt 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.diff []) >>=? fun (items, ctxt) ->
+              return (Micheline.Seq (-1, String (-1, "...") :: items), ctxt)
+            ) else (
+              return (Micheline.Seq (-1, []), ctxt)
+            )
+        | Lambda_t _, Lam (_, original_code) ->
+            unparse_code ctxt mode (root original_code)
+      )
+
+(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
+and unparse_code ctxt 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 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 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 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)
+
+(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
+let unparse_script ctxt mode { code ; arg_type ; storage ; storage_type } =
+  let Lam (_, original_code) = code in
+  unparse_code ctxt mode (root original_code) >>=? fun (code, ctxt) ->
+  unparse_data ctxt mode storage_type storage >>=? fun (storage, ctxt) ->
+  unparse_ty ctxt arg_type >>=? fun (arg_type, ctxt) ->
+  unparse_ty ctxt storage_type >>=? fun (storage_type, ctxt) ->
+  let open Micheline in
+  let code =
+    Seq (-1, [ Prim (-1, K_parameter, [ arg_type ], []) ;
+               Prim (-1, K_storage, [ storage_type ], []) ;
+               Prim (-1, K_code, [ code ], []) ]) in
+  Lwt.return
+    (Gas.consume ctxt (Unparse_costs.seq_cost 3) >>? fun ctxt ->
+     Gas.consume ctxt (Unparse_costs.prim_cost 1 []) >>? fun ctxt ->
+     Gas.consume ctxt (Unparse_costs.prim_cost 1 []) >>? fun ctxt ->
+     Gas.consume ctxt (Unparse_costs.prim_cost 1 [])) >>=? fun ctxt ->
+  return ({ code = lazy_expr (strip_locations code) ;
+            storage = lazy_expr (strip_locations storage) }, ctxt)
+
+let pack_data ctxt typ data =
+  unparse_data ctxt Optimized typ data >>=? fun (data, ctxt) ->
+  let unparsed = strip_annotations @@ data in
+  let bytes = Data_encoding.Binary.to_bytes_exn expr_encoding (Micheline.strip_locations unparsed) in
+  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes) >>=? fun ctxt ->
+  let bytes = MBytes.concat "" [ MBytes.of_string "\005" ; bytes ] in
+  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes) >>=? fun ctxt ->
+  return (bytes, ctxt)
+
+let hash_data ctxt typ data =
+  pack_data ctxt typ data >>=? fun (bytes, ctxt) ->
+  Lwt.return @@ Gas.consume ctxt
+    (Michelson_v1_gas.Cost_of.hash bytes Script_expr_hash.size) >>=? fun ctxt ->
+  return (Script_expr_hash.(hash_bytes [ bytes ]), ctxt)
+
+(* ---------------- Big map -------------------------------------------------*)
+
+let big_map_mem ctxt contract key { diff ; key_type ; _ } =
+  match map_get key diff with
+  | None -> hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
+      Alpha_context.Contract.Big_map.mem ctxt contract hash >>=? fun (ctxt, res) ->
+      return (res, ctxt)
+  | Some None -> return (false, ctxt)
+  | Some (Some _) -> return (true, ctxt)
+
+let big_map_get ctxt contract key { diff ; key_type ; value_type } =
+  match map_get key diff with
+  | Some x -> return (x, ctxt)
+  | None ->
+      hash_data ctxt key_type key >>=? fun (hash, ctxt) ->
+      Alpha_context.Contract.Big_map.get_opt
+        ctxt contract hash >>=? begin function
+        | (ctxt, None) -> return (None, ctxt)
+        | (ctxt, Some value) ->
+            parse_data ctxt value_type
+              (Micheline.root value) >>=? fun (x, ctxt) ->
+            return (Some x, ctxt)
+      end
+
+let big_map_update key value ({ diff ; _ } as map) =
+  { map with diff = map_set key value diff }
+
+let diff_of_big_map ctxt mode (Ex_bm { key_type ; value_type ; diff }) =
+  Lwt.return (Gas.consume ctxt (Michelson_v1_gas.Cost_of.map_to_list diff)) >>=? fun ctxt ->
+  let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in
+  fold_left_s
+    (fun (acc, ctxt) (key, value) ->
+       Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt ->
+       hash_data ctxt key_type key >>=? fun (diff_key_hash, ctxt) ->
+       unparse_data ctxt mode key_type key >>=? fun (key_node, ctxt) ->
+       let diff_key = Micheline.strip_locations key_node in
+       begin
+         match value with
+         | None -> return (None, ctxt)
+         | Some x ->
+             begin
+               unparse_data ctxt mode value_type x >>=? fun (node, ctxt) ->
+               return (Some (Micheline.strip_locations node), ctxt)
+             end
+       end >>=? fun (diff_value, ctxt) ->
+       let diff_item = Contract.{ diff_key ; diff_key_hash ; diff_value } in
+       return (diff_item :: acc, ctxt))
+    ([], ctxt) pairs
+
+(* Get the big map from a contract's storage if one exists *)
+let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->
+  match (ty, x) with
+  | Pair_t ((Big_map_t (_, _, _), _, _), _, _), (map, _) -> Some (Ex_bm map)
+  | _, _ -> None
+
+let erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) =
+  Script.force_decode ctxt code >>=? fun (code, ctxt) ->
+  Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->
+  Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) ->
+  Lwt.return @@ parse_storage_ty ctxt storage_type >>=? fun (Ex_ty ty, ctxt) ->
+  parse_data ctxt ty
+    (Micheline.root storage) >>=? fun (storage, ctxt) ->
+  begin
+    match extract_big_map ty storage with
+    | None -> return (None, ctxt)
+    | Some bm -> diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) ->
+        return (Some bm, ctxt)
+  end >>=? fun (bm, ctxt) ->
+  unparse_data ctxt mode ty storage >>=? fun (storage, ctxt) ->
+  return ({ code = Script.lazy_expr code ;
+            storage = Script.lazy_expr (Micheline.strip_locations storage) }, bm, ctxt)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.mli
new file mode 100644
index 000000000..87934a3bb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -0,0 +1,170 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script_tc_errors
+
+type ('ta, 'tb) eq = Eq : ('same, 'same) eq
+
+type ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty
+type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
+type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
+type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
+type ex_typed_value = Ex_typed_value : ('a Script_typed_ir.ty * 'a) -> ex_typed_value
+
+type unparsing_mode = Optimized | Readable
+
+type type_logger =
+  int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot)  list -> unit
+
+val ty_of_comparable_ty : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.ty
+
+(* ---- Sets and Maps -------------------------------------------------------*)
+
+val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set
+val set_fold :
+  ('elt -> 'acc -> 'acc) ->
+  'elt Script_typed_ir.set -> 'acc -> 'acc
+val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set
+val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool
+val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num
+
+val empty_map : 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map
+val map_fold :
+  ('key -> 'value -> 'acc -> 'acc) ->
+  ('key, 'value) Script_typed_ir.map -> 'acc -> 'acc
+val map_update :
+  'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> ('a, 'b) Script_typed_ir.map
+val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool
+val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
+val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
+val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
+
+val big_map_mem :
+  context -> Contract.t -> 'key ->
+  ('key, 'value) Script_typed_ir.big_map ->
+  (bool * context) tzresult Lwt.t
+val big_map_get :
+  context ->
+  Contract.t -> 'key ->
+  ('key, 'value) Script_typed_ir.big_map ->
+  ('value option * context) tzresult Lwt.t
+val big_map_update :
+  'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->
+  ('key, 'value) Script_typed_ir.big_map
+
+val ty_eq :
+  context ->
+  'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
+  (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult
+
+val stack_ty_eq :
+  context -> int ->
+  'ta Script_typed_ir.stack_ty -> 'tb Script_typed_ir.stack_ty ->
+  (('ta Script_typed_ir.stack_ty, 'tb Script_typed_ir.stack_ty) eq * context) tzresult
+
+val parse_data :
+  ?type_logger: type_logger ->
+  context ->
+  'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
+
+val unparse_data :
+  context -> ?mapper:(ex_typed_value -> Script.node option tzresult Lwt.t)
+  -> unparsing_mode -> 'a Script_typed_ir.ty -> 'a ->
+  (Script.node * context) tzresult Lwt.t
+
+val parse_ty :
+  context ->
+  allow_big_map: bool ->
+  allow_operation: bool ->
+  Script.node -> (ex_ty * context) tzresult
+
+val unparse_ty :
+  context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t
+
+val parse_storage_ty :
+  context ->
+  Script.node -> (ex_ty * context) tzresult
+
+type tc_context =
+  | Lambda : tc_context
+  | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
+  | Toplevel : { storage_type : 'sto Script_typed_ir.ty ; param_type : 'param Script_typed_ir.ty } -> tc_context
+
+type 'bef judgement =
+  | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
+  | Failed : { descr : 'aft. 'aft Script_typed_ir.stack_ty -> ('bef, 'aft) Script_typed_ir.descr } -> 'bef judgement
+
+val parse_instr :
+  ?type_logger: type_logger ->
+  tc_context -> context ->
+  Script.node -> 'bef Script_typed_ir.stack_ty -> ('bef judgement * context) tzresult Lwt.t
+
+val parse_returning :
+  ?type_logger: type_logger ->
+  tc_context -> context ->
+  'arg Script_typed_ir.ty * Script_typed_ir.var_annot option -> 'ret Script_typed_ir.ty -> Script.node ->
+  (('arg, 'ret) Script_typed_ir.lambda * context) tzresult Lwt.t
+
+val parse_toplevel :
+  Script.expr -> (Script.node * Script.node * Script.node) tzresult
+
+val typecheck_code :
+  context -> Script.expr -> (type_map * context) tzresult Lwt.t
+
+val typecheck_data :
+  ?type_logger: type_logger ->
+  context -> Script.expr * Script.expr -> context tzresult Lwt.t
+
+val parse_script :
+  ?type_logger: type_logger ->
+  context -> Script.t -> (ex_script * context) tzresult Lwt.t
+
+(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
+val unparse_script :
+  context -> unparsing_mode ->
+  ('a, 'b) Script_typed_ir.script -> (Script.t * context) tzresult Lwt.t
+
+val parse_contract :
+  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t
+
+val parse_contract_for_script :
+  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t
+
+val pack_data : context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t
+val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script_expr_hash.t * context) tzresult Lwt.t
+
+val extract_big_map :
+  'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
+
+val diff_of_big_map :
+  context -> unparsing_mode -> Script_typed_ir.ex_big_map ->
+  (Contract.big_map_diff * context) tzresult Lwt.t
+
+val erase_big_map_initialization :
+  context -> unparsing_mode -> Script.t ->
+  (Script.t * Contract.big_map_diff option * context) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.ml
new file mode 100644
index 000000000..c51cfd8f3
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.ml
@@ -0,0 +1,197 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type location = Micheline.canonical_location
+
+let location_encoding = Micheline.canonical_location_encoding
+
+type annot = Micheline.annot
+
+type expr = Michelson_v1_primitives.prim Micheline.canonical
+
+type lazy_expr = expr Data_encoding.lazy_t
+
+type node = (location, Michelson_v1_primitives.prim) Micheline.node
+
+
+
+let expr_encoding =
+  Micheline.canonical_encoding_v1
+    ~variant:"michelson_v1"
+    Michelson_v1_primitives.prim_encoding
+
+type error += Lazy_script_decode (* `Permanent *)
+
+let () =
+  register_error_kind `Permanent
+    ~id:"invalid_binary_format"
+    ~title:"Invalid binary format"
+    ~description:"Could not deserialize some piece of data \
+                  from its binary representation"
+    Data_encoding.empty
+    (function Lazy_script_decode -> Some () | _ -> None)
+    (fun () -> Lazy_script_decode)
+
+let lazy_expr_encoding =
+  Data_encoding.lazy_encoding expr_encoding
+
+let lazy_expr expr =
+  Data_encoding.make_lazy expr_encoding expr
+
+type t = {
+  code : lazy_expr ;
+  storage : lazy_expr
+}
+
+let encoding =
+  let open Data_encoding in
+  def "scripted.contracts" @@
+  conv
+    (fun { code ; storage } -> (code, storage))
+    (fun (code, storage) -> { code ; storage })
+    (obj2
+       (req "code" lazy_expr_encoding)
+       (req "storage" lazy_expr_encoding))
+
+let int_node_size_of_numbits n =
+  (1, 1 + (n + 63) / 64)
+let int_node_size n =
+  int_node_size_of_numbits (Z.numbits n)
+let string_node_size_of_length s =
+  (1, 1 + (s + 7) / 8)
+let string_node_size s =
+  string_node_size_of_length (String.length s)
+let bytes_node_size_of_length s =
+  (* approx cost of indirection to the C heap *)
+  (2, 1 + (s + 7) / 8 + 12)
+let bytes_node_size s =
+  bytes_node_size_of_length (MBytes.length s)
+let prim_node_size_nonrec_of_lengths n_args annots =
+  let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in
+  if Compare.Int.(annots_length = 0) then
+    (1 + n_args, 2 + 2 * n_args)
+  else
+    (2 + n_args, 4 + 2 * n_args + (annots_length + 7) / 8)
+let prim_node_size_nonrec args annots =
+  let n_args = List.length args in
+  prim_node_size_nonrec_of_lengths n_args annots
+let seq_node_size_nonrec_of_length n_args =
+  (1 + n_args, 2 + 2 * n_args)
+let seq_node_size_nonrec args =
+  let n_args = List.length args in
+  seq_node_size_nonrec_of_length n_args
+
+let rec node_size node =
+  let open Micheline in
+  match node with
+  | Int (_, n) -> int_node_size n
+  | String (_, s) -> string_node_size s
+  | Bytes (_, s) -> bytes_node_size s
+  | Prim (_, _, args, annot) ->
+      List.fold_left
+        (fun (blocks, words) node ->
+           let (nblocks, nwords) = node_size node in
+           (blocks + nblocks, words + nwords))
+        (prim_node_size_nonrec args annot)
+        args
+  | Seq (_, args) ->
+      List.fold_left
+        (fun (blocks, words) node ->
+           let (nblocks, nwords) = node_size node in
+           (blocks + nblocks, words + nwords))
+        (seq_node_size_nonrec args)
+        args
+
+let expr_size expr =
+  node_size (Micheline.root expr)
+
+let traversal_cost node =
+  let blocks, _words = node_size node in
+  Gas_limit_repr.step_cost blocks
+
+let cost_of_size (blocks, words) =
+  let open Gas_limit_repr in
+  ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@
+  alloc_cost words +@
+  step_cost blocks
+
+let node_cost node =
+  cost_of_size (node_size node)
+
+let int_node_cost n = cost_of_size (int_node_size n)
+let int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)
+let string_node_cost s = cost_of_size (string_node_size s)
+let string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)
+let bytes_node_cost s = cost_of_size (bytes_node_size s)
+let bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)
+let prim_node_cost_nonrec args annot = cost_of_size (prim_node_size_nonrec args annot)
+let prim_node_cost_nonrec_of_length n_args annot = cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)
+let seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)
+let seq_node_cost_nonrec_of_length n_args = cost_of_size (seq_node_size_nonrec_of_length n_args)
+
+let deserialized_cost expr =
+  cost_of_size (expr_size expr)
+
+let serialized_cost bytes =
+  let open Gas_limit_repr in
+  alloc_mbytes_cost (MBytes.length bytes)
+
+let force_decode lexpr =
+  let account_deserialization_cost =
+    Data_encoding.apply_lazy
+      ~fun_value:(fun _ -> false)
+      ~fun_bytes:(fun _ -> true)
+      ~fun_combine:(fun _ _ -> false)
+      lexpr in
+  match Data_encoding.force_decode lexpr with
+  | Some v ->
+      if account_deserialization_cost then
+        ok (v, deserialized_cost v)
+      else
+        ok (v, Gas_limit_repr.free)
+  | None -> error Lazy_script_decode
+
+let force_bytes expr =
+  let open Gas_limit_repr in
+  let account_serialization_cost =
+    Data_encoding.apply_lazy
+      ~fun_value:(fun v -> Some v)
+      ~fun_bytes:(fun _ -> None)
+      ~fun_combine:(fun _ _ -> None)
+      expr in
+  match Data_encoding.force_bytes expr with
+  | bytes ->
+      begin match account_serialization_cost with
+        | Some v -> ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)
+        | None -> ok (bytes, Gas_limit_repr.free)
+      end
+  | exception _ -> error Lazy_script_decode
+
+let minimal_deserialize_cost lexpr =
+  Data_encoding.apply_lazy
+    ~fun_value:(fun _ -> Gas_limit_repr.free)
+    ~fun_bytes:(fun b -> serialized_cost b)
+    ~fun_combine:(fun c_free _ -> c_free)
+    lexpr
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.mli
new file mode 100644
index 000000000..34dc0d90a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_repr.mli
@@ -0,0 +1,71 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type location = Micheline.canonical_location
+
+type annot = Micheline.annot
+
+type expr = Michelson_v1_primitives.prim Micheline.canonical
+
+type error += Lazy_script_decode (* `Permanent *)
+
+type lazy_expr = expr Data_encoding.lazy_t
+
+type node = (location, Michelson_v1_primitives.prim) Micheline.node
+
+val location_encoding : location Data_encoding.t
+
+val expr_encoding : expr Data_encoding.t
+
+val lazy_expr_encoding : lazy_expr Data_encoding.t
+
+val lazy_expr : expr -> lazy_expr
+
+type t = { code : lazy_expr ; storage : lazy_expr }
+
+val encoding : t Data_encoding.encoding
+
+val deserialized_cost : expr -> Gas_limit_repr.cost
+
+val serialized_cost : MBytes.t -> Gas_limit_repr.cost
+val traversal_cost : node -> Gas_limit_repr.cost
+val node_cost : node -> Gas_limit_repr.cost
+
+val int_node_cost : Z.t -> Gas_limit_repr.cost
+val int_node_cost_of_numbits : int -> Gas_limit_repr.cost
+val string_node_cost : string -> Gas_limit_repr.cost
+val string_node_cost_of_length : int -> Gas_limit_repr.cost
+val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost
+val bytes_node_cost_of_length : int -> Gas_limit_repr.cost
+val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost
+val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost
+val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost
+val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost
+
+val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult
+
+val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult
+
+val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors.ml
new file mode 100644
index 000000000..e0ec2ff63
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors.ml
@@ -0,0 +1,84 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script
+
+
+(* ---- Error definitions ---------------------------------------------------*)
+
+(* Auxiliary types for error documentation *)
+type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
+type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind
+type unparsed_stack_ty = (Script.expr * Script.annot) list
+type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list
+
+(* Structure errors *)
+type error += Invalid_arity of Script.location * prim * int * int
+type error += Invalid_namespace of Script.location * prim * namespace * namespace
+type error += Invalid_primitive of Script.location * prim list * prim
+type error += Invalid_kind of Script.location * kind list * kind
+type error += Missing_field of prim
+type error += Duplicate_field of Script.location * prim
+type error += Unexpected_big_map of Script.location
+type error += Unexpected_operation of Script.location
+
+(* Instruction typing errors *)
+type error += Fail_not_in_tail_position of Script.location
+type error += Undefined_binop : Script.location * prim * Script.expr * Script.expr -> error
+type error += Undefined_unop : Script.location * prim * Script.expr -> error
+type error += Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error
+type error += Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error
+type error += Unmatched_branches : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
+type error += Self_in_lambda of Script.location
+type error += Bad_stack_length
+type error += Bad_stack_item of int
+type error += Inconsistent_annotations of string * string
+type error += Inconsistent_type_annotations : Script.location * Script.expr * Script.expr -> error
+type error += Inconsistent_field_annotations of string * string
+type error += Unexpected_annotation of Script.location
+type error += Ungrouped_annotations of Script.location
+type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error
+type error += Invalid_map_block_fail of Script.location
+type error += Invalid_iter_body : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
+type error += Type_too_large : Script.location * int * int -> error
+
+(* Value typing errors *)
+type error += Invalid_constant : Script.location * Script.expr * Script.expr -> error
+type error += Invalid_contract of Script.location * Contract.t
+type error += Comparable_type_expected : Script.location * Script.expr -> error
+type error += Inconsistent_types : Script.expr * Script.expr -> error
+type error += Unordered_map_keys of Script.location * Script.expr
+type error += Unordered_set_values of Script.location * Script.expr
+type error += Duplicate_map_keys of Script.location * Script.expr
+type error += Duplicate_set_values of Script.location * Script.expr
+
+(* Toplevel errors *)
+type error += Ill_typed_data : string option * Script.expr * Script.expr -> error
+type error += Ill_formed_type of string option * Script.expr * Script.location
+type error += Ill_typed_contract : Script.expr * type_map -> error
+
+(* Gas related errors *)
+type error += Cannot_serialize_error
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml
new file mode 100644
index 000000000..43f874c98
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_tc_errors_registration.ml
@@ -0,0 +1,622 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script
+open Script_tc_errors
+
+(* Helpers for encoding *)
+let type_map_enc =
+  let open Data_encoding in
+  let stack_enc = list (tup2 Script.expr_encoding (list string)) in
+  list
+    (conv
+       (fun (loc, (bef, aft)) -> (loc, bef, aft))
+       (fun (loc, bef, aft) -> (loc, (bef, aft)))
+       (obj3
+          (req "location" Script.location_encoding)
+          (req "stackBefore" stack_enc)
+          (req "stackAfter" stack_enc)))
+
+let stack_ty_enc =
+  let open Data_encoding in
+  (list
+     (obj2
+        (req "type" Script.expr_encoding)
+        (dft "annots" (list string) [])))
+
+(* main registration *)
+let () =
+  let open Data_encoding in
+  let located enc =
+    merge_objs
+      (obj1 (req "location" Script.location_encoding))
+      enc in
+  let arity_enc =
+    int8 in
+  let namespace_enc =
+    def "primitiveNamespace"
+      ~title: "Primitive namespace"
+      ~description:
+        "One of the three possible namespaces of primitive \
+         (data constructor, type name or instruction)." @@
+    string_enum [ "type", Type_namespace ;
+                  "constant", Constant_namespace ;
+                  "instruction", Instr_namespace ] in
+  let kind_enc =
+    def "expressionKind"
+      ~title: "Expression kind"
+      ~description:
+        "One of the four possible kinds of expression \
+         (integer, string, primitive application or sequence)." @@
+    string_enum [ "integer", Int_kind ;
+                  "string", String_kind ;
+                  "bytes", Bytes_kind ;
+                  "primitiveApplication", Prim_kind ;
+                  "sequence", Seq_kind ] in
+  (* -- Structure errors ---------------------- *)
+  (* Invalid arity *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidArityTypeError"
+    ~title: "Invalid arity (typechecking error)"
+    ~description:
+      "In a script or data expression, a primitive was applied \
+       to an unsupported number of arguments."
+    (located (obj3
+                (req "primitiveName" Script.prim_encoding)
+                (req "expectedArity" arity_enc)
+                (req "wrongArity" arity_enc)))
+    (function
+      | Invalid_arity (loc, name, exp, got) ->
+          Some (loc, (name, exp, got))
+      | _ -> None)
+    (fun (loc, (name, exp, got)) ->
+       Invalid_arity (loc, name, exp, got)) ;
+  (* Missing field *)
+  register_error_kind
+    `Permanent
+    ~id:"missingScriptField"
+    ~title:"Script is missing a field (parse error)"
+    ~description:
+      "When parsing script, a field was expected, but not provided"
+    (obj1 (req "prim" prim_encoding))
+    (function Missing_field prim -> Some prim | _ -> None)
+    (fun prim -> Missing_field prim) ;
+  (* Invalid primitive *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidPrimitiveTypeError"
+    ~title: "Invalid primitive (typechecking error)"
+    ~description:
+      "In a script or data expression, a primitive was unknown."
+    (located (obj2
+                (dft "expectedPrimitiveNames" (list prim_encoding) [])
+                (req "wrongPrimitiveName" prim_encoding)))
+    (function
+      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got))
+      | _ -> None)
+    (fun (loc, (exp, got)) ->
+       Invalid_primitive (loc, exp, got)) ;
+  (* Invalid kind *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidExpressionKindTypeError"
+    ~title: "Invalid expression kind (typechecking error)"
+    ~description:
+      "In a script or data expression, an expression was of the wrong kind \
+       (for instance a string where only a primitive applications can appear)."
+    (located (obj2
+                (req "expectedKinds" (list kind_enc))
+                (req "wrongKind" kind_enc)))
+    (function
+      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got))
+      | _ -> None)
+    (fun (loc, (exp, got)) ->
+       Invalid_kind (loc, exp, got)) ;
+  (* Invalid namespace *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidPrimitiveNamespaceTypeError"
+    ~title: "Invalid primitive namespace (typechecking error)"
+    ~description:
+      "In a script or data expression, a primitive was of the wrong namespace."
+    (located (obj3
+                (req "primitiveName" prim_encoding)
+                (req "expectedNamespace" namespace_enc)
+                (req "wrongNamespace" namespace_enc)))
+    (function
+      | Invalid_namespace (loc, name, exp, got) -> Some (loc, (name, exp, got))
+      | _ -> None)
+    (fun (loc, (name, exp, got)) ->
+       Invalid_namespace (loc, name, exp, got)) ;
+  (* Duplicate field *)
+  register_error_kind
+    `Permanent
+    ~id:"duplicateScriptField"
+    ~title: "Script has a duplicated field (parse error)"
+    ~description:
+      "When parsing script, a field was found more than once"
+    (obj2
+       (req "loc" location_encoding)
+       (req "prim" prim_encoding))
+    (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)
+    (fun (loc, prim) -> Duplicate_field (loc, prim)) ;
+  (* Unexpected big_map *)
+  register_error_kind
+    `Permanent
+    ~id:"unexpectedBigMap"
+    ~title: "Big map in unauthorized position (type error)"
+    ~description:
+      "When parsing script, a big_map type was found somewhere else \
+       than in the left component of the toplevel storage pair."
+    (obj1
+       (req "loc" location_encoding))
+    (function Unexpected_big_map loc -> Some loc | _ -> None)
+    (fun loc -> Unexpected_big_map loc) ;
+  (* Unexpected operation *)
+  register_error_kind
+    `Permanent
+    ~id:"unexpectedOperation"
+    ~title: "Big map in unauthorized position (type error)"
+    ~description:
+      "When parsing script, a operation type was found \
+       in the storage or parameter field."
+    (obj1
+       (req "loc" location_encoding))
+    (function Unexpected_operation loc -> Some loc | _ -> None)
+    (fun loc -> Unexpected_operation loc) ;
+  (* -- Value typing errors ---------------------- *)
+  (* Unordered map keys *)
+  register_error_kind
+    `Permanent
+    ~id:"unorderedMapLiteral"
+    ~title:"Invalid map key order"
+    ~description:"Map keys must be in strictly increasing order"
+    (obj2
+       (req "location" Script.location_encoding)
+       (req "item" Script.expr_encoding))
+    (function
+      | Unordered_map_keys (loc, expr) -> Some (loc, expr)
+      | _ -> None)
+    (fun (loc, expr) -> Unordered_map_keys (loc, expr));
+  (* Duplicate map keys *)
+  register_error_kind
+    `Permanent
+    ~id:"duplicateMapKeys"
+    ~title:"Duplicate map keys"
+    ~description:"Map literals cannot contain duplicated keys"
+    (obj2
+       (req "location" Script.location_encoding)
+       (req "item" Script.expr_encoding))
+    (function
+      | Duplicate_map_keys (loc, expr) -> Some (loc, expr)
+      | _ -> None)
+    (fun (loc, expr) -> Duplicate_map_keys (loc, expr));
+  (* Unordered set values *)
+  register_error_kind
+    `Permanent
+    ~id:"unorderedSetLiteral"
+    ~title:"Invalid set value order"
+    ~description:"Set values must be in strictly increasing order"
+    (obj2
+       (req "location" Script.location_encoding)
+       (req "value" Script.expr_encoding))
+    (function
+      | Unordered_set_values (loc, expr) -> Some (loc, expr)
+      | _ -> None)
+    (fun (loc, expr) -> Unordered_set_values (loc, expr));
+  (* Duplicate set values *)
+  register_error_kind
+    `Permanent
+    ~id:"duplicateSetValuesInLiteral"
+    ~title:"Sets literals cannot contain duplicate elements"
+    ~description:"Set literals cannot contain duplicate elements, \
+                  but a duplicae was found while parsing."
+    (obj2
+       (req "location" Script.location_encoding)
+       (req "value" Script.expr_encoding))
+    (function
+      | Duplicate_set_values (loc, expr) -> Some (loc, expr)
+      | _ -> None)
+    (fun (loc, expr) -> Duplicate_set_values (loc, expr));
+  (* -- Instruction typing errors ------------- *)
+  (* Fail not in tail position *)
+  register_error_kind
+    `Permanent
+    ~id:"failNotInTailPositionTypeError"
+    ~title: "FAIL not in tail position (typechecking error)"
+    ~description:
+      "There is non trivial garbage code after a FAIL instruction."
+    (located empty)
+    (function
+      | Fail_not_in_tail_position loc -> Some (loc, ())
+      | _ -> None)
+    (fun (loc, ()) ->
+       Fail_not_in_tail_position loc) ;
+  (* Undefined binary operation *)
+  register_error_kind
+    `Permanent
+    ~id:"undefinedBinopTypeError"
+    ~title: "Undefined binop (typechecking error)"
+    ~description:
+      "A binary operation is called on operands of types \
+       over which it is not defined."
+    (located (obj3
+                (req "operatorName" prim_encoding)
+                (req "wrongLeftOperandType" Script.expr_encoding)
+                (req "wrongRightOperandType" Script.expr_encoding)))
+    (function
+      | Undefined_binop (loc, n, tyl, tyr) ->
+          Some (loc, (n, tyl, tyr))
+      | _ -> None)
+    (fun (loc, (n, tyl, tyr)) ->
+       Undefined_binop (loc, n, tyl, tyr)) ;
+  (* Undefined unary operation *)
+  register_error_kind
+    `Permanent
+    ~id:"undefinedUnopTypeError"
+    ~title: "Undefined unop (typechecking error)"
+    ~description:
+      "A unary operation is called on an operand of type \
+       over which it is not defined."
+    (located (obj2
+                (req "operatorName" prim_encoding)
+                (req "wrongOperandType" Script.expr_encoding)))
+    (function
+      | Undefined_unop (loc, n, ty) ->
+          Some (loc, (n, ty))
+      | _ -> None)
+    (fun (loc, (n, ty)) ->
+       Undefined_unop (loc, n, ty)) ;
+  (* Bad return *)
+  register_error_kind
+    `Permanent
+    ~id:"badReturnTypeError"
+    ~title: "Bad return (typechecking error)"
+    ~description:
+      "Unexpected stack at the end of a lambda or script."
+    (located (obj2
+                (req "expectedReturnType" Script.expr_encoding)
+                (req "wrongStackType" stack_ty_enc)))
+    (function
+      | Bad_return (loc, sty, ty) -> Some (loc, (ty, sty))
+      | _ -> None)
+    (fun (loc, (ty, sty)) ->
+       Bad_return (loc, sty, ty)) ;
+  (* Bad stack *)
+  register_error_kind
+    `Permanent
+    ~id:"badStackTypeError"
+    ~title: "Bad stack (typechecking error)"
+    ~description:
+      "The stack has an unexpected length or contents."
+    (located (obj3
+                (req "primitiveName" prim_encoding)
+                (req "relevantStackPortion" int16)
+                (req "wrongStackType" stack_ty_enc)))
+    (function
+      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty))
+      | _ -> None)
+    (fun (loc, (name, s, sty)) ->
+       Bad_stack (loc, name, s, sty)) ;
+  (* Inconsistent annotations *)
+  register_error_kind
+    `Permanent
+    ~id:"inconsistentAnnotations"
+    ~title:"Annotations inconsistent between branches"
+    ~description:"The annotations on two types could not be merged"
+    (obj2
+       (req "annot1" string)
+       (req "annot2" string))
+    (function Inconsistent_annotations (annot1, annot2) -> Some (annot1, annot2)
+            | _ -> None)
+    (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ;
+  (* Inconsistent field annotations *)
+  register_error_kind
+    `Permanent
+    ~id:"inconsistentFieldAnnotations"
+    ~title:"Annotations for field accesses is inconsistent"
+    ~description:"The specified field does not match the field annotation in the type"
+    (obj2
+       (req "annot1" string)
+       (req "annot2" string))
+    (function Inconsistent_field_annotations (annot1, annot2) -> Some (annot1, annot2)
+            | _ -> None)
+    (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ;
+  (* Inconsistent type annotations *)
+  register_error_kind
+    `Permanent
+    ~id:"inconsistentTypeAnnotations"
+    ~title:"Types contain inconsistent annotations"
+    ~description:"The two types contain annotations that do not match"
+    (located (obj2
+                (req "type1" Script.expr_encoding)
+                (req "type2" Script.expr_encoding)))
+    (function
+      | Inconsistent_type_annotations (loc, ty1, ty2) -> Some (loc, (ty1, ty2))
+      | _ -> None)
+    (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
+  (* Unexpected annotation *)
+  register_error_kind
+    `Permanent
+    ~id:"unexpectedAnnotation"
+    ~title:"An annotation was encountered where no annotation is expected"
+    ~description:"A node in the syntax tree was impropperly annotated"
+    (located empty)
+    (function Unexpected_annotation loc -> Some (loc, ())
+            | _ -> None)
+    (fun (loc, ()) -> Unexpected_annotation loc);
+  (* Ungrouped annotations *)
+  register_error_kind
+    `Permanent
+    ~id:"ungroupedAnnotations"
+    ~title:"Annotations of the same kind were found spread apart"
+    ~description:"Annotations of the same kind must be grouped"
+    (located empty)
+    (function Ungrouped_annotations loc -> Some (loc, ())
+            | _ -> None)
+    (fun (loc, ()) -> Ungrouped_annotations loc);
+  (* Unmatched branches *)
+  register_error_kind
+    `Permanent
+    ~id:"unmatchedBranchesTypeError"
+    ~title: "Unmatched branches (typechecking error)"
+    ~description:
+      "At the join point at the end of two code branches \
+       the stacks have inconsistent lengths or contents."
+    (located (obj2
+                (req "firstStackType" stack_ty_enc)
+                (req "otherStackType" stack_ty_enc)))
+    (function
+      | Unmatched_branches (loc, stya, styb) ->
+          Some (loc, (stya, styb))
+      | _ -> None)
+    (fun (loc, (stya, styb)) ->
+       Unmatched_branches (loc, stya, styb)) ;
+  (* Bad stack item *)
+  register_error_kind
+    `Permanent
+    ~id:"badStackItemTypeError"
+    ~title: "Bad stack item (typechecking error)"
+    ~description:
+      "The type of a stack item is unexpected \
+       (this error is always accompanied by a more precise one)."
+    (obj1 (req "itemLevel" int16))
+    (function
+      | Bad_stack_item n -> Some n
+      | _ -> None)
+    (fun n ->
+       Bad_stack_item n) ;
+  (* SELF in lambda *)
+  register_error_kind
+    `Permanent
+    ~id:"selfInLambda"
+    ~title: "SELF instruction in lambda (typechecking error)"
+    ~description:
+      "A SELF instruction was encountered in a lambda expression."
+    (located empty)
+    (function
+      | Self_in_lambda loc -> Some (loc, ())
+      | _ -> None)
+    (fun (loc, ()) ->
+       Self_in_lambda loc) ;
+  (* Bad stack length *)
+  register_error_kind
+    `Permanent
+    ~id:"inconsistentStackLengthsTypeError"
+    ~title: "Inconsistent stack lengths (typechecking error)"
+    ~description:
+      "A stack was of an unexpected length \
+       (this error is always in the context of a located error)."
+    empty
+    (function
+      | Bad_stack_length -> Some ()
+      | _ -> None)
+    (fun () ->
+       Bad_stack_length) ;
+  (* -- Value typing errors ------------------- *)
+  (* Invalid constant *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidConstantTypeError"
+    ~title: "Invalid constant (typechecking error)"
+    ~description:
+      "A data expression was invalid for its expected type."
+    (located (obj2
+                (req "expectedType" Script.expr_encoding)
+                (req "wrongExpression" Script.expr_encoding)))
+    (function
+      | Invalid_constant (loc, expr, ty) ->
+          Some (loc, (ty, expr))
+      | _ -> None)
+    (fun (loc, (ty, expr)) ->
+       Invalid_constant (loc, expr, ty)) ;
+  (* Invalid contract *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidContractTypeError"
+    ~title: "Invalid contract (typechecking error)"
+    ~description:
+      "A script or data expression references a contract that does not \
+       exist or assumes a wrong type for an existing contract."
+    (located (obj1 (req "contract" Contract.encoding)))
+    (function
+      | Invalid_contract (loc, c) ->
+          Some (loc, c)
+      | _ -> None)
+    (fun (loc, c) ->
+       Invalid_contract (loc, c)) ;
+  (* Comparable type expected *)
+  register_error_kind
+    `Permanent
+    ~id:"comparableTypeExpectedTypeError"
+    ~title: "Comparable type expected (typechecking error)"
+    ~description:
+      "A non comparable type was used in a place where \
+       only comparable types are accepted."
+    (located (obj1 (req "wrongType" Script.expr_encoding)))
+    (function
+      | Comparable_type_expected (loc, ty) -> Some (loc, ty)
+      | _ -> None)
+    (fun (loc, ty) ->
+       Comparable_type_expected (loc, ty)) ;
+  (* Inconsistent types *)
+  register_error_kind
+    `Permanent
+    ~id:"InconsistentTypesTypeError"
+    ~title: "Inconsistent types (typechecking error)"
+    ~description:
+      "This is the basic type clash error, \
+       that appears in several places where the equality of \
+       two types have to be proven, it is always accompanied \
+       with another error that provides more context."
+    (obj2
+       (req "firstType" Script.expr_encoding)
+       (req "otherType" Script.expr_encoding))
+    (function
+      | Inconsistent_types (tya, tyb) -> Some (tya, tyb)
+      | _ -> None)
+    (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;
+  (* -- Instruction typing errors ------------------- *)
+  (* Invalid map body *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidMapBody"
+    ~title: "Invalid map body"
+    ~description:
+      "The body of a map block did not match the expected type"
+    (obj2
+       (req "loc" Script.location_encoding)
+       (req "bodyType" stack_ty_enc))
+    (function
+      | Invalid_map_body (loc, stack) -> Some (loc, stack)
+      | _ -> None)
+    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;
+  (* Invalid map block FAIL *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidMapBlockFail"
+    ~title:"FAIL instruction occurred as body of map block"
+    ~description:"FAIL cannot be the only instruction in the body. \
+                  The propper type of the return list cannot be inferred."
+    (obj1 (req "loc" Script.location_encoding))
+    (function
+      | Invalid_map_block_fail loc -> Some loc
+      | _ -> None)
+    (fun loc -> Invalid_map_block_fail loc) ;
+  (* Invalid ITER body *)
+  register_error_kind
+    `Permanent
+    ~id:"invalidIterBody"
+    ~title:"ITER body returned wrong stack type"
+    ~description:"The body of an ITER instruction \
+                  must result in the same stack type as before \
+                  the ITER."
+    (obj3
+       (req "loc" Script.location_encoding)
+       (req "befStack" stack_ty_enc)
+       (req "aftStack" stack_ty_enc))
+    (function
+      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft)
+      | _ -> None)
+    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;
+  (* Type too large *)
+  register_error_kind
+    `Permanent
+    ~id:"typeTooLarge"
+    ~title:"Stack item type too large"
+    ~description:"An instruction generated a type larger than the limit."
+    (obj3
+       (req "loc" Script.location_encoding)
+       (req "typeSize" uint16)
+       (req "maximumTypeSize" uint16))
+    (function
+      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts)
+      | _ -> None)
+    (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ;
+  (* -- Toplevel errors ------------------- *)
+  (* Ill typed data *)
+  register_error_kind
+    `Permanent
+    ~id:"illTypedDataTypeError"
+    ~title: "Ill typed data (typechecking error)"
+    ~description:
+      "The toplevel error thrown when trying to typecheck \
+       a data expression against a given type \
+       (always followed by more precise errors)."
+    (obj3
+       (opt "identifier" string)
+       (req "expectedType" Script.expr_encoding)
+       (req "illTypedExpression" Script.expr_encoding))
+    (function
+      | Ill_typed_data (name, expr, ty) -> Some (name, ty,  expr)
+      | _ -> None)
+    (fun (name, ty,  expr) -> Ill_typed_data (name, expr, ty)) ;
+  (* Ill formed type *)
+  register_error_kind
+    `Permanent
+    ~id:"illFormedTypeTypeError"
+    ~title: "Ill formed type (typechecking error)"
+    ~description:
+      "The toplevel error thrown when trying to parse a type expression \
+       (always followed by more precise errors)."
+    (obj3
+       (opt "identifier" string)
+       (req "illFormedExpression" Script.expr_encoding)
+       (req "location" Script.location_encoding))
+    (function
+      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc)
+      | _ -> None)
+    (fun (name, expr, loc) ->
+       Ill_formed_type (name, expr, loc)) ;
+  (* Ill typed contract *)
+  register_error_kind
+    `Permanent
+    ~id:"illTypedContractTypeError"
+    ~title: "Ill typed contract (typechecking error)"
+    ~description:
+      "The toplevel error thrown when trying to typecheck \
+       a contract code against given input, output and storage types \
+       (always followed by more precise errors)."
+    (obj2
+       (req "illTypedCode" Script.expr_encoding)
+       (req "typeMap" type_map_enc))
+    (function
+      | Ill_typed_contract (expr, type_map) ->
+          Some (expr, type_map)
+      | _ -> None)
+    (fun (expr, type_map) ->
+       Ill_typed_contract (expr, type_map)) ;
+  (* Cannot serialize error *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeError"
+    ~title:"Not enough gas to serialize error"
+    ~description:"The error was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_error -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_error)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.ml
new file mode 100644
index 000000000..8c6a48d32
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.ml
@@ -0,0 +1,64 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = Z.t
+
+let compare = Z.compare
+
+let of_int64 = Z.of_int64
+
+let of_string x =
+  match Time_repr.of_notation x with
+  | None ->
+      begin try Some (Z.of_string x)
+        with _ -> None
+      end
+  | Some time ->
+      Some (of_int64 (Time_repr.to_seconds time))
+
+let to_notation x =
+  try
+    let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
+    if String.equal notation "out_of_range"
+    then None
+    else Some notation
+  with _ -> None
+
+let to_num_str = Z.to_string
+
+let to_string x =
+  match to_notation x with
+  | None -> to_num_str x
+  | Some s -> s
+
+let diff x y = Script_int_repr.of_zint @@ Z.sub x y
+
+let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)
+
+let add_delta t delta =
+  Z.add t (Script_int_repr.to_zint delta)
+
+let to_zint x = x
+let of_zint x = x
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.mli
new file mode 100644
index 000000000..73496c369
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_timestamp_repr.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Script_int_repr
+
+type t
+
+val of_int64 : int64 -> t
+
+val compare : t -> t -> int
+
+(* Convert a timestamp to a notation if possible *)
+val to_notation : t -> string option
+(* Convert a timestamp to a string representation of the seconds *)
+val to_num_str : t -> string
+(* Convert to a notation if possible, or num if not *)
+val to_string : t -> string
+val of_string : string -> t option
+
+val diff : t -> t -> z num
+
+val add_delta : t -> z num -> t
+
+val sub_delta : t -> z num -> t
+
+val to_zint : t -> Z.t
+val of_zint : Z.t -> t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_typed_ir.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_typed_ir.ml
new file mode 100644
index 000000000..7656fc44a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -0,0 +1,401 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+open Script_int
+
+(* ---- Auxiliary types -----------------------------------------------------*)
+
+type var_annot = [ `Var_annot of string ]
+type type_annot = [ `Type_annot of string ]
+type field_annot = [ `Field_annot of string ]
+
+type annot = [ var_annot | type_annot | field_annot ]
+
+type 'ty comparable_ty =
+  | Int_key : type_annot option -> (z num) comparable_ty
+  | Nat_key : type_annot option -> (n num) comparable_ty
+  | String_key : type_annot option -> string comparable_ty
+  | Bytes_key : type_annot option -> MBytes.t comparable_ty
+  | Mutez_key : type_annot option -> Tez.t comparable_ty
+  | Bool_key : type_annot option -> bool comparable_ty
+  | Key_hash_key : type_annot option -> public_key_hash comparable_ty
+  | Timestamp_key : type_annot option -> Script_timestamp.t comparable_ty
+  | Address_key : type_annot option -> Contract.t comparable_ty
+
+
+module type Boxed_set = sig
+  type elt
+  module OPS : S.SET with type elt = elt
+  val boxed : OPS.t
+  val size : int
+end
+
+type 'elt set = (module Boxed_set with type elt = 'elt)
+
+module type Boxed_map = sig
+  type key
+  type value
+  val key_ty : key comparable_ty
+  module OPS : S.MAP with type key = key
+  val boxed : value OPS.t * int
+end
+
+type ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)
+
+type ('arg, 'storage) script =
+  { code : (('arg, 'storage) pair, (packed_internal_operation list, 'storage) pair) lambda ;
+    arg_type : 'arg ty ;
+    storage : 'storage ;
+    storage_type : 'storage ty }
+
+and ('a, 'b) pair = 'a * 'b
+
+and ('a, 'b) union = L of 'a | R of 'b
+
+and end_of_stack = unit
+
+and ('arg, 'ret) lambda =
+    Lam of ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.expr
+
+and 'arg typed_contract =
+  'arg ty * Contract.t
+
+and 'ty ty =
+  | Unit_t : type_annot option -> unit ty
+  | Int_t : type_annot option -> z num ty
+  | Nat_t : type_annot option -> n num ty
+  | Signature_t : type_annot option -> signature ty
+  | String_t : type_annot option -> string ty
+  | Bytes_t : type_annot option -> MBytes.t ty
+  | Mutez_t : type_annot option -> Tez.t ty
+  | Key_hash_t : type_annot option -> public_key_hash ty
+  | Key_t : type_annot option -> public_key ty
+  | Timestamp_t : type_annot option -> Script_timestamp.t ty
+  | Address_t : type_annot option -> Contract.t ty
+  | Bool_t : type_annot option -> bool ty
+  | Pair_t :
+      ('a ty * field_annot option * var_annot option) *
+      ('b ty * field_annot option * var_annot option) *
+      type_annot option -> ('a, 'b) pair ty
+  | Union_t : ('a ty * field_annot option) * ('b ty * field_annot option) * type_annot option  -> ('a, 'b) union ty
+  | Lambda_t : 'arg ty * 'ret ty * type_annot option  -> ('arg, 'ret) lambda ty
+  | Option_t : ('v ty * field_annot option) * field_annot option * type_annot option  -> 'v option ty
+  | List_t : 'v ty * type_annot option -> 'v list ty
+  | Set_t : 'v comparable_ty * type_annot option -> 'v set ty
+  | Map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) map ty
+  | Big_map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) big_map ty
+  | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty
+  | Operation_t : type_annot option -> packed_internal_operation ty
+
+and 'ty stack_ty =
+  | Item_t : 'ty ty * 'rest stack_ty * var_annot option -> ('ty * 'rest) stack_ty
+  | Empty_t : end_of_stack stack_ty
+
+and ('key, 'value) big_map = { diff : ('key, 'value option) map ;
+                               key_type : 'key ty ;
+                               value_type : 'value ty }
+
+(* ---- Instructions --------------------------------------------------------*)
+
+(* The low-level, typed instructions, as a GADT whose parameters
+   encode the typing rules. The left parameter is the typed shape of
+   the stack before the instruction, the right one the shape
+   after. Any program whose construction is accepted by OCaml's
+   type-checker is guaranteed to be type-safe.  Overloadings of the
+   concrete syntax are already resolved in this representation, either
+   by using different constructors or type witness parameters. *)
+and ('bef, 'aft) instr =
+  (* stack ops *)
+  | Drop :
+      (_ * 'rest, 'rest) instr
+  | Dup :
+      ('top * 'rest, 'top * ('top * 'rest)) instr
+  | Swap :
+      ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr
+  | Const : 'ty ->
+    ('rest, ('ty * 'rest)) instr
+  (* pairs *)
+  | Cons_pair :
+      (('car * ('cdr * 'rest)), (('car, 'cdr) pair * 'rest)) instr
+  | Car :
+      (('car, _) pair * 'rest, 'car * 'rest) instr
+  | Cdr :
+      ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr
+  (* options *)
+  | Cons_some :
+      ('v * 'rest, 'v option * 'rest) instr
+  | Cons_none : 'a ty ->
+    ('rest, 'a option * 'rest) instr
+  | If_none : ('bef, 'aft) descr * ('a * 'bef, 'aft) descr ->
+    ('a option * 'bef, 'aft) instr
+  (* unions *)
+  | Left :
+      ('l * 'rest, (('l, 'r) union * 'rest)) instr
+  | Right :
+      ('r * 'rest, (('l, 'r) union * 'rest)) instr
+  | If_left : ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr ->
+    (('l, 'r) union * 'bef, 'aft) instr
+  (* lists *)
+  | Cons_list :
+      ('a * ('a list * 'rest), ('a list * 'rest)) instr
+  | Nil :
+      ('rest, ('a list * 'rest)) instr
+  | If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr ->
+    ('a list * 'bef, 'aft) instr
+  | List_map : ('a * 'rest, 'b * 'rest) descr ->
+    ('a list * 'rest, 'b list * 'rest) instr
+  | List_iter : ('a * 'rest, 'rest) descr ->
+    ('a list * 'rest, 'rest) instr
+  | List_size : ('a list * 'rest, n num * 'rest) instr
+  (* sets *)
+  | Empty_set : 'a comparable_ty ->
+    ('rest, 'a set * 'rest) instr
+  | Set_iter : ('a * 'rest, 'rest) descr ->
+    ('a set * 'rest, 'rest) instr
+  | Set_mem :
+      ('elt * ('elt set * 'rest), bool * 'rest) instr
+  | Set_update :
+      ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
+  | Set_size : ('a set * 'rest, n num * 'rest) instr
+  (* maps *)
+  | Empty_map : 'a comparable_ty * 'v ty ->
+    ('rest, ('a, 'v) map * 'rest) instr
+  | Map_map : (('a * 'v) * 'rest, 'r * 'rest) descr ->
+    (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
+  | Map_iter : (('a * 'v) * 'rest, 'rest) descr ->
+    (('a, 'v) map * 'rest, 'rest) instr
+  | Map_mem :
+      ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
+  | Map_get :
+      ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
+  | Map_update :
+      ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
+  | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
+  (* big maps *)
+  | Big_map_mem :
+      ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
+  | Big_map_get :
+      ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
+  | Big_map_update :
+      ('key * ('value option * (('key, 'value) big_map * 'rest)), ('key, 'value) big_map * 'rest) instr
+  (* string operations *)
+  | Concat_string :
+      (string list * 'rest, string * 'rest) instr
+  | Concat_string_pair :
+      (string * (string * 'rest), string * 'rest) instr
+  | Slice_string :
+      (n num * (n num * (string * 'rest)), string option * 'rest) instr
+  | String_size :
+      (string * 'rest, n num * 'rest) instr
+  (* bytes operations *)
+  | Concat_bytes :
+      (MBytes.t list * 'rest, MBytes.t * 'rest) instr
+  | Concat_bytes_pair :
+      (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
+  | Slice_bytes :
+      (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
+  | Bytes_size :
+      (MBytes.t * 'rest, n num * 'rest) instr
+  (* timestamp operations *)
+  | Add_seconds_to_timestamp :
+      (z num * (Script_timestamp.t * 'rest),
+       Script_timestamp.t * 'rest) instr
+  | Add_timestamp_to_seconds :
+      (Script_timestamp.t * (z num * 'rest),
+       Script_timestamp.t * 'rest) instr
+  | Sub_timestamp_seconds :
+      (Script_timestamp.t * (z num * 'rest),
+       Script_timestamp.t * 'rest) instr
+  | Diff_timestamps :
+      (Script_timestamp.t * (Script_timestamp.t * 'rest),
+       z num * 'rest) instr
+  (* currency operations *)
+  (* TODO: we can either just have conversions to/from integers and
+     do all operations on integers, or we need more operations on
+     Tez. Also Sub_tez should return Tez.t option (if negative) and *)
+  | Add_tez :
+      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
+  | Sub_tez :
+      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
+  | Mul_teznat :
+      (Tez.t * (n num * 'rest), Tez.t * 'rest) instr
+  | Mul_nattez :
+      (n num * (Tez.t * 'rest), Tez.t * 'rest) instr
+  | Ediv_teznat :
+      (Tez.t * (n num * 'rest), ((Tez.t, Tez.t) pair) option * 'rest) instr
+  | Ediv_tez :
+      (Tez.t * (Tez.t * 'rest), ((n num, Tez.t) pair) option * 'rest) instr
+  (* boolean operations *)
+  | Or :
+      (bool * (bool * 'rest), bool * 'rest) instr
+  | And :
+      (bool * (bool * 'rest), bool * 'rest) instr
+  | Xor :
+      (bool * (bool * 'rest), bool * 'rest) instr
+  | Not :
+      (bool * 'rest, bool * 'rest) instr
+  (* integer operations *)
+  | Is_nat :
+      (z num * 'rest, n num option * 'rest) instr
+  | Neg_nat :
+      (n num * 'rest, z num * 'rest) instr
+  | Neg_int :
+      (z num * 'rest, z num * 'rest) instr
+  | Abs_int :
+      (z num * 'rest, n num * 'rest) instr
+  | Int_nat :
+      (n num * 'rest, z num * 'rest) instr
+  | Add_intint :
+      (z num * (z num * 'rest), z num * 'rest) instr
+  | Add_intnat :
+      (z num * (n num * 'rest), z num * 'rest) instr
+  | Add_natint :
+      (n num * (z num * 'rest), z num * 'rest) instr
+  | Add_natnat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | Sub_int :
+      ('s num * ('t num * 'rest), z num * 'rest) instr
+  | Mul_intint :
+      (z num * (z num * 'rest), z num * 'rest) instr
+  | Mul_intnat :
+      (z num * (n num * 'rest), z num * 'rest) instr
+  | Mul_natint :
+      (n num * (z num * 'rest), z num * 'rest) instr
+  | Mul_natnat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | Ediv_intint :
+      (z num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr
+  | Ediv_intnat :
+      (z num * (n num * 'rest), ((z num, n num) pair) option * 'rest) instr
+  | Ediv_natint :
+      (n num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr
+  | Ediv_natnat :
+      (n num * (n num * 'rest), ((n num, n num) pair) option * 'rest) instr
+  | Lsl_nat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | Lsr_nat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | Or_nat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | And_nat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | And_int_nat :
+      (z num * (n num * 'rest), n num * 'rest) instr
+  | Xor_nat :
+      (n num * (n num * 'rest), n num * 'rest) instr
+  | Not_nat :
+      (n num * 'rest, z num * 'rest) instr
+  | Not_int :
+      (z num * 'rest, z num * 'rest) instr
+  (* control *)
+  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr ->
+    ('bef, 'aft) instr
+  | If : ('bef, 'aft) descr * ('bef, 'aft) descr ->
+    (bool * 'bef, 'aft) instr
+  | Loop : ('rest, bool * 'rest) descr ->
+    (bool * 'rest, 'rest) instr
+  | Loop_left : ('a * 'rest, ('a, 'b) union * 'rest) descr ->
+    (('a, 'b) union * 'rest, 'b * 'rest) instr
+  | Dip : ('bef, 'aft) descr ->
+    ('top * 'bef, 'top * 'aft) instr
+  | Exec :
+      ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
+  | Lambda : ('arg, 'ret) lambda ->
+    ('rest, ('arg, 'ret) lambda * 'rest) instr
+  | Failwith :
+      'a ty -> ('a * 'rest, 'aft) instr
+  | Nop :
+      ('rest, 'rest) instr
+  (* comparison *)
+  | Compare : 'a comparable_ty ->
+    ('a * ('a * 'rest), z num * 'rest) instr
+  (* comparators *)
+  | Eq :
+      (z num * 'rest, bool * 'rest) instr
+  | Neq :
+      (z num * 'rest, bool * 'rest) instr
+  | Lt :
+      (z num * 'rest, bool * 'rest) instr
+  | Gt :
+      (z num * 'rest, bool * 'rest) instr
+  | Le :
+      (z num * 'rest, bool * 'rest) instr
+  | Ge :
+      (z num * 'rest, bool * 'rest) instr
+
+  (* protocol *)
+  | Address :
+      (_ typed_contract * 'rest, Contract.t * 'rest) instr
+  | Contract : 'p ty ->
+    (Contract.t * 'rest, 'p typed_contract option * 'rest) instr
+  | Transfer_tokens :
+      ('arg * (Tez.t * ('arg typed_contract * 'rest)), packed_internal_operation * 'rest) instr
+  | Create_account :
+      (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
+       packed_internal_operation * (Contract.t * 'rest)) instr
+  | Implicit_account :
+      (public_key_hash * 'rest, unit typed_contract * 'rest) instr
+  | Create_contract : 'g ty * 'p ty * ('p * 'g, packed_internal_operation list * 'g) lambda  ->
+    (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
+     packed_internal_operation * (Contract.t * 'rest)) instr
+  | Set_delegate :
+      (public_key_hash option * 'rest, packed_internal_operation * 'rest) instr
+  | Now :
+      ('rest, Script_timestamp.t * 'rest) instr
+  | Balance :
+      ('rest, Tez.t * 'rest) instr
+  | Check_signature :
+      (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
+  | Hash_key :
+      (public_key * 'rest, public_key_hash * 'rest) instr
+  | Pack : 'a ty ->
+    ('a * 'rest, MBytes.t * 'rest) instr
+  | Unpack : 'a ty ->
+    (MBytes.t * 'rest, 'a option * 'rest) instr
+  | Blake2b :
+      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Sha256 :
+      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Sha512 :
+      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Steps_to_quota : (* TODO: check that it always returns a nat *)
+      ('rest, n num * 'rest) instr
+  | Source :
+      ('rest, Contract.t * 'rest) instr
+  | Sender :
+      ('rest, Contract.t * 'rest) instr
+  | Self : 'p ty ->
+    ('rest, 'p typed_contract * 'rest) instr
+  | Amount :
+      ('rest, Tez.t * 'rest) instr
+
+and ('bef, 'aft) descr =
+  { loc : Script.location ;
+    bef : 'bef stack_ty ;
+    aft : 'aft stack_ty ;
+    instr : ('bef, 'aft)  instr }
+
+type ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.ml
new file mode 100644
index 000000000..4a18d2a6a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.ml
@@ -0,0 +1,139 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Tezos Protocol Implementation - Random number generation *)
+
+type seed = B of State_hash.t
+type t = T of State_hash.t
+type sequence = S of State_hash.t
+type nonce = MBytes.t
+
+let nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length
+
+let init = "Laissez-faire les proprietaires."
+let zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\000')
+
+let state_hash_encoding =
+  let open Data_encoding in
+  conv
+    State_hash.to_bytes
+    State_hash.of_bytes_exn
+    (Fixed.bytes Nonce_hash.size)
+
+let seed_encoding =
+  let open Data_encoding in
+  conv
+    (fun (B b) -> b)
+    (fun b -> B b)
+    state_hash_encoding
+
+let empty = B (State_hash.hash_bytes [MBytes.of_string init])
+
+let nonce (B state) nonce =
+  B (State_hash.hash_bytes ( [State_hash.to_bytes state; nonce] ))
+
+let initialize_new (B state) append =
+  T (State_hash.hash_bytes
+       (State_hash.to_bytes state :: zero_bytes :: append ))
+
+let xor_higher_bits i b =
+  let higher = MBytes.get_int32 b 0 in
+  let r = Int32.logxor higher i in
+  let res = MBytes.copy b in
+  MBytes.set_int32 res 0 r;
+  res
+
+let sequence (T state) n =
+  State_hash.to_bytes state
+  |> xor_higher_bits n
+  |> (fun b -> S (State_hash.hash_bytes [b]))
+
+let take (S state) =
+  let b = State_hash.to_bytes state in
+  let h = State_hash.hash_bytes [b] in
+  (State_hash.to_bytes h, S h)
+
+let take_int32 s bound =
+  if Compare.Int32.(bound <= 0l)
+  then invalid_arg "Seed_repr.take_int32" (* FIXME *)
+  else
+    let rec loop s =
+      let bytes, s = take s in
+      let r = Int32.abs (MBytes.get_int32 bytes 0) in
+      let drop_if_over =
+        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) in
+      if Compare.Int32.(r >= drop_if_over)
+      then loop s
+      else
+        let v = Int32.rem r bound in
+        v, s
+    in
+    loop s
+
+type error += Unexpected_nonce_length (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"unexpected_nonce_length"
+    ~title:"Unexpected nonce length"
+    ~description:"Nonce length is incorrect."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Nonce length is not %i bytes long as it should."
+          Constants_repr.nonce_length)
+    Data_encoding.empty
+    (function Unexpected_nonce_length -> Some () | _ -> None)
+    (fun () -> Unexpected_nonce_length)
+
+let make_nonce nonce =
+  if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length)
+  then error Unexpected_nonce_length
+  else ok nonce
+
+let hash nonce = Nonce_hash.hash_bytes [nonce]
+
+let check_hash nonce hash =
+  Compare.Int.(MBytes.length nonce = Constants_repr.nonce_length)
+  && Nonce_hash.equal (Nonce_hash.hash_bytes [nonce]) hash
+
+let nonce_hash_key_part = Nonce_hash.to_path
+
+let initial_nonce_0 = zero_bytes
+
+let initial_nonce_hash_0 =
+  hash initial_nonce_0
+
+let deterministic_seed seed = nonce seed zero_bytes
+
+let initial_seeds n =
+  let rec loop acc elt i =
+    if Compare.Int.(i = 1) then
+      List.rev (elt :: acc)
+    else
+      loop
+        (elt :: acc)
+        (deterministic_seed elt)
+        (i-1) in
+  loop [] (B (State_hash.hash_bytes [])) n
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.mli
new file mode 100644
index 000000000..ae9827c8e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_repr.mli
@@ -0,0 +1,99 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Random number generation
+
+    This is not expected to be a good cryptographic random number
+    generator. In particular this is supposed to be used in situations
+    where the seed is a globaly known information.
+
+    The only expected property is: It should be difficult to find a
+    seed such that the generated sequence is a given one. *)
+
+
+(** {2 Random Generation} ****************************************************)
+
+(** The state of the random number generator *)
+type t
+
+(** A random seed, to derive random sequences from *)
+type seed
+
+(** A random sequence, to derive random values from *)
+type sequence
+
+(** [initialize_new state ident] returns a new generator *)
+val initialize_new : seed -> MBytes.t list -> t
+
+(** [sequence state n] prepares the n-th sequence of a state  *)
+val sequence : t -> int32 -> sequence
+
+(** Generates the next random value in the sequence *)
+val take : sequence -> MBytes.t * sequence
+
+(** Generates the next random value as a bounded [int32] *)
+val take_int32 : sequence -> int32 -> int32 * sequence
+
+(** {2 Predefined seeds} *****************************************************)
+
+val empty : seed
+
+(** Returns a new seed by hashing the one passed with a constant. *)
+val deterministic_seed : seed -> seed
+
+(** [intial_seeds n] generates the first [n] seeds for which there are no nonces.
+    The first seed is a constant value. The kth seed is the hash of seed (k-1)
+    concatenated with a constant. *)
+val initial_seeds : int -> seed list
+
+(** {2 Entropy} **************************************************************)
+
+(** A nonce for adding entropy to the generator *)
+type nonce
+
+(** Add entropy to the seed generator *)
+val nonce : seed -> nonce -> seed
+
+(** Use a byte sequence as a nonce *)
+val make_nonce : MBytes.t -> nonce tzresult
+
+(** Compute the has of a nonce *)
+val hash : nonce -> Nonce_hash.t
+
+(** [check_hash nonce hash] is true if the nonce correspond to the hash *)
+val check_hash : nonce -> Nonce_hash.t -> bool
+
+(** For using nonce hashes as keys in the hierarchical database *)
+val nonce_hash_key_part : Nonce_hash.t -> string list -> string list
+
+(** {2 Predefined nonce} *****************************************************)
+
+val initial_nonce_0 : nonce
+val initial_nonce_hash_0 : Nonce_hash.t
+
+(** {2 Serializers} **********************************************************)
+
+val nonce_encoding  : nonce Data_encoding.t
+val seed_encoding : seed Data_encoding.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.ml
new file mode 100644
index 000000000..6f855b652
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.ml
@@ -0,0 +1,124 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Misc
+
+type error +=
+  | Unknown of { oldest : Cycle_repr.t ;
+                 cycle : Cycle_repr.t ;
+                 latest : Cycle_repr.t } (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"seed.unknown_seed"
+    ~title:"Unknown seed"
+    ~description:"The requested seed is not available"
+    ~pp:(fun ppf (oldest, cycle, latest) ->
+        if Cycle_repr.(cycle < oldest) then
+          Format.fprintf ppf
+            "The seed for cycle %a has been cleared from the context \
+            \ (oldest known seed is for cycle %a)"
+            Cycle_repr.pp cycle
+            Cycle_repr.pp oldest
+        else
+          Format.fprintf ppf
+            "The seed for cycle %a has not been computed yet \
+            \ (latest known seed is for cycle %a)"
+            Cycle_repr.pp cycle
+            Cycle_repr.pp latest)
+    Data_encoding.(obj3
+                     (req "oldest" Cycle_repr.encoding)
+                     (req "requested" Cycle_repr.encoding)
+                     (req "latest" Cycle_repr.encoding))
+    (function
+      | Unknown { oldest ; cycle ; latest } -> Some (oldest, cycle, latest)
+      | _ -> None)
+    (fun (oldest, cycle, latest) -> Unknown { oldest ; cycle ; latest })
+
+let compute_for_cycle c ~revealed cycle =
+  match Cycle_repr.pred cycle with
+  | None -> assert false (* should not happen *)
+  | Some previous_cycle ->
+      let levels = Level_storage.levels_with_commitments_in_cycle c revealed in
+      let combine (c, random_seed, unrevealed) level =
+        Storage.Seed.Nonce.get c level >>=? function
+        | Revealed nonce ->
+            Storage.Seed.Nonce.delete c level >>=? fun c ->
+            return (c, Seed_repr.nonce random_seed nonce, unrevealed)
+        | Unrevealed u ->
+            Storage.Seed.Nonce.delete c level >>=? fun c ->
+            return (c, random_seed, u :: unrevealed)
+      in
+      Storage.Seed.For_cycle.get c previous_cycle >>=? fun prev_seed ->
+      let seed = Seed_repr.deterministic_seed prev_seed in
+      fold_left_s combine (c, seed, []) levels >>=? fun (c, seed, unrevealed) ->
+      Storage.Seed.For_cycle.init c cycle seed >>=? fun c ->
+      return (c, unrevealed)
+
+let for_cycle ctxt cycle =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  let current_level = Level_storage.current ctxt in
+  let current_cycle = current_level.cycle in
+  let latest =
+    if Cycle_repr.(current_cycle = root) then
+      Cycle_repr.add current_cycle (preserved + 1)
+    else
+      Cycle_repr.add current_cycle preserved in
+  let oldest =
+    match Cycle_repr.sub current_cycle preserved with
+    | None -> Cycle_repr.root
+    | Some oldest -> oldest in
+  fail_unless Cycle_repr.(oldest <= cycle && cycle <= latest)
+    (Unknown { oldest ; cycle ; latest }) >>=? fun () ->
+  Storage.Seed.For_cycle.get ctxt cycle
+
+let clear_cycle c cycle =
+  Storage.Seed.For_cycle.delete c cycle
+
+let init ctxt =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  List.fold_left2
+    (fun ctxt c seed ->
+       ctxt >>=? fun ctxt ->
+       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
+       Storage.Seed.For_cycle.init ctxt cycle seed)
+    (return ctxt)
+    (0 --> (preserved+1))
+    (Seed_repr.initial_seeds (preserved+2))
+
+let cycle_end ctxt last_cycle =
+  let preserved = Constants_storage.preserved_cycles ctxt in
+  begin
+    match Cycle_repr.sub last_cycle preserved with
+    | None -> return ctxt
+    | Some cleared_cycle ->
+        clear_cycle ctxt cleared_cycle
+  end >>=? fun ctxt ->
+  match Cycle_repr.pred last_cycle with
+  | None -> return (ctxt, [])
+  | Some revealed -> (* cycle with revelations *)
+      let inited_seed_cycle = Cycle_repr.add last_cycle (preserved+1) in
+      compute_for_cycle ctxt ~revealed inited_seed_cycle
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.mli
new file mode 100644
index 000000000..2a1fd25a0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/seed_storage.mli
@@ -0,0 +1,44 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error +=
+  | Unknown of { oldest : Cycle_repr.t ;
+                 cycle : Cycle_repr.t ;
+                 latest : Cycle_repr.t } (* `Permanent *)
+
+(** Generates the first [preserved_cycles+2] seeds for which
+    there are no nonces. *)
+val init:
+  Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val for_cycle:
+  Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t
+
+(** If it is the end of the cycle, computes and stores the seed of cycle at
+    distance [preserved_cycle+2] in the future using the seed of the previous
+    cycle and the revelations of the current one.  *)
+val cycle_end:
+  Raw_context.t -> Cycle_repr.t ->
+  (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/services_registration.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/services_registration.ml
new file mode 100644
index 000000000..120afb9cf
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/services_registration.ml
@@ -0,0 +1,94 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+type rpc_context = {
+  block_hash: Block_hash.t ;
+  block_header: Block_header.shell_header ;
+  context: Alpha_context.t ;
+}
+
+let rpc_init ({ block_hash ; block_header ; context } : Updater.rpc_context) =
+  let level = block_header.level in
+  let timestamp = block_header.timestamp in
+  let fitness = block_header.fitness in
+  Alpha_context.prepare ~level ~timestamp ~fitness context >>=? fun context ->
+  return { block_hash ; block_header ; context }
+
+let rpc_services = ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)
+
+let register0_fullctxt s f =
+  rpc_services :=
+    RPC_directory.register !rpc_services s
+      (fun ctxt q i ->
+         rpc_init ctxt >>=? fun ctxt ->
+         f ctxt q i)
+let opt_register0_fullctxt s f =
+  rpc_services :=
+    RPC_directory.opt_register !rpc_services s
+      (fun ctxt q i ->
+         rpc_init ctxt >>=? fun ctxt ->
+         f ctxt q i)
+let register0 s f =
+  register0_fullctxt s (fun { context ; _ } -> f context)
+let register0_noctxt s f =
+  rpc_services :=
+    RPC_directory.register !rpc_services s
+      (fun _ q i -> f q i)
+
+let register1_fullctxt s f =
+  rpc_services :=
+    RPC_directory.register !rpc_services s
+      (fun (ctxt, arg) q i ->
+         rpc_init ctxt >>=? fun ctxt ->
+         f ctxt arg q i)
+let register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)
+let register1_noctxt s f =
+  rpc_services :=
+    RPC_directory.register !rpc_services s
+      (fun (_, arg) q i -> f arg q i)
+
+let register2_fullctxt s f =
+  rpc_services :=
+    RPC_directory.register !rpc_services s
+      (fun ((ctxt, arg1), arg2) q i ->
+         rpc_init ctxt >>=? fun ctxt ->
+         f ctxt arg1 arg2 q i)
+let register2 s f =
+  register2_fullctxt s (fun { context ; _ } a1 a2 q i -> f context a1 a2 q i)
+
+let get_rpc_services () =
+  let p =
+    RPC_directory.map
+      (fun c ->
+         rpc_init c >>= function
+         | Error _ -> assert false
+         | Ok c -> Lwt.return c.context)
+      (Storage_description.build_directory Alpha_context.description) in
+  RPC_directory.register_dynamic_directory
+    !rpc_services
+    RPC_path.(open_root / "context" / "raw" / "json")
+    (fun _ -> Lwt.return p)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/state_hash.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/state_hash.ml
new file mode 100644
index 000000000..ac240a4ad
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/state_hash.ml
@@ -0,0 +1,37 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 random_state_hash = "\076\064\204" (* rng(53): never used... *)
+
+include Blake2B.Make(Base58)(struct
+    let name = "random"
+    let title = "A random generation state"
+    let b58check_prefix = random_state_hash
+    let size = None
+  end)
+
+let () =
+  Base58.check_encoded_prefix b58check_encoding "rng" 53
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.ml
new file mode 100644
index 000000000..dd859e0af
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.ml
@@ -0,0 +1,656 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Storage_functors
+
+module Int = struct
+  type t = int
+  let encoding = Data_encoding.uint16
+end
+
+module Int32 = struct
+  type t = Int32.t
+  let encoding = Data_encoding.int32
+end
+
+module Z = struct
+  type t = Z.t
+  let encoding = Data_encoding.z
+end
+
+module Int_index = struct
+  type t = int
+  let path_length = 1
+  let to_path c l = string_of_int c :: l
+  let of_path = function
+    | [] | _ :: _ :: _ -> None
+    | [ c ] -> int_of_string_opt c
+  type 'a ipath = 'a * t
+  let args = Storage_description.One {
+      rpc_arg = RPC_arg.int ;
+      encoding = Data_encoding.int31 ;
+      compare = Compare.Int.compare ;
+    }
+end
+
+module Make_index(H : Storage_description.INDEX)
+  : INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct
+  include H
+  type 'a ipath = 'a * t
+  let args = Storage_description.One {
+      rpc_arg ;
+      encoding ;
+      compare ;
+    }
+end
+
+module Last_block_priority =
+  Make_single_data_storage
+    (Raw_context)
+    (struct let name = ["last_block_priority"] end)
+    (Int)
+
+(** Contracts handling *)
+
+module Contract = struct
+
+  module Raw_context =
+    Make_subcontext(Raw_context)(struct let name = ["contracts"] end)
+
+  module Global_counter =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["global_counter"] end)
+      (Z)
+
+  module Indexed_context =
+    Make_indexed_subcontext
+      (Make_subcontext(Raw_context)(struct let name = ["index"] end))
+      (Make_index(Contract_repr.Index))
+
+  let fold = Indexed_context.fold_keys
+  let list = Indexed_context.keys
+
+  module Balance =
+    Indexed_context.Make_map
+      (struct let name = ["balance"] end)
+      (Tez_repr)
+
+  module Frozen_balance_index =
+    Make_indexed_subcontext
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["frozen_balance"] end))
+      (Make_index(Cycle_repr.Index))
+
+  module Frozen_deposits =
+    Frozen_balance_index.Make_map
+      (struct let name = ["deposits"] end)
+      (Tez_repr)
+
+  module Frozen_fees =
+    Frozen_balance_index.Make_map
+      (struct let name = ["fees"] end)
+      (Tez_repr)
+
+  module Frozen_rewards =
+    Frozen_balance_index.Make_map
+      (struct let name = ["rewards"] end)
+      (Tez_repr)
+
+  module Manager =
+    Indexed_context.Make_map
+      (struct let name = ["manager"] end)
+      (Manager_repr)
+
+  module Spendable =
+    Indexed_context.Make_set
+      (struct let name = ["spendable"] end)
+
+  module Delegatable =
+    Indexed_context.Make_set
+      (struct let name = ["delegatable"] end)
+
+  module Delegate =
+    Indexed_context.Make_map
+      (struct let name = ["delegate"] end)
+      (Signature.Public_key_hash)
+
+  module Inactive_delegate =
+    Indexed_context.Make_set
+      (struct let name = ["inactive_delegate"] end)
+
+  module Delegate_desactivation =
+    Indexed_context.Make_map
+      (struct let name = ["delegate_desactivation"] end)
+      (Cycle_repr)
+
+  module Delegated =
+    Make_data_set_storage
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["delegated"] end))
+      (Make_index(Contract_hash))
+
+  module Counter =
+    Indexed_context.Make_map
+      (struct let name = ["counter"] end)
+      (Z)
+
+  (* Consume gas for serilization and deserialization of expr in this
+     module *)
+  module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct
+    module I = Indexed_context.Make_carbonated_map
+        (N)
+        (struct
+          type t = Script_repr.lazy_expr
+          let encoding = Script_repr.lazy_expr_encoding
+        end)
+
+    type context = I.context
+    type key = I.key
+    type value = I.value
+
+    let mem = I.mem
+    let delete = I.delete
+    let remove = I.remove
+
+    let consume_deserialize_gas ctxt value =
+      Lwt.return @@
+      (Raw_context.check_enough_gas ctxt (Script_repr.minimal_deserialize_cost value) >>? fun () ->
+       Script_repr.force_decode value >>? fun (_value, value_cost) ->
+       Raw_context.consume_gas ctxt value_cost)
+
+    let consume_serialize_gas ctxt value =
+      Lwt.return @@
+      (Script_repr.force_bytes value >>? fun (_value, value_cost) ->
+       Raw_context.consume_gas ctxt value_cost)
+
+    let get ctxt contract =
+      I.get ctxt contract >>=? fun (ctxt, value) ->
+      consume_deserialize_gas ctxt value >>|? fun ctxt ->
+      (ctxt, value)
+
+    let get_option ctxt contract =
+      I.get_option ctxt contract >>=? fun (ctxt, value_opt) ->
+      match value_opt with
+      | None -> return (ctxt, None)
+      | Some value ->
+          consume_deserialize_gas ctxt value >>|? fun ctxt ->
+          (ctxt, value_opt)
+
+    let set ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      I.set ctxt contract value
+
+    let set_option ctxt contract value_opt =
+      match value_opt with
+      | None -> I.set_option ctxt contract None
+      | Some value ->
+          consume_serialize_gas ctxt value >>=? fun ctxt ->
+          I.set_option ctxt contract value_opt
+
+    let init ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      I.init ctxt contract value
+
+    let init_set ctxt contract value =
+      consume_serialize_gas ctxt value >>=? fun ctxt ->
+      I.init_set ctxt contract value
+  end
+
+  module Code =
+    Make_carbonated_map_expr
+      (struct let name = ["code"] end)
+
+  module Storage =
+    Make_carbonated_map_expr
+      (struct let name = ["storage"] end)
+
+  type bigmap_key = Raw_context.t * Contract_repr.t
+
+  (* Consume gas for serilization and deserialization of expr in this
+     module *)
+  module Big_map = struct
+    module I = Storage_functors.Make_indexed_carbonated_data_storage
+        (Make_subcontext
+           (Indexed_context.Raw_context)
+           (struct let name = ["big_map"] end))
+        (Make_index(Script_expr_hash))
+        (struct
+          type t = Script_repr.expr
+          let encoding = Script_repr.expr_encoding
+        end)
+
+    type context = I.context
+    type key = I.key
+    type value = I.value
+
+    let mem = I.mem
+    let delete = I.delete
+    let remove = I.remove
+    let set = I.set
+    let set_option = I.set_option
+    let init = I.init
+    let init_set = I.init_set
+
+    let consume_deserialize_gas ctxt value =
+      Lwt.return @@
+      Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)
+
+    let get ctxt contract =
+      I.get ctxt contract >>=? fun (ctxt, value) ->
+      consume_deserialize_gas ctxt value >>|? fun ctxt ->
+      (ctxt, value)
+
+    let get_option ctxt contract =
+      I.get_option ctxt contract >>=? fun (ctxt, value_opt) ->
+      match value_opt with
+      | None -> return (ctxt, None)
+      | Some value ->
+          consume_deserialize_gas ctxt value >>|? fun ctxt ->
+          (ctxt, value_opt)
+  end
+
+  module Paid_storage_space =
+    Indexed_context.Make_map
+      (struct let name = ["paid_bytes"] end)
+      (Z)
+
+  module Used_storage_space =
+    Indexed_context.Make_map
+      (struct let name = ["used_bytes"] end)
+      (Z)
+
+  module Roll_list =
+    Indexed_context.Make_map
+      (struct let name = ["roll_list"] end)
+      (Roll_repr)
+
+  module Change =
+    Indexed_context.Make_map
+      (struct let name = ["change"] end)
+      (Tez_repr)
+
+end
+
+module Delegates =
+  Make_data_set_storage
+    (Make_subcontext(Raw_context)(struct let name = ["delegates"] end))
+    (Make_index(Signature.Public_key_hash))
+
+module Active_delegates_with_rolls =
+  Make_data_set_storage
+    (Make_subcontext(Raw_context)(struct let name = ["active_delegates_with_rolls"] end))
+    (Make_index(Signature.Public_key_hash))
+
+module Delegates_with_frozen_balance_index =
+  Make_indexed_subcontext
+    (Make_subcontext(Raw_context)
+       (struct let name = ["delegates_with_frozen_balance"] end))
+    (Make_index(Cycle_repr.Index))
+
+module Delegates_with_frozen_balance =
+  Make_data_set_storage
+    (Delegates_with_frozen_balance_index.Raw_context)
+    (Make_index(Signature.Public_key_hash))
+
+(** Rolls *)
+
+module Cycle = struct
+
+  module Indexed_context =
+    Make_indexed_subcontext
+      (Make_subcontext(Raw_context)(struct let name = ["cycle"] end))
+      (Make_index(Cycle_repr.Index))
+
+  module Last_roll =
+    Make_indexed_data_storage
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["last_roll"] end))
+      (Int_index)
+      (Roll_repr)
+
+  module Roll_snapshot =
+    Indexed_context.Make_map
+      (struct let name = ["roll_snapshot"] end)
+      (Int)
+
+  type unrevealed_nonce = {
+    nonce_hash: Nonce_hash.t ;
+    delegate: Signature.Public_key_hash.t ;
+    rewards: Tez_repr.t ;
+    fees: Tez_repr.t ;
+  }
+
+  type nonce_status =
+    | Unrevealed of unrevealed_nonce
+    | Revealed of Seed_repr.nonce
+
+  let nonce_status_encoding =
+    let open Data_encoding in
+    union [
+      case (Tag 0)
+        ~title:"Unrevealed"
+        (tup4
+           Nonce_hash.encoding
+           Signature.Public_key_hash.encoding
+           Tez_repr.encoding
+           Tez_repr.encoding)
+        (function
+          | Unrevealed { nonce_hash ; delegate ; rewards ; fees } ->
+              Some (nonce_hash, delegate, rewards, fees)
+          | _ -> None)
+        (fun (nonce_hash, delegate, rewards, fees) ->
+           Unrevealed { nonce_hash ; delegate ; rewards ; fees }) ;
+      case (Tag 1)
+        ~title:"Revealed"
+        Seed_repr.nonce_encoding
+        (function
+          | Revealed nonce -> Some nonce
+          | _ -> None)
+        (fun nonce -> Revealed nonce)
+    ]
+
+  module Nonce =
+    Make_indexed_data_storage
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["nonces"] end))
+      (Make_index(Raw_level_repr.Index))
+      (struct
+        type t = nonce_status
+        let encoding = nonce_status_encoding
+      end)
+
+  module Seed =
+    Indexed_context.Make_map
+      (struct let name = ["random_seed"] end)
+      (struct
+        type t = Seed_repr.seed
+        let encoding = Seed_repr.seed_encoding
+      end)
+
+end
+
+module Roll = struct
+
+  module Raw_context =
+    Make_subcontext(Raw_context)(struct let name = ["rolls"] end)
+
+  module Indexed_context =
+    Make_indexed_subcontext
+      (Make_subcontext(Raw_context)(struct let name = ["index"] end))
+      (Make_index(Roll_repr.Index))
+
+  module Next =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["next"] end)
+      (Roll_repr)
+
+  module Limbo =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["limbo"] end)
+      (Roll_repr)
+
+  module Delegate_roll_list =
+    Wrap_indexed_data_storage(Contract.Roll_list)(struct
+      type t = Signature.Public_key_hash.t
+      let wrap = Contract_repr.implicit_contract
+      let unwrap = Contract_repr.is_implicit
+    end)
+
+  module Successor =
+    Indexed_context.Make_map
+      (struct let name = ["successor"] end)
+      (Roll_repr)
+
+  module Delegate_change =
+    Wrap_indexed_data_storage(Contract.Change)(struct
+      type t = Signature.Public_key_hash.t
+      let wrap = Contract_repr.implicit_contract
+      let unwrap = Contract_repr.is_implicit
+    end)
+
+  module Snapshoted_owner_index = struct
+    type t = Cycle_repr.t * int
+    let path_length = Cycle_repr.Index.path_length + 1
+    let to_path (c, n) s =
+      Cycle_repr.Index.to_path c (string_of_int n :: s)
+    let of_path l =
+      match Misc.take Cycle_repr.Index.path_length l with
+      | None | Some (_, ([] | _ :: _ :: _ ))-> None
+      | Some (l1, [l2]) ->
+          match Cycle_repr.Index.of_path l1, int_of_string_opt l2 with
+          | None, _ | _, None -> None
+          | Some c, Some i -> Some (c, i)
+
+    type 'a ipath = ('a * Cycle_repr.t) * int
+    let left_args =
+      Storage_description.One {
+        rpc_arg = Cycle_repr.rpc_arg ;
+        encoding = Cycle_repr.encoding ;
+        compare = Cycle_repr.compare
+      }
+    let right_args =
+      Storage_description.One {
+        rpc_arg = RPC_arg.int ;
+        encoding = Data_encoding.int31 ;
+        compare = Compare.Int.compare ;
+      }
+    let args =
+      Storage_description.(Pair (left_args, right_args))
+  end
+
+  module Owner =
+    Make_indexed_data_snapshotable_storage
+      (Make_subcontext(Raw_context)(struct let name = ["owner"] end))
+      (Snapshoted_owner_index)
+      (Make_index(Roll_repr.Index))
+      (Signature.Public_key)
+
+  module Snapshot_for_cycle = Cycle.Roll_snapshot
+  module Last_for_snapshot = Cycle.Last_roll
+
+  let clear = Indexed_context.clear
+
+end
+
+(** Votes **)
+
+module Vote = struct
+
+  module Raw_context =
+    Make_subcontext(Raw_context)(struct let name = ["votes"] end)
+
+  module Current_period_kind =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["current_period_kind"] end)
+      (struct
+        type t = Voting_period_repr.kind
+        let encoding = Voting_period_repr.kind_encoding
+      end)
+
+  module Current_quorum =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["current_quorum"] end)
+      (Int32)
+
+  module Current_proposal =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["current_proposal"] end)
+      (Protocol_hash)
+
+  module Listings_size =
+    Make_single_data_storage
+      (Raw_context)
+      (struct let name = ["listings_size"] end)
+      (Int32)
+
+  module Listings =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)(struct let name = ["listings"] end))
+      (Make_index(Signature.Public_key_hash))
+      (Int32)
+
+  module Proposals =
+    Make_data_set_storage
+      (Make_subcontext(Raw_context)(struct let name = ["proposals"] end))
+      (Pair(Make_index(Protocol_hash))(Make_index(Signature.Public_key_hash)))
+
+  module Proposals_count =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)
+         (struct let name = ["proposals_count"] end))
+      (Make_index(Signature.Public_key_hash))
+      (Int)
+
+  module Ballots =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)(struct let name = ["ballots"] end))
+      (Make_index(Signature.Public_key_hash))
+      (struct
+        type t = Vote_repr.ballot
+        let encoding = Vote_repr.ballot_encoding
+      end)
+
+end
+
+(** Seed *)
+
+module Seed = struct
+
+  type unrevealed_nonce = Cycle.unrevealed_nonce = {
+    nonce_hash: Nonce_hash.t ;
+    delegate: Signature.Public_key_hash.t ;
+    rewards: Tez_repr.t ;
+    fees: Tez_repr.t ;
+  }
+
+  type nonce_status = Cycle.nonce_status =
+    | Unrevealed of unrevealed_nonce
+    | Revealed of Seed_repr.nonce
+
+  module Nonce = struct
+    open Level_repr
+    type context = Raw_context.t
+    let mem ctxt l = Cycle.Nonce.mem (ctxt, l.cycle) l.level
+    let get ctxt l = Cycle.Nonce.get (ctxt, l.cycle) l.level
+    let get_option ctxt l = Cycle.Nonce.get_option (ctxt, l.cycle) l.level
+    let set ctxt l v = Cycle.Nonce.set (ctxt, l.cycle) l.level v
+    let init ctxt l v = Cycle.Nonce.init (ctxt, l.cycle) l.level v
+    let init_set ctxt l v = Cycle.Nonce.init_set (ctxt, l.cycle) l.level v
+    let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v
+    let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level
+    let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level
+  end
+  module For_cycle = Cycle.Seed
+
+end
+
+(** Commitments *)
+
+module Commitments =
+  Make_indexed_data_storage
+    (Make_subcontext(Raw_context)(struct let name = ["commitments"] end))
+    (Make_index(Blinded_public_key_hash.Index))
+    (Tez_repr)
+
+(** Ramp up security deposits... *)
+
+module Ramp_up = struct
+
+  module Rewards =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "rewards"] end))
+      (Make_index(Cycle_repr.Index))
+      (struct
+        type t = Tez_repr.t * Tez_repr.t
+        let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
+      end)
+
+  module Security_deposits =
+    Make_indexed_data_storage
+      (Make_subcontext(Raw_context)(struct let name = ["ramp_up"; "deposits"] end))
+      (Make_index(Cycle_repr.Index))
+      (struct
+        type t = Tez_repr.t * Tez_repr.t
+        let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
+      end)
+
+end
+
+(** Resolver *)
+
+let () =
+  Raw_context.register_resolvers
+    Contract_hash.b58check_encoding
+    (fun ctxt p ->
+       let p = Contract_repr.Index.contract_prefix p in
+       Contract.Indexed_context.resolve ctxt p >|= fun l ->
+       List.map
+         (function
+           | Contract_repr.Implicit _ -> assert false
+           | Contract_repr.Originated s -> s)
+         l) ;
+  Raw_context.register_resolvers
+    Ed25519.Public_key_hash.b58check_encoding
+    (fun ctxt p ->
+       let p = Contract_repr.Index.pkh_prefix_ed25519 p in
+       Contract.Indexed_context.resolve ctxt p >|= fun l ->
+       List.map
+         (function
+           | Contract_repr.Implicit (Ed25519 pkh) -> pkh
+           | Contract_repr.Implicit _ -> assert false
+           | Contract_repr.Originated _ -> assert false)
+         l) ;
+  Raw_context.register_resolvers
+    Secp256k1.Public_key_hash.b58check_encoding
+    (fun ctxt p ->
+       let p = Contract_repr.Index.pkh_prefix_secp256k1 p in
+       Contract.Indexed_context.resolve ctxt p >|= fun l ->
+       List.map
+         (function
+           | Contract_repr.Implicit (Secp256k1 pkh) -> pkh
+           | Contract_repr.Implicit _ -> assert false
+           | Contract_repr.Originated _ -> assert false)
+         l) ;
+  Raw_context.register_resolvers
+    P256.Public_key_hash.b58check_encoding
+    (fun ctxt p ->
+       let p = Contract_repr.Index.pkh_prefix_p256 p in
+       Contract.Indexed_context.resolve ctxt p >|= fun l ->
+       List.map
+         (function
+           | Contract_repr.Implicit (P256 pkh) -> pkh
+           | Contract_repr.Implicit _ -> assert false
+           | Contract_repr.Originated _ -> assert false)
+         l)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.mli
new file mode 100644
index 000000000..809d5cf17
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage.mli
@@ -0,0 +1,324 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Typed storage
+
+    This module hides the hierarchical (key x value) database under
+    pre-allocated typed accessors for all persistent entities of the
+    tezos context.
+
+    This interface enforces no invariant on the contents of the
+    database. Its goal is to centralize all accessors in order to have
+    a complete view over the database contents and avoid key
+    collisions. *)
+
+open Storage_sigs
+
+module Last_block_priority : sig
+  val get : Raw_context.t -> int tzresult Lwt.t
+  val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
+  val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
+end
+
+module Roll : sig
+
+  (** Storage from this submodule must only be accessed through the
+      module `Roll`. *)
+
+  module Owner : Indexed_data_snapshotable_storage
+    with type key = Roll_repr.t
+     and type snapshot = (Cycle_repr.t * int)
+     and type value = Signature.Public_key.t
+     and type t := Raw_context.t
+
+  val clear: Raw_context.t -> Raw_context.t Lwt.t
+
+  (** The next roll to be allocated. *)
+  module Next : Single_data_storage
+    with type value = Roll_repr.t
+     and type t := Raw_context.t
+
+  (** Rolls linked lists represent both account owned and free rolls.
+      All rolls belongs either to the limbo list or to an owned list. *)
+
+  (** Head of the linked list of rolls in limbo *)
+  module Limbo : Single_data_storage
+    with type value = Roll_repr.t
+     and type t := Raw_context.t
+
+  (** Rolls associated to contracts, a linked list per contract *)
+  module Delegate_roll_list : Indexed_data_storage
+    with type key = Signature.Public_key_hash.t
+     and type value = Roll_repr.t
+     and type t := Raw_context.t
+
+  (** Use this to iter on a linked list of rolls *)
+  module Successor : Indexed_data_storage
+    with type key = Roll_repr.t
+     and type value = Roll_repr.t
+     and type t := Raw_context.t
+
+  (** The tez of a contract that are not assigned to rolls *)
+  module Delegate_change : Indexed_data_storage
+    with type key = Signature.Public_key_hash.t
+     and type value = Tez_repr.t
+     and type t := Raw_context.t
+
+  (** Index of the randomly selected roll snapshot of a given cycle. *)
+  module Snapshot_for_cycle : Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = int
+     and type t := Raw_context.t
+
+  (** Last roll in the snapshoted roll allocation of a given cycle. *)
+  module Last_for_snapshot : Indexed_data_storage
+    with type key = int
+     and type value = Roll_repr.t
+     and type t = Raw_context.t * Cycle_repr.t
+
+end
+
+module Contract : sig
+
+  (** Storage from this submodule must only be accessed through the
+      module `Contract`. *)
+
+  module Global_counter : sig
+    val get : Raw_context.t -> Z.t tzresult Lwt.t
+    val set : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t
+    val init : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t
+  end
+
+  (** The domain of alive contracts *)
+  val fold :
+    Raw_context.t ->
+    init:'a -> f:(Contract_repr.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  val list : Raw_context.t -> Contract_repr.t list Lwt.t
+
+  (** All the tez possesed by a contract, including rolls and change *)
+  module Balance : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Tez_repr.t
+     and type t := Raw_context.t
+
+  (** Frozen balance, see 'delegate_storage.mli' for more explanation.
+      Always update `Delegates_with_frozen_balance` accordingly. *)
+  module Frozen_deposits : Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t
+     and type t = Raw_context.t * Contract_repr.t
+
+  module Frozen_fees : Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t
+     and type t = Raw_context.t * Contract_repr.t
+
+  module Frozen_rewards : Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t
+     and type t = Raw_context.t * Contract_repr.t
+
+  (** The manager of a contract *)
+  module Manager : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Manager_repr.t
+     and type t := Raw_context.t
+
+  (** The delegate of a contract, if any. *)
+  module Delegate : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Signature.Public_key_hash.t
+     and type t := Raw_context.t
+
+  module Delegated : Data_set_storage
+    with type elt = Contract_hash.t
+     and type t = Raw_context.t * Contract_repr.t
+
+  module Inactive_delegate : Data_set_storage
+    with type elt = Contract_repr.t
+     and type t = Raw_context.t
+
+  (** The cycle where the delegate should be desactivated. *)
+  module Delegate_desactivation : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Cycle_repr.t
+     and type t := Raw_context.t
+
+  module Spendable : Data_set_storage
+    with type elt = Contract_repr.t
+     and type t := Raw_context.t
+
+  module Delegatable : Data_set_storage
+    with type elt = Contract_repr.t
+     and type t := Raw_context.t
+
+  module Counter : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Z.t
+     and type t := Raw_context.t
+
+  module Code : Non_iterable_indexed_carbonated_data_storage
+    with type key = Contract_repr.t
+     and type value = Script_repr.lazy_expr
+     and type t := Raw_context.t
+
+  module Storage : Non_iterable_indexed_carbonated_data_storage
+    with type key = Contract_repr.t
+     and type value = Script_repr.lazy_expr
+     and type t := Raw_context.t
+
+  (** Current storage space in bytes.
+      Includes code, global storage and big map elements. *)
+  module Used_storage_space : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Z.t
+     and type t := Raw_context.t
+
+  (** Maximal space available without needing to burn new fees. *)
+  module Paid_storage_space : Indexed_data_storage
+    with type key = Contract_repr.t
+     and type value = Z.t
+     and type t := Raw_context.t
+
+  type bigmap_key = Raw_context.t * Contract_repr.t
+
+  module Big_map : Non_iterable_indexed_carbonated_data_storage
+    with type key = Script_expr_hash.t
+     and type value = Script_repr.expr
+     and type t := bigmap_key
+
+end
+
+(** Set of all registered delegates. *)
+module Delegates : Data_set_storage
+  with type t := Raw_context.t
+   and type elt = Signature.Public_key_hash.t
+
+(** Set of all active delegates with rolls. *)
+module Active_delegates_with_rolls : Data_set_storage
+  with type t := Raw_context.t
+   and type elt = Signature.Public_key_hash.t
+
+(** Set of all the delegates with frozen rewards/bonds/fees for a given cycle. *)
+module Delegates_with_frozen_balance : Data_set_storage
+  with type t = Raw_context.t * Cycle_repr.t
+   and type elt = Signature.Public_key_hash.t
+
+(** Votes *)
+
+module Vote : sig
+
+  module Current_period_kind : Single_data_storage
+    with type value = Voting_period_repr.kind
+     and type t := Raw_context.t
+
+  module Current_quorum : Single_data_storage
+    with type value = int32 (* in centile of percentage *)
+     and type t := Raw_context.t
+
+  module Current_proposal : Single_data_storage
+    with type value = Protocol_hash.t
+     and type t := Raw_context.t
+
+  module Listings_size : Single_data_storage
+    with type value = int32 (* total number of rolls in the listing. *)
+     and type t := Raw_context.t
+
+  module Listings : Indexed_data_storage
+    with type key = Signature.Public_key_hash.t
+     and type value = int32 (* number of rolls for the key. *)
+     and type t := Raw_context.t
+
+  module Proposals : Data_set_storage
+    with type elt = Protocol_hash.t * Signature.Public_key_hash.t
+     and type t := Raw_context.t
+
+  module Proposals_count : Indexed_data_storage
+    with type key = Signature.Public_key_hash.t
+     and type value = int
+     and type t := Raw_context.t
+
+  module Ballots : Indexed_data_storage
+    with type key = Signature.Public_key_hash.t
+     and type value = Vote_repr.ballot
+     and type t := Raw_context.t
+
+end
+
+(** Seed *)
+
+module Seed : sig
+
+  (** Storage from this submodule must only be accessed through the
+      module `Seed`. *)
+
+  type unrevealed_nonce = {
+    nonce_hash: Nonce_hash.t ;
+    delegate: Signature.Public_key_hash.t ;
+    rewards: Tez_repr.t ;
+    fees: Tez_repr.t ;
+  }
+
+  type nonce_status =
+    | Unrevealed of unrevealed_nonce
+    | Revealed of Seed_repr.nonce
+
+  module Nonce : Non_iterable_indexed_data_storage
+    with type key := Level_repr.t
+     and type value := nonce_status
+     and type t := Raw_context.t
+
+  module For_cycle : sig
+    val init : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed -> Raw_context.t tzresult Lwt.t
+    val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t
+    val delete : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
+  end
+
+end
+
+(** Commitments *)
+
+module Commitments : Indexed_data_storage
+  with type key = Blinded_public_key_hash.t
+   and type value = Tez_repr.t
+   and type t := Raw_context.t
+
+(** Ramp up security deposits... *)
+
+module Ramp_up : sig
+
+  module Rewards :
+    Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t * Tez_repr.t (* baking * endorsement *)
+     and type t := Raw_context.t
+
+  module Security_deposits :
+    Indexed_data_storage
+    with type key = Cycle_repr.t
+     and type value = Tez_repr.t * Tez_repr.t (* baking * endorsement *)
+     and type t := Raw_context.t
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.ml
new file mode 100644
index 000000000..96aef4fea
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.ml
@@ -0,0 +1,306 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module StringMap = Map.Make(String)
+
+type 'key t = 'key description ref
+
+and 'key description =
+  | Empty : 'key description
+  | Value : { get: 'key -> 'a option tzresult Lwt.t ;
+              encoding: 'a Data_encoding.t } -> 'key description
+  | NamedDir: 'key t StringMap.t -> 'key description
+  | IndexedDir: { arg: 'a RPC_arg.t ;
+                  arg_encoding: 'a Data_encoding.t ;
+                  list: 'key -> 'a list tzresult Lwt.t ;
+                  subdir: ('key * 'a) t }-> 'key description
+
+let rec register_named_subcontext : type r. r t -> string list -> r t =
+  fun dir names ->
+    match !dir, names with
+    | _, [] -> dir
+    | Value _, _ -> invalid_arg ""
+    | IndexedDir _, _ -> invalid_arg ""
+    | Empty, name :: names ->
+        let subdir = ref Empty in
+        dir := NamedDir (StringMap.singleton name subdir) ;
+        register_named_subcontext subdir names
+    | NamedDir map, name :: names ->
+        let subdir =
+          match StringMap.find_opt name map with
+          | Some subdir -> subdir
+          | None ->
+              let subdir = ref Empty in
+              dir := NamedDir (StringMap.add name subdir map) ;
+              subdir in
+        register_named_subcontext subdir names
+
+type (_, _, _) args =
+  | One : { rpc_arg: 'a RPC_arg.t ;
+            encoding: 'a Data_encoding.t ;
+            compare: 'a -> 'a -> int } -> ('key, 'a, 'key * 'a) args
+  | Pair : ('key, 'a, 'inter_key) args *
+           ('inter_key, 'b, 'sub_key) args -> ('key, 'a * 'b, 'sub_key) args
+
+let rec unpack : type a b c. (a, b, c) args -> c -> a * b = function
+  | One _ -> (fun x -> x)
+  | Pair (l, r) ->
+      let unpack_l = unpack l in
+      let unpack_r = unpack r in
+      fun x ->
+        let c, d = unpack_r x in
+        let b, a = unpack_l c in
+        (b, (a, d))
+
+let rec pack : type a b c. (a, b, c) args -> a -> b -> c = function
+  | One _ -> (fun b a -> (b, a))
+  | Pair (l, r) ->
+      let pack_l = pack l in
+      let pack_r = pack r in
+      fun b (a, d) ->
+        let c = pack_l b a in
+        pack_r c d
+
+let rec compare : type a b c. (a, b, c) args -> b -> b -> int = function
+  | One { compare ; _ } -> compare
+  | Pair (l, r) ->
+      let compare_l = compare l in
+      let compare_r = compare r in
+      fun (a1, b1) (a2, b2) ->
+        match compare_l a1 a2 with
+        | 0 -> compare_r b1 b2
+        | x -> x
+
+let destutter equal l =
+  match l with
+  | [] -> []
+  | (i, _) :: l ->
+      let rec loop acc i = function
+        | [] -> acc
+        | (j, _) :: l ->
+            if equal i j then loop acc i l
+            else loop (j :: acc) j l in
+      loop [i] i l
+
+let rec register_indexed_subcontext
+  : type r a b. r t -> list:(r -> a list tzresult Lwt.t) ->
+  (r, a, b) args -> b t =
+  fun dir ~list path ->
+    match path with
+    | Pair (left, right) ->
+        let compare_left = compare left in
+        let equal_left x y = Compare.Int.(compare_left x y = 0) in
+        let list_left r =
+          list r >>=? fun l ->
+          return (destutter equal_left l) in
+        let list_right r =
+          let a, k = unpack left r in
+          list a >>=? fun l ->
+          return
+            (List.map snd
+               (List.filter (fun (x, _) ->  equal_left x k) l)) in
+        register_indexed_subcontext
+          (register_indexed_subcontext dir ~list:list_left left)
+          ~list:list_right right
+    | One { rpc_arg = arg ; encoding = arg_encoding ; _ } ->
+        match !dir with
+        | Value _ -> invalid_arg ""
+        | NamedDir _ -> invalid_arg ""
+        | Empty ->
+            let subdir = ref Empty in
+            dir := IndexedDir { arg ; arg_encoding ; list ;  subdir };
+            subdir
+        | IndexedDir { arg = inner_arg ; subdir ; _ } ->
+            match RPC_arg.eq arg inner_arg with
+            | None -> invalid_arg ""
+            | Some RPC_arg.Eq -> subdir
+
+let register_value :
+  type a b. a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit =
+  fun dir ~get encoding ->
+    match !dir with
+    | Empty -> dir := Value { get ; encoding }
+    | _ -> invalid_arg ""
+
+let create () = ref Empty
+
+let rec pp : type a. Format.formatter -> a t -> unit = fun ppf dir ->
+  match !dir with
+  | Empty ->
+      Format.fprintf ppf "EMPTY"
+  | Value _e ->
+      Format.fprintf ppf "Value"
+  | NamedDir map ->
+      Format.fprintf ppf "@[<v>%a@]"
+        (Format.pp_print_list pp_item)
+        (StringMap.bindings map)
+  | IndexedDir { arg ; subdir ; _ } ->
+      let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in
+      pp_item ppf (name, subdir)
+
+and pp_item : type a. Format.formatter -> (string * a t) -> unit =
+  fun ppf (name, dir) ->
+    Format.fprintf ppf "@[<v 2>%s@ %a@]"
+      name
+      pp dir
+
+
+module type INDEX = sig
+  type t
+  val path_length: int
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  val rpc_arg: t RPC_arg.t
+  val encoding: t Data_encoding.t
+  val compare: t -> t -> int
+end
+
+type _ handler =
+    Handler :
+      { encoding: 'a Data_encoding.t ;
+        get: 'key -> int -> 'a tzresult Lwt.t } -> 'key handler
+
+type _ opt_handler =
+    Opt_handler :
+      { encoding: 'a Data_encoding.t ;
+        get: 'key -> int -> 'a option tzresult Lwt.t } -> 'key opt_handler
+
+let rec combine_object = function
+  | [] -> Handler { encoding = Data_encoding.unit ;
+                    get = fun _ _ -> return_unit }
+  | (name, Opt_handler handler) :: fields ->
+      let Handler handlers = combine_object fields in
+      Handler { encoding =
+                  Data_encoding.merge_objs
+                    Data_encoding.(obj1 (opt name (dynamic_size handler.encoding)))
+                    handlers.encoding ;
+                get = fun k i ->
+                  handler.get k i >>=? fun v1 ->
+                  handlers.get k i >>=? fun v2 ->
+                  return (v1, v2) }
+
+type query = {
+  depth: int ;
+}
+
+let depth_query =
+  let open RPC_query in
+  query (fun depth -> { depth })
+  |+ field "depth" RPC_arg.int 0 (fun t -> t.depth)
+  |> seal
+
+let build_directory : type key. key t -> key RPC_directory.t =
+  fun dir ->
+    let rpc_dir = ref (RPC_directory.empty : key RPC_directory.t) in
+    let register : type ikey. (key, ikey) RPC_path.t -> ikey opt_handler -> unit =
+      fun path (Opt_handler { encoding ; get }) ->
+        let service =
+          RPC_service.get_service
+            ~query: depth_query
+            ~output: encoding
+            path in
+        rpc_dir :=
+          RPC_directory.register !rpc_dir service begin
+            fun k q () ->
+              get k (q.depth + 1) >>=? function
+              | None -> raise Not_found
+              | Some x -> return x
+          end in
+    let rec build_handler : type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler =
+      fun dir path ->
+        match !dir with
+        | Empty -> Opt_handler { encoding = Data_encoding.unit ;
+                                 get = fun _ _ -> return_none }
+        | Value { get ; encoding } ->
+            let handler =
+              Opt_handler {
+                encoding ;
+                get =
+                  fun k i -> if Compare.Int.(i < 0) then return_none else get k
+              } in
+            register path handler ;
+            handler
+        | NamedDir map ->
+            let fields = StringMap.bindings map in
+            let fields =
+              List.map
+                (fun (name, dir) ->
+                   (name, build_handler dir RPC_path.(path / name)))
+                fields in
+            let Handler handler = combine_object fields in
+            let handler =
+              Opt_handler
+                { encoding = handler.encoding ;
+                  get = fun k i ->
+                    if Compare.Int.(i < 0) then
+                      return_none
+                    else
+                      handler.get k (i-1) >>=? fun v ->
+                      return_some v } in
+            register path handler ;
+            handler
+        | IndexedDir { arg ; arg_encoding ; list ; subdir } ->
+            let Opt_handler handler =
+              build_handler subdir RPC_path.(path /: arg) in
+            let encoding =
+              let open Data_encoding in
+              union [
+                case (Tag 0)
+                  ~title:"Leaf"
+                  (dynamic_size arg_encoding)
+                  (function (key, None) -> Some key | _ -> None)
+                  (fun key -> (key, None)) ;
+                case (Tag 1)
+                  ~title:"Dir"
+                  (tup2
+                     (dynamic_size arg_encoding)
+                     (dynamic_size handler.encoding))
+                  (function (key, Some value) -> Some (key, value) | _ -> None)
+                  (fun (key, value) -> (key, Some value)) ;
+              ] in
+            let get k i =
+              if Compare.Int.(i < 0) then return_none
+              else if Compare.Int.(i = 0) then return_some []
+              else
+                list k >>=? fun keys ->
+                map_p
+                  (fun key ->
+                     if Compare.Int.(i = 1) then
+                       return (key, None)
+                     else
+                       handler.get (k, key) (i-1) >>=? fun value ->
+                       return (key, value))
+                  keys >>=? fun values ->
+                return_some values in
+            let handler =
+              Opt_handler {
+                encoding = Data_encoding.(list (dynamic_size encoding)) ;
+                get ;
+              } in
+            register path handler ;
+            handler in
+    ignore (build_handler dir RPC_path.open_root : key opt_handler) ;
+    !rpc_dir
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.mli
new file mode 100644
index 000000000..2f6a59fd0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_description.mli
@@ -0,0 +1,82 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Typed description of the key-value context. *)
+type 'key t
+
+(** Trivial display of the key-value context layout. *)
+val pp: Format.formatter -> 'key t -> unit
+
+(** Export an RPC hierarchy for querying the context. There is one service
+    by possible path in the context. Services for "directory" are able to
+    aggregate in one JSON object the whole subtree. *)
+val build_directory: 'key t -> 'key RPC_directory.t
+
+(** Create a empty context description,
+    keys will be registred by side effects. *)
+val create: unit -> 'key t
+
+(** Register a single key accessor at a given path. *)
+val register_value:
+  'key t ->
+  get:('key -> 'a option tzresult Lwt.t) ->
+  'a Data_encoding.t -> unit
+
+(** Return a description for a prefixed fragment of the given context.
+    All keys registred in the subcontext will be shared by the external
+    context *)
+val register_named_subcontext: 'key t -> string list -> 'key t
+
+(** Description of an index as a sequence of `RPC_arg.t`. *)
+type (_, _, _) args =
+  | One : { rpc_arg: 'a RPC_arg.t ;
+            encoding: 'a Data_encoding.t ;
+            compare: 'a -> 'a -> int } -> ('key, 'a, 'key * 'a) args
+  | Pair : ('key, 'a, 'inter_key) args *
+           ('inter_key, 'b, 'sub_key) args -> ('key, 'a * 'b, 'sub_key) args
+
+(** Return a description for a indexed sub-context.
+    All keys registred in the subcontext will be shared by the external
+    context. One should provide a function to list all the registred
+    index in the context. *)
+val register_indexed_subcontext:
+  'key t ->
+  list:('key -> 'arg list tzresult Lwt.t) ->
+  ('key, 'arg, 'sub_key) args -> 'sub_key t
+
+(** Helpers for manipulating and defining indexes. *)
+
+val pack: ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key
+val unpack: ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a
+
+module type INDEX = sig
+  type t
+  val path_length: int
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  val rpc_arg: t RPC_arg.t
+  val encoding: t Data_encoding.t
+  val compare: t -> t -> int
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.ml
new file mode 100644
index 000000000..0fdfbc06b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.ml
@@ -0,0 +1,878 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Storage_sigs
+
+module Make_encoder (V : VALUE) = struct
+  let of_bytes ~key b =
+    match Data_encoding.Binary.of_bytes V.encoding b with
+    | None -> Error [Raw_context.Storage_error (Corrupted_data key)]
+    | Some v -> Ok v
+  let to_bytes v =
+    match Data_encoding.Binary.to_bytes V.encoding v with
+    | Some b -> b
+    | None -> MBytes.create 0
+end
+
+let len_name = "len"
+let data_name = "data"
+
+let encode_len_value bytes =
+  let length = MBytes.length bytes in
+  Data_encoding.(Binary.to_bytes_exn int31) length
+
+let decode_len_value key len =
+  match Data_encoding.(Binary.of_bytes int31) len with
+  | None ->
+      fail (Raw_context.Storage_error (Corrupted_data key))
+  | Some len ->
+      return len
+
+let map_key f = function
+  | `Key k -> `Key (f k)
+  | `Dir k -> `Dir (f k)
+
+module Make_subcontext (C : Raw_context.T) (N : NAME)
+  : Raw_context.T with type t = C.t = struct
+  type t = C.t
+  type context = t
+  let name_length = List.length N.name
+  let to_key k = N.name @ k
+  let of_key k = Misc.remove_elem_from_list name_length k
+  let mem t k = C.mem t (to_key k)
+  let dir_mem t k = C.dir_mem t (to_key k)
+  let get t k = C.get t (to_key k)
+  let get_option t k = C.get_option t (to_key k)
+  let init t k v = C.init t (to_key k) v
+  let set t k v = C.set t (to_key k) v
+  let init_set t k v = C.init_set t (to_key k) v
+  let set_option t k v = C.set_option t (to_key k) v
+  let delete t k = C.delete t (to_key k)
+  let remove t k = C.remove t (to_key k)
+  let remove_rec t k = C.remove_rec t (to_key k)
+  let copy t ~from ~to_ = C.copy t ~from:(to_key from) ~to_:(to_key to_)
+  let fold t k ~init ~f =
+    C.fold t (to_key k) ~init
+      ~f:(fun k acc -> f (map_key of_key k) acc)
+  let keys t k = C.keys t (to_key k) >|= fun keys -> List.map of_key keys
+  let fold_keys t k ~init ~f =
+    C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)
+  let project = C.project
+  let absolute_key c k = C.absolute_key c (to_key k)
+  let consume_gas = C.consume_gas
+  let check_enough_gas = C.check_enough_gas
+  let description =
+    Storage_description.register_named_subcontext C.description N.name
+end
+
+module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)
+  : Single_data_storage with type t = C.t
+                         and type value = V.t = struct
+  type t = C.t
+  type context = t
+  type value = V.t
+  let mem t =
+    C.mem t N.name
+  include Make_encoder(V)
+  let get t =
+    C.get t N.name >>=? fun b ->
+    let key = C.absolute_key t N.name in
+    Lwt.return (of_bytes ~key b)
+  let get_option t =
+    C.get_option t N.name >>= function
+    | None -> return_none
+    | Some b ->
+        let key = C.absolute_key t N.name in
+        match of_bytes ~key b with
+        | Ok v -> return_some v
+        | Error _ as err -> Lwt.return err
+  let init t v =
+    C.init t N.name (to_bytes v) >>=? fun t ->
+    return (C.project t)
+  let set t v =
+    C.set t N.name (to_bytes v) >>=? fun t ->
+    return (C.project t)
+  let init_set t v =
+    C.init_set t N.name (to_bytes v) >>= fun t ->
+    Lwt.return (C.project t)
+  let set_option t v =
+    C.set_option t N.name (Option.map ~f:to_bytes v) >>= fun t ->
+    Lwt.return (C.project t)
+  let remove t =
+    C.remove t N.name >>= fun t ->
+    Lwt.return (C.project t)
+  let delete t =
+    C.delete t N.name >>=? fun t ->
+    return (C.project t)
+
+  let () =
+    let open Storage_description in
+    register_value
+      ~get:get_option
+      (register_named_subcontext C.description N.name)
+      V.encoding
+
+end
+
+module type INDEX = sig
+  type t
+  val path_length: int
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  type 'a ipath
+  val args: ('a, t, 'a ipath) Storage_description.args
+end
+
+module Pair(I1 : INDEX)(I2 : INDEX)
+  : INDEX with type t = I1.t * I2.t = struct
+  type t = I1.t * I2.t
+  let path_length = I1.path_length + I2.path_length
+  let to_path (x, y) l = I1.to_path x (I2.to_path y l)
+  let of_path l =
+    match Misc.take I1.path_length l with
+    | None -> None
+    | Some (l1, l2) ->
+        match I1.of_path l1, I2.of_path l2 with
+        | Some x, Some y -> Some (x, y)
+        | _ -> None
+  type 'a ipath = 'a I1.ipath I2.ipath
+  let args = Storage_description.Pair (I1.args, I2.args)
+end
+
+module Make_data_set_storage (C : Raw_context.T) (I : INDEX)
+  : Data_set_storage with type t = C.t and type elt = I.t = struct
+
+  type t = C.t
+  type context = t
+  type elt = I.t
+
+  let inited = MBytes.of_string "inited"
+
+  let mem s i =
+    C.mem s (I.to_path i [])
+  let add s i =
+    C.init_set s (I.to_path i []) inited >>= fun t ->
+    Lwt.return (C.project t)
+  let del s i =
+    C.remove s (I.to_path i []) >>= fun t ->
+    Lwt.return (C.project t)
+  let set s i = function
+    | true -> add s i
+    | false -> del s i
+  let clear s =
+    C.remove_rec s [] >>= fun t ->
+    Lwt.return (C.project t)
+
+  let fold s ~init ~f =
+    let rec dig i path acc =
+      if Compare.Int.(i <= 1) then
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir _ -> Lwt.return acc
+          | `Key file ->
+              match I.of_path file with
+              | None -> assert false
+              | Some p -> f p acc
+        end
+      else
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k ->
+              dig (i-1) k acc
+          | `Key _ ->
+              Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let elements s =
+    fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+  let () =
+    let open Storage_description in
+    let unpack = unpack I.args in
+    register_value
+      (* TODO fixme 'elements...' *)
+      ~get:(fun c ->
+          let (c, k) = unpack c in
+          mem c k >>= function
+          | true -> return_some true
+          | false -> return_none)
+      (register_indexed_subcontext
+         ~list:(fun c -> elements c >>= return)
+         C.description I.args)
+      Data_encoding.bool
+
+end
+
+module Make_indexed_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : VALUE)
+  : Indexed_data_storage with type t = C.t
+                          and type key = I.t
+                          and type value = V.t = struct
+  type t = C.t
+  type context = t
+  type key = I.t
+  type value = V.t
+  include Make_encoder(V)
+  let mem s i =
+    C.mem s (I.to_path i [])
+  let get s i =
+    C.get s (I.to_path i []) >>=? fun b ->
+    let key = C.absolute_key s (I.to_path i []) in
+    Lwt.return (of_bytes ~key b)
+  let get_option s i =
+    C.get_option s (I.to_path i []) >>= function
+    | None -> return_none
+    | Some b ->
+        let key = C.absolute_key s (I.to_path i []) in
+        match of_bytes ~key b with
+        | Ok v -> return_some v
+        | Error _ as err -> Lwt.return err
+  let set s i v =
+    C.set s (I.to_path i []) (to_bytes v) >>=? fun t ->
+    return (C.project t)
+  let init s i v =
+    C.init s (I.to_path i []) (to_bytes v) >>=? fun t ->
+    return (C.project t)
+  let init_set s i v =
+    C.init_set s (I.to_path i []) (to_bytes v) >>= fun t ->
+    Lwt.return (C.project t)
+  let set_option s i v =
+    C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v) >>= fun t ->
+    Lwt.return (C.project t)
+  let remove s i =
+    C.remove s (I.to_path i []) >>= fun t ->
+    Lwt.return (C.project t)
+  let delete s i =
+    C.delete s (I.to_path i []) >>=? fun t ->
+    return (C.project t)
+  let clear s =
+    C.remove_rec s [] >>= fun t ->
+    Lwt.return (C.project t)
+
+  let fold_keys s ~init ~f =
+    let rec dig i path acc =
+      if Compare.Int.(i <= 1) then
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir _ -> Lwt.return acc
+          | `Key file ->
+              match I.of_path file with
+              | None -> assert false
+              | Some path -> f path acc
+        end
+      else
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k -> dig (i-1) k acc
+          | `Key _ -> Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let fold s ~init ~f =
+    let f path acc =
+      get s path >>= function
+      | Error _ ->
+          (* FIXME: silently ignore unparsable data *)
+          Lwt.return acc
+      | Ok v ->
+          f path v acc in
+    fold_keys s ~init ~f
+  let bindings s =
+    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
+  let keys s =
+    fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+  let () =
+    let open Storage_description in
+    let unpack = unpack I.args in
+    register_value
+      ~get:(fun c ->
+          let (c, k) = unpack c in
+          get_option c k)
+      (register_indexed_subcontext
+         ~list:(fun c -> keys c >>= return)
+         C.description I.args)
+      V.encoding
+
+end
+
+module Make_indexed_carbonated_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : VALUE)
+  : Non_iterable_indexed_carbonated_data_storage with type t = C.t
+                                                  and type key = I.t
+                                                  and type value = V.t = struct
+  type t = C.t
+  type context = t
+  type key = I.t
+  type value = V.t
+  include Make_encoder(V)
+  let name i =
+    I.to_path i [data_name]
+  let len_name i =
+    I.to_path i [len_name]
+  let consume_mem_gas c =
+    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
+  let existing_size c i =
+    C.get_option c (len_name i) >>= function
+    | None -> return 0
+    | Some len -> decode_len_value (len_name i) len
+  let consume_read_gas get c i =
+    get c (len_name i) >>=? fun len ->
+    decode_len_value (len_name i) len >>=? fun len ->
+    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))
+  let consume_serialize_write_gas set c i v =
+    let bytes = to_bytes v in
+    let len = MBytes.length bytes in
+    Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len)) >>=? fun c ->
+    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
+    set c (len_name i) (encode_len_value bytes) >>=? fun c ->
+    return (c, bytes)
+  let consume_remove_gas del c i =
+    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c ->
+    del c (len_name i)
+  let mem s i =
+    consume_mem_gas s >>=? fun s ->
+    C.mem s (name i) >>= fun exists ->
+    return (C.project s, exists)
+  let get s i =
+    consume_read_gas C.get s i >>=? fun s ->
+    C.get s (name i) >>=? fun b ->
+    let key = C.absolute_key s (name i) in
+    Lwt.return (of_bytes ~key b) >>=? fun v ->
+    return (C.project s, v)
+  let get_option s i =
+    consume_mem_gas s >>=? fun s ->
+    C.mem s (name i) >>= fun exists ->
+    if exists then
+      get s i >>=? fun (s, v) ->
+      return (s, Some v)
+    else
+      return (C.project s, None)
+  let set s i v =
+    existing_size s i >>=? fun prev_size ->
+    consume_serialize_write_gas C.set s i v >>=? fun (s, bytes) ->
+    C.set s (name i) bytes >>=? fun t ->
+    let size_diff = MBytes.length bytes - prev_size in
+    return (C.project t, size_diff)
+  let init s i v =
+    consume_serialize_write_gas C.init s i v >>=? fun (s, bytes) ->
+    C.init s (name i) bytes >>=? fun t ->
+    let size = MBytes.length bytes in
+    return (C.project t, size)
+  let init_set s i v =
+    let init_set s i v = C.init_set s i v >>= return in
+    existing_size s i >>=? fun prev_size ->
+    consume_serialize_write_gas init_set s i v >>=? fun (s, bytes) ->
+    init_set s (name i) bytes >>=? fun t ->
+    let size_diff = MBytes.length bytes - prev_size in
+    return (C.project t, size_diff)
+  let remove s i =
+    let remove s i = C.remove s i >>= return in
+    existing_size s i >>=? fun prev_size ->
+    consume_remove_gas remove s i >>=? fun s ->
+    remove s (name i) >>=? fun t ->
+    return (C.project t, prev_size)
+  let delete s i =
+    existing_size s i >>=? fun prev_size ->
+    consume_remove_gas C.delete s i >>=? fun s ->
+    C.delete s (name i) >>=? fun t ->
+    return (C.project t, prev_size)
+  let set_option s i v =
+    match v with
+    | None -> remove s i
+    | Some v -> init_set s i v
+
+  let fold_keys_unaccounted s ~init ~f =
+    let rec dig i path acc =
+      if Compare.Int.(i <= 1) then
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir _ -> Lwt.return acc
+          | `Key file ->
+              match I.of_path file with
+              | None -> assert false
+              | Some path -> f path acc
+        end
+      else
+        C.fold s path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k -> dig (i-1) k acc
+          | `Key _ -> Lwt.return acc
+        end in
+    dig I.path_length [data_name] init
+
+  let keys_unaccounted s =
+    fold_keys_unaccounted s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+  let () =
+    let open Storage_description in
+    let unpack = unpack I.args in
+    register_value
+      (* TODO export consumed gas ?? *)
+      ~get:(fun c ->
+          let (c, k) = unpack c in
+          get_option c k >>=? fun (_, v) ->
+          return v)
+      (register_indexed_subcontext
+         ~list:(fun c -> keys_unaccounted c >>= return)
+         C.description I.args)
+      V.encoding
+
+end
+
+
+module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
+    (Snapshot_index : INDEX) (I : INDEX) (V : VALUE)
+  : Indexed_data_snapshotable_storage with type t = C.t
+                                       and type snapshot = Snapshot_index.t
+                                       and type key = I.t
+                                       and type value = V.t = struct
+  type snapshot = Snapshot_index.t
+
+  let data_name = ["current"]
+  let snapshot_name = ["snapshot"]
+
+  module C_data = Make_subcontext(C)(struct let name = data_name end)
+  module C_snapshot = Make_subcontext(C)(struct let name = snapshot_name end)
+
+  include Make_indexed_data_storage(C_data)(I) (V)
+  module Snapshot = Make_indexed_data_storage(C_snapshot)(Pair(Snapshot_index)(I))(V)
+
+  let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []
+
+  let snapshot_exists s id =
+    C.dir_mem s (snapshot_path id)
+
+  let snapshot s id =
+    C.copy s ~from:data_name ~to_:(snapshot_path id) >>=? fun t ->
+    return (C.project t)
+
+  let delete_snapshot s id =
+    C.remove_rec s (snapshot_path id) >>= fun t ->
+    Lwt.return (C.project t)
+
+end
+
+
+module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
+  : Indexed_raw_context with type t = C.t
+                         and type key = I.t
+                         and type 'a ipath = 'a I.ipath = struct
+
+  type t = C.t
+  type context = t
+  type key = I.t
+  type 'a ipath = 'a I.ipath
+
+  let clear t =
+    C.remove_rec t [] >>= fun t ->
+    Lwt.return (C.project t)
+
+  let fold_keys t ~init ~f =
+    let rec dig i path acc =
+      if Compare.Int.(i <= 0) then
+        match I.of_path path with
+        | None -> assert false
+        | Some path -> f path acc
+      else
+        C.fold t path ~init:acc ~f:begin fun k acc ->
+          match k with
+          | `Dir k -> dig (i-1) k acc
+          | `Key _ -> Lwt.return acc
+        end in
+    dig I.path_length [] init
+
+  let keys t =
+    fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))
+
+  let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
+
+  let description =
+    Storage_description.register_indexed_subcontext
+      ~list:(fun c -> keys c >>= return)
+      C.description
+      I.args
+
+  let unpack = Storage_description.unpack I.args
+  let pack = Storage_description.pack I.args
+
+  module Raw_context = struct
+    type t = C.t I.ipath
+    type context = t
+    let to_key i k = I.to_path i k
+    let of_key k = Misc.remove_elem_from_list I.path_length k
+    let mem c k = let (t, i) = unpack c in C.mem t (to_key i k)
+    let dir_mem c k = let (t, i) = unpack c in C.dir_mem t (to_key i k)
+    let get c k = let (t, i) = unpack c in C.get t (to_key i k)
+    let get_option c k = let (t, i) = unpack c in C.get_option t (to_key i k)
+    let init c k v =
+      let (t, i) = unpack c in
+      C.init t (to_key i k) v >>=? fun t -> return (pack t i)
+    let set c k v =
+      let (t, i) = unpack c in
+      C.set t (to_key i k) v >>=? fun t -> return (pack t i)
+    let init_set c k v =
+      let (t, i) = unpack c in
+      C.init_set t (to_key i k) v >>= fun t -> Lwt.return (pack t i)
+    let set_option c k v =
+      let (t, i) = unpack c in
+      C.set_option t (to_key i k) v >>= fun t -> Lwt.return (pack t i)
+    let delete c k =
+      let (t, i) = unpack c in
+      C.delete t (to_key i k) >>=? fun t -> return (pack t i)
+    let remove c k =
+      let (t, i) = unpack c in
+      C.remove t (to_key i k) >>= fun t -> Lwt.return (pack t i)
+    let remove_rec c k =
+      let (t, i) = unpack c in
+      C.remove_rec t (to_key i k) >>= fun t -> Lwt.return (pack t i)
+    let copy c ~from ~to_ =
+      let (t, i) = unpack c in
+      C.copy t ~from:(to_key i from) ~to_:(to_key i to_) >>=? fun t ->
+      return (pack t i)
+    let fold c k ~init ~f =
+      let (t, i) = unpack c in
+      C.fold t (to_key i k) ~init
+        ~f:(fun k acc -> f (map_key of_key k) acc)
+    let keys c k =
+      let (t, i) = unpack c in
+      C.keys t (to_key i k) >|= fun keys -> List.map of_key keys
+    let fold_keys c k ~init ~f =
+      let (t, i) = unpack c in
+      C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)
+    let project c =
+      let (t, _) = unpack c in
+      C.project t
+    let absolute_key c k =
+      let (t, i) = unpack c in
+      C.absolute_key t (to_key i k)
+    let consume_gas c g =
+      let (t, i) = unpack c in
+      C.consume_gas t g >>? fun t -> ok (pack t i)
+    let check_enough_gas c g =
+      let (t, _i) = unpack c in
+      C.check_enough_gas t g
+    let description = description
+  end
+
+  let resolve t prefix =
+    let rec loop i prefix = function
+      | [] when Compare.Int.(i = I.path_length) -> begin
+          match I.of_path prefix with
+          | None -> assert false
+          | Some path -> Lwt.return [path]
+        end
+      | [] ->
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix -> loop (i+1) prefix []) prefixes
+          >|= List.flatten
+      | [d] when Compare.Int.(i = I.path_length - 1) ->
+          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix ->
+                  match Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix)) with
+                  | None -> Lwt.return_nil
+                  | Some _ -> loop (i+1) prefix [])
+            prefixes
+          >|= List.flatten
+      | "" :: ds ->
+          list t prefix >>= fun prefixes ->
+          Lwt_list.map_p (function
+              | `Key prefix | `Dir prefix -> loop (i+1) prefix ds) prefixes
+          >|= List.flatten
+      | d :: ds ->
+          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
+          C.dir_mem t (prefix @ [d]) >>= function
+          | true -> loop (i+1) (prefix @ [d]) ds
+          | false -> Lwt.return_nil in
+    loop 0 [] prefix
+
+  module Make_set (N : NAME) = struct
+    type t = C.t
+    type context = t
+    type elt = I.t
+    let inited = MBytes.of_string "inited"
+    let mem s i = Raw_context.mem (pack s i) N.name
+    let add s i =
+      Raw_context.init_set (pack s i) N.name inited >>= fun c ->
+      let (s, _) = unpack c in
+      Lwt.return (C.project s)
+    let del s i =
+      Raw_context.remove (pack s i) N.name >>= fun c ->
+      let (s, _) = unpack c in
+      Lwt.return (C.project s)
+    let set s i = function
+      | true -> add s i
+      | false -> del s i
+    let clear s =
+      fold_keys s
+        ~init:s
+        ~f:begin fun i s ->
+          Raw_context.remove (pack s i) N.name >>= fun c ->
+          let (s, _) = unpack c in
+          Lwt.return s
+        end >>= fun t ->
+      Lwt.return (C.project t)
+    let fold s ~init ~f =
+      fold_keys s ~init
+        ~f:(fun i acc ->
+            mem s i >>= function
+            | true -> f i acc
+            | false -> Lwt.return acc)
+    let elements s =
+      fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+    let () =
+      let open Storage_description in
+      let unpack = unpack I.args in
+      register_value
+        ~get:(fun c ->
+            let (c, k) = unpack c in
+            mem c k >>= function
+            | true -> return_some true
+            | false -> return_none)
+        (register_named_subcontext Raw_context.description N.name)
+        Data_encoding.bool
+
+  end
+
+  module Make_map (N : NAME) (V : VALUE) = struct
+    type t = C.t
+    type context = t
+    type key = I.t
+    type value = V.t
+    include Make_encoder(V)
+    let mem s i =
+      Raw_context.mem (pack s i) N.name
+    let get s i =
+      Raw_context.get (pack s i) N.name >>=? fun b ->
+      let key = Raw_context.absolute_key (pack s i) N.name in
+      Lwt.return (of_bytes ~key b)
+    let get_option s i =
+      Raw_context.get_option (pack s i) N.name >>= function
+      | None -> return_none
+      | Some b ->
+          let key = Raw_context.absolute_key (pack s i) N.name in
+          match of_bytes ~key b with
+          | Ok v -> return_some v
+          | Error _ as err -> Lwt.return err
+    let set s i v =
+      Raw_context.set (pack s i) N.name (to_bytes v) >>=? fun c ->
+      let (s, _) = unpack c in
+      return (C.project s)
+    let init s i v =
+      Raw_context.init (pack s i) N.name (to_bytes v) >>=? fun c ->
+      let (s, _) = unpack c in
+      return (C.project s)
+    let init_set s i v =
+      Raw_context.init_set (pack s i) N.name (to_bytes v) >>= fun c ->
+      let (s, _) = unpack c in
+      Lwt.return (C.project s)
+    let set_option s i v =
+      Raw_context.set_option (pack s i)
+        N.name (Option.map ~f:to_bytes v) >>= fun c ->
+      let (s, _) = unpack c in
+      Lwt.return (C.project s)
+    let remove s i =
+      Raw_context.remove (pack s i) N.name >>= fun c ->
+      let (s, _) = unpack c in
+      Lwt.return (C.project s)
+    let delete s i =
+      Raw_context.delete (pack s i) N.name >>=? fun c ->
+      let (s, _) = unpack c in
+      return (C.project s)
+    let clear s =
+      fold_keys s ~init:s
+        ~f:begin fun i s ->
+          Raw_context.remove (pack s i) N.name >>= fun c ->
+          let (s, _) = unpack c in
+          Lwt.return s
+        end >>= fun t ->
+      Lwt.return (C.project t)
+    let fold s ~init ~f =
+      fold_keys s ~init
+        ~f:(fun i acc ->
+            get s i >>= function
+            | Error _ -> Lwt.return acc
+            | Ok v -> f i v acc)
+    let bindings s =
+      fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
+    let fold_keys s ~init ~f =
+      fold_keys s ~init
+        ~f:(fun i acc ->
+            mem s i >>= function
+            | false -> Lwt.return acc
+            | true -> f i acc)
+    let keys s =
+      fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+    let () =
+      let open Storage_description in
+      let unpack = unpack I.args in
+      register_value
+        ~get:(fun c ->
+            let (c, k) = unpack c in
+            get_option c k)
+        (register_named_subcontext Raw_context.description N.name)
+        V.encoding
+
+  end
+
+  module Make_carbonated_map (N : NAME) (V : VALUE) = struct
+    type t = C.t
+    type context = t
+    type key = I.t
+    type value = V.t
+    include Make_encoder(V)
+    let len_name = len_name :: N.name
+    let data_name = data_name :: N.name
+    let consume_mem_gas c =
+      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
+    let existing_size c =
+      Raw_context.get_option c len_name >>= function
+      | None -> return 0
+      | Some len -> decode_len_value len_name len
+    let consume_read_gas get c =
+      get c (len_name) >>=? fun len ->
+      decode_len_value len_name len >>=? fun len ->
+      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))
+    let consume_write_gas set c v =
+      let bytes = to_bytes v in
+      let len = MBytes.length bytes in
+      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->
+      set c len_name (encode_len_value bytes) >>=? fun c ->
+      return (c, bytes)
+    let consume_remove_gas del c =
+      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c ->
+      del c len_name
+    let mem s i =
+      consume_mem_gas (pack s i) >>=? fun c ->
+      Raw_context.mem c data_name >>= fun res ->
+      return (Raw_context.project c, res)
+    let get s i =
+      consume_read_gas Raw_context.get (pack s i) >>=? fun c ->
+      Raw_context.get c data_name >>=? fun b ->
+      let key = Raw_context.absolute_key c data_name in
+      Lwt.return (of_bytes ~key b) >>=? fun v ->
+      return (Raw_context.project c, v)
+    let get_option s i =
+      consume_mem_gas (pack s i) >>=? fun c ->
+      let (s, _) = unpack c in
+      Raw_context.mem (pack s i) data_name >>= fun exists ->
+      if exists then
+        get s i >>=? fun (s, v) ->
+        return (s, Some v)
+      else
+        return (C.project s, None)
+    let set s i v =
+      existing_size (pack s i) >>=? fun prev_size ->
+      consume_write_gas Raw_context.set (pack s i) v >>=? fun (c, bytes) ->
+      Raw_context.set c data_name bytes >>=? fun c ->
+      let size_diff = MBytes.length bytes - prev_size in
+      return (Raw_context.project c, size_diff)
+    let init s i v =
+      consume_write_gas Raw_context.init (pack s i) v >>=? fun (c, bytes) ->
+      Raw_context.init c data_name bytes >>=? fun c ->
+      let size = MBytes.length bytes in
+      return (Raw_context.project c, size)
+    let init_set s i v =
+      let init_set c k v = Raw_context.init_set c k v >>= return in
+      existing_size (pack s i) >>=? fun prev_size ->
+      consume_write_gas init_set (pack s i) v >>=? fun (c, bytes) ->
+      init_set c data_name bytes >>=? fun c ->
+      let size_diff = MBytes.length bytes - prev_size in
+      return (Raw_context.project c, size_diff)
+    let remove s i =
+      let remove c k = Raw_context.remove c k >>= return in
+      existing_size (pack s i) >>=? fun prev_size ->
+      consume_remove_gas remove (pack s i) >>=? fun c ->
+      remove c data_name >>=? fun c ->
+      return (Raw_context.project c, prev_size)
+    let delete s i =
+      existing_size (pack s i) >>=? fun prev_size ->
+      consume_remove_gas Raw_context.delete (pack s i) >>=? fun c ->
+      Raw_context.delete c data_name >>=? fun c ->
+      return (Raw_context.project c, prev_size)
+    let set_option s i v =
+      match v with
+      | None -> remove s i
+      | Some v -> init_set s i v
+
+    let () =
+      let open Storage_description in
+      let unpack = unpack I.args in
+      register_value
+        ~get:(fun c ->
+            let (c, k) = unpack c in
+            get_option c k >>=? fun (_, v) ->
+            return v)
+        (register_named_subcontext Raw_context.description N.name)
+        V.encoding
+
+  end
+
+end
+
+module Wrap_indexed_data_storage
+    (C : Indexed_data_storage)
+    (K : sig
+       type t
+       val wrap: t -> C.key
+       val unwrap: C.key -> t option
+     end) = struct
+  type t = C.t
+  type context = C.t
+  type key = K.t
+  type value = C.value
+  let mem ctxt k = C.mem ctxt (K.wrap k)
+  let get ctxt k = C.get ctxt (K.wrap k)
+  let get_option ctxt k = C.get_option ctxt (K.wrap k)
+  let set ctxt k v = C.set ctxt (K.wrap k) v
+  let init ctxt k v = C.init ctxt (K.wrap k) v
+  let init_set ctxt k v = C.init_set ctxt (K.wrap k) v
+  let set_option ctxt k v = C.set_option ctxt (K.wrap k) v
+  let delete ctxt k = C.delete ctxt (K.wrap k)
+  let remove ctxt k = C.remove ctxt (K.wrap k)
+  let clear ctxt = C.clear ctxt
+  let fold ctxt ~init ~f =
+    C.fold ctxt ~init ~f:(fun k v acc ->
+        match K.unwrap k with
+        | None -> Lwt.return acc
+        | Some k -> f k v acc)
+  let bindings s =
+    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
+  let fold_keys s ~init ~f =
+    C.fold_keys s ~init
+      ~f:(fun k acc ->
+          match K.unwrap k with
+          | None -> Lwt.return acc
+          | Some k -> f k acc)
+  let keys s =
+    fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.mli
new file mode 100644
index 000000000..83452908c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_functors.mli
@@ -0,0 +1,85 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Typed storage builders. *)
+
+open Storage_sigs
+
+module Make_subcontext (C : Raw_context.T) (N : NAME)
+  : Raw_context.T with type t = C.t
+
+module Make_single_data_storage
+    (C : Raw_context.T) (N : NAME) (V : VALUE)
+  : Single_data_storage with type t = C.t
+                         and type value = V.t
+
+module type INDEX = sig
+  type t
+  val path_length: int
+  val to_path: t -> string list -> string list
+  val of_path: string list -> t option
+  type 'a ipath
+  val args: ('a, t, 'a ipath) Storage_description.args
+end
+
+module Pair(I1 : INDEX)(I2 : INDEX) : INDEX with type t = I1.t * I2.t
+
+module Make_data_set_storage (C : Raw_context.T) (I : INDEX)
+  : Data_set_storage with type t = C.t and type elt = I.t
+
+module Make_indexed_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : VALUE)
+  : Indexed_data_storage with type t = C.t
+                          and type key = I.t
+                          and type value = V.t
+
+module Make_indexed_carbonated_data_storage
+    (C : Raw_context.T) (I : INDEX) (V : VALUE)
+  : Non_iterable_indexed_carbonated_data_storage with type t = C.t
+                                                  and type key = I.t
+                                                  and type value = V.t
+
+module Make_indexed_data_snapshotable_storage (C : Raw_context.T)
+    (Snapshot : INDEX) (I : INDEX) (V : VALUE)
+  : Indexed_data_snapshotable_storage with type t = C.t
+                                       and type snapshot = Snapshot.t
+                                       and type key = I.t
+                                       and type value = V.t
+
+module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)
+  : Indexed_raw_context with type t = C.t
+                         and type key = I.t
+                         and type 'a ipath = 'a I.ipath
+
+module Wrap_indexed_data_storage
+    (C : Indexed_data_storage)
+    (K : sig
+       type t
+       val wrap: t -> C.key
+       val unwrap: C.key -> t option
+     end)
+  : Indexed_data_storage with type t = C.t
+                          and type key = K.t
+                          and type value = C.value
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_sigs.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_sigs.ml
new file mode 100644
index 000000000..baf3e09eb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/storage_sigs.ml
@@ -0,0 +1,392 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** {1 Entity Accessor Signatures} ****************************************)
+
+(** The generic signature of a single data accessor (a single value
+    bound to a specific key in the hierarchical (key x value)
+    database). *)
+module type Single_data_storage = sig
+
+  type t
+  type context = t
+
+  (** The type of the value *)
+  type value
+
+  (** Tells if the data is already defined *)
+  val mem: context -> bool Lwt.t
+
+  (** Retrieve the value from the storage bucket ; returns a
+      {!Storage_error} if the key is not set or if the deserialisation
+      fails *)
+  val get: context -> value tzresult Lwt.t
+
+  (** Retrieves the value from the storage bucket ; returns [None] if
+      the data is not initialized, or {!Storage_helpers.Storage_error}
+      if the deserialisation fails *)
+  val get_option: context -> value option tzresult Lwt.t
+
+  (** Allocates the storage bucket and initializes it ; returns a
+      {!Storage_error Missing_key} if the bucket exists *)
+  val init: context -> value -> Raw_context.t tzresult Lwt.t
+
+  (** Updates the content of the bucket ; returns a {!Storage_Error
+      Existing_key} if the value does not exists *)
+  val set: context -> value -> Raw_context.t tzresult Lwt.t
+
+  (** Allocates the data and initializes it with a value ; just
+      updates it if the bucket exists *)
+  val init_set: context -> value -> Raw_context.t Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      it with [v] ; just updates it if the bucket exists. When the
+      valus is [None], delete the storage bucket when the value ; does
+      nothing if the bucket does not exists. *)
+  val set_option: context -> value option -> Raw_context.t Lwt.t
+
+  (** Delete the storage bucket ; returns a {!Storage_error
+      Missing_key} if the bucket does not exists *)
+  val delete: context -> Raw_context.t tzresult Lwt.t
+
+  (** Removes the storage bucket and its contents ; does nothing if
+      the bucket does not exists *)
+  val remove: context -> Raw_context.t Lwt.t
+
+end
+
+(** Variant of {!Single_data_storage} with gas accounting. *)
+module type Single_carbonated_data_storage = sig
+
+  type t
+  type context = t
+
+  (** The type of the value *)
+  type value
+
+  (** Tells if the data is already defined.
+      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
+  val mem: context -> (Raw_context.t * bool) tzresult Lwt.t
+
+  (** Retrieve the value from the storage bucket ; returns a
+      {!Storage_error} if the key is not set or if the deserialisation
+      fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
+  val get: context -> (Raw_context.t * value) tzresult Lwt.t
+
+  (** Retrieves the value from the storage bucket ; returns [None] if
+      the data is not initialized, or {!Storage_helpers.Storage_error}
+      if the deserialisation fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
+      or [Gas_repr.read_bytes_cost Z.zero]. *)
+  val get_option: context -> (Raw_context.t * value option) tzresult Lwt.t
+
+  (** Allocates the storage bucket and initializes it ; returns a
+      {!Storage_error Missing_key} if the bucket exists.
+      Consumes [Gas_repr.write_bytes_cost <size of the value>].
+      Returns the size. *)
+  val init: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Updates the content of the bucket ; returns a {!Storage_Error
+      Existing_key} if the value does not exists.
+      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
+      Returns the difference from the old to the new size. *)
+  val set: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Allocates the data and initializes it with a value ; just
+      updates it if the bucket exists.
+      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
+      Returns the difference from the old (maybe 0) to the new size. *)
+  val init_set: context -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      it with [v] ; just updates it if the bucket exists. When the
+      valus is [None], delete the storage bucket when the value ; does
+      nothing if the bucket does not exists.
+      Consumes the same gas cost as either {!remove} or {!init_set}.
+      Returns the difference from the old (maybe 0) to the new size. *)
+  val set_option: context -> value option -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Delete the storage bucket ; returns a {!Storage_error
+      Missing_key} if the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val delete: context -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Removes the storage bucket and its contents ; does nothing if
+      the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val remove: context -> (Raw_context.t * int) tzresult Lwt.t
+
+end
+
+(** Restricted version of {!Indexed_data_storage} w/o iterators. *)
+module type Non_iterable_indexed_data_storage = sig
+
+  type t
+  type context = t
+
+  (** An abstract type for keys *)
+  type key
+
+  (** The type of values *)
+  type value
+
+  (** Tells if a given key is already bound to a storage bucket *)
+  val mem: context -> key -> bool Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns {!Storage_error Missing_key} if the key is not set ;
+      returns {!Storage_error Corrupted_data} if the deserialisation
+      fails. *)
+  val get: context -> key -> value tzresult Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns [None] if the value is not set ; returns {!Storage_error
+      Corrupted_data} if the deserialisation fails. *)
+  val get_option: context -> key -> value option tzresult Lwt.t
+
+  (** Updates the content of a bucket ; returns A {!Storage_Error
+      Missing_key} if the value does not exists. *)
+  val set: context -> key -> value -> Raw_context.t tzresult Lwt.t
+
+  (** Allocates a storage bucket at the given key and initializes it ;
+      returns a {!Storage_error Existing_key} if the bucket exists. *)
+  val init: context -> key -> value -> Raw_context.t tzresult Lwt.t
+
+  (** Allocates a storage bucket at the given key and initializes it
+      with a value ; just updates it if the bucket exists. *)
+  val init_set: context -> key -> value -> Raw_context.t Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      it with [v] ; just updates it if the bucket exists. When the
+      valus is [None], delete the storage bucket when the value ; does
+      nothing if the bucket does not exists. *)
+  val set_option: context -> key -> value option -> Raw_context.t Lwt.t
+
+  (** Delete a storage bucket and its contents ; returns a
+      {!Storage_error Missing_key} if the bucket does not exists. *)
+  val delete: context -> key -> Raw_context.t tzresult Lwt.t
+
+  (** Removes a storage bucket and its contents ; does nothing if the
+      bucket does not exists. *)
+  val remove: context -> key -> Raw_context.t Lwt.t
+
+end
+
+(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)
+module type Non_iterable_indexed_carbonated_data_storage = sig
+
+  type t
+  type context = t
+
+  (** An abstract type for keys *)
+  type key
+
+  (** The type of values *)
+  type value
+
+  (** Tells if a given key is already bound to a storage bucket.
+      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
+  val mem: context -> key -> (Raw_context.t * bool) tzresult Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns {!Storage_error Missing_key} if the key is not set ;
+      returns {!Storage_error Corrupted_data} if the deserialisation
+      fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
+  val get: context -> key -> (Raw_context.t * value) tzresult Lwt.t
+
+  (** Retrieve a value from the storage bucket at a given key ;
+      returns [None] if the value is not set ; returns {!Storage_error
+      Corrupted_data} if the deserialisation fails.
+      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
+      or [Gas_repr.read_bytes_cost Z.zero]. *)
+  val get_option: context -> key -> (Raw_context.t * value option) tzresult Lwt.t
+
+  (** Updates the content of a bucket ; returns A {!Storage_Error
+      Missing_key} if the value does not exists.
+      Consumes serialization cost.
+      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
+      Returns the difference from the old to the new size. *)
+  val set: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Allocates a storage bucket at the given key and initializes it ;
+      returns a {!Storage_error Existing_key} if the bucket exists.
+      Consumes serialization cost.
+      Consumes [Gas_repr.write_bytes_cost <size of the value>].
+      Returns the size. *)
+  val init: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Allocates a storage bucket at the given key and initializes it
+      with a value ; just updates it if the bucket exists.
+      Consumes serialization cost.
+      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
+      Returns the difference from the old (maybe 0) to the new size. *)
+  val init_set: context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** When the value is [Some v], allocates the data and initializes
+      it with [v] ; just updates it if the bucket exists. When the
+      valus is [None], delete the storage bucket when the value ; does
+      nothing if the bucket does not exists.
+      Consumes serialization cost.
+      Consumes the same gas cost as either {!remove} or {!init_set}.
+      Returns the difference from the old (maybe 0) to the new size. *)
+  val set_option: context -> key -> value option -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Delete a storage bucket and its contents ; returns a
+      {!Storage_error Missing_key} if the bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val delete: context -> key -> (Raw_context.t * int) tzresult Lwt.t
+
+  (** Removes a storage bucket and its contents ; does nothing if the
+      bucket does not exists.
+      Consumes [Gas_repr.write_bytes_cost Z.zero].
+      Returns the freed size. *)
+  val remove: context -> key -> (Raw_context.t * int) tzresult Lwt.t
+
+end
+
+(** The generic signature of indexed data accessors (a set of values
+    of the same type indexed by keys of the same form in the
+    hierarchical (key x value) database). *)
+module type Indexed_data_storage = sig
+
+  include Non_iterable_indexed_data_storage
+
+  (** Empties all the keys and associated data. *)
+  val clear: context -> Raw_context.t Lwt.t
+
+  (** Lists all the keys. *)
+  val keys: context -> key list Lwt.t
+
+  (** Lists all the keys and associated data. *)
+  val bindings: context -> (key * value) list Lwt.t
+
+  (** Iterates over all the keys and associated data. *)
+  val fold:
+    context -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  (** Iterate over all the keys. *)
+  val fold_keys:
+    context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+end
+
+module type Indexed_data_snapshotable_storage = sig
+  type snapshot
+  type key
+
+  include Indexed_data_storage with type key := key
+
+  module Snapshot : Indexed_data_storage
+    with type key = (snapshot * key)
+     and type value = value
+     and type t = t
+
+  val snapshot_exists : context -> snapshot -> bool Lwt.t
+  val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t
+  val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t
+
+end
+
+(** The generic signature of a data set accessor (a set of values
+    bound to a specific key prefix in the hierarchical (key x value)
+    database). *)
+module type Data_set_storage = sig
+
+  type t
+  type context = t
+
+  (** The type of elements. *)
+  type elt
+
+  (** Tells if a elt is a member of the set *)
+  val mem: context -> elt -> bool Lwt.t
+
+  (** Adds a elt is a member of the set *)
+  val add: context -> elt -> Raw_context.t Lwt.t
+
+  (** Removes a elt of the set ; does nothing if not a member *)
+  val del: context -> elt -> Raw_context.t Lwt.t
+
+  (** Adds/Removes a elt of the set *)
+  val set: context -> elt -> bool -> Raw_context.t Lwt.t
+
+  (** Returns the elements of the set, deserialized in a list in no
+      particular order. *)
+  val elements: context -> elt list Lwt.t
+
+  (** Iterates over the elements of the set. *)
+  val fold: context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+
+  (** Removes all elements in the set *)
+  val clear: context -> Raw_context.t Lwt.t
+
+end
+
+module type NAME = sig
+  val name: Raw_context.key
+end
+
+module type VALUE = sig
+  type t
+  val encoding: t Data_encoding.t
+end
+
+module type Indexed_raw_context = sig
+
+  type t
+  type context = t
+  type key
+  type 'a ipath
+
+  val clear: context -> Raw_context.t Lwt.t
+
+  val fold_keys:
+    context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  val keys: context -> key list Lwt.t
+
+  val resolve: context -> string list -> key list Lwt.t
+
+  module Make_set (N : NAME)
+    : Data_set_storage with type t = t
+                        and type elt = key
+
+  module Make_map (N : NAME) (V : VALUE)
+    : Indexed_data_storage with type t = t
+                            and type key = key
+                            and type value = V.t
+
+  module Make_carbonated_map (N : NAME) (V : VALUE)
+    : Non_iterable_indexed_carbonated_data_storage with type t = t
+                                                    and type key = key
+                                                    and type value = V.t
+
+  module Raw_context : Raw_context.T with type t = t ipath
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/activation.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/activation.ml
new file mode 100644
index 000000000..4fc57e6ff
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/activation.ml
@@ -0,0 +1,369 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** The activation operation creates an implicit contract from a
+    registered commitment present in the context. It is parametrized by
+    a public key hash (pkh) and a secret.
+
+    The commitments are composed of :
+    - a blinded pkh that can be revealed by the secret ;
+    - an amount.
+
+    The commitments and the secrets are generated from
+    /scripts/create_genesis/create_genenis.py and should be coherent.
+*)
+
+open Proto_alpha
+open Alpha_context
+open Test_utils
+open Test_tez
+
+(* Generated commitments and secrets  *)
+
+let commitments =
+  List.map (fun (bpkh, a) ->
+      Commitment_repr.{
+        blinded_public_key_hash=Blinded_public_key_hash.of_b58check_exn bpkh ;
+        amount = Tez_repr.of_mutez_exn (Int64.of_string a)}
+    )
+    [ ( "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ) ;
+      ( "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ) ;
+      ( "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428349" ) ;
+      ( "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ) ;
+      ( "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ) ;
+      ( "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ) ;
+      ( "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ) ;
+      ( "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ) ;
+      ( "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ) ;
+      ( "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ) ;
+    ]
+
+type secret_account = {
+  account : public_key_hash ;
+  activation_code : Blinded_public_key_hash.activation_code ;
+  amount : Tez.t ;
+}
+
+let secrets () =
+  (* Exported from proto_alpha client - TODO : remove when relocated to lib_crypto *)
+  let read_key mnemonic email password =
+    match Bip39.of_words mnemonic with
+    | None -> assert false
+    | Some t ->
+        (* TODO: unicode normalization (NFKD)... *)
+        let passphrase = MBytes.(concat "" [
+            of_string email ;
+            of_string password ;
+          ]) in
+        let sk = Bip39.to_seed ~passphrase t in
+        let sk = MBytes.sub sk 0 32 in
+        let sk : Signature.Secret_key.t =
+          Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in
+        let pk = Signature.Secret_key.to_public_key sk in
+        let pkh = Signature.Public_key.hash pk in
+        (pkh, pk, sk)
+  in
+  List.map (fun (mnemonic, secret, amount, pkh, password, email) ->
+      let (pkh', pk, sk) = read_key mnemonic email password in
+      let pkh = Signature.Public_key_hash.of_b58check_exn pkh in
+      assert (Signature.Public_key_hash.equal pkh pkh');
+      let account = Account.{ pkh ; pk ; sk } in
+      Account.add_account account ;
+      { account = account.pkh ;
+        activation_code = Blinded_public_key_hash.activation_code_of_hex secret ;
+        amount = Option.unopt_exn (Invalid_argument "tez conversion")
+            (Tez.of_mutez (Int64.of_string amount))
+      })
+    [
+      (["envelope"; "hospital"; "mind"; "sunset"; "cancel"; "muscle"; "leisure";
+        "thumb"; "wine"; "market"; "exit"; "lucky"; "style"; "picnic"; "success"],
+       "0f39ed0b656509c2ecec4771712d9cddefe2afac",
+       "23932454669343",
+       "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF",
+       "z0eZHQQGKt",
+       "cjgfoqmk.wpxnvnup@tezos.example.org"
+      );
+      (["flag"; "quote"; "will"; "valley"; "mouse"; "chat"; "hold"; "prosper";
+        "silk"; "tent"; "cruel"; "cause"; "demise"; "bottom"; "practice"],
+       "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4",
+       "72954577464032",
+       "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX",
+       "MHErskWPE6",
+       "oklmcktr.ztljnpzc@tezos.example.org"
+      );
+      (["library"; "away"; "inside"; "paper"; "wise"; "focus"; "sweet"; "expose";
+        "require"; "change"; "stove"; "planet"; "zone"; "reflect"; "finger"],
+       "411dfef031eeecc506de71c9df9f8e44297cf5ba",
+       "217487035428349",
+       "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc",
+       "0AO6BzQNfN",
+       "ctgnkvqm.kvtiybky@tezos.example.org"
+      );
+      (["cruel"; "fluid"; "damage"; "demand"; "mimic"; "above"; "village"; "alpha";
+        "vendor"; "staff"; "absent"; "uniform"; "fire"; "asthma"; "milk"],
+       "08d7d355bc3391d12d140780b39717d9f46fcf87",
+       "4092742372031",
+       "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS",
+       "9kbZ7fR6im",
+       "bnyxxzqr.tdszcvqb@tezos.example.org"
+      ) ;
+      (["opera"; "divorce"; "easy"; "myself"; "idea"; "aim"; "dash"; "scout";
+        "case"; "resource"; "vote"; "humor"; "ticket"; "client"; "edge"],
+       "9b7cad042fba557618bdc4b62837c5f125b50e56",
+       "17590039016550",
+       "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM",
+       "suxT5H09yY",
+       "iilkhohu.otnyuvna@tezos.example.org"
+      ) ;
+      (["token"; "similar"; "ginger"; "tongue"; "gun"; "sort"; "piano"; "month";
+        "hotel"; "vote"; "undo"; "success"; "hobby"; "shell"; "cart"],
+       "124c0ca217f11ffc6c7b76a743d867c8932e5afd",
+       "26322312350555",
+       "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU",
+       "4odVdLykaa",
+       "kwhlglvr.slriitzy@tezos.example.org"
+      ) ;
+      (["shield"; "warrior"; "gorilla"; "birth"; "steak"; "neither"; "feel";
+        "only"; "liberty"; "float"; "oven"; "extend"; "pulse"; "suffer"; "vapor"],
+       "ac7a2125beea68caf5266a647f24dce9fea018a7",
+       "244951387881443",
+       "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur",
+       "A6yeMqBFG8",
+       "lvrmlbyj.yczltcxn@tezos.example.org"
+      ) ;
+      (["waste"; "open"; "scan"; "tip"; "subway"; "dance"; "rent"; "copper";
+        "garlic"; "laundry"; "defense"; "clerk"; "another"; "staff"; "liar"],
+       "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2",
+       "80065050465525",
+       "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs",
+       "oVZqpq60sk",
+       "rfodmrha.zzdndvyk@tezos.example.org"
+      ) ;
+      (["fiber"; "next"; "property"; "cradle"; "silk"; "obey"; "gossip";
+        "push"; "key"; "second"; "across"; "minimum"; "nice"; "boil"; "age"],
+       "dac31640199f2babc157aadc0021cd71128ca9ea",
+       "3569618927693",
+       "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX",
+       "FfytQTTVbu",
+       "owecikdy.gxnyttya@tezos.example.org"
+      ) ;
+      (["print"; "labor"; "budget"; "speak"; "poem"; "diet"; "chunk"; "eternal";
+        "book"; "saddle"; "pioneer"; "ankle"; "happy"; "only"; "exclude"],
+       "bb841227f250a066eb8429e56937ad504d7b34dd",
+       "9034781424478",
+       "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u",
+       "zknAl3lrX2",
+       "ettilrvh.zsrqrbud@tezos.example.org"
+      ) ;
+    ]
+
+let activation_init () =
+  Context.init ~commitments 1 >>=? fun (b, cs) ->
+  secrets () |> fun ss ->
+  return (b, cs, ss)
+
+let simple_init_with_commitments () =
+  activation_init () >>=? fun (blk, _contracts, _secrets) ->
+  Block.bake blk >>=? fun _ ->
+  return_unit
+
+(** A single activation *)
+let single_activation () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+  let { account ; activation_code ; amount=expected_amount ; _ } as _first_one = List.hd secrets in
+
+  (* Contract does not exist *)
+  Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) Tez.zero >>=? fun () ->
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  (* Contract does exist *)
+  Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount
+
+(** 10 activations, one per bake *)
+let multi_activation_1 () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+
+  Error_monad.fold_left_s (fun blk { account ; activation_code ; amount = expected_amount ; _ } ->
+      Op.activation (B blk) account activation_code >>=? fun operation ->
+      Block.bake ~operation blk >>=? fun blk ->
+
+      Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount >>=? fun () ->
+
+      return blk
+    ) blk secrets >>=? fun _ ->
+  return_unit
+
+(** All in one bake *)
+let multi_activation_2 () =
+  activation_init () >>=? fun (blk, _contracts, secrets) ->
+
+  Error_monad.fold_left_s (fun ops { account ; activation_code ; _ } ->
+      Op.activation (B blk) account activation_code >>=? fun op ->
+      return (op::ops)
+    ) [] secrets >>=? fun ops ->
+
+  Block.bake ~operations:ops blk >>=? fun blk ->
+
+  Error_monad.iter_s (fun { account ; amount = expected_amount ; _ } ->
+      (* Contract does exist *)
+      Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount
+    ) secrets
+
+(** Transfer with activated account *)
+let activation_and_transfer () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let first_contract = Contract.implicit_contract account in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  Context.Contract.balance (B blk) bootstrap_contract >>=? fun amount ->
+  Tez.(/?) amount 2L >>?= fun half_amount ->
+  Context.Contract.balance (B blk) first_contract >>=? fun activated_amount_before ->
+
+  Op.transaction (B blk) bootstrap_contract first_contract half_amount >>=? fun operation ->
+  Block.bake ~operation blk >>=? fun blk ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B blk) (Contract.implicit_contract account) activated_amount_before half_amount
+
+(** Transfer to an unactivated account and then activating it *)
+let transfer_to_unactivated_then_activate () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; activation_code ; amount } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let unactivated_commitment_contract = Contract.implicit_contract account in
+
+  Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount ->
+  Tez.(/?) b_amount 2L >>?= fun b_half_amount ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Op.transaction (I inc) bootstrap_contract unactivated_commitment_contract b_half_amount >>=? fun op ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Op.activation (I inc) account activation_code >>=? fun op' ->
+  Incremental.add_operation inc op' >>=? fun inc ->
+  Incremental.finalize_block inc >>=? fun blk2 ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B blk2) (Contract.implicit_contract account) amount b_half_amount
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Invalid pkh activation : expected to fail as the context does not
+    contain any commitment *)
+let invalid_activation_with_no_commitments () =
+  Context.init 1 >>=? fun (blk, _) ->
+  let secrets = secrets () in
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Wrong activation : wrong secret given in the operation *)
+let invalid_activation_wrong_secret () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { account ; _ } as _first_one = List.nth secrets 0 in
+  let { activation_code ; _ } as _second_one = List.nth secrets 1 in
+
+  Op.activation (B blk) account activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res  begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Invalid pkh activation : expected to fail as the context does not
+    contain an associated commitment *)
+let invalid_activation_inexistent_pkh () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { activation_code ; _ } as _first_one = List.hd secrets in
+  let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn
+      "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" in
+
+  Op.activation (B blk) inexistent_pkh activation_code >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Invalid pkh activation : expected to fail as the commitment has
+    already been claimed *)
+let invalid_double_activation () =
+  activation_init () >>=? fun (blk, _, secrets) ->
+  let { account ; activation_code ; _ } as _first_one = List.hd secrets in
+  Incremental.begin_construction blk >>=? fun inc ->
+
+  Op.activation (I inc) account activation_code >>=? fun op ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Op.activation (I inc) account activation_code >>=? fun op' ->
+  Incremental.add_operation inc op' >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_activation _ -> true
+    | _ -> false
+  end
+
+(** Transfer from an unactivated commitment account *)
+let invalid_transfer_from_unactived_account () =
+  activation_init () >>=? fun (blk, contracts, secrets) ->
+  let { account ; _ } as _first_one = List.hd secrets in
+  let bootstrap_contract = List.hd contracts in
+  let unactivated_commitment_contract = Contract.implicit_contract account in
+
+  (* No activation *)
+
+  Op.transaction (B blk) unactivated_commitment_contract bootstrap_contract Tez.one >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Empty_implicit_contract pkh -> if pkh = account then true else false
+    | _ -> false
+  end
+
+let tests = [
+  Test.tztest "init with commitments" `Quick simple_init_with_commitments ;
+  Test.tztest "single activation" `Quick single_activation ;
+  Test.tztest "multi-activation one-by-one" `Quick multi_activation_1 ;
+  Test.tztest "multi-activation all at a time" `Quick multi_activation_2 ;
+  Test.tztest "activation and transfer" `Quick activation_and_transfer ;
+  Test.tztest "transfer to unactivated account then activate" `Quick transfer_to_unactivated_then_activate ;
+  Test.tztest "invalid activation with no commitments" `Quick invalid_activation_with_no_commitments ;
+  Test.tztest "invalid activation with commitments" `Quick invalid_activation_inexistent_pkh ;
+  Test.tztest "invalid double activation" `Quick invalid_double_activation ;
+  Test.tztest "wrong activation code" `Quick invalid_activation_wrong_secret ;
+  Test.tztest "invalid transfer from unactivated account" `Quick invalid_transfer_from_unactived_account
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/baking.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/baking.ml
new file mode 100644
index 000000000..d34a635ce
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/baking.ml
@@ -0,0 +1,53 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+(** Tests for [bake_n] and [bake_until_end_cycle]. *)
+let test_cycle () =
+  Context.init 5 >>=? fun (b,_) ->
+  Context.get_constants (B b) >>=? fun csts ->
+  let blocks_per_cycle = csts.parametric.blocks_per_cycle in
+
+  let pp = fun fmt x -> Format.fprintf fmt "%ld" x in
+
+  (* Tests that [bake_n n] bakes [n] blocks. *)
+  Block.bake_n 10 b >>=? fun b ->
+  Context.get_level (B b) >>=? fun curr_level ->
+  Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp
+    (Alpha_context.Raw_level.to_int32 curr_level)
+    10l >>=? fun () ->
+
+  (* Tests that [bake_until_cycle_end] returns a block at
+     level [blocks_per_cycle]. *)
+  Block.bake_until_cycle_end b >>=? fun b ->
+  Context.get_level (B b) >>=? fun curr_level ->
+  Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp
+    (Alpha_context.Raw_level.to_int32 curr_level)
+    blocks_per_cycle
+
+let tests = [
+  Test.tztest "cycle" `Quick (test_cycle) ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/combined_operations.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/combined_operations.ml
new file mode 100644
index 000000000..1d088d0f3
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/combined_operations.ml
@@ -0,0 +1,224 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Multiple operations can be grouped in one ensuring their
+    derministic application.
+
+    If an invalid operation is present in this group of operation, the
+    previous applied operations are backtracked leaving the context
+    unchanged and the following operations are skipped. Fees attributed
+    to the operations are collected by the baker nonetheless.
+
+    Only manager operations are allowed in multiple transactions.
+    They must all belong to the same manager as there is only one signature. *)
+
+open Proto_alpha
+open Test_tez
+open Test_utils
+
+let ten_tez = Tez.of_int 10
+
+(** Groups ten transactions between the same parties. *)
+let multiple_transfers () =
+  Context.init 3 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+  let c3 = List.nth contracts 2 in
+
+  map_s (fun _ ->
+      Op.transaction (B blk) c1 c2 Tez.one
+    ) (1--10) >>=? fun ops ->
+
+  Op.combine_operations ~source:c1 (B blk) ops >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+  Context.Contract.pkh c3 >>=? fun baker_pkh ->
+  Block.bake ~policy:(By_account baker_pkh) ~operation blk >>=? fun blk ->
+
+  Assert.balance_was_debited ~loc:__LOC__
+    (B blk) c1 c1_old_balance (Tez.of_int 10) >>=? fun () ->
+  Assert.balance_was_credited ~loc:__LOC__
+    (B blk) c2 c2_old_balance (Tez.of_int 10) >>=? fun () ->
+  return_unit
+
+
+(** Groups ten delegated originations. *)
+let multiple_origination_and_delegation () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let n = 10 in
+  Context.get_constants (B blk) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
+  Context.Contract.pkh c1 >>=? fun delegate_pkh ->
+
+  let new_accounts = List.map (fun _ -> Account.new_account ()) (1 -- n) in
+  mapi_s (fun i { Account.pk ; _ } ->
+      Op.origination ~delegate:delegate_pkh ~counter:(Z.of_int i) ~fee:Tez.zero
+        ~public_key:pk ~spendable:true ~credit:(Tez.of_int 10) (B blk) c1
+    ) new_accounts >>=? fun originations ->
+  (* These computed originated contracts are not the ones really created *)
+  (* We will extract them from the tickets *)
+  let (originations_operations, _) = List.split originations in
+
+  Op.combine_operations ~source:c1 (B blk) originations_operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation inc operation >>=? fun inc ->
+
+  (* To retrieve the originated contracts, it is easier to extract them
+     from the tickets. Else, we could (could we ?) hash each combined
+     operation individually. *)
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets |> List.rev in
+  let new_contracts =
+    List.map (function
+        | Contents_result
+            (Manager_operation_result
+               { operation_result =
+                   Applied (Origination_result { originated_contracts = [ h ] })
+               }) ->
+            h
+        | _ -> assert false
+      ) tickets in
+
+  (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *)
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Tez.(origination_burn *? (Int64.of_int n)) >>?= fun origination_total_cost ->
+  Tez.((Tez.of_int (10 * n)) +? origination_total_cost) >>?= fun total_cost ->
+  Assert.balance_was_debited ~loc:__LOC__
+    (I inc) c1 c1_old_balance total_cost >>=? fun () ->
+
+  iter_s (fun c ->
+      Assert.balance_is ~loc:__LOC__ (I inc) c (Tez.of_int 10)
+    ) new_contracts >>=? fun () ->
+
+  return_unit
+
+let expect_balance_too_low = function
+  | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
+      return_unit
+  | _ ->
+      failwith "Contract should not have a sufficient balance : operation expected to fail."
+
+(** Groups three operations, the midlle one failing.
+    Checks that the receipt is consistent.
+    Variant without fees. *)
+let failing_operation_in_the_middle () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op1 ->
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez >>=? fun op2 ->
+  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op3 ->
+  let operations = [ op1 ; op2 ; op3 ] in
+
+  Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation
+    ~expect_failure:expect_balance_too_low inc operation >>=? fun inc ->
+
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets in
+  begin match tickets with
+    | Contents_result (Manager_operation_result { operation_result = (Backtracked _) }) ::
+      Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) }) ::
+      Contents_result (Manager_operation_result { operation_result = Skipped _ }) ::
+      _ -> ()
+    | _ -> assert false
+  end ;
+
+  Assert.balance_is ~loc:__LOC__ (I inc) c1 c1_old_balance >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () ->
+
+  return_unit
+
+(** Groups three operations, the midlle one failing.
+    Checks that the receipt is consistent.
+    Variant with fees, that should be spent even in case of failure. *)
+let failing_operation_in_the_middle_with_fees () =
+  Context.init 2 >>=? fun (blk, contracts) ->
+  let c1 = List.nth contracts 0 in
+  let c2 = List.nth contracts 1 in
+
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op1 ->
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez >>=? fun op2 ->
+  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op3 ->
+  let operations = [ op1 ; op2 ; op3 ] in
+
+  Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation ->
+
+  Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance ->
+  Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance ->
+
+  Incremental.begin_construction blk >>=? fun inc ->
+  Incremental.add_operation
+    ~expect_failure:expect_balance_too_low inc operation >>=? fun inc ->
+
+  let tickets = Incremental.rev_tickets inc in
+  let open Apply_results in
+  let tickets =
+    List.fold_left (fun acc -> function
+        | No_operation_metadata -> assert false
+        | Operation_metadata { contents } ->
+            to_list (Contents_result_list contents) @ acc
+      ) [] tickets in
+  begin match tickets with
+    | Contents_result (Manager_operation_result { operation_result = (Backtracked _) }) ::
+      Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) }) ::
+      Contents_result (Manager_operation_result { operation_result = Skipped _ }) ::
+      _ -> ()
+    | _ -> assert false
+  end ;
+
+  (* In the presence of a failure, all the fees are collected. Even for skipped operations. *)
+  Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance (Tez.of_int 3) >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () ->
+
+  return_unit
+
+let tests = [
+  Test.tztest "multiple transfers" `Quick multiple_transfers ;
+  Test.tztest "multiple originations and delegations" `Quick multiple_origination_and_delegation ;
+  Test.tztest "Failing operation in the middle" `Quick failing_operation_in_the_middle ;
+  Test.tztest "Failing operation in the middle (with fees)" `Quick failing_operation_in_the_middle_with_fees ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact.tz b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact.tz
new file mode 100644
index 000000000..445ceca44
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact.tz
@@ -0,0 +1,16 @@
+storage nat ;
+parameter nat ;
+code { UNPAIR ;
+       DIP { SELF ; ADDRESS ; SOURCE;
+             IFCMPEQ {} { DROP ; PUSH @storage nat 1 } };
+       DUP ;
+       PUSH nat 1 ;
+       IFCMPGE
+         { DROP ; NIL operation ; PAIR }
+         { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ;
+           IF_NONE
+             { NIL operation ; PAIR }
+             { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; SWAP;
+               DIP { DIP { SELF; PUSH mutez 0 } ;
+                     TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ;
+               SWAP ; PAIR } } }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact_2.tz b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact_2.tz
new file mode 100644
index 000000000..5dbcb6167
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/contracts/cps_fact_2.tz
@@ -0,0 +1,14 @@
+storage unit ;
+parameter (pair nat nat) ;
+code { CAR ; UNPAIR ;
+       DUP ;
+       PUSH nat 1 ;
+       IFCMPGE
+         { DROP ; DROP ; UNIT ; NIL operation ; PAIR }
+         { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ;
+           IF_NONE
+             { DROP ; UNIT ; NIL operation ; PAIR }
+             { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; PAIR ;
+               DIP { SELF; PUSH tez "0" } ;
+               TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS ;
+               UNIT ; SWAP ; PAIR } } }
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/delegation.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/delegation.ml
new file mode 100644
index 000000000..8f1dcef81
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/delegation.ml
@@ -0,0 +1,1185 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Test_tez
+open Test_utils
+
+(**************************************************************************)
+(* bootstrap contracts *)
+(**************************************************************************)
+(* Bootstrap contracts are heavily used in other tests. It is helpful
+   to test some properties of these contracts, so we can correctly
+   interpret the other tests that use them. *)
+
+let expect_error err = function
+  | err0 :: _ when err = err0 -> return_unit
+  | _ -> failwith "Unexpected successful result"
+
+let expect_alpha_error err =
+  expect_error (Alpha_environment.Ecoproto_error err)
+
+let expect_non_delegatable_contract = function
+  | Alpha_environment.Ecoproto_error (Delegate_storage.Non_delegatable_contract _) :: _ ->
+      return_unit
+  | _ ->
+      failwith "Contract is not delegatable and operation should fail."
+
+let expect_no_deletion_pkh pkh = function
+  | Alpha_environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ when pkh0 = pkh ->
+      return_unit
+  | _ ->
+      failwith "Delegate can not be deleted and operation should fail."
+
+(** bootstrap contracts delegate to themselves *)
+let bootstrap_manager_is_bootstrap_delegate () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  let bootstrap0 = List.hd bootstrap_contracts in
+  Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0 ->
+  Context.Contract.manager (B b) bootstrap0 >>=? fun manager0 ->
+  Assert.equal_pkh ~loc:__LOC__ delegate0 manager0.pkh
+
+(** bootstrap contracts cannot change their delegate *)
+let bootstrap_delegate_cannot_change ~fee () =
+  Context.init 2 >>=? fun (b, bootstrap_contracts) ->
+  let bootstrap0 = List.nth bootstrap_contracts 0 in
+  let bootstrap1 = List.nth bootstrap_contracts 1 in
+  Context.Contract.pkh bootstrap0 >>=? fun pkh1 ->
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun i ->
+  Context.Contract.manager (I i) bootstrap1 >>=? fun manager1 ->
+  Context.Contract.balance (I i) bootstrap0 >>=? fun balance0 ->
+  Context.Contract.delegate (I i) bootstrap0 >>=? fun delegate0 ->
+  Op.delegation ~fee (I i) bootstrap0 (Some manager1.pkh) >>=? fun set_delegate ->
+  if fee > balance0 then
+    Incremental.add_operation i set_delegate >>= fun err ->
+    Assert.proto_error ~loc:__LOC__ err (function
+        | Contract_storage.Balance_too_low _ -> true
+        | _ -> false)
+  else
+    Incremental.add_operation
+      ~expect_failure:expect_non_delegatable_contract i set_delegate >>=? fun i ->
+    Incremental.finalize_block i >>=? fun b ->
+    (* bootstrap0 still has same delegate *)
+    Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0_after ->
+    Assert.equal_pkh ~loc:__LOC__ delegate0 delegate0_after >>=? fun () ->
+    (* fee has been debited *)
+    Assert.balance_was_debited ~loc:__LOC__ (B b) bootstrap0 balance0 fee
+
+
+(** bootstrap contracts cannot delete their delegation *)
+let bootstrap_delegate_cannot_be_removed ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  let bootstrap = List.hd bootstrap_contracts in
+  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.balance (I i) bootstrap >>=? fun balance ->
+  Context.Contract.delegate (I i) bootstrap >>=? fun delegate ->
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  Op.delegation ~fee (I i) bootstrap None >>=? fun set_delegate ->
+  if fee > balance then
+    Incremental.add_operation i set_delegate >>= fun err ->
+    Assert.proto_error ~loc:__LOC__ err (function
+        | Contract_storage.Balance_too_low _ -> true
+        | _ -> false)
+  else
+    Incremental.add_operation
+      ~expect_failure:(expect_no_deletion_pkh manager.pkh) i set_delegate >>=? fun i ->
+    (* delegate has not changed *)
+    Context.Contract.delegate (I i) bootstrap >>=? fun delegate_after ->
+    Assert.equal_pkh ~loc:__LOC__ delegate delegate_after >>=? fun () ->
+    (* fee has been debited *)
+    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee
+
+(** bootstrap keys are already registered as delegate keys *)
+let bootstrap_manager_already_registered_delegate ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  let pkh = manager.pkh in
+  let impl_contract = Contract.implicit_contract pkh in
+  Context.Contract.balance (I i) impl_contract >>=? fun balance ->
+  Op.delegation ~fee (I i) impl_contract (Some pkh) >>=? fun sec_reg ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i sec_reg >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    begin
+      Incremental.add_operation ~expect_failure:(function
+          |  Alpha_environment.Ecoproto_error Delegate_storage.Active_delegate :: _ ->
+              return_unit
+          | _ ->
+              failwith "Delegate is already active and operation should fail.")
+        i sec_reg >>=? fun i ->
+      (* fee has been debited *)
+      Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee
+    end
+
+(** bootstrap manager can be set as delegate of an originated contract
+    (through origination operation) *)
+let delegate_to_bootstrap_by_origination ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  Context.Contract.balance (I i) bootstrap >>=? fun balance ->
+  (* originate a contract with bootstrap's manager as delegate *)
+  Op.origination ~fee ~credit:Tez.zero ~delegate:manager.pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} -> (* 0.257tz *)
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Lwt.return (Tez.(+?) fee origination_burn) >>=? fun total_fee ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else if total_fee > balance && balance >= fee then
+    (* origination did not proceed; fee has been debited *)
+    begin
+      Incremental.add_operation i ~expect_failure:(function
+          |  Alpha_environment.Ecoproto_error Contract.Balance_too_low _ :: _ ->
+              return_unit
+          | _ ->
+              failwith "Not enough balance for origination burn: operation should fail.")
+        op >>=? fun i ->
+      (* fee was taken *)
+      Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () ->
+      (* originated contract has not been created *)
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+  else
+    (* bootstrap is delegate, fee + origination burn have been debited *)
+    begin
+      Incremental.add_operation i op >>=? fun i ->
+      Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun () ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance total_fee
+    end
+
+(** bootstrap manager can be set as delegate of an originated contract
+    without initial delegate (through delegation operation) *)
+let delegate_to_bootstrap_by_delegation ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  (* originate a contract with no delegate *)
+  Op.origination ~fee:Tez.zero (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.balance (I i) orig_contract >>=? fun orig_balance ->
+  (* Format.printf "\nBalance of originated contract: %a\n%!" Tez.pp orig_balance; *)
+  (* delegate to bootstrap *)
+  Op.delegation ~fee (I i) orig_contract (Some manager.pkh) >>=? fun deleg_op ->
+  if fee > orig_balance then
+    begin
+      Incremental.add_operation i deleg_op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* manager is delegate, fee is debited *)
+    begin
+      Incremental.add_operation i deleg_op >>=? fun i ->
+      Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun () ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) orig_contract orig_balance fee
+    end
+
+(** bootstrap manager can be set as delegate of an originated contract
+    with initial delegate (through delegation operation) *)
+let delegate_to_bootstrap_by_delegation_switch ~fee () =
+  Context.init 2 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap0 = List.hd bootstrap_contracts in
+  Context.Contract.manager (I i) bootstrap0 >>=? fun manager0 ->
+  let bootstrap1 = List.nth bootstrap_contracts 1 in
+  Context.Contract.manager (I i) bootstrap1 >>=? fun manager1 ->
+  (* originate a contract with bootstrap1's manager as delegate *)
+  Op.origination ~fee:Tez.zero ~credit:Tez.one ~delegate:manager1.pkh (I i) bootstrap0 >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.balance (I i) orig_contract >>=? fun orig_balance ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate manager1.pkh >>=? fun _ ->
+  (* switch delegate to bootstrap0 *)
+  Op.delegation ~fee (I i) orig_contract (Some manager0.pkh) >>=? fun switch_deleg ->
+  if fee > orig_balance then
+    begin
+      Incremental.add_operation i switch_deleg >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* manager0 is delegate, fee is debited *)
+    begin
+      Incremental.add_operation i switch_deleg >>=? fun i ->
+      Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager0.pkh >>=? fun () ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) orig_contract orig_balance fee
+    end
+
+let tests_bootstrap_contracts = [
+  Test.tztest "bootstrap contracts delegate to themselves" `Quick bootstrap_manager_is_bootstrap_delegate ;
+  Test.tztest "bootstrap contracts cannot change their delegate (small fee)" `Quick (bootstrap_delegate_cannot_change ~fee:Tez.one_mutez) ;
+  Test.tztest "bootstrap contracts cannot change their delegate (max fee)" `Quick (bootstrap_delegate_cannot_change ~fee:Tez.max_tez) ;
+  Test.tztest "bootstrap contracts cannot delete their delegation (small fee)" `Quick (bootstrap_delegate_cannot_be_removed ~fee:Tez.one_mutez) ;
+  Test.tztest "bootstrap contracts cannot delete their delegation (max fee)" `Quick (bootstrap_delegate_cannot_be_removed ~fee:Tez.max_tez) ;
+  Test.tztest "bootstrap keys are already registered as delegate keys (small fee)" `Quick (bootstrap_manager_already_registered_delegate ~fee:Tez.one_mutez) ;
+  Test.tztest "bootstrap keys are already registered as delegate keys (max fee)" `Quick (bootstrap_manager_already_registered_delegate ~fee:Tez.max_tez) ;
+  Test.tztest "bootstrap manager can be delegate (init origination, small fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:Tez.one_mutez) ;
+  (* balance enough for fee but not for fee + origination burn *)
+  Test.tztest "bootstrap manager can be delegate (init origination, edge case)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_mutez_exn 3_999_999_743_000L)) ;
+  (* fee bigger than bootstrap's initial balance*)
+  Test.tztest "bootstrap manager can be delegate (init origination, large fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_int 10_000_000)) ;
+  Test.tztest "bootstrap manager can be delegate (init delegation, small fee)" `Quick (delegate_to_bootstrap_by_delegation ~fee:Tez.one_mutez) ;
+  Test.tztest "bootstrap manager can be delegate (init delegation, max fee)" `Quick (delegate_to_bootstrap_by_delegation ~fee:Tez.max_tez) ;
+  Test.tztest "bootstrap manager can be delegate (switch delegation, small fee)" `Quick (delegate_to_bootstrap_by_delegation_switch ~fee:Tez.one_mutez) ;
+  Test.tztest "bootstrap manager can be delegate (switch delegation, max fee)" `Quick (delegate_to_bootstrap_by_delegation_switch ~fee:Tez.max_tez) ;
+]
+
+(**************************************************************************)
+(* delegate registration *)
+(**************************************************************************)
+(* A delegate is a pkh. Delegates must be registered. Registration is
+   done via the self-delegation of the implicit contract corresponding
+   to the pkh. The implicit contract must be credited when the
+   self-delegation is done. Furthermore, trying to register an already
+   registered key raises an error.
+
+   In this series of tests, we verify that
+   1- unregistered delegate keys cannot be delegated to,
+   2- registered keys can be delegated to,
+   3- registering an already registered key raises an error.
+
+
+   We consider three scenarios for setting a delegate:
+   - through origination,
+   - through delegation when the originated contract has no delegate yet,
+   - through delegation when the originated contract already has a delegate.
+
+   We also test that emptying the implicit contract linked to a
+   registered delegate key does not unregister the delegate key.
+*)
+
+(*
+   Valid registration
+
+   Unregistered key:
+   - contract not credited and no self-delegation
+   - contract credited but no self-delegation
+   - contract not credited and self-delegation
+
+Not credited:
+- no credit operation
+- credit operation of 1μꜩ and then debit operation of 1μꜩ
+
+*)
+
+(** A- unregistered delegate keys cannot be used for delegation *)
+
+(* Two main series of tests: without self-delegation, and with a failed attempt at self-delegation
+   1- no self-delegation
+     a- no credit
+        - no token transfer
+        - credit of 1μꜩ and then debit of 1μꜩ
+     b- with credit of 1μꜩ.
+   For every scenario, we try three different ways of delegating:
+   - through origination (init origination)
+   - through delegation when no delegate was assigned at origination (init delegation)
+   - through delegation when a delegate was assigned at origination (switch delegation).
+
+   2- Self-delegation fails if the contract has no credit. We try the
+   two possibilities of 1a for non-credited contracts.
+*)
+
+let expect_unregistered_key pkh = function
+  | Alpha_environment.Ecoproto_error Roll_storage.Unregistered_delegate pkh0 :: _
+    when pkh = pkh0 -> return_unit
+  | _ -> failwith "Delegate key is not registered: operation should fail."
+
+(* A1: no self-delegation *)
+(* no token transfer, no self-delegation *)
+let unregistered_delegate_key_init_origination ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  (* origination with delegate argument *)
+  Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Lwt.return (Tez.(+?) fee origination_burn) >>=? fun _total_fee -> (* FIXME unused variable *)
+  Context.Contract.balance (I i) bootstrap >>=? fun balance ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* origination did not proceed; fee has been debited *)
+    begin
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () ->
+      (* originated contract has not been created *)
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_init_delegation ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  Context.Contract.balance (I i) bootstrap >>=? fun _balance -> (* FIXME unused variable *)
+  (* origination without delegate argument *)
+  let credit = Tez.of_int 10 in
+  Op.origination (I i) bootstrap ~credit  >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Op.delegation ~fee (I i) orig_contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    begin
+      Incremental.add_operation i delegate_op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* fee has been debited; no delegate *)
+    begin
+      Incremental.add_operation i
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) orig_contract credit fee >>=? fun () ->
+      (* originated contract has no delegate *)
+      Context.Contract.delegate (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_switch_delegation ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  (* origination with delegate setting *)
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  let credit = Tez.of_int 10 in
+  Op.origination (I i) ~delegate:manager.pkh bootstrap ~credit >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun _ ->
+  (* switch delegate through delegation *)
+  Op.delegation ~fee (I i) orig_contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    begin
+      Incremental.add_operation i delegate_op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* fee has been debited; no delegate *)
+    begin
+      Incremental.add_operation i
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) orig_contract credit fee >>=? fun () ->
+      (* originated contract's delegate has not changed *)
+      Context.Contract.delegate (I i) orig_contract >>=? fun delegate ->
+      Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_pkh >>=? fun () ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh
+    end
+
+(* credit of some amount, no self-delegation *)
+let unregistered_delegate_key_init_origination_credit ~fee ~amount () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* origination with delegate argument *)
+  Context.Contract.balance (I i) bootstrap >>=? fun balance ->
+  Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else (* origination not done, fee taken *)
+    begin
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () ->
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_init_delegation_credit ~fee ~amount () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* origination without delegate argument *)
+  let credit = Tez.of_int 10 in
+  Op.origination ~fee:Tez.zero ~credit (I i) bootstrap >>=? fun (op, contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Op.delegation ~fee (I i) contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    Incremental.add_operation i delegate_op >>= fun err ->
+    Assert.proto_error ~loc:__LOC__ err (function
+        | Contract_storage.Balance_too_low _ -> true
+        | _ -> false)
+  else
+    begin
+      (* fee has been taken, no delegate for contract *)
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract credit fee >>=? fun () ->
+      Context.Contract.delegate (I i) contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* origination without delegate setting *)
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  let credit = Tez.of_int 10 in
+  Op.origination (I i) ~fee:Tez.zero ~credit ~delegate:manager.pkh bootstrap >>=? fun (op, contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.delegate (I i) contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun _ ->
+  (* switch delegate through delegation *)
+  Op.delegation ~fee (I i) contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    Incremental.add_operation i delegate_op >>= fun err ->
+    Assert.proto_error ~loc:__LOC__ err (function
+        | Contract_storage.Balance_too_low _ -> true
+        | _ -> false)
+  else
+    begin
+      (* fee has been taken, delegate for contract has not changed *)
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract credit fee >>=? fun () ->
+      Context.Contract.delegate (I i) contract >>=? fun delegate ->
+      Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_pkh >>=? fun () ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh
+    end
+
+(* a credit of some amount followed by a debit of the same amount, no self-delegation *)
+let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* debit + check balance *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun debit_contract ->
+  Incremental.add_operation i debit_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* origination with delegate argument *)
+  Context.Contract.balance (I i) bootstrap >>=? fun balance ->
+  Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op  >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else (* fee taken, origination not processed *)
+    begin
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () ->
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* debit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) impl_contract bootstrap amount >>=? fun debit_contract ->
+  Incremental.add_operation i debit_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* origination without delegate argument *)
+  let credit = Tez.of_int 10 in
+  Op.origination ~fee:Tez.zero (I i) ~credit bootstrap >>=? fun (op, contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* set a delegate with delegation operation *)
+  Op.delegation ~fee (I i) contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    begin
+      Incremental.add_operation i delegate_op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    begin
+      (* fee has been taken, no delegate for contract *)
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract credit fee >>=? fun () ->
+      Context.Contract.delegate (I i) contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let unregistered_account = Account.new_account () in
+  let unregistered_pkh = Account.(unregistered_account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* credit + check balance *)
+  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* debit + check balance *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun debit_contract ->
+  Incremental.add_operation i debit_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* origination with delegate setting *)
+  Context.Contract.manager (I i) bootstrap >>=? fun manager ->
+  let credit = Tez.of_int 10 in
+  Op.origination (I i) ~fee:Tez.zero ~credit ~delegate:manager.pkh bootstrap >>=? fun (op, contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.delegate (I i) contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun _ ->
+  (* switch delegate through delegation *)
+  Op.delegation (I i) ~fee contract (Some unregistered_pkh) >>=? fun delegate_op ->
+  if fee > credit then
+    Incremental.add_operation i delegate_op >>= fun err ->
+    Assert.proto_error ~loc:__LOC__ err (function
+        | Contract_storage.Balance_too_low _ -> true
+        | _ -> false)
+  else
+    begin
+      (* fee has been taken, delegate for contract has not changed *)
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key unregistered_pkh)
+        i delegate_op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract credit fee >>=? fun () ->
+      Context.Contract.delegate (I i) contract >>=? fun delegate ->
+      Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_pkh >>=? fun () ->
+      Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh
+    end
+
+(* A2- self-delegation to an empty contract fails *)
+let failed_self_delegation_no_transaction () =
+  Context.init 1 >>=? fun (b, _) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let account = Account.new_account () in
+  let unregistered_pkh = Account.(account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (* check balance *)
+  Context.Contract.balance (I i) impl_contract >>=? fun balance ->
+  Assert.equal_tez ~loc:__LOC__ Tez.zero balance >>=? fun _ ->
+  (* self delegation fails *)
+  Op.delegation (I i) impl_contract (Some unregistered_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>= fun err ->
+  Assert.proto_error ~loc:__LOC__ err (function
+      | Contract_storage.Empty_implicit_contract pkh ->
+          if pkh = unregistered_pkh then true else false
+      | _ -> false)
+
+let failed_self_delegation_emptied_implicit_contract amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let account = Account.new_account () in
+  let unregistered_pkh = Account.(account.pkh) in
+  let impl_contract = Contract.implicit_contract unregistered_pkh in
+  (*  credit implicit contract and check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* empty implicit contract and check balance *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* self delegation fails *)
+  Op.delegation (I i) impl_contract (Some unregistered_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>= fun err ->
+  Assert.proto_error ~loc:__LOC__ err (function
+      | Contract_storage.Empty_implicit_contract pkh ->
+          if pkh = unregistered_pkh then true else false
+      | _ -> false)
+
+(** B- valid registration:
+    - credit implicit contract with some ꜩ + verification of balance
+    - self delegation + verification
+    - empty contract + verification of balance + verification of not being erased / self-delegation
+    - originate contract w implicit contract as delegate + verification of delegation *)
+let valid_delegate_registration_init_origination_credit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ + check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun _ ->
+  (* originating a contract with the newly registered delegate account as delegate *)
+  Op.origination ~delegate:delegate_account.pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+let valid_delegate_registration_init_delegation_credit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ + check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun _ ->
+  (* originating a contract with no delegate *)
+  Op.origination (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* check no delegate for orig contract *)
+  Context.Contract.delegate (I i) orig_contract >>= fun err ->
+  Assert.error ~loc:__LOC__ err (function
+      | RPC_context.Not_found _ -> true
+      | _ -> false) >>=? fun _ ->
+  (* delegation to the newly registered key *)
+  Op.delegation (I i) orig_contract (Some delegate_account.pkh) >>=? fun delegation ->
+  Incremental.add_operation i delegation >>=? fun i ->
+  (* check delegation *)
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+let valid_delegate_registration_switch_delegation_credit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ + check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun _ ->
+  (* originating a contract with bootstrap's account as delegate *)
+  Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager ->
+  Op.origination (I i) ~delegate:bootstrap_manager.pkh bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* test delegate of new contract is bootstrap *)
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate bootstrap_manager.pkh  >>=? fun _ ->
+  (* delegation with newly registered key *)
+  Op.delegation (I i) orig_contract (Some delegate_account.pkh) >>=? fun delegation ->
+  Incremental.add_operation i delegation >>=? fun i ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+let valid_delegate_registration_init_origination_credit_debit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ ->
+  (* empty implicit contracts are usually deleted but they are kept if
+     they were registered as delegates. we empty the contract in
+     order to verify this. *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun empty_contract ->
+  Incremental.add_operation i empty_contract >>=? fun i ->
+  (* impl_contract is empty *)
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* verify self-delegation after contract is emptied *)
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ ->
+  (* originating a contract with the newly registered delegate account as delegate *)
+  Op.origination ~delegate:delegate_account.pkh (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+let valid_delegate_registration_init_delegation_credit_debit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ ->
+  (* empty implicit contracts are usually deleted but they are kept if
+     they were registered as delegates. we empty the contract in
+     order to verify this. *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun empty_contract ->
+  Incremental.add_operation i empty_contract >>=? fun i ->
+  (* impl_contract is empty *)
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* verify self-delegation after contract is emptied *)
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ ->
+  (* originating a contract with no delegate *)
+  Op.origination (I i) bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* check no delegate for orig contract *)
+  Context.Contract.delegate (I i) orig_contract >>= fun err ->
+  Assert.error ~loc:__LOC__ err (function
+      | RPC_context.Not_found _ -> true
+      | _ -> false) >>=? fun _ ->
+  (* delegation to the newly registered key *)
+  Op.delegation (I i) orig_contract (Some delegate_account.pkh) >>=? fun delegation ->
+  Incremental.add_operation i delegation >>=? fun i ->
+  (* check delegation *)
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+let valid_delegate_registration_switch_delegation_credit_debit amount () =
+  (* create an implicit contract *)
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let delegate_account = Account.new_account () in
+  let delegate_pkh = Account.(delegate_account.pkh) in
+  let impl_contract = Contract.implicit_contract delegate_pkh in
+  (* credit > 0ꜩ + check balance *)
+  Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ ->
+  (* self delegation + verification *)
+  Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  Context.Contract.delegate (I i) impl_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ ->
+  (* empty implicit contracts are usually deleted but they are kept if
+     they were registered as delegates. we empty the contract in
+     order to verify this. *)
+  Op.transaction (I i) impl_contract bootstrap amount >>=? fun empty_contract ->
+  Incremental.add_operation i empty_contract >>=? fun i ->
+  (* impl_contract is empty *)
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* originating a contract with bootstrap's account as delegate *)
+  Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager ->
+  Op.origination (I i) ~delegate:bootstrap_manager.pkh bootstrap >>=? fun (op, orig_contract) ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* test delegate of new contract is bootstrap *)
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate bootstrap_manager.pkh  >>=? fun _ ->
+  (* delegation with newly registered key *)
+  Op.delegation (I i) orig_contract (Some delegate_account.pkh) >>=? fun delegation ->
+  Incremental.add_operation i delegation >>=? fun i ->
+  Context.Contract.delegate (I i) orig_contract >>=? fun orig_delegate ->
+  Assert.equal_pkh ~loc:__LOC__ orig_delegate delegate_pkh
+
+(** C- a second self-delegation should raise an `Active_delegate` error *)
+(* with implicit contract with some credit *)
+let double_registration () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let account = Account.new_account () in
+  let pkh = Account.(account.pkh) in
+  let impl_contract = Contract.implicit_contract pkh in
+  (* credit 1μꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract (Tez.one_mutez) >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ ->
+  (* self-delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  (* second self-delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration ->
+  Incremental.add_operation i second_registration >>= fun err ->
+
+  Assert.proto_error ~loc:__LOC__ err (function
+      | Delegate_storage.Active_delegate -> true
+      | _ -> false)
+
+(* with implicit contract emptied after first self-delegation  *)
+let double_registration_when_empty () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let account = Account.new_account () in
+  let pkh = Account.(account.pkh) in
+  let impl_contract = Contract.implicit_contract pkh in
+  (* credit 1μꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ ->
+  (* self delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  (* empty the delegate account *)
+  Op.transaction (I i) impl_contract bootstrap Tez.one_mutez >>=? fun empty_contract ->
+  Incremental.add_operation i empty_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* second self-delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration ->
+  Incremental.add_operation i second_registration >>= fun err ->
+
+  Assert.proto_error ~loc:__LOC__ err (function
+      | Delegate_storage.Active_delegate -> true
+      | _ -> false)
+
+(* with implicit contract emptied then recredited after first self-delegation  *)
+let double_registration_when_recredited () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let account = Account.new_account () in
+  let pkh = Account.(account.pkh) in
+  let impl_contract = Contract.implicit_contract pkh in
+  (* credit 1μꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ ->
+  (* self delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation ->
+  Incremental.add_operation i self_delegation >>=? fun i ->
+  (* empty the delegate account *)
+  Op.transaction (I i) impl_contract bootstrap Tez.one_mutez >>=? fun empty_contract ->
+  Incremental.add_operation i empty_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ ->
+  (* credit 1μꜩ+ check balance *)
+  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract ->
+  Incremental.add_operation i create_contract >>=? fun i ->
+  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ ->
+  (* second self-delegation *)
+  Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration ->
+  Incremental.add_operation i second_registration >>= fun err ->
+
+  Assert.proto_error ~loc:__LOC__ err (function
+      | Delegate_storage.Active_delegate -> true
+      | _ -> false)
+
+(* originate and self-delegation on unrevealed contract *)
+let unregistered_and_unrevealed_self_delegate_key_init_origination ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let { Account.pkh ; _ }  = Account.new_account () in
+  let contract = Alpha_context.Contract.implicit_contract pkh in
+  Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* origination with delegate argument *)
+  Op.origination ~fee ~delegate:pkh (I i) contract >>=? fun (op, orig_contract) ->
+  Context.Contract.balance (I i) contract >>=? fun balance ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* origination did not proceed; fee has been debited *)
+    begin
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key pkh)
+        i op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee >>=? fun () ->
+      (* originated contract has not been created *)
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+(* originate and self-delegation on revelead but not registered contract *)
+let unregistered_and_revealed_self_delegate_key_init_origination ~fee () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let { Account.pkh ; pk ; _ }  = Account.new_account () in
+  let contract = Alpha_context.Contract.implicit_contract pkh in
+  Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  Op.revelation (I i) pk >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  (* origination with delegate argument *)
+  Op.origination ~fee ~delegate:pkh (I i) contract >>=? fun (op, orig_contract) ->
+  Context.Contract.balance (I i) contract >>=? fun balance ->
+  if fee > balance then
+    begin
+      Incremental.add_operation i op >>= fun err ->
+      Assert.proto_error ~loc:__LOC__ err (function
+          | Contract_storage.Balance_too_low _ -> true
+          | _ -> false)
+    end
+  else
+    (* origination did not proceed; fee has been debited *)
+    begin
+      Incremental.add_operation
+        ~expect_failure:(expect_unregistered_key pkh)
+        i op >>=? fun i ->
+      Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee >>=? fun () ->
+      (* originated contract has not been created *)
+      Context.Contract.balance (I i) orig_contract >>= fun err ->
+      Assert.error ~loc:__LOC__ err (function
+          | RPC_context.Not_found _ -> true
+          | _ -> false)
+    end
+
+(* originate and self-delegation on revealed and registered contract *)
+let registered_self_delegate_key_init_origination () =
+  Context.init 1 >>=? fun (b, bootstrap_contracts) ->
+  Incremental.begin_construction b >>=? fun i ->
+  let bootstrap = List.hd bootstrap_contracts in
+  let { Account.pkh ; pk ; _ }  = Account.new_account () in
+  let contract = Alpha_context.Contract.implicit_contract pkh in
+  Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  Op.revelation (I i) pk >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  Op.delegation (I i) contract (Some pkh) >>=? fun op ->
+  Incremental.add_operation i op >>=? fun i ->
+  Context.Contract.balance (I i) contract >>=? fun balance ->
+  Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }} ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  (* origination with delegate argument *)
+  Op.origination ~delegate:pkh ~credit:Tez.one (I i) contract >>=? fun (op, orig_contract) ->
+  Tez.(origination_burn +? Tez.one) >>?= fun total_cost ->
+  Incremental.add_operation i op >>=? fun i ->
+  Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance total_cost >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (I i) orig_contract Tez.one >>=? fun () ->
+  return_unit
+
+let tests_delegate_registration =
+  [
+    (*** unregistered delegate key: no self-delegation ***)
+    (* no token transfer, no self-delegation *)
+    Test.tztest "unregistered delegate key (origination, small fee)"
+      `Quick (unregistered_delegate_key_init_origination ~fee:Tez.one_mutez);
+    Test.tztest "unregistered delegate key (origination, edge case fee)"
+      `Quick (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 3_999_488));
+    Test.tztest "unregistered delegate key (origination, large fee)"
+      `Quick (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 10_000_000));
+
+    Test.tztest "unregistered delegate key (init with delegation, small fee)"
+      `Quick (unregistered_delegate_key_init_delegation ~fee:Tez.one_mutez);
+    Test.tztest "unregistered delegate key (init with delegation, max fee)"
+      `Quick (unregistered_delegate_key_init_delegation ~fee:Tez.max_tez);
+
+    Test.tztest "unregistered delegate key (switch with delegation, small fee)"
+      `Quick (unregistered_delegate_key_switch_delegation ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key (switch with delegation, max fee)"
+      `Quick (unregistered_delegate_key_switch_delegation ~fee:Tez.max_tez) ;
+
+    (* credit/debit 1μꜩ, no self-delegation *)
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (origination, small fee)"
+      `Quick (unregistered_delegate_key_init_origination_credit_debit ~fee:Tez.one_mutez ~amount:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (origination, large fee)"
+      `Quick (unregistered_delegate_key_init_origination_credit_debit ~fee:Tez.max_tez ~amount:Tez.one_mutez) ;
+
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (init with delegation, small fee)"
+      `Quick (unregistered_delegate_key_init_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (init with delegation, large fee)"
+      `Quick (unregistered_delegate_key_init_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ;
+
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, small fee)"
+      `Quick (unregistered_delegate_key_switch_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, large fee)"
+      `Quick (unregistered_delegate_key_switch_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ;
+
+    (* credit 1μꜩ, no self-delegation *)
+    Test.tztest "unregistered delegate key - credit 1μꜩ (origination, small fee)"
+      `Quick (unregistered_delegate_key_init_origination_credit ~fee:Tez.one_mutez ~amount:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit 1μꜩ (origination, edge case fee)"
+      `Quick (unregistered_delegate_key_init_origination_credit ~fee:(Tez.of_int 3_999_488) ~amount:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit 1μꜩ (origination, large fee)"
+      `Quick (unregistered_delegate_key_init_origination_credit ~fee:(Tez.of_int 10_000_000) ~amount:Tez.one_mutez) ;
+
+    Test.tztest "unregistered delegate key - credit 1μꜩ (init with delegation, small fee)"
+      `Quick (unregistered_delegate_key_init_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit 1μꜩ (init with delegation, large fee)"
+      `Quick (unregistered_delegate_key_init_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ;
+
+    Test.tztest "unregistered delegate key - credit 1μꜩ (switch with delegation, small fee)"
+      `Quick (unregistered_delegate_key_switch_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered delegate key - credit 1μꜩ (switch with delegation, large fee)"
+      `Quick (unregistered_delegate_key_switch_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ;
+
+    (* origination with self_delegation on unrevealed and unregistered contract *)
+    Test.tztest "unregistered and unrevealed self-delegation (origination, small fee)"
+      `Quick (unregistered_and_unrevealed_self_delegate_key_init_origination ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered and unrevealed self-delegation (origination, large fee)"
+      `Quick (unregistered_and_unrevealed_self_delegate_key_init_origination ~fee:Tez.max_tez) ;
+
+    (* origination with self_delegation on unregistered contract *)
+    Test.tztest "unregistered and revealed self-delegation (origination, small fee)"
+      `Quick (unregistered_and_revealed_self_delegate_key_init_origination ~fee:Tez.one_mutez) ;
+    Test.tztest "unregistered and revealed self-delegation (origination, large fee)"
+      `Quick (unregistered_and_revealed_self_delegate_key_init_origination ~fee:Tez.max_tez) ;
+
+    (* origination with self_delegation on registered contract *)
+    Test.tztest "registered and revelead self-delegation (origination)"
+      `Quick registered_self_delegate_key_init_origination ;
+
+    (*** unregistered delegate key: failed self-delegation ***)
+    (* no token transfer, self-delegation *)
+    Test.tztest "failed self-delegation: no transaction" `Quick failed_self_delegation_no_transaction ;
+    (* credit 1μtz, debit 1μtz, self-delegation *)
+    Test.tztest "failed self-delegation: credit & debit 1μꜩ" `Quick (failed_self_delegation_emptied_implicit_contract Tez.one_mutez) ;
+
+    (*** valid registration ***)
+    (* valid registration: credit 1 μꜩ, self delegation *)
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation (origination)"
+      `Quick (valid_delegate_registration_init_origination_credit Tez.one_mutez) ;
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation (init with delegation)"
+      `Quick (valid_delegate_registration_init_delegation_credit Tez.one_mutez) ;
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation (switch with delegation)"
+      `Quick (valid_delegate_registration_switch_delegation_credit Tez.one_mutez) ;
+    (* valid registration: credit 1 μꜩ, self delegation, debit 1μꜩ *)
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (origination)"
+      `Quick (valid_delegate_registration_init_origination_credit_debit Tez.one_mutez) ;
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (init with delegation)"
+      `Quick (valid_delegate_registration_init_delegation_credit_debit Tez.one_mutez) ;
+    Test.tztest "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (switch with delegation)"
+      `Quick (valid_delegate_registration_switch_delegation_credit_debit Tez.one_mutez) ;
+
+    (*** double registration ***)
+    Test.tztest "double registration" `Quick double_registration ;
+    Test.tztest "double registration when delegate account is emptied" `Quick double_registration_when_empty ;
+    Test.tztest "double registration when delegate account is emptied and then recredited" `Quick double_registration_when_recredited ;
+  ]
+
+
+
+(******************************************************************************)
+(* Main                                                                       *)
+(******************************************************************************)
+
+let tests =
+  tests_bootstrap_contracts  @
+  tests_delegate_registration
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_baking.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_baking.ml
new file mode 100644
index 000000000..590178648
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_baking.ml
@@ -0,0 +1,189 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Double baking evidence operation may happen when a baker
+    baked two different blocks on the same level. *)
+
+open Proto_alpha
+open Alpha_context
+
+(****************************************************************)
+(*                  Utility functions                           *)
+(****************************************************************)
+
+let get_first_different_baker baker bakers =
+  return @@ List.find (fun baker' ->
+      Signature.Public_key_hash.(<>) baker baker')
+    bakers
+
+let get_first_different_bakers ctxt =
+  Context.get_bakers ctxt >>=? fun bakers ->
+  let baker_1 = List.hd bakers in
+  get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 ->
+  return (baker_1, baker_2)
+
+let get_first_different_endorsers ctxt =
+  Context.get_endorsers ctxt >>=? fun endorsers ->
+  let endorser_1 = (List.hd endorsers).delegate in
+  let endorser_2 = (List.hd (List.tl endorsers)).delegate in
+  return (endorser_1, endorser_2)
+
+(** Bake two block at the same level using the same policy (i.e. same
+    baker) *)
+let block_fork ?policy contracts b =
+  let (contract_a, contract_b) =
+    List.hd contracts, List.hd (List.tl contracts) in
+  Op.transaction (B b) contract_a contract_b  Alpha_context.Tez.one_cent >>=? fun operation ->
+  Block.bake ?policy ~operation b >>=? fun blk_a ->
+  Block.bake ?policy b >>=? fun blk_b ->
+  return (blk_a, blk_b)
+
+(****************************************************************)
+(*                        Tests                                 *)
+(****************************************************************)
+
+(** Simple scenario where two blocks are baked by a same baker and
+    exposed by a double baking evidence operation *)
+let valid_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+
+  Context.get_bakers (B b) >>=? fun bakers ->
+  let priority_0_baker = List.hd bakers in
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~policy:(Excluding [ priority_0_baker ]) ~operation blk_a >>=? fun blk ->
+
+  (* Check that the frozen deposit, the fees and rewards are removed *)
+  iter_s (fun kind ->
+      let contract = Alpha_context.Contract.implicit_contract priority_0_baker in
+      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
+    [ Deposit ; Fees ; Rewards ]
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Check that a double baking operation fails if it exposes the same two blocks *)
+let same_blocks () =
+  Context.init 2 >>=? fun (b, _contracts) ->
+  Block.bake b >>=? fun ba ->
+  Op.double_baking (B ba) ba.header ba.header >>=? fun operation ->
+  Block.bake ~operation ba >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_baking_evidence _ -> true
+    | _ -> false end >>=? fun () ->
+  return_unit
+
+(** Check that a double baking operation exposing two blocks with
+    different levels fails *)
+let different_levels () =
+  Context.init 2 >>=? fun (b, contracts) ->
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Block.bake blk_b >>=? fun blk_b_2 ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b_2.header >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that a double baking operation exposing two yet to be baked
+    blocks fails *)
+let too_early_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  Op.double_baking (B b) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Too_early_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that after [preserved_cycles + 1], it is not possible to
+    create a double baking operation anymore *)
+let too_late_double_baking_evidence () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  Context.get_constants (B b)
+  >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } ->
+
+  block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) ->
+
+  fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
+    blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
+
+  Op.double_baking (B blk) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Outdated_double_baking_evidence _ -> true
+    | _ -> false end
+
+(** Check that an invalid double baking evidence that exposes two block
+    baking with same level made by different bakers fails *)
+let different_delegates () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b ->
+
+  Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Apply.Inconsistent_double_baking_evidence _ -> true
+    | _ -> false end
+
+let wrong_signer () =
+  (* Baker_2 bakes a block but baker signs it. *)
+  let header_custom_signer baker baker_2 b =
+    Block.Forge.forge_header ~policy:(By_account baker_2) b >>=? fun header ->
+    Block.Forge.set_baker baker header |>
+    Block.Forge.sign_header
+  in
+
+  Context.init 2 >>=? fun (b, _) ->
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  header_custom_signer baker_1 baker_2 b >>=? fun header_b ->
+  Op.double_baking (B blk_a) blk_a.header header_b >>=? fun operation ->
+  Block.bake ~operation blk_a >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Baking.Invalid_block_signature _ -> true
+    | _ -> false end
+
+let tests = [
+  Test.tztest "valid double baking evidence" `Quick valid_double_baking_evidence ;
+
+  (* Should fail*)
+  Test.tztest "same blocks" `Quick same_blocks ;
+  Test.tztest "different levels" `Quick different_levels ;
+  Test.tztest "too early double baking evidence" `Quick too_early_double_baking_evidence ;
+  Test.tztest "too late double baking evidence" `Quick too_late_double_baking_evidence ;
+  Test.tztest "different delegates" `Quick different_delegates ;
+  Test.tztest "wrong delegate" `Quick wrong_signer ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_endorsement.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_endorsement.ml
new file mode 100644
index 000000000..4d5187c9b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/double_endorsement.ml
@@ -0,0 +1,204 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Double endorsement evidence operation may happen when an endorser
+    endorsed two different blocks on the same level. *)
+
+open Proto_alpha
+open Alpha_context
+
+(****************************************************************)
+(*                  Utility functions                           *)
+(****************************************************************)
+
+let get_first_different_baker baker bakers =
+  return @@ List.find (fun baker' ->
+      Signature.Public_key_hash.(<>) baker baker')
+    bakers
+
+let get_first_different_bakers ctxt =
+  Context.get_bakers ctxt >>=? fun bakers ->
+  let baker_1 = List.hd bakers in
+  get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 ->
+  return (baker_1, baker_2)
+
+let get_first_different_endorsers ctxt =
+  Context.get_endorsers ctxt >>=? fun endorsers ->
+  let endorser_1 = (List.hd endorsers) in
+  let endorser_2 = (List.hd (List.tl endorsers)) in
+  return (endorser_1, endorser_2)
+
+let block_fork b =
+  get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) ->
+  Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a ->
+  Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b ->
+  return (blk_a, blk_b)
+
+(****************************************************************)
+(*                        Tests                                 *)
+(****************************************************************)
+
+(** Simple scenario where two endorsements are made from the same
+    delegate and exposed by a double_endorsement operation. Also verify
+    that punishment is operated. *)
+let valid_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+  Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a ->
+  (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
+
+  Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation ->
+
+  (* Bake with someone different than the bad endorser *)
+  Context.get_bakers (B blk_a) >>=? fun bakers ->
+  get_first_different_baker delegate bakers >>=? fun baker ->
+
+  Block.bake ~policy:(By_account baker) ~operation blk_a >>=? fun blk ->
+
+  (* Check that the frozen deposit, the fees and rewards are removed *)
+  iter_s (fun kind ->
+      let contract = Alpha_context.Contract.implicit_contract delegate in
+      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
+    [ Deposit ; Fees ; Rewards ]
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Check that an invalid double endorsement operation that exposes a valid
+    endorsement fails. *)
+let invalid_double_endorsement () =
+  Context.init 10 >>=? fun (b, _) ->
+  Block.bake b >>=? fun b ->
+
+  Op.endorsement (B b) () >>=? fun endorsement ->
+  Block.bake ~operation:(Operation.pack endorsement) b >>=? fun b ->
+
+  Op.double_endorsement (B b) endorsement endorsement >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_double_endorsement_evidence -> true
+    | _ -> false end
+
+(** Check that a double endorsement added at the same time as a double
+    endorsement operation fails. *)
+let too_early_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Too_early_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that after [preserved_cycles + 1], it is not possible
+    to create a double_endorsement anymore. *)
+let too_late_double_endorsement_evidence () =
+  Context.init 2 >>=? fun (b, _) ->
+  Context.get_constants (B b)
+  >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } ->
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+
+  Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
+  Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
+    blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
+
+  Op.double_endorsement (B blk) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation blk >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Outdated_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that an invalid double endorsement evidence that expose two
+    endorsements made by two different endorsers fails. *)
+let different_delegates () =
+  Context.init 2 >>=? fun (b, _) ->
+
+  Block.bake b >>=? fun b ->
+  block_fork b >>=? fun (blk_a, blk_b) ->
+  Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) ->
+  get_first_different_endorsers (B blk_b) >>=? fun (endorser_b1c, endorser_b2c) ->
+  let endorser_b =
+    if Signature.Public_key_hash.(=) endorser_a endorser_b1c.delegate
+    then endorser_b2c.delegate
+    else endorser_b1c.delegate
+  in
+
+  Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun e_a ->
+  Op.endorsement ~delegate:endorser_b (B blk_b) () >>=? fun e_b ->
+  Block.bake ~operation:(Operation.pack e_b) blk_b >>=? fun _ ->
+  Op.double_endorsement (B blk_b) e_a e_b >>=? fun operation ->
+  Block.bake ~operation blk_b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Inconsistent_double_endorsement_evidence _ -> true
+    | _ -> false end
+
+(** Check that a double endorsement evidence that exposes a ill-formed
+    endorsement fails. *)
+let wrong_delegate () =
+  Context.init ~endorsers_per_block:1 2 >>=? fun (b, contracts) ->
+  Error_monad.map_s (Context.Contract.manager (B b)) contracts >>=? fun accounts ->
+  let pkh1 = (List.nth accounts 0).Account.pkh in
+  let pkh2 = (List.nth accounts 1).Account.pkh in
+
+  block_fork b >>=? fun (blk_a, blk_b) ->
+  Context.get_endorser (B blk_a) >>=? fun (endorser_a, _) ->
+  Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun endorsement_a ->
+  Context.get_endorser (B blk_b) >>=? fun (endorser_b, _) ->
+  let delegate =
+    if Signature.Public_key_hash.equal pkh1 endorser_b
+    then pkh2
+    else pkh1
+  in
+  Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
+
+  Op.double_endorsement (B blk_b) endorsement_a endorsement_b >>=? fun operation ->
+  Block.bake ~operation blk_b >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Baking.Unexpected_endorsement -> true
+    | _ -> false end
+
+let tests = [
+  Test.tztest "valid double endorsement evidence" `Quick valid_double_endorsement_evidence ;
+  Test.tztest "invalid double endorsement evidence" `Quick invalid_double_endorsement ;
+  Test.tztest "too early double endorsement evidence" `Quick too_early_double_endorsement_evidence ;
+  Test.tztest "too late double endorsement evidence" `Quick too_late_double_endorsement_evidence ;
+  Test.tztest "different delegates" `Quick different_delegates ;
+  Test.tztest "wrong delegate" `Quick wrong_delegate ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/dune b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/dune
new file mode 100644
index 000000000..3fe334c64
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/dune
@@ -0,0 +1,43 @@
+(executable
+ (name main)
+ (libraries tezos-base
+            tezos-micheline
+            tezos-protocol-environment
+            alcotest-lwt
+            tezos_alpha_test_helpers
+            michelson_parser
+            tezos-stdlib-unix
+            bip39
+            )
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_micheline
+                   -open Tezos_alpha_test_helpers
+                   )))
+
+(alias
+ (name buildtest)
+ (package tezos-protocol-alpha)
+ (deps main.exe))
+
+; runs only the `Quick tests
+(alias
+ (name runtest_proto_alpha)
+ (package tezos-protocol-alpha)
+ (action (chdir %{workspace_root} (run %{exe:main.exe} -v -q))))
+
+; runs both `Quick and `Slow tests
+(alias
+ (name runtest_slow)
+ (package tezos-protocol-alpha)
+ (action (chdir %{workspace_root} (run %{exe:main.exe} -v))))
+
+(alias
+ (name runtest)
+ (package tezos-protocol-alpha)
+ (deps (alias runtest_proto_alpha)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml*))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/endorsement.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/endorsement.ml
new file mode 100644
index 000000000..cfab6d079
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/endorsement.ml
@@ -0,0 +1,348 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Endorsing a block adds an extra layer of confidence to the Tezos's
+    PoS algorithm. The block endorsing operation must be included in
+    the following block. Each endorser possess a slot corresponding to
+    their priority. After [preserved_cycles], a reward is given to the
+    endorser. This reward depends on the priority of the endorsed
+    block. *)
+
+open Proto_alpha
+open Alpha_context
+open Test_utils
+open Test_tez
+
+(****************************************************************)
+(*                    Utility functions                         *)
+(****************************************************************)
+
+let get_expected_reward ?(priority=0) ~nb_baking ~nb_endorsement ctxt =
+  Context.get_constants ctxt >>=? fun Constants.
+    { parametric = { endorsement_reward ; block_reward ; _ } ; _  } ->
+  let open Alpha_environment in let open Tez in
+  endorsement_reward /? Int64.(succ (of_int priority)) >>?= fun endorsement_reward ->
+
+  endorsement_reward *? (Int64.of_int nb_endorsement) >>?= fun endorsement_reward ->
+  block_reward *? (Int64.of_int nb_baking) >>?= fun baking_reward ->
+  endorsement_reward +? baking_reward >>?= fun reward -> return reward
+
+let get_expected_deposit ctxt ~nb_baking ~nb_endorsement =
+  Context.get_constants ctxt >>=? fun Constants.
+    { parametric = { endorsement_security_deposit ;
+                     block_security_deposit ; _ } ; _  } ->
+  let open Alpha_environment in let open Tez in
+  endorsement_security_deposit *? (Int64.of_int nb_endorsement) >>?= fun endorsement_deposit ->
+  block_security_deposit *? (Int64.of_int nb_baking) >>?= fun baking_deposit ->
+  endorsement_deposit +? baking_deposit >>?= fun deposit -> return deposit
+
+let assert_endorser_balance_consistency ~loc ?(priority=0) ?(nb_baking=0) ~nb_endorsement
+    ctxt pkh initial_balance =
+  let contract = Contract.implicit_contract pkh in
+  get_expected_reward ~priority ~nb_baking ~nb_endorsement ctxt >>=? fun reward ->
+  get_expected_deposit ctxt ~nb_baking ~nb_endorsement >>=? fun deposit ->
+
+  Assert.balance_was_debited ~loc ctxt contract initial_balance deposit >>=? fun () ->
+  Context.Contract.balance ~kind:Rewards ctxt contract >>=? fun reward_balance ->
+  Assert.equal_tez ~loc reward_balance reward >>=? fun () ->
+  Context.Contract.balance ~kind:Deposit ctxt contract >>=? fun deposit_balance ->
+  Assert.equal_tez ~loc deposit_balance deposit
+
+(****************************************************************)
+(*                      Tests                                   *)
+(****************************************************************)
+
+(** Apply a single endorsement from the slot 0 endorser *)
+let simple_endorsement () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_endorser (B b) >>=? fun (delegate, slots) ->
+  Op.endorsement ~delegate (B b) () >>=? fun op ->
+  Context.Contract.balance (B b)
+    (Contract.implicit_contract delegate) >>=? fun initial_balance ->
+  Block.bake
+    ~policy:(Excluding [delegate])
+    ~operations:[Operation.pack op]
+    b >>=? fun b2 ->
+  assert_endorser_balance_consistency ~loc:__LOC__
+    (B b2) ~nb_endorsement:(List.length slots)
+    delegate initial_balance
+
+(** Apply a maximum number of endorsement. A endorser can be selected
+    twice. *)
+let max_endorsement () =
+  let endorsers_per_block = 16 in
+  Context.init ~endorsers_per_block 32 >>=? fun (b, _) ->
+
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  Assert.equal_int ~loc:__LOC__
+    (List.length (List.concat (List.map (fun { Alpha_services.Delegate.Endorsing_rights.slots } -> slots) endorsers))) endorsers_per_block >>=? fun () ->
+
+  fold_left_s (fun (delegates, ops, balances) (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
+      let delegate = endorser.delegate in
+      Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance ->
+      Op.endorsement ~delegate (B b) () >>=? fun op ->
+      return (delegate :: delegates, Operation.pack op :: ops, (List.length endorser.slots, balance) :: balances)
+    )
+    ([], [], [])
+    endorsers >>=? fun (delegates, ops, previous_balances) ->
+
+  Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b >>=? fun b ->
+
+  (* One account can endorse more than one time per level, we must
+     check that the bonds are summed up *)
+  iter_s (fun (endorser_account, (nb_endorsement, previous_balance)) ->
+      assert_endorser_balance_consistency ~loc:__LOC__
+        (B b) ~nb_endorsement endorser_account previous_balance
+    ) (List.combine delegates previous_balances)
+
+(** Check that an endorser balance is consistent with a different priority *)
+let consistent_priority () =
+  Context.init 32 >>=? fun (b, _) ->
+  Block.get_next_baker ~policy:(By_priority 15) b >>=? fun (baker_account, _, _) ->
+  Block.bake ~policy:(By_priority 15) b >>=? fun b ->
+
+  (* Grab an endorser that didn't bake the previous block *)
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let endorser =
+    List.find
+      (fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
+      endorsers in
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
+
+  Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~policy:( Excluding [ endorser.delegate ] ) ~operation b >>=? fun b ->
+
+  assert_endorser_balance_consistency ~loc:__LOC__ ~priority:15
+    (B b) ~nb_endorsement:(List.length endorser.slots) endorser.delegate balance
+
+(** Check every 32 endorser's balances are consistent with a different priority *)
+let consistent_priorities () =
+  let priorities = 15 -- 31 in
+  Context.init 64 >>=? fun (b, _) ->
+
+  iter_s (fun priority ->
+      (* Bake with a specific priority *)
+      Block.get_next_baker ~policy:(By_priority priority) b >>=? fun (baker_account, _, _) ->
+      Block.bake ~policy:(By_priority priority) b >>=? fun b ->
+
+      (* Grab an endorser that didn't bake the previous block *)
+      Context.get_endorsers (B b) >>=? fun endorsers ->
+      let endorser =
+        List.find
+          (fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
+          endorsers in
+
+      Context.Contract.balance (B b) (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
+      Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
+      let operation = Operation.pack operation in
+      Block.bake ~policy:( Excluding [ endorser.delegate ] ) ~operation b >>=? fun b ->
+
+      assert_endorser_balance_consistency ~loc:__LOC__ ~priority
+        (B b) ~nb_endorsement:(List.length endorser.slots) endorser.delegate balance
+    ) priorities
+
+(** Check that after [preserved_cycles] cycles the endorser gets his reward *)
+let reward_retrieval () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_constants (B b) >>=? fun Constants.
+    { parametric = { preserved_cycles ; endorsement_reward ; _ } ; _ } ->
+
+  Context.get_endorser (B b) >>=? fun (endorser, slots) ->
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
+  Op.endorsement ~delegate:endorser (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~policy:(Excluding [ endorser ]) ~operation b >>=? fun b ->
+  (* Bake (preserved_cycles + 1) cycles *)
+  fold_left_s (fun b _ ->
+      Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) b
+    ) b (0 -- preserved_cycles) >>=? fun b ->
+
+  Lwt.return Tez.(endorsement_reward *? Int64.of_int (List.length slots)) >>=? fun reward ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser) balance reward
+
+
+(** Check that after [preserved_cycles] cycles endorsers get their
+    reward. Two endorsers are used and they endorse in different
+    cycles. *)
+let reward_retrieval_two_endorsers () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_constants (B b) >>=? fun Constants.
+    { parametric = { preserved_cycles ; endorsement_reward ; endorsement_security_deposit ; _ } ; _ } ->
+
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let endorser1 = List.hd endorsers in
+  let endorser2 = List.hd (List.tl endorsers) in
+
+  let policy = Block.Excluding [ endorser1.delegate ; endorser2.delegate ] in
+
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser1.delegate) >>=? fun balance1 ->
+  Context.Contract.balance (B b) (Contract.implicit_contract endorser2.delegate) >>=? fun balance2 ->
+
+  Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser1.slots)) >>=? fun security_deposit1 ->
+  Lwt.return Tez.(endorsement_reward *? Int64.of_int (List.length endorser1.slots)) >>=? fun reward1 ->
+
+  (* endorser1 endorses the genesis block in cycle 0 *)
+  Op.endorsement ~delegate:endorser1.delegate (B b) () >>=? fun operation1 ->
+
+  (* bake next block, include endorsement of endorser1 *)
+  Block.bake ~policy ~operation:(Operation.pack operation1) b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2  >>=? fun () ->
+
+  (* complete cycle 0 *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2  >>=? fun () ->
+
+  (* get the slots of endorser2 for the current block *)
+  Context.get_endorsers (B b) >>=? fun endorsers ->
+  let same_endorser2 endorser = Signature.Public_key_hash.compare endorser.Delegate_services.Endorsing_rights.delegate endorser2.delegate = 0 in
+  let endorser2 = List.find same_endorser2 endorsers in (* No exception raised: in sandboxed mode endorsers do not change between blocks *)
+  Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) >>=? fun security_deposit2 ->
+
+  (* endorser2 endorses the last block in cycle 0 *)
+  Op.endorsement ~delegate:endorser2.delegate (B b) () >>=? fun operation2 ->
+  let priority = b.header.protocol_data.contents.priority in
+  Tez.(endorsement_reward /? Int64.(succ (of_int priority))) >>?= fun reward_per_slot ->
+  Lwt.return Tez.(reward_per_slot *? Int64.of_int (List.length endorser2.slots)) >>=? fun reward2 ->
+
+  (* bake first block in cycle 1, include endorsement of endorser2 *)
+  Block.bake ~policy ~operation:(Operation.pack operation2) b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+
+  (* bake [preserved_cycles] cycles *)
+  fold_left_s (fun b _ ->
+      Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () ->
+      Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+      Block.bake_until_cycle_end ~policy b
+    ) b (1 -- preserved_cycles) >>=? fun b ->
+
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () ->
+
+  (* bake cycle [preserved_cycle + 1] *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () ->
+  Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 reward2
+
+
+
+(****************************************************************)
+(*  The following test scenarios are supposed to raise errors.  *)
+(****************************************************************)
+
+(** Wrong endorsement predecessor : apply an endorsement with an
+    incorrect block predecessor *)
+let wrong_endorsement_predecessor () =
+  Context.init 5 >>=? fun (b, _) ->
+
+  Context.get_endorser (B b) >>=? fun (genesis_endorser, _slots) ->
+  Block.bake b >>=? fun b' ->
+  Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b) (B b') () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~operation b' >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Wrong_endorsement_predecessor _ -> true
+    | _ -> false
+  end
+
+(** Invalid_endorsement_level : apply an endorsement with an incorrect
+    level (i.e. the predecessor level) *)
+let invalid_endorsement_level () =
+  Context.init 5 >>=? fun (b, _) ->
+  Context.get_level (B b) >>=? fun genesis_level ->
+  Block.bake b >>=? fun b ->
+  Op.endorsement ~level:genesis_level (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Block.bake ~operation b >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Invalid_endorsement_level -> true
+    | _ -> false
+  end
+
+(** Duplicate endorsement : apply an endorsement that has already been done *)
+let duplicate_endorsement () =
+  Context.init 5 >>=? fun (b, _) ->
+  Incremental.begin_construction b >>=? fun inc ->
+  Op.endorsement (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Incremental.add_operation inc operation >>=? fun inc ->
+  Op.endorsement (B b) () >>=? fun operation ->
+  let operation = Operation.pack operation in
+  Incremental.add_operation inc operation >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Apply.Duplicate_endorsement _ -> true
+    | _ -> false
+  end
+
+(** Apply a single endorsement from the slot 0 endorser *)
+let no_enough_for_deposit () =
+  Context.init 5 ~endorsers_per_block:1 >>=? fun (b, contracts) ->
+  Error_monad.map_s (fun c ->
+      Context.Contract.manager (B b) c >>=? fun m -> return (m, c)) contracts >>=?
+  fun managers ->
+  Context.get_endorser (B b) >>=? fun (endorser,_) ->
+  let _, contract_other_than_endorser =
+    List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser))
+      managers
+  in
+  let _, contract_of_endorser =
+    List.find (fun (c, _) -> (Signature.Public_key_hash.equal c.Account.pkh endorser))
+      managers
+  in
+  Op.endorsement ~delegate:endorser (B b) () >>=? fun op_endo ->
+  Context.Contract.balance (B b)
+    (Contract.implicit_contract endorser) >>=? fun initial_balance ->
+  Op.transaction (B b) contract_of_endorser contract_other_than_endorser initial_balance >>=? fun op_trans ->
+  Block.bake
+    ~policy:(Excluding [endorser])
+    ~operations:[Operation.pack op_endo; op_trans]
+    b >>= fun res ->
+
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Delegate_storage.Balance_too_low_for_deposit _ -> true
+    | _ -> false
+  end
+
+let tests = [
+  Test.tztest "Simple endorsement" `Quick simple_endorsement ;
+  Test.tztest "Maximum endorsement" `Quick max_endorsement ;
+
+  Test.tztest "Consistent priority" `Quick consistent_priority ;
+  Test.tztest "Consistent priorities" `Quick consistent_priorities ;
+  Test.tztest "Reward retrieval" `Quick reward_retrieval ;
+  Test.tztest "Reward retrieval two endorsers" `Quick reward_retrieval_two_endorsers ;
+
+  (* Fail scenarios *)
+  Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ;
+  Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ;
+  Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ;
+  Test.tztest "Not enough for deposit" `Quick no_enough_for_deposit ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.ml
new file mode 100644
index 000000000..abc33230f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.ml
@@ -0,0 +1,78 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+type t = {
+  pkh : Signature.Public_key_hash.t ;
+  pk :  Signature.Public_key.t ;
+  sk :  Signature.Secret_key.t ;
+}
+type account = t
+
+let known_accounts = Signature.Public_key_hash.Table.create 17
+
+let new_account () =
+  let (pkh, pk, sk) = Signature.generate_key () in
+  let account = { pkh ; pk ; sk } in
+  Signature.Public_key_hash.Table.add known_accounts pkh account ;
+  account
+
+let add_account ({ pkh ; _ } as account) =
+  Signature.Public_key_hash.Table.add known_accounts pkh account
+
+let activator_account = new_account ()
+
+let find pkh =
+  try return (Signature.Public_key_hash.Table.find known_accounts pkh)
+  with Not_found ->
+    failwith "Missing account: %a" Signature.Public_key_hash.pp pkh
+
+let find_alternate pkh =
+  let exception Found of t in
+  try
+    Signature.Public_key_hash.Table.iter
+      (fun pkh' account ->
+         if not (Signature.Public_key_hash.equal pkh pkh') then
+           raise (Found account))
+      known_accounts ;
+    raise Not_found
+  with Found account -> account
+
+let dummy_account = new_account ()
+
+let generate_accounts ?(initial_balances = []) n : (t * Tez_repr.t) list =
+  Signature.Public_key_hash.Table.clear known_accounts ;
+  let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
+  let amount i = match List.nth_opt initial_balances i with
+    | None -> default_amount
+    | Some a -> Tez_repr.of_mutez_exn a
+  in
+  List.map (fun i ->
+      let (pkh, pk, sk) = Signature.generate_key () in
+      let account = { pkh ; pk ; sk } in
+      Signature.Public_key_hash.Table.add known_accounts pkh account ;
+      account, amount i)
+    (0--(n-1))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.mli
new file mode 100644
index 000000000..b49979c29
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/account.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+type t = {
+  pkh : Signature.Public_key_hash.t ;
+  pk :  Signature.Public_key.t ;
+  sk :  Signature.Secret_key.t ;
+}
+type account = t
+
+val activator_account: account
+val dummy_account: account
+
+val new_account: unit -> account
+
+val add_account : t -> unit
+
+val find: Signature.Public_key_hash.t -> t tzresult Lwt.t
+val find_alternate: Signature.Public_key_hash.t -> t
+
+(** [generate_accounts ?initial_balances n] : generates [n] random
+    accounts with the initial balance of the [i]th account given by the
+    [i]th value in the list [initial_balances] or otherwise
+    4.000.000.000 tz (if the list is too short); and add them to the
+    global account state *)
+val generate_accounts : ?initial_balances:int64 list -> int -> (t * Tez_repr.t) list
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/assert.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/assert.ml
new file mode 100644
index 000000000..d823092cb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/assert.ml
@@ -0,0 +1,124 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let error ~loc v f =
+  match v with
+  | Error err when List.exists f err ->
+      return_unit
+  | Ok _ ->
+      failwith "Unexpected successful result (%s)" loc
+  | Error err ->
+      failwith "@[Unexpected error (%s): %a@]" loc pp_print_error err
+
+let proto_error ~loc v f =
+  error ~loc v
+    (function
+      | Alpha_environment.Ecoproto_error err -> f err
+      | _ -> false)
+
+let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b  =
+  if not (cmp a b) then
+    failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b
+  else
+    return_unit
+
+let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b  =
+  if cmp a b then
+    failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b
+  else
+    return_unit
+
+(* tez *)
+let equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) =
+  let open Alpha_context in
+  equal ~loc Tez.(=) "Tez aren't equal" Tez.pp a b
+
+let not_equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) =
+  let open Alpha_context in
+  not_equal ~loc Tez.(=) "Tez are equal" Tez.pp a b
+
+(* int *)
+let equal_int ~loc (a:int) (b:int) =
+  equal ~loc (=) "Integers aren't equal" Format.pp_print_int a b
+
+let not_equal_int ~loc (a:int) (b:int) =
+  not_equal ~loc (=) "Integers are equal" Format.pp_print_int a b
+
+(* bool *)
+let equal_bool ~loc (a:bool) (b:bool) =
+  equal ~loc (=) "Booleans aren't equal" Format.pp_print_bool a b
+
+let not_equal_bool ~loc (a:bool) (b:bool) =
+  not_equal ~loc (=) "Booleans are equal" Format.pp_print_bool a b
+
+(* pkh *)
+let equal_pkh ~loc (a:Signature.Public_key_hash.t) (b:Signature.Public_key_hash.t) =
+  let module PKH = Signature.Public_key_hash in
+  equal ~loc PKH.equal "Public key hashes  aren't equal" PKH.pp a b
+
+let not_equal_pkh ~loc (a:Signature.Public_key_hash.t) (b:Signature.Public_key_hash.t) =
+  let module PKH = Signature.Public_key_hash in
+  not_equal ~loc PKH.equal "Public key hashes are equal" PKH.pp a b
+
+open Context
+(* Some asserts for account operations *)
+
+(** [balance_is b c amount] checks that the current balance of contract [c] is
+    [amount].
+    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
+    [Rewards] for the others. *)
+let balance_is ~loc b contract ?(kind = Contract.Main) expected =
+  Contract.balance b contract ~kind >>=? fun balance ->
+  equal_tez ~loc balance expected
+
+(** [balance_was_operated ~operand b c old_balance amount] checks that the
+    current balance of contract [c] is [operand old_balance amount] and
+    returns the current balance.
+    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
+    [Rewards] for the others. *)
+let balance_was_operated ~(operand) ~loc b contract ?(kind = Contract.Main) old_balance amount =
+  operand old_balance amount |>
+  Alpha_environment.wrap_error |> Lwt.return >>=? fun expected ->
+  balance_is ~loc b contract ~kind expected
+
+let balance_was_credited = balance_was_operated ~operand:Alpha_context.Tez.(+?)
+
+let balance_was_debited = balance_was_operated ~operand:Alpha_context.Tez.(-?)
+
+
+(* debug *)
+
+let print_balances ctxt id =
+  Contract.balance ~kind:Main ctxt id >>=? fun main ->
+  Contract.balance ~kind:Deposit ctxt id >>=? fun deposit ->
+  Contract.balance ~kind:Fees ctxt id >>=? fun fees ->
+  Contract.balance ~kind:Rewards ctxt id >>|? fun rewards ->
+  Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n"
+    (Alpha_context.Tez.to_string main)
+    (Alpha_context.Tez.to_string deposit)
+    (Alpha_context.Tez.to_string fees)
+    (Alpha_context.Tez.to_string rewards)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.ml
new file mode 100644
index 000000000..41cde873e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.ml
@@ -0,0 +1,405 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+module Proto_Nonce = Nonce (* Renamed otherwise is masked by Alpha_context *)
+open Alpha_context
+
+(* This type collects a block and the context that results from its application *)
+type t = {
+  hash : Block_hash.t ;
+  header : Block_header.t ;
+  operations : Operation.packed list ;
+  context : Tezos_protocol_environment_memory.Context.t ;
+}
+type block = t
+
+let rpc_context block = {
+  Alpha_environment.Updater.block_hash = block.hash ;
+  block_header = block.header.shell ;
+  context = block.context ;
+}
+
+let rpc_ctxt =
+  new Alpha_environment.proto_rpc_context_of_directory
+    rpc_context Proto_alpha.rpc_services
+
+(******** Policies ***********)
+
+(* Policies are functions that take a block and return a tuple
+   [(account, level, timestamp)] for the [forge_header] function. *)
+
+(* This type is used only to provide a simpler interface to the exterior. *)
+type baker_policy =
+  | By_priority of int
+  | By_account of public_key_hash
+  | Excluding of public_key_hash list
+
+let get_next_baker_by_priority priority block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~all:true
+    ~max_priority:(priority+1) block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp} = List.find (fun { Alpha_services.Delegate.Baking_rights.priority = p } -> p = priority)  bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let get_next_baker_by_account pkh block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~delegates:[pkh]
+    ~max_priority:256 block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp ; priority } = List.hd bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let get_next_baker_excluding excludes block =
+  Alpha_services.Delegate.Baking_rights.get rpc_ctxt
+    ~max_priority:256 block >>=? fun bakers ->
+  let { Alpha_services.Delegate.Baking_rights.delegate = pkh ;
+        timestamp ; priority } =
+    List.find
+      (fun { Alpha_services.Delegate.Baking_rights.delegate } ->
+         not (List.mem delegate excludes))
+      bakers in
+  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)
+
+let dispatch_policy = function
+  | By_priority p -> get_next_baker_by_priority p
+  | By_account a -> get_next_baker_by_account a
+  | Excluding al -> get_next_baker_excluding al
+
+let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy
+
+module Forge = struct
+
+  type header = {
+    baker : public_key_hash ;   (* the signer of the block *)
+    shell : Block_header.shell_header ;
+    contents : Block_header.contents ;
+  }
+
+  let default_proof_of_work_nonce =
+    MBytes.create Constants.proof_of_work_nonce_size
+
+  let make_contents
+      ?(proof_of_work_nonce = default_proof_of_work_nonce)
+      ~priority ~seed_nonce_hash () =
+    Block_header.{ priority ;
+                   proof_of_work_nonce ;
+                   seed_nonce_hash }
+
+  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 = Context_hash.zero ;
+    }
+
+  let set_seed_nonce_hash seed_nonce_hash { baker ; shell ; contents } =
+    { baker ; shell ; contents = { contents with seed_nonce_hash } }
+
+  let set_baker baker header = { header with baker }
+
+  let sign_header { baker ; shell ; contents } =
+    Account.find baker >>=? fun delegate ->
+    let unsigned_bytes =
+      Data_encoding.Binary.to_bytes_exn
+        Block_header.unsigned_encoding
+        (shell, contents) in
+    let signature =
+      Signature.sign ~watermark:Signature.(Block_header Chain_id.zero) delegate.sk unsigned_bytes in
+    Block_header.{ shell ; protocol_data = { contents ; signature } } |>
+    return
+
+  let forge_header
+      ?(policy = By_priority 0)
+      ?(operations = []) pred =
+    dispatch_policy policy pred >>=? fun (pkh, priority, timestamp) ->
+    let level = Int32.succ pred.header.shell.level in
+    begin
+      match Fitness_repr.to_int64 pred.header.shell.fitness with
+      | Ok old_fitness ->
+          return (Fitness_repr.from_int64
+                    (Int64.add (Int64.of_int 1) old_fitness))
+      | Error _ -> assert false
+    end >>=? fun fitness ->
+    begin
+      Alpha_services.Helpers.current_level ~offset:1l (rpc_ctxt) pred >>|? function
+      | { expected_commitment = true } -> Some (fst (Proto_Nonce.generate ()))
+      | { expected_commitment = false } -> None
+    end >>=? fun seed_nonce_hash ->
+    let hashes = List.map Operation.hash_packed operations in
+    let operations_hash = Operation_list_list_hash.compute
+        [Operation_list_hash.compute hashes] in
+    let shell = make_shell ~level ~predecessor:pred.hash
+        ~timestamp ~fitness ~operations_hash in
+    let contents = make_contents ~priority ~seed_nonce_hash () in
+    return { baker = pkh ; shell ; contents }
+
+  (* compatibility only, needed by incremental *)
+  let contents
+      ?(proof_of_work_nonce = default_proof_of_work_nonce)
+      ?(priority = 0) ?seed_nonce_hash () =
+    {
+      Block_header.priority ;
+      proof_of_work_nonce ;
+      seed_nonce_hash ;
+    }
+
+end
+
+(********* Genesis creation *************)
+
+(* Hard-coded context key *)
+let protocol_param_key = [ "protocol_parameters" ]
+
+let check_constants_consistency constants =
+  let open Constants_repr 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 bootstrap_accounts =
+    List.map (fun (Account.{ pk ; pkh ; _ }, amount) ->
+        Parameters_repr.{ 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.t * 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 *)
+  begin try
+      let open Test_utils 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_unit
+  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 =
+    Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
+  in
+  let shell = Forge.make_shell
+      ~level:0l
+      ~predecessor:hash
+      ~timestamp:Time.epoch
+      ~fitness: (Fitness_repr.from_int64 0L)
+      ~operations_hash: Operation_list_list_hash.zero in
+  let contents = Forge.make_contents
+      ~priority:0
+      ~seed_nonce_hash:None () in
+  initial_context
+    constants
+    shell
+    commitments
+    initial_accounts
+    security_deposit_ramp_up_cycles
+    no_reward_cycles
+  >>=? fun context ->
+  let block =
+    { hash ;
+      header = {
+        shell = shell ;
+        protocol_data = {
+          contents = contents ;
+          signature = Signature.zero ;
+        } ;
+      };
+      operations = [] ;
+      context ;
+    }
+  in
+  return block
+
+(********* Baking *************)
+
+let apply header ?(operations = []) pred =
+  begin
+    let open Alpha_environment.Error_monad in
+    Proto_alpha.Main.begin_application
+      ~chain_id: Chain_id.zero
+      ~predecessor_context: pred.context
+      ~predecessor_fitness: pred.header.shell.fitness
+      ~predecessor_timestamp: pred.header.shell.timestamp
+      header >>=? fun vstate ->
+    fold_left_s
+      (fun vstate op ->
+         Proto_alpha.apply_operation vstate op >>=? fun (state, _result) ->
+         return state)
+      vstate operations >>=? fun vstate ->
+    Proto_alpha.Main.finalize_block vstate >>=? fun (validation, _result) ->
+    return validation.context
+  end >|= Alpha_environment.wrap_error >>|? fun context ->
+  let hash = Block_header.hash header in
+  { hash ; header ; operations ; context }
+
+let bake ?policy ?operation ?operations pred =
+  let operations =
+    match operation,operations with
+    | Some op, Some ops -> Some (op::ops)
+    | Some op, None -> Some [op]
+    | None, Some ops -> Some ops
+    | None, None -> None
+  in
+  Forge.forge_header ?policy ?operations pred >>=? fun header ->
+  Forge.sign_header header >>=? fun header ->
+  apply header ?operations pred
+
+(********** Cycles ****************)
+
+(* This function is duplicated from Context to avoid a cyclic dependency *)
+let get_constants b =
+  Alpha_services.Constants.all rpc_ctxt b
+
+let bake_n ?policy n b =
+  Error_monad.fold_left_s
+    (fun b _ -> bake ?policy b) b (1 -- n)
+
+let bake_until_cycle_end ?policy b =
+  get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } ->
+  let current_level = b.header.shell.level in
+  let current_level = Int32.rem current_level blocks_per_cycle in
+  let delta = Int32.sub blocks_per_cycle current_level in
+  bake_n ?policy (Int32.to_int delta) b
+
+let bake_until_n_cycle_end ?policy n b =
+  Error_monad.fold_left_s
+    (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n)
+
+let bake_until_cycle ?policy cycle (b:t) =
+  get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } ->
+  let rec loop (b:t) =
+    let current_cycle =
+      let current_level = b.header.shell.level in
+      let current_cycle = Int32.div current_level blocks_per_cycle in
+      current_cycle
+    in
+    if Int32.equal (Cycle.to_int32 cycle) current_cycle then
+      return b
+    else
+      bake_until_cycle_end ?policy b >>=? fun b ->
+      loop b
+  in
+  loop b
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.mli
new file mode 100644
index 000000000..28b10a8db
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/block.mli
@@ -0,0 +1,150 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t = {
+  hash : Block_hash.t ;
+  header : Block_header.t ;
+  operations : Operation.packed list ;
+  context : Tezos_protocol_environment_memory.Context.t ; (** Resulting context *)
+}
+type block = t
+
+val rpc_ctxt: t Alpha_environment.RPC_context.simple
+
+(** Policies to select the next baker:
+    - [By_priority p] selects the baker at priority [p]
+    - [By_account pkh] selects the first slot for baker [pkh]
+    - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs]
+*)
+type baker_policy =
+  | By_priority of int
+  | By_account of public_key_hash
+  | Excluding of public_key_hash list
+
+(** Returns (account, priority, timestamp) of the next baker given
+    a policy, defaults to By_priority 0. *)
+val get_next_baker:
+  ?policy:baker_policy ->
+  t -> (public_key_hash * int * Time.t) tzresult Lwt.t
+
+module Forge : sig
+
+  val contents:
+    ?proof_of_work_nonce:MBytes.t ->
+    ?priority:int ->
+    ?seed_nonce_hash: Nonce_hash.t ->
+    unit -> Block_header.contents
+
+  type header
+
+  (** Forges a correct header following the policy.
+      The header can then be modified and applied with [apply]. *)
+  val forge_header:
+    ?policy:baker_policy ->
+    ?operations: Operation.packed list ->
+    t -> header tzresult Lwt.t
+
+  (** Sets uniquely seed_nonce_hash of a header *)
+  val set_seed_nonce_hash:
+    Nonce_hash.t option -> header -> header
+
+  (** Sets the baker that will sign the header to an arbitrary pkh *)
+  val set_baker:
+    public_key_hash -> header -> header
+
+  (** Signs the header with the key of the baker configured in the header.
+      The header can no longer be modified, only applied. *)
+  val sign_header:
+    header ->
+    Block_header.block_header tzresult Lwt.t
+
+end
+
+(** [genesis <opts> accounts] : generates an initial block with the
+    given constants [<opts>] and initializes [accounts] with their
+    associated amounts.
+*)
+val genesis:
+  ?preserved_cycles:int ->
+  ?blocks_per_cycle:int32 ->
+  ?blocks_per_commitment:int32 ->
+  ?blocks_per_roll_snapshot:int32 ->
+  ?blocks_per_voting_period:int32 ->
+  ?time_between_blocks:Period_repr.t list ->
+  ?endorsers_per_block:int ->
+  ?hard_gas_limit_per_operation:Z.t ->
+  ?hard_gas_limit_per_block:Z.t ->
+  ?proof_of_work_threshold:int64 ->
+  ?tokens_per_roll:Tez_repr.tez ->
+  ?michelson_maximum_type_size:int ->
+  ?seed_nonce_revelation_tip:Tez_repr.tez ->
+  ?origination_size:int ->
+  ?block_security_deposit:Tez_repr.tez ->
+  ?endorsement_security_deposit:Tez_repr.tez ->
+  ?block_reward:Tez_repr.tez ->
+  ?endorsement_reward:Tez_repr.tez ->
+  ?cost_per_byte: Tez_repr.t ->
+  ?hard_storage_limit_per_operation: Z.t ->
+  ?commitments:Commitment_repr.t list ->
+  ?security_deposit_ramp_up_cycles: int option ->
+  ?no_reward_cycles: int option ->
+  (Account.t * Tez_repr.tez) list -> block tzresult Lwt.t
+
+(** Applies a signed header and its operations to a block and
+    obtains a new block *)
+val apply:
+  Block_header.block_header ->
+  ?operations: Operation.packed list ->
+  t -> t tzresult Lwt.t
+
+(**
+   [bake b] returns a block [b'] which has as predecessor block [b].
+   Optional parameter [policy] allows to pick the next baker in several ways.
+   This function bundles together [forge_header], [sign_header] and [apply].
+   These functions should be used instead of bake to craft unusual blocks for
+   testing together with setters for properties of the headers.
+   For examples see seed.ml or double_baking.ml
+*)
+val bake:
+  ?policy: baker_policy ->
+  ?operation: Operation.packed ->
+  ?operations: Operation.packed list ->
+  t -> t tzresult Lwt.t
+
+(** Bakes [n] blocks. *)
+val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t
+
+(** Given a block [b] at level [l] bakes enough blocks to complete a cycle,
+    that is [blocks_per_cycle - (l % blocks_per_cycle)]. *)
+val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t
+
+(** Bakes enough blocks to end [n] cycles. *)
+val bake_until_n_cycle_end : ?policy:baker_policy -> int -> t -> t tzresult Lwt.t
+
+(** Bakes enough blocks to reach the cycle. *)
+val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.ml
new file mode 100644
index 000000000..00c16839f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.ml
@@ -0,0 +1,257 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t =
+  | B of Block.t
+  | I of Incremental.t
+
+let branch = function
+  | B b -> b.hash
+  | I i -> (Incremental.predecessor i).hash
+
+let level = function
+  | B b -> b.header.shell.level
+  | I i -> (Incremental.level i)
+
+let get_level ctxt =
+  level ctxt
+  |> Raw_level.of_int32
+  |> Alpha_environment.wrap_error
+  |> Lwt.return
+
+let rpc_ctxt = object
+  method call_proto_service0 :
+    'm 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr q i ->
+      match pr with
+      | B b -> Block.rpc_ctxt#call_proto_service0 s b q i
+      | I b -> Incremental.rpc_ctxt#call_proto_service0 s b q i
+  method call_proto_service1 :
+    'm 'a 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service1 s bl a q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service1 s bl a q i
+  method call_proto_service2 :
+    'm 'a 'b 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, (Alpha_environment.RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a b q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service2 s bl a b q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service2 s bl a b q i
+  method call_proto_service3 :
+    'm 'a 'b 'c 'q 'i 'o.
+    ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, ((Alpha_environment.RPC_context.t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t ->
+    t -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t =
+    fun s pr a b c q i ->
+      match pr with
+      | B bl -> Block.rpc_ctxt#call_proto_service3 s bl a b c q i
+      | I bl -> Incremental.rpc_ctxt#call_proto_service3 s bl a b c q i
+end
+
+let get_endorsers ctxt =
+  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
+
+let get_endorser ctxt =
+  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >>=? fun endorsers ->
+  let endorser = List.hd endorsers in
+  return (endorser.delegate, endorser.slots)
+
+let get_bakers ctxt =
+  Alpha_services.Delegate.Baking_rights.get
+    ~max_priority:256
+    rpc_ctxt ctxt >>=? fun bakers ->
+  return (List.map
+            (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate)
+            bakers)
+
+let get_seed_nonce_hash ctxt =
+  let header =
+    match ctxt with
+    | B { header } -> header
+    | I i -> Incremental.header i in
+  match header.protocol_data.contents.seed_nonce_hash with
+  | None -> failwith "No committed nonce"
+  | Some hash -> return hash
+
+let get_seed ctxt = Alpha_services.Seed.get rpc_ctxt ctxt
+
+let get_constants ctxt =
+  Alpha_services.Constants.all rpc_ctxt ctxt
+
+(* Voting *)
+
+module Vote = struct
+
+  let get_ballots ctxt =
+    Alpha_services.Voting.ballots rpc_ctxt ctxt
+
+  let get_ballot_list ctxt =
+    Alpha_services.Voting.ballot_list rpc_ctxt ctxt
+
+  let get_voting_period ctxt =
+    Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt >>=? fun l ->
+    return l.voting_period
+
+  let get_voting_period_position ctxt =
+    Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt >>=? fun l ->
+    return l.voting_period_position
+
+  let get_current_period_kind ctxt =
+    Alpha_services.Voting.current_period_kind rpc_ctxt ctxt
+
+  let get_current_quorum ctxt =
+    Alpha_services.Voting.current_quorum rpc_ctxt ctxt
+
+  let get_listings ctxt =
+    Alpha_services.Voting.listings rpc_ctxt ctxt
+
+  let get_proposals ctxt =
+    Alpha_services.Voting.proposals rpc_ctxt ctxt
+
+  let get_current_proposal ctxt =
+    Alpha_services.Voting.current_proposal rpc_ctxt ctxt
+
+  let get_protocol (b:Block.t) =
+    Alpha_environment.Context.get b.context ["protocol"] >>= function
+    | None -> assert false
+    | Some p -> Lwt.return (Protocol_hash.of_bytes_exn p)
+
+  let get_protocol (b:Block.t) =
+    Alpha_environment.Context.get b.context ["protocol"] >>= function
+    | None -> assert false
+    | Some p -> Lwt.return (Protocol_hash.of_bytes_exn p)
+
+end
+
+module Contract = struct
+
+  let pp = Alpha_context.Contract.pp
+
+  let pkh c = Alpha_context.Contract.is_implicit c |> function
+    | Some p -> return p
+    | None -> failwith "pkh: only for implicit contracts"
+
+  type balance_kind = Main | Deposit | Fees | Rewards
+
+  let balance ?(kind = Main) ctxt contract =
+    begin match kind with
+      | Main ->
+          Alpha_services.Contract.balance rpc_ctxt ctxt contract
+      | _ ->
+          match Alpha_context.Contract.is_implicit contract with
+          | None ->
+              invalid_arg
+                "get_balance: no frozen accounts for an originated contract."
+          | Some pkh ->
+              Alpha_services.Delegate.frozen_balance_by_cycle
+                rpc_ctxt ctxt pkh >>=? fun map ->
+              Lwt.return @@
+              Cycle.Map.fold
+                (fun _cycle { Delegate.deposit ; fees ; rewards } acc ->
+                   acc >>?fun acc ->
+                   match kind with
+                   | Deposit -> Test_tez.Tez.(acc +? deposit)
+                   | Fees -> Test_tez.Tez.(acc +? fees)
+                   | Rewards ->  Test_tez.Tez.(acc +? rewards)
+                   | _ -> assert false)
+                map
+                (Ok Tez.zero)
+    end
+
+  let counter ctxt contract =
+    Alpha_services.Contract.counter rpc_ctxt ctxt contract
+
+  let manager ctxt contract =
+    Alpha_services.Contract.manager rpc_ctxt ctxt contract >>=? fun pkh ->
+    Account.find pkh
+
+  let is_manager_key_revealed ctxt contract =
+    Alpha_services.Contract.manager_key rpc_ctxt ctxt contract >>=? fun (_, res) ->
+    return (res <> None)
+
+  let delegate ctxt contract =
+    Alpha_services.Contract.delegate rpc_ctxt ctxt contract
+
+  let delegate_opt ctxt contract =
+    Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract
+
+end
+
+module Delegate = struct
+
+  type info = Delegate_services.info = {
+    balance: Tez.t ;
+    frozen_balance: Tez.t ;
+    frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+    staking_balance: Tez.t ;
+    delegated_contracts: Contract_hash.t list ;
+    delegated_balance: Tez.t ;
+    deactivated: bool ;
+    grace_period: Cycle.t ;
+  }
+
+  let info ctxt pkh =
+    Alpha_services.Delegate.info rpc_ctxt ctxt pkh
+
+end
+
+let init
+    ?(slow=false)
+    ?preserved_cycles
+    ?endorsers_per_block
+    ?commitments
+    ?(initial_balances = [])
+    n =
+  let accounts = Account.generate_accounts ~initial_balances n in
+  let contracts = List.map (fun (a, _) ->
+      Alpha_context.Contract.implicit_contract Account.(a.pkh)) accounts in
+  begin
+    if slow then
+      Block.genesis
+        ?preserved_cycles
+        ?endorsers_per_block
+        ?commitments
+        accounts
+    else
+      Block.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 blk ->
+  return (blk, contracts)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.mli
new file mode 100644
index 000000000..0acc9a1f7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/context.mli
@@ -0,0 +1,111 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_environment
+open Alpha_context
+
+type t =
+  | B of Block.t
+  | I of Incremental.t
+
+val branch: t -> Block_hash.t
+
+val get_level: t -> Raw_level.t tzresult Lwt.t
+
+val get_endorsers: t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t
+
+val get_endorser: t -> (public_key_hash * int list) tzresult Lwt.t
+
+val get_bakers: t -> public_key_hash list tzresult Lwt.t
+
+val get_seed_nonce_hash: t -> Nonce_hash.t tzresult Lwt.t
+
+(** Returns the seed of the cycle to which the block belongs to. *)
+val get_seed: t -> Seed.seed tzresult Lwt.t
+
+(** Returns all the constants of the protocol *)
+val get_constants: t -> Constants.t tzresult Lwt.t
+
+module Vote : sig
+  val get_ballots: t -> Vote.ballots tzresult Lwt.t
+  val get_ballot_list: t -> (Signature.Public_key_hash.t * Vote.ballot) list tzresult Lwt.t
+  val get_voting_period: t -> Voting_period.t tzresult Lwt.t
+  val get_voting_period_position: t -> Int32.t tzresult Lwt.t
+  val get_current_period_kind: t -> Voting_period.kind tzresult Lwt.t
+  val get_current_quorum: t -> Int32.t tzresult Lwt.t
+  val get_listings: t -> (Signature.Public_key_hash.t * int32) list tzresult Lwt.t
+  val get_proposals: t -> Int32.t Protocol_hash.Map.t tzresult Lwt.t
+  val get_current_proposal: t -> Protocol_hash.t option tzresult Lwt.t
+  val get_protocol : Block.t -> Protocol_hash.t Lwt.t
+end
+
+module Contract : sig
+
+  val pp : Format.formatter -> Contract.t -> unit
+  val pkh: Contract.t -> public_key_hash tzresult Lwt.t
+
+  type balance_kind = Main | Deposit | Fees | Rewards
+
+  (** Returns the balance of a contract, by default the main balance.
+      If the contract is implicit the frozen balances are available too:
+      deposit, fees ot rewards. *)
+  val balance: ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t
+
+  val counter: t -> Contract.t -> Z.t tzresult Lwt.t
+  val manager: t -> Contract.t -> Account.t tzresult Lwt.t
+  val is_manager_key_revealed: t -> Contract.t -> bool tzresult Lwt.t
+
+  val delegate: t -> Contract.t -> public_key_hash tzresult Lwt.t
+  val delegate_opt: t -> Contract.t -> public_key_hash option tzresult Lwt.t
+
+end
+
+module Delegate : sig
+
+  type info = Delegate_services.info = {
+    balance: Tez.t ;
+    frozen_balance: Tez.t ;
+    frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
+    staking_balance: Tez.t ;
+    delegated_contracts: Contract_hash.t list ;
+    delegated_balance: Tez.t ;
+    deactivated: bool ;
+    grace_period: Cycle.t ;
+  }
+
+  val info: t -> public_key_hash -> Delegate_services.info tzresult Lwt.t
+
+end
+
+(** [init n] : returns an initial block with [n] initialized accounts
+    and the associated implicit contracts *)
+val init:
+  ?slow: bool ->
+  ?preserved_cycles:int ->
+  ?endorsers_per_block:int ->
+  ?commitments:Commitment_repr.t list ->
+  ?initial_balances: int64 list ->
+  int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/dune b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/dune
new file mode 100644
index 000000000..e790c36c4
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/dune
@@ -0,0 +1,17 @@
+(library
+ (name tezos_alpha_test_helpers)
+ (libraries tezos-base
+            tezos-stdlib-unix
+            tezos-shell-services
+            tezos-protocol-environment
+            tezos-protocol-alpha
+            alcotest-lwt)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_stdlib_unix
+                   -open Tezos_shell_services)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml*))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.ml
new file mode 100644
index 000000000..4f46d787b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.ml
@@ -0,0 +1,180 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t = {
+  predecessor: Block.t ;
+  state: M.validation_state ;
+  rev_operations: Operation.packed list ;
+  rev_tickets: operation_receipt list ;
+  header: Block_header.t ;
+  delegate: Account.t ;
+}
+type incremental = t
+
+let predecessor { predecessor ; _ } = predecessor
+let header { header ; _ } = header
+let rev_tickets { rev_tickets ; _ } = rev_tickets
+let level st = st.header.shell.level
+
+let rpc_context st =
+  let result = Alpha_context.finalize st.state.ctxt in
+  {
+    Alpha_environment.Updater.block_hash = Block_hash.zero ;
+    block_header = { st.header.shell with fitness = result.fitness } ;
+    context = result.context ;
+  }
+
+let rpc_ctxt =
+  new Alpha_environment.proto_rpc_context_of_directory
+    rpc_context Proto_alpha.rpc_services
+
+let begin_construction ?(priority=0) ?timestamp
+    ?(policy=Block.By_priority priority) (predecessor : Block.t) =
+  Block.get_next_baker ~policy
+    predecessor >>=? fun (delegate, priority, real_timestamp) ->
+  Account.find delegate >>=? fun delegate ->
+  let timestamp = Option.unopt ~default:real_timestamp timestamp in
+  let contents = Block.Forge.contents ~priority () in
+  let protocol_data = {
+    Block_header.contents ;
+    signature = Signature.zero ;
+  } in
+  let header = {
+    Block_header.shell = {
+      predecessor = predecessor.hash ;
+      proto_level = predecessor.header.shell.proto_level ;
+      validation_passes = predecessor.header.shell.validation_passes ;
+      fitness = predecessor.header.shell.fitness ;
+      timestamp ;
+      level = predecessor.header.shell.level ;
+      context = Context_hash.zero ;
+      operations_hash = Operation_list_list_hash.zero ;
+    } ;
+    protocol_data = {
+      contents ;
+      signature = Signature.zero ;
+    } ;
+  } in
+  M.begin_construction
+    ~chain_id: Chain_id.zero
+    ~predecessor_context: predecessor.context
+    ~predecessor_timestamp: predecessor.header.shell.timestamp
+    ~predecessor_fitness: predecessor.header.shell.fitness
+    ~predecessor_level: predecessor.header.shell.level
+    ~predecessor:predecessor.hash
+    ~timestamp
+    ~protocol_data
+    () >>=? fun state ->
+  return {
+    predecessor ;
+    state ;
+    rev_operations = [] ;
+    rev_tickets = [] ;
+    header ;
+    delegate ;
+  }
+
+let detect_script_failure :
+  type kind. kind Apply_results.operation_metadata -> _ =
+  let rec detect_script_failure :
+    type kind. kind Apply_results.contents_result_list -> _ =
+    let open Apply_results in
+    let detect_script_failure_single
+        (type kind)
+        (Manager_operation_result { operation_result ;
+                                    internal_operation_results }
+         : kind Kind.manager Apply_results.contents_result) =
+      let detect_script_failure (type kind) (result : kind manager_operation_result) =
+        match result with
+        | Applied _ -> Ok ()
+        | Skipped _ -> assert false
+        | Backtracked (_, None) ->
+            (* there must be another error for this to happen *)
+            Ok ()
+        | Backtracked (_, Some errs) ->
+            Alpha_environment.wrap_error (Error errs)
+        | Failed (_, errs) ->
+            Alpha_environment.wrap_error (Error errs) in
+      List.fold_left
+        (fun acc (Internal_operation_result (_, r)) ->
+           acc >>? fun () ->
+           detect_script_failure r)
+        (detect_script_failure operation_result)
+        internal_operation_results in
+    function
+    | Single_result (Manager_operation_result _ as res) ->
+        detect_script_failure_single res
+    | Single_result _ ->
+        Ok ()
+    | Cons_result (res, rest) ->
+        detect_script_failure_single res >>? fun () ->
+        detect_script_failure rest in
+  fun { contents } -> detect_script_failure contents
+
+let add_operation ?expect_failure st op =
+  let open Apply_results in
+  M.apply_operation st.state op >>=? function
+  | state, (Operation_metadata result as metadata) ->
+      Lwt.return @@ detect_script_failure result >>= fun result ->
+      begin match expect_failure with
+        | None ->
+            Lwt.return result
+        | Some f ->
+            match result with
+            | Ok _ ->
+                failwith "Error expected while adding operation"
+            | Error e ->
+                f e
+      end >>=? fun () ->
+      return { st with state ; rev_operations = op :: st.rev_operations ;
+                       rev_tickets = metadata :: st.rev_tickets }
+  | state, (No_operation_metadata as metadata) ->
+      return { st with state ; rev_operations = op :: st.rev_operations ;
+                       rev_tickets = metadata :: st.rev_tickets }
+
+let finalize_block st =
+  M.finalize_block st.state >>=? fun (result, _) ->
+  let operations = List.rev st.rev_operations in
+  let operations_hash =
+    Operation_list_list_hash.compute [
+      Operation_list_hash.compute (List.map Operation.hash_packed operations)
+    ] in
+  let header =
+    { st.header with
+      shell = {
+        st.header.shell with
+        level = Int32.succ st.header.shell.level ;
+        operations_hash ; fitness = result.fitness ;
+      } } in
+  let hash = Block_header.hash header in
+  return {
+    Block.hash ;
+    header ;
+    operations ;
+    context = result.context ;
+  }
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.mli
new file mode 100644
index 000000000..48775a97b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/incremental.mli
@@ -0,0 +1,50 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+type t
+type incremental = t
+
+val predecessor: incremental -> Block.t
+val header: incremental -> Block_header.t
+val rev_tickets: incremental -> operation_receipt list
+val level: incremental -> int32
+
+val begin_construction:
+  ?priority:int ->
+  ?timestamp:Time.t ->
+  ?policy:Block.baker_policy ->
+  Block.t ->
+  incremental tzresult Lwt.t
+
+val add_operation:
+  ?expect_failure:(error list -> unit tzresult Lwt.t) ->
+  incremental -> Operation.packed -> incremental tzresult Lwt.t
+
+val finalize_block: incremental -> Block.t tzresult Lwt.t
+
+val rpc_ctxt: incremental Alpha_environment.RPC_context.simple
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.ml
new file mode 100644
index 000000000..416cec574
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.ml
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*                                                                        *)
+(*    Copyright (c) 2014 - 2018.                                          *)
+(*    Dynamic Ledger Solutions, Inc.< contact@tezos.com >                 *)
+(*                                                                        *)
+(*    All rights reserved.No warranty, explicit or implicit, provided.    *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Proto_alpha
+
+module Table = Hashtbl.Make(struct
+    type t = Nonce_hash.t
+    let hash h =
+      Int32.to_int (MBytes.get_int32 (Nonce_hash.to_bytes h) 0)
+    let equal = Nonce_hash.equal
+  end)
+
+let known_nonces = Table.create 17
+
+let generate () =
+  match
+    Alpha_context.Nonce.of_bytes @@
+    Rand.generate Alpha_context.Constants.nonce_length
+  with
+  | Ok nonce ->
+      let hash = Alpha_context.Nonce.hash nonce in
+      Table.add known_nonces hash nonce ;
+      (hash, nonce)
+  | Error _ -> assert false
+
+let forget_all () = Table.clear known_nonces
+let get hash = Table.find known_nonces hash
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.mli
new file mode 100644
index 000000000..d95991157
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/nonce.mli
@@ -0,0 +1,31 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+(** Returns a fresh nonce and its corresponding hash (and stores them). *)
+val generate: unit -> Nonce_hash.t * Alpha_context.Nonce.t
+val get: Nonce_hash.t -> Alpha_context.Nonce.t
+val forget_all: unit -> unit
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.ml
new file mode 100644
index 000000000..fc93802dc
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.ml
@@ -0,0 +1,317 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+let sign ?(watermark = Signature.Generic_operation)
+    sk ctxt contents =
+  let branch = Context.branch ctxt in
+  let unsigned =
+    Data_encoding.Binary.to_bytes_exn
+      Operation.unsigned_encoding
+      ({ branch }, Contents_list contents) in
+  let signature = Some (Signature.sign ~watermark sk unsigned) in
+  ({ shell = { branch } ;
+     protocol_data = {
+       contents ;
+       signature ;
+     } ;
+   } : _ Operation.t)
+
+let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () =
+  begin
+    match delegate with
+    | None ->
+        Context.get_endorser ctxt >>=? fun (delegate, _slots) ->
+        return delegate
+    | Some delegate -> return delegate
+  end >>=? fun delegate_pkh ->
+  Account.find delegate_pkh >>=? fun delegate ->
+  begin
+    match level with
+    | None -> Context.get_level ctxt
+    | Some level -> return level
+  end >>=? fun level ->
+  let op = Single (Endorsement { level }) in
+  return (sign ~watermark:Signature.(Endorsement Chain_id.zero) delegate.sk signing_context op)
+
+let sign ?watermark sk ctxt (Contents_list contents) =
+  Operation.pack (sign ?watermark sk ctxt contents)
+
+let combine_operations
+    ?public_key
+    ?counter
+    ~source ctxt
+    (packed_operations : packed_operation list) =
+  assert (List.length packed_operations > 0);
+  (* Hypothesis : each operation must have the same branch (is this really true?) *)
+  let { Tezos_base.Operation.branch } = (List.hd packed_operations).shell in
+  assert (List.for_all
+            (fun { shell = { Tezos_base.Operation.branch = b } } -> Block_hash.(branch = b))
+            packed_operations) ;
+  (* TODO? : check signatures consistency *)
+  let unpacked_operations =
+    List.map (function
+        | ({ Alpha_context.protocol_data = Operation_data { contents } } ) ->
+            match Contents_list contents with
+            | Contents_list (Single o) -> Contents o
+            | Contents_list (Cons
+                               ((Manager_operation { operation = Reveal _ })
+                               , (Single o))) -> Contents o
+            | _ -> (* TODO : decent error *) assert false
+      ) packed_operations in
+  begin match counter with
+    | Some counter -> return counter
+    | None -> Context.Contract.counter ctxt source
+  end >>=? fun counter ->
+  (* We increment the counter *)
+  let counter = Z.succ counter in
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let public_key = Option.unopt ~default:account.pk public_key in
+  begin Context.Contract.is_manager_key_revealed ctxt source >>=? function
+    | false ->
+        let reveal_op = Manager_operation {
+            source ;
+            fee = Tez.zero ;
+            counter ;
+            operation = Reveal public_key ;
+            gas_limit = Z.of_int 10000 ;
+            storage_limit = Z.zero ;
+          } in
+        return (Some (Contents reveal_op), Z.succ counter)
+    | true -> return (None, counter)
+  end >>=? fun (manager_op, counter) ->
+  (* Update counters and transform into a contents_list *)
+  let operations =
+    List.fold_left (fun (counter, acc) -> function
+        | Contents (Manager_operation m) ->
+            (Z.succ counter,
+             (Contents (Manager_operation { m with counter }) :: acc))
+        | x -> counter, x :: acc)
+      (counter, (match manager_op with
+           | None -> []
+           | Some op -> [ op ]))
+      unpacked_operations
+    |> snd |> List.rev
+  in
+
+  let operations = Operation.of_list operations in
+  return @@ sign account.sk ctxt operations
+
+let manager_operation
+    ?counter
+    ?(fee = Tez.zero)
+    ?(gas_limit = Constants_repr.default.hard_gas_limit_per_operation)
+    ?(storage_limit = Constants_repr.default.hard_storage_limit_per_operation)
+    ?public_key ~source ctxt operation =
+  begin match counter with
+    | Some counter -> return counter
+    | None ->  Context.Contract.counter ctxt source end
+  >>=? fun counter ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let public_key = Option.unopt ~default:account.pk public_key in
+  let counter = Z.succ counter in
+  Context.Contract.is_manager_key_revealed ctxt source >>=? function
+  | true ->
+      let op =
+        Manager_operation {
+          source ;
+          fee ;
+          counter ;
+          operation ;
+          gas_limit ;
+          storage_limit ;
+        } in
+      return (Contents_list (Single op))
+  | false ->
+      let op_reveal =
+        Manager_operation {
+          source ;
+          fee = Tez.zero ;
+          counter ;
+          operation = Reveal public_key ;
+          gas_limit = Z.of_int 10000 ;
+          storage_limit = Z.zero ;
+        } in
+      let op =
+        Manager_operation {
+          source ;
+          fee ;
+          counter = Z.succ counter ;
+          operation ;
+          gas_limit ;
+          storage_limit ;
+        } in
+      return (Contents_list (Cons (op_reveal, Single op)))
+
+let revelation ctxt public_key =
+  let pkh = Signature.Public_key.hash public_key in
+  let source = Contract.implicit_contract pkh in
+  Context.Contract.counter ctxt source >>=? fun counter ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let counter = Z.succ counter in
+  let sop =
+    Contents_list
+      (Single
+         (Manager_operation {
+             source ;
+             fee = Tez.zero ;
+             counter ;
+             operation = Reveal public_key ;
+             gas_limit = Z.of_int 10000 ;
+             storage_limit = Z.zero ;
+           })) in
+  return @@ sign account.sk ctxt sop
+
+let originated_contract op =
+  let nonce = Contract.initial_origination_nonce (Operation.hash_packed op) in
+  Contract.originated_contract nonce
+
+exception Impossible
+
+let origination ?counter ?delegate ?script
+    ?(spendable = true) ?(delegatable = true) ?(preorigination = None)
+    ?public_key ?manager ?credit ?fee ?gas_limit ?storage_limit ctxt source =
+  Context.Contract.manager ctxt source >>=? fun account ->
+  let manager = Option.unopt ~default:account.pkh manager in
+  let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in
+  let default_credit = Option.unopt_exn Impossible default_credit in
+  let credit = Option.unopt ~default:default_credit credit in
+  let operation =
+    Origination {
+      manager ;
+      delegate ;
+      script ;
+      spendable ;
+      delegatable ;
+      credit ;
+      preorigination ;
+    } in
+  manager_operation ?counter ?public_key ?fee ?gas_limit ?storage_limit
+    ~source ctxt operation >>=? fun sop ->
+  let op = sign account.sk ctxt sop in
+  return (op , originated_contract op)
+
+let miss_signed_endorsement ?level ctxt  =
+  begin
+    match level with
+    | None -> Context.get_level ctxt
+    | Some level -> return level
+  end >>=? fun level ->
+  Context.get_endorser ctxt >>=? fun (real_delegate_pkh, _slots) ->
+  let delegate = Account.find_alternate real_delegate_pkh in
+  endorsement ~delegate:delegate.pkh ~level ctxt ()
+
+let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt
+    (src:Contract.t) (dst:Contract.t)
+    (amount:Tez.t) =
+  let top = Transaction {
+      amount;
+      parameters;
+      destination=dst;
+    } in
+  manager_operation ?fee ?gas_limit ?storage_limit
+    ~source:src ctxt top >>=? fun sop ->
+  Context.Contract.manager ctxt src >>=? fun account ->
+  return @@ sign account.sk ctxt sop
+
+let delegation ?fee ctxt source dst =
+  let top = Delegation dst in
+  manager_operation ?fee ~source ctxt top >>=? fun sop ->
+  Context.Contract.manager ctxt source >>=? fun account ->
+  return @@ sign account.sk ctxt sop
+
+let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code =
+  begin match pkh with
+    | Ed25519 edpkh -> return edpkh
+    | _ -> failwith "Wrong public key hash : %a - Commitments must be activated with an Ed25519 \
+                     encrypted public key hash" Signature.Public_key_hash.pp pkh
+  end >>=? fun id ->
+  let contents =
+    Single (Activate_account { id ; activation_code } ) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
+
+let double_endorsement ctxt op1 op2 =
+  let contents =
+    Single (Double_endorsement_evidence {op1 ; op2}) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
+
+let double_baking ctxt bh1 bh2 =
+  let contents =
+    Single (Double_baking_evidence {bh1 ; bh2}) in
+  let branch = Context.branch ctxt in
+  return {
+    shell = { branch } ;
+    protocol_data = Operation_data {
+        contents ;
+        signature = None ;
+      } ;
+  }
+
+let seed_nonce_revelation ctxt level nonce =
+  return
+    { shell = { branch = Context.branch ctxt } ;
+      protocol_data = Operation_data {
+          contents = Single (Seed_nonce_revelation { level ; nonce }) ;
+          signature = None ;
+        } ;
+    }
+
+let proposals ctxt (pkh: Contract.t) proposals =
+  Context.Contract.pkh pkh >>=? fun source ->
+  Context.Vote.get_voting_period ctxt >>=? fun period ->
+  let op =
+    Proposals { source ;
+                period ;
+                proposals } in
+  Account.find source >>=? fun account ->
+  return (sign account.sk ctxt (Contents_list (Single op)))
+
+let ballot ctxt (pkh: Contract.t) proposal ballot =
+  Context.Contract.pkh pkh >>=? fun source ->
+  Context.Vote.get_voting_period ctxt >>=? fun period ->
+  let op =
+    Ballot { source ;
+             period ;
+             proposal ;
+             ballot
+           } in
+  Account.find source >>=? fun account ->
+  return (sign account.sk ctxt (Contents_list (Single op)))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.mli
new file mode 100644
index 000000000..2cc7ae415
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/op.mli
@@ -0,0 +1,113 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+
+val endorsement:
+  ?delegate:public_key_hash ->
+  ?level:Raw_level.t ->
+  Context.t -> ?signing_context:Context.t -> unit ->
+  Kind.endorsement Operation.t tzresult Lwt.t
+
+val miss_signed_endorsement:
+  ?level:Raw_level.t ->
+  Context.t -> Kind.endorsement Operation.t tzresult Lwt.t
+
+val transaction:
+  ?fee:Tez.tez ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  ?parameters:Script.lazy_expr ->
+  Context.t ->
+  Contract.t ->
+  Contract.t ->
+  Tez.t ->
+  Operation.packed tzresult Lwt.t
+
+val delegation:
+  ?fee:Tez.tez -> Context.t ->
+  Contract.t -> public_key_hash option ->
+  Operation.packed tzresult Lwt.t
+
+val revelation:
+  Context.t -> public_key -> Operation.packed tzresult Lwt.t
+
+val origination:
+  ?counter: Z.t ->
+  ?delegate:public_key_hash ->
+  ?script:Script.t ->
+  ?spendable:bool ->
+  ?delegatable:bool ->
+  ?preorigination: Contract.contract option ->
+  ?public_key:public_key ->
+  ?manager:public_key_hash ->
+  ?credit:Tez.tez ->
+  ?fee:Tez.tez ->
+  ?gas_limit:Z.t ->
+  ?storage_limit:Z.t ->
+  Context.t ->
+  Contract.contract ->
+  (Operation.packed * Contract.contract) tzresult Lwt.t
+
+val originated_contract:
+  Operation.packed -> Contract.contract
+
+val double_endorsement:
+  Context.t ->
+  Kind.endorsement Operation.t ->
+  Kind.endorsement Operation.t ->
+  Operation.packed tzresult Lwt.t
+
+val double_baking:
+  Context.t ->
+  Block_header.block_header ->
+  Block_header.block_header ->
+  Operation.packed tzresult Lwt.t
+
+val activation:
+  Context.t ->
+  Signature.Public_key_hash.t -> Blinded_public_key_hash.activation_code ->
+  Operation.packed tzresult Lwt.t
+
+val combine_operations :
+  ?public_key:public_key ->
+  ?counter:counter ->
+  source:Contract.t ->
+  Context.t ->
+  packed_operation list -> packed_operation tzresult Lwt.t
+
+(** Reveals a seed_nonce that was previously committed at a certain level *)
+val seed_nonce_revelation:
+  Context.t -> Raw_level.t -> Nonce.t -> Operation.packed tzresult Lwt.t
+
+(** Propose a list of protocol hashes during the approval voting *)
+val proposals : Context.t -> Contract.t -> Protocol_hash.t list ->
+  Operation.packed tzresult Lwt.t
+
+(** Cast a vote yay, nay or pass *)
+val ballot : Context.t ->
+  Contract.t -> Protocol_hash.t -> Vote.ballot ->
+  Operation.packed tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml
new file mode 100644
index 000000000..13f35d481
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Name = struct let name = "alpha" end
+module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)()
+
+type alpha_error = Alpha_environment.Error_monad.error
+type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
+
+module Proto = Tezos_protocol_alpha.Functor.Make(Alpha_environment)
+module Block_services = struct
+  include Block_services
+  include Block_services.Make(Proto)(Proto)
+end
+include Proto
+
+module M = Alpha_environment.Lift(Main)
+
+let register_error_kind
+    category ~id ~title ~description ?pp
+    encoding from_error to_error =
+  let id = "client." ^ Name.name ^ "." ^ id in
+  register_error_kind
+    category ~id ~title ~description ?pp
+    encoding from_error to_error
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test.ml
new file mode 100644
index 000000000..dbd4b9967
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test.ml
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* Wraps an alcotest so that it prints correcly errors from the Error_monad. *)
+let tztest name speed f =
+  Alcotest_lwt.test_case name speed begin fun _sw () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error err ->
+        Tezos_stdlib_unix.Logging_unix.close () >>= fun () ->
+        Format.printf "@.%a@." pp_print_error err ;
+        Lwt.fail Alcotest.Test_error
+  end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
new file mode 100644
index 000000000..4a21e5745
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml
@@ -0,0 +1,61 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Alpha_environment
+
+(* This module is mostly to wrap the errors from the protocol *)
+module Tez = struct
+  include Tez
+
+  let ( +? ) t1 t2 = (t1 +? t2) |> wrap_error
+  let ( -? ) t1 t2 = (t1 -? t2) |> wrap_error
+  let ( *? ) t1 t2 = (t1 *? t2) |> wrap_error
+  let ( /? ) t1 t2 = (t1 /? t2) |> wrap_error
+
+  let ( + ) t1 t2 =
+    match t1 +? t2 with
+    | Ok r -> r
+    | Error _ ->
+        Pervasives.failwith "adding tez"
+
+  let of_int x =
+    match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with
+    | None -> invalid_arg "tez_of_int"
+    | Some x -> x
+
+  let of_mutez_exn x =
+    match Tez.of_mutez x with
+    | None -> invalid_arg "tez_of_mutez"
+    | Some x -> x
+
+
+  let max_tez =
+    match Tez.of_mutez Int64.max_int with
+    | None -> assert false
+    | Some p -> p
+
+end
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_utils.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_utils.ml
new file mode 100644
index 000000000..e71947bc7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/helpers/test_utils.ml
@@ -0,0 +1,43 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* This file should not depend on any other file from tests. *)
+
+let (>>?=) x y = match x with
+  | Ok(a) -> y a
+  | Error(b) -> fail @@ List.hd b
+
+(** Like List.find but returns the index of the found element *)
+let findi p =
+  let rec aux p i = function
+    | [] -> raise Not_found
+    | x :: l -> if p x then (x,i) else aux p (i+1) l
+  in
+  aux p 0
+
+exception Pair_of_list
+let pair_of_list = function
+  | [a;b] -> a,b
+  | _ -> raise Pair_of_list
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/main.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/main.ml
new file mode 100644
index 000000000..593244ffd
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/main.ml
@@ -0,0 +1,41 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 () =
+  Alcotest.run "protocol_alpha" [
+    "transfer", Transfer.tests ;
+    "origination", Origination.tests ;
+    "activation", Activation.tests ;
+    "endorsement", Endorsement.tests ;
+    "double endorsement", Double_endorsement.tests ;
+    "double baking", Double_baking.tests ;
+    "seed", Seed.tests ;
+    "baking", Baking.tests ;
+    "delegation", Delegation.tests ;
+    "rolls", Rolls.tests ;
+    "combined", Combined_operations.tests ;
+    "qty", Qty.tests ;
+    "voting", Voting.tests ;
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/dune b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/dune
new file mode 100644
index 000000000..7666c2a01
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/dune
@@ -0,0 +1,12 @@
+(library
+ (name michelson_parser)
+ (libraries tezos-base
+            tezos_alpha_test_helpers)
+ (flags (:standard -w -9-32 -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_alpha_test_helpers)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml*))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.ml
new file mode 120000
index 000000000..f615f483b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.ml
@@ -0,0 +1 @@
+../../../lib_client/michelson_v1_macros.ml
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.mli
new file mode 120000
index 000000000..a15ab86a6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_macros.mli
@@ -0,0 +1 @@
+../../../lib_client/michelson_v1_macros.mli
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.ml
new file mode 120000
index 000000000..68138c4bc
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.ml
@@ -0,0 +1 @@
+../../../lib_client/michelson_v1_parser.ml
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.mli
new file mode 120000
index 000000000..fbd4c39c2
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/michelson_parser/v1.mli
@@ -0,0 +1 @@
+../../../lib_client/michelson_v1_parser.mli
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/origination.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/origination.ml
new file mode 100644
index 000000000..57cdf7fd5
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/origination.ml
@@ -0,0 +1,432 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Test_utils
+open Test_tez
+
+let ten_tez = Tez.of_int 10
+
+(** [register_origination fee credit spendable delegatable] takes four
+    optional parameter: fee for the fee need to be paid if set to
+    create an originated contract; credit is the amount of tez that
+    send to this originated contract; spendable default is set to true
+    meaning that this contract is spendable; delegatable default is
+    set to true meaning that this contract is able to delegate. *)
+let register_origination ?(fee=Tez.zero) ?(credit=Tez.zero) ?spendable ?delegatable () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let source = List.hd contracts in
+  Context.Contract.balance (B b) source >>=? fun source_balance ->
+  Op.origination (B b) source ~fee ~credit ?spendable ?delegatable
+  >>=? fun (operation, originated) ->
+  Block.bake ~operation b >>=? fun b ->
+  (* fee + credit + block security deposit were debited from source *)
+  Context.get_constants (B b) >>=? fun {parametric = { origination_size ;
+                                                       cost_per_byte ;
+                                                       block_security_deposit }} ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Lwt.return (
+    Tez.(+?) credit block_security_deposit >>?
+    Tez.(+?) fee >>?
+    Tez.(+?) origination_burn ) >>=? fun total_fee ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) source source_balance total_fee >>=? fun () ->
+  (* originated contract has been credited *)
+  Assert.balance_was_credited ~loc:__LOC__ (B b) originated Tez.zero credit >>=? fun () ->
+  (* TODO spendable or not and delegatable or not if relevant for some
+     test. Not the case at the moment, cf. uses of
+     register_origination *)
+  return (b, source, originated)
+
+
+(* [test_origination_balances fee credit spendable delegatable]
+   takes four optional parameter: fee is the fee that pay if require to create an originated contract; credit is the amount of tez that will send to this contract; spendable default is set to true meaning that this contract is spendable; delegatable default is set to true meaning that this contract is able to delegate.
+   This function will create a contract, get the balance of this contract, call the origination operation to create a new originated contract from this contract with all the possible fees; and check the balance before/after originated operation valid.
+   - the source contract has payed all the fees
+   - the originated has been credited correctly *)
+let test_origination_balances ~loc ?(fee=Tez.zero) ?(credit=Tez.zero)
+    ?spendable ?delegatable () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract = List.hd contracts in
+  Context.Contract.balance (B b) contract >>=? fun balance ->
+  Op.origination (B b) contract ~fee ~credit ?spendable ?delegatable >>=? fun (operation, new_contract) ->
+  (* The possible fees are: a given credit, an origination burn fee
+     (constants_repr.default.origination_burn = 257 mtez),
+     a fee that is paid when creating an originate contract.
+
+     We also take into account a block security deposit. Note that it
+     is not related to origination but to the baking done in the
+     tests.*)
+  Context.get_constants (B b) >>=? fun
+    { parametric =
+        { origination_size ;
+          cost_per_byte ;
+          block_security_deposit
+        }
+    } ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  Lwt.return (
+    Tez.(+?) credit block_security_deposit >>?
+    Tez.(+?) fee >>?
+    Tez.(+?) origination_burn ) >>=? fun total_fee ->
+  Block.bake ~operation b >>=? fun b ->
+  (* check that after the block has been baked the source contract
+     was debited all the fees *)
+  Assert.balance_was_debited ~loc (B b) contract balance total_fee
+  >>=? fun _ ->
+  (* check the balance of the originate contract is equal to credit *)
+  Assert.balance_is ~loc (B b) new_contract credit
+
+(** [transfer_and_check_balances b source dest amount] takes a block,
+    a source contract, a destination and the amount that one wants to send
+    (with no fee) and check the source and destination balances. *)
+let transfer_and_check_balances b source dest amount =
+  Context.Contract.balance (B b) source >>=? fun balance ->
+  Op.transaction (B b) source dest amount >>=? fun operation ->
+  Block.bake ~operation b >>=? fun b ->
+  Assert.balance_was_debited ~loc:__LOC__ (B b) source balance amount >>=? fun _ ->
+  return b
+
+(******************************************************)
+(** Tests *)
+(******************************************************)
+
+(** compute half of the balance and divided it by nth times *)
+
+let two_nth_of_balance incr contract nth =
+  Context.Contract.balance (I incr) contract >>=? fun balance ->
+  Tez.(/?) balance nth >>?= fun res ->
+  Tez.( *?) res 2L >>?= fun balance ->
+  return balance
+
+(*******************)
+(** Basic test *)
+(*******************)
+
+let balances_simple () = test_origination_balances ~loc:__LOC__ ()
+
+let balances_credit () =
+  test_origination_balances ~loc:__LOC__ ~credit:ten_tez ()
+
+let balances_credit_fee () =
+  test_origination_balances ~loc:__LOC__ ~credit:(Tez.of_int 2) ~fee:ten_tez ()
+
+let balances_credit_unspendable () =
+  test_origination_balances ~loc:__LOC__ ~credit:Tez.one ~spendable:false ()
+
+let balances_undelegatable () =
+  test_origination_balances ~loc:__LOC__ ~delegatable:false ()
+
+(*******************)
+(** create an originate contract with a credit, then use this contract to
+    transfer some tez back into the source contract, change the delegate
+    contract to the endorser account *)
+(*******************)
+
+let regular () =
+  register_origination ~credit:ten_tez () >>=? fun (b, contract, new_contract) ->
+  transfer_and_check_balances b new_contract contract Tez.one_cent >>=? fun _ ->
+
+  (* Delegatable *)
+  Context.get_endorser (B b) >>=? fun (account, _slots) ->
+  Op.delegation (B b) new_contract (Some account) >>=? fun operation ->
+  Block.bake ~operation b >>=? fun _ ->
+  return_unit
+
+(*******************)
+(** ask source contract to pay a fee when originating a contract *)
+(*******************)
+
+let pay_fee () =
+  register_origination ~credit:(Tez.of_int 2) ~fee:ten_tez () >>=? fun (b, contract, new_contract) ->
+  transfer_and_check_balances b new_contract contract (Tez.of_int 2) >>=? fun _ ->
+  return_unit
+
+(******************************************************)
+(** Errors *)
+(******************************************************)
+
+(*******************)
+(** The originate contract is marked as unspendable. Then ask this
+    contract to transfer, it will raise an error *)
+(*******************)
+
+let unspendable () =
+  register_origination ~credit:Tez.one ~spendable:false () >>=? fun (b, contract, new_contract) ->
+  Op.transaction (B b) new_contract contract Tez.one_cent >>=? fun operation ->
+  Block.bake ~operation b >>= fun e ->
+  let unspendable = function
+    | Proto_alpha.Contract_storage.Unspendable_contract _ -> true
+    | _ -> false in
+  Assert.proto_error ~loc:__LOC__ e unspendable
+
+(*******************)
+(** The originate contract is marked as undelegatable. Then do the delegation
+    for this contract, it will raise an error *)
+(*******************)
+
+let undelegatable fee () =
+  register_origination ~delegatable:false () >>=? fun (b, _, new_contract) ->
+  Context.get_endorser (B b) >>=? fun (account, _slots) ->
+  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.balance (I i) new_contract >>=? fun balance ->
+  Context.Contract.delegate_opt (I i) new_contract >>=? fun delegate_opt ->
+  assert (delegate_opt = None) ;
+  Op.delegation ~fee (I i) new_contract (Some account) >>=? fun operation ->
+  if fee > balance then
+    (* fees cannot be paid *)
+    begin
+      Incremental.add_operation i operation >>= fun res ->
+      let not_enough_money = function
+        | Proto_alpha.Contract_storage.Balance_too_low _ -> true
+        | _ -> false
+      in
+      Assert.proto_error ~loc:__LOC__ res not_enough_money
+    end
+  else
+    (* delegation is processed ; but delegate does not change *)
+    begin
+      let expect_failure = function
+        | Alpha_environment.Ecoproto_error (Delegate_storage.Non_delegatable_contract _) :: _ ->
+            return_unit
+        | _ ->
+            failwith "The contract is not delegatable, it fails!"
+      in
+      Incremental.add_operation ~expect_failure i operation >>=? fun i ->
+      (* still no delegate *)
+      Context.Contract.delegate_opt (I i) new_contract >>=? fun new_delegate_opt ->
+      assert (new_delegate_opt = None) ;
+      (* new contract loses the fee *)
+      Assert.balance_was_debited ~loc:__LOC__ (I i) new_contract balance fee
+    end
+
+(*******************)
+(** the credit is zero tez *)
+(*******************)
+
+let credit fee () =
+  register_origination ~credit:Tez.zero () >>=? fun (b, contract, new_contract) ->
+  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.balance (I i) contract >>=? fun balance ->
+  Context.Contract.balance (I i) new_contract >>=? fun new_balance ->
+  (* the source contract does not have enough tez to transfer *)
+  Op.transaction ~fee (I i) new_contract contract Tez.one_cent >>=? fun operation ->
+  if fee > new_balance then
+    begin
+      Incremental.add_operation i operation >>= fun res ->
+      let not_enough_money = function
+        | Proto_alpha.Contract_storage.Balance_too_low _ -> true
+        | _ -> false
+      in
+      Assert.proto_error ~loc:__LOC__ res not_enough_money
+    end
+  else
+    begin
+      let not_enough_money = function
+        | Alpha_environment.Ecoproto_error (Proto_alpha.Contract_storage.Balance_too_low _) :: _ ->
+            return_unit
+        | _ -> failwith "The contract does not have enough money, it fails!"
+      in
+      Incremental.add_operation ~expect_failure:not_enough_money i operation >>=? fun i ->
+      (* new contract loses the fee *)
+      Assert.balance_was_debited ~loc:__LOC__ (I i) new_contract new_balance fee >>=? fun () ->
+      (* contract is not credited *)
+      Assert.balance_was_credited ~loc:__LOC__ (I i) contract balance Tez.zero
+    end
+
+(*******************)
+(** same as register_origination but for an incremental *)
+(*******************)
+
+let register_origination_inc ~credit () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let source_contract = List.hd contracts in
+  Incremental.begin_construction b >>=? fun inc ->
+  Op.origination (I inc)
+    ~storage_limit:(Z.of_int Constants_repr.default.origination_size)
+    ~credit source_contract >>=? fun (operation, new_contract) ->
+  Incremental.add_operation inc operation >>=? fun inc ->
+  return (inc, source_contract, new_contract)
+
+(*******************)
+(** Using the originate contract to create another
+    originate contract *)
+(*******************)
+
+let origination_contract_from_origination_contract_not_enough_fund fee () =
+  let amount = Tez.one in
+  register_origination_inc ~credit:amount () >>=? fun (inc, _, contract) ->
+  (* contract's balance is not enough to afford origination burn  *)
+  Op.origination ~fee (I inc) ~credit:amount contract >>=? fun (operation, orig_contract) ->
+  let expect_failure = function
+    | Alpha_environment.Ecoproto_error (Alpha_context.Fees.Cannot_pay_storage_fee) :: _ ->
+        return_unit
+    | e ->
+        failwith "The contract has not enough funds, it fails! %a"
+          Error_monad.pp_print_error e
+  in
+  Incremental.add_operation ~expect_failure inc operation >>=? fun inc ->
+  Context.Contract.balance (I inc) contract >>=? fun balance_aft ->
+  (* contract was debited of [fee] but not of origination burn *)
+  Assert.balance_was_debited ~loc:__LOC__ (I inc) contract balance_aft fee >>=? fun () ->
+  (* orig_contract does not exist *)
+  Context.Contract.balance (I inc) orig_contract >>= fun res ->
+  Assert.error ~loc:__LOC__ res begin function
+    | RPC_context.Not_found _ -> true
+    | _ -> false
+  end
+(*******************)
+(** create an originate contract where the contract
+    does not have enough tez to pay for the fee *)
+(*******************)
+
+let not_tez_in_contract_to_pay_fee () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  let contract_1 = List.nth contracts 0 in
+  let contract_2 = List.nth contracts 1 in
+  Incremental.begin_construction b >>=? fun inc ->
+  (* transfer everything but one tez from 1 to 2 and check balance of 1 *)
+  Context.Contract.balance (I inc) contract_1 >>=? fun balance ->
+  Lwt.return @@ Tez.(-?) balance Tez.one >>=? fun amount ->
+  Op.transaction (I inc) contract_1 contract_2 amount >>=? fun operation ->
+  Incremental.add_operation inc operation >>=? fun inc ->
+  Assert.balance_was_debited ~loc:__LOC__ (I inc) contract_1 balance amount
+  >>=? fun _ ->
+  (* use this source contract to create an originate contract where it requires
+     to pay a fee and add an amount of credit into this new contract *)
+  Op.origination (I inc) ~fee:ten_tez ~credit:Tez.one contract_1 >>=? fun (op, _) ->
+  Incremental.add_operation inc op >>= fun inc ->
+  Assert.proto_error ~loc:__LOC__ inc begin function
+    | Contract_storage.Balance_too_low _ -> true
+    | _ -> false
+  end
+
+(***************************************************)
+(* set the endorser of the block as manager/delegate of the originated
+   account *)
+(***************************************************)
+
+let register_contract_get_endorser () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract = List.hd contracts in
+  Incremental.begin_construction b >>=? fun inc ->
+  Context.get_endorser (I inc) >>=? fun (account_endorser, _slots) ->
+  return (inc, contract, account_endorser)
+
+let set_manager () =
+  register_contract_get_endorser () >>=? fun (inc, contract, account_endorser) ->
+  Op.origination ~manager:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, orig_contract) ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Incremental.finalize_block inc >>=? fun b ->
+  (* the manager is indeed the endorser *)
+  Context.Contract.manager (B b) orig_contract >>=? fun manager ->
+  Assert.equal_pkh ~loc:__LOC__ manager.pkh account_endorser
+
+let set_delegate () =
+  register_contract_get_endorser () >>=? fun (inc, contract, account_endorser) ->
+  Op.origination ~delegate:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, orig_contract) ->
+  Incremental.add_operation inc op >>=? fun inc ->
+  Incremental.finalize_block inc >>=? fun b ->
+  (* the delegate is indeed the endorser *)
+  Context.Contract.delegate (B b) orig_contract >>=? fun delegate ->
+  Assert.equal_pkh ~loc:__LOC__ delegate account_endorser
+
+(*******************)
+(** create multiple originated contracts and
+    ask contract to pay the fee *)
+(*******************)
+
+let n_originations n ?credit ?fee ?spendable ?delegatable () =
+  fold_left_s (fun new_contracts _ ->
+      register_origination ?fee ?credit ?spendable ?delegatable () >>=? fun (_b, _source, new_contract) ->
+
+      let contracts = new_contract :: new_contracts in
+      return contracts
+    ) [] (1 -- n)
+
+let multiple_originations () =
+  n_originations 100 ~credit:(Tez.of_int 2) ~fee:ten_tez () >>=? fun contracts ->
+  Assert.equal_int ~loc:__LOC__ (List.length contracts) 100
+
+(*******************)
+(** cannot originate two contracts with the same context's counter *)
+(*******************)
+
+let counter () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract = List.hd contracts in
+  Incremental.begin_construction b >>=? fun inc ->
+  Op.origination (I inc) ~credit:Tez.one contract >>=? fun (op1, _) ->
+  Op.origination (I inc) ~credit:Tez.one contract >>=? fun (op2, _) ->
+  Incremental.add_operation inc op1 >>=? fun inc ->
+  Incremental.add_operation inc op2 >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Counter_in_the_past _ -> true
+    | _ -> false
+  end
+
+(*******************)
+(* create an originate contract from an originate contract *)
+(*******************)
+
+let origination_contract_from_origination_contract () =
+  register_origination_inc ~credit:ten_tez () >>=? fun (inc, _source_contract, new_contract) ->
+  let credit = Tez.one in
+  Op.origination (I inc) ~credit new_contract >>=? fun (op2, orig_contract) ->
+  Incremental.add_operation inc op2 >>=? fun inc ->
+  Incremental.finalize_block inc >>=? fun b ->
+  (* operation has been processed:
+     originated contract exists and has been credited with the right amount *)
+  Context.Contract.balance (B b) orig_contract >>=? fun credit0 ->
+  Assert.equal_tez ~loc:__LOC__ credit0 credit
+
+(******************************************************)
+
+let tests = [
+  Test.tztest "balances_simple" `Quick balances_simple ;
+  Test.tztest "balances_credit" `Quick balances_credit ;
+  Test.tztest "balances_credit_fee" `Quick balances_credit_fee ;
+  Test.tztest "balances_credit_unspendable" `Quick balances_credit_unspendable ;
+  Test.tztest "balances_undelegatable" `Quick balances_undelegatable ;
+
+  Test.tztest "regular" `Quick regular ;
+  Test.tztest "pay_fee" `Quick pay_fee;
+
+  Test.tztest "unspendable" `Quick unspendable ;
+  Test.tztest "undelegatable (no fee)" `Quick (undelegatable Tez.zero);
+  Test.tztest "undelegatable (with fee)" `Quick (undelegatable Tez.one);
+  Test.tztest "credit" `Quick (credit Tez.one) ;
+  Test.tztest "create origination from origination not enough fund" `Quick  (origination_contract_from_origination_contract_not_enough_fund Tez.zero);
+  Test.tztest "not enough tez in contract to pay fee" `Quick not_tez_in_contract_to_pay_fee;
+
+  Test.tztest "set manager" `Quick set_manager;
+  Test.tztest "set delegate" `Quick set_delegate;
+
+  Test.tztest "multiple originations" `Quick multiple_originations;
+
+  Test.tztest "counter" `Quick counter;
+
+  Test.tztest "create origination from origination" `Quick
+    origination_contract_from_origination_contract;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/qty.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/qty.ml
new file mode 100644
index 000000000..6cb567ead
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/qty.ml
@@ -0,0 +1,141 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+
+let known_ok_tez_litterals =
+  [ 0L, "0" ;
+    10L, "0.00001" ;
+    100L, "0.0001" ;
+    1_000L, "0.001" ;
+    10_000L, "0.01" ;
+    100_000L, "0.1" ;
+    1_000_000L, "1" ;
+    10_000_000L, "10" ;
+    100_000_000L, "100" ;
+    1_000_000_000L, "1000" ;
+    10_000_000_000L, "10000" ;
+    100_000_000_000L, "100000" ;
+    1_000_000_000_000L, "1000000" ;
+    1_000_000_000_001L, "1000000.000001" ;
+    1_000_000_000_010L, "1000000.00001" ;
+    1_000_000_000_100L, "1000000.0001" ;
+    1_000_000_001_000L, "1000000.001" ;
+    1_000_000_010_000L, "1000000.01" ;
+    1_000_000_100_000L, "1000000.1" ;
+    123_123_123_123_123_123L, "123123123123.123123" ;
+    999_999_999_999_999_999L, "999999999999.999999" ]
+
+let known_bad_tez_litterals =
+  [ "10000." ;
+    "100,." ;
+    "100," ;
+    "1,0000" ;
+    "0.0000,1" ;
+    "0.00,1" ;
+    "0,1" ;
+    "HAHA" ;
+    "0.000,000,1" ;
+    "0.0000000" ;
+    "9,999,999,999,999.999,999"]
+
+let fail expected given msg =
+  Format.kasprintf Pervasives.failwith
+    "@[%s@ expected: %s@ got: %s@]" msg expected given
+
+let fail_msg fmt = Format.kasprintf (fail "" "") fmt
+
+let default_printer _ = ""
+
+let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y =
+  if not (eq x y) then fail (prn x) (prn y) msg
+
+let is_none ?(msg="") x =
+  if x <> None then fail "None" "Some _" msg
+
+let is_some ?(msg="") x =
+  if x = None then fail "Some _" "None" msg
+
+let test_known_tez_litterals () =
+  List.iter
+    (fun (v, s) ->
+       let vv = Tez_repr.of_mutez v in
+       let vs = Tez_repr.of_string s in
+       let vs' = Tez_repr.of_string (String.concat "" (String.split_on_char ',' s)) in
+       let vv = match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv in
+       let vs = match vs with None -> fail_msg "could not unopt %s" s | Some vs -> vs in
+       let vs' = match vs' with None -> fail_msg "could not unopt %s" s | Some vs' -> vs' in
+
+       equal ~prn:Tez_repr.to_string vv vs ;
+       equal ~prn:Tez_repr.to_string vv vs' ;
+       equal ~prn:(fun s -> s) (Tez_repr.to_string vv) s)
+    known_ok_tez_litterals ;
+  List.iter
+    (fun s ->
+       let vs = Tez_repr.of_string s in
+       is_none ~msg:("Unexpected successful parsing of " ^ s) vs)
+    known_bad_tez_litterals ;
+  return_unit
+
+let test_random_tez_litterals () =
+  for _ = 0 to 100_000 do
+    let v = Random.int64 12L in
+    let vv = Tez_repr.of_mutez v in
+    let vv = match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv in
+    let s = Tez_repr.to_string vv in
+    let vs = Tez_repr.of_string s in
+    let s' = String.concat "" (String.split_on_char ',' s) in
+    let vs' = Tez_repr.of_string s' in
+    is_some ~msg:("Could not parse " ^ s ^ " back") vs ;
+    is_some ~msg:("Could not parse " ^ s ^ " back") vs' ;
+    begin match vs with
+      | None -> assert false
+      | Some vs ->
+          let rev = Tez_repr.to_int64 vs in
+          equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev
+    end ;
+    begin match vs' with
+      | None -> assert false
+      | Some vs' ->
+          let rev = Tez_repr.to_int64 vs' in
+          equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev
+    end
+  done ;
+  return_unit
+
+let tests = [
+  "tez-litterals", (fun _ -> test_known_tez_litterals ()) ;
+  "rnd-tez-litterals", (fun _ -> test_random_tez_litterals ()) ;
+]
+
+let wrap (n, f) =
+  Alcotest_lwt.test_case n `Quick begin fun _ () ->
+    f () >>= function
+    | Ok () -> Lwt.return_unit
+    | Error error ->
+        Format.kasprintf Pervasives.failwith "%a" pp_print_error error
+  end
+
+let tests = List.map wrap tests
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/rolls.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/rolls.ml
new file mode 100644
index 000000000..ecc36fbf0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/rolls.ml
@@ -0,0 +1,248 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Test_tez
+open Test_utils
+
+let account_pair = function
+  | [a1; a2] -> (a1, a2)
+  | _ -> assert false
+
+let wrap e = Lwt.return (Alpha_environment.wrap_error e)
+let traverse_rolls ctxt head =
+  let rec loop acc roll =
+    Storage.Roll.Successor.get_option ctxt roll >>= wrap >>=? function
+    | None -> return (List.rev acc)
+    | Some next -> loop (next :: acc) next in
+  loop [head] head
+
+let get_rolls ctxt delegate =
+  Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>= wrap >>=? function
+  | None -> return_nil
+  | Some head_roll -> traverse_rolls ctxt head_roll
+
+let check_rolls b (account:Account.t) =
+  Context.get_constants (B b) >>=? fun constants ->
+  Context.Delegate.info (B b) account.pkh >>=? fun { staking_balance } ->
+  let token_per_roll = constants.parametric.tokens_per_roll in
+  let expected_rolls = Int64.div (Tez.to_mutez staking_balance) (Tez.to_mutez token_per_roll) in
+  Raw_context.prepare b.context
+    ~level:b.header.shell.level
+    ~timestamp:b.header.shell.timestamp
+    ~fitness:b.header.shell.fitness >>= wrap >>=? fun ctxt ->
+  get_rolls ctxt account.pkh >>=? fun rolls ->
+  Assert.equal_int ~loc:__LOC__ (List.length rolls) (Int64.to_int expected_rolls)
+
+let check_no_rolls (b : Block.t) (account:Account.t) =
+  Raw_context.prepare b.context
+    ~level:b.header.shell.level
+    ~timestamp:b.header.shell.timestamp
+    ~fitness:b.header.shell.fitness >>= wrap >>=? fun ctxt ->
+  get_rolls ctxt account.pkh >>=? fun rolls ->
+  Assert.equal_int ~loc:__LOC__ (List.length rolls) 0
+
+let simple_staking_rights () =
+  Context.init 2 >>=? fun (b,accounts) ->
+  let (a1, _a2) = account_pair accounts in
+
+  Context.Contract.balance (B b) a1 >>=? fun balance ->
+  Context.Contract.manager (B b) a1 >>=? fun m1 ->
+
+  Context.Delegate.info (B b) m1.pkh >>=? fun info ->
+  Assert.equal_tez ~loc:__LOC__ balance info.staking_balance >>=? fun () ->
+  check_rolls b m1
+
+let simple_staking_rights_after_baking () =
+  Context.init 2 >>=? fun (b,accounts) ->
+  let (a1, a2) = account_pair accounts in
+
+  Context.Contract.balance (B b) a1 >>=? fun balance ->
+  Context.Contract.manager (B b) a1 >>=? fun m1 ->
+  Context.Contract.manager (B b) a2 >>=? fun m2 ->
+
+  Block.bake_n ~policy:(By_account m2.pkh) 5 b >>=? fun b ->
+
+  Context.Delegate.info (B b) m1.pkh >>=? fun info ->
+  Assert.equal_tez ~loc:__LOC__ balance info.staking_balance >>=? fun () ->
+  check_rolls b m1 >>=? fun () ->
+  check_rolls b m2
+
+let frozen_deposit (info:Context.Delegate.info) =
+  Cycle.Map.fold (fun _ { Delegate.deposit } acc ->
+      Test_tez.Tez.(deposit + acc))
+    info.frozen_balance_by_cycle Tez.zero
+
+let check_activate_staking_balance ~loc ~deactivated b (a, (m:Account.t)) =
+  Context.Delegate.info (B b) m.pkh >>=? fun info ->
+  Assert.equal_bool ~loc info.deactivated deactivated >>=? fun () ->
+  Context.Contract.balance (B b) a >>=? fun balance ->
+  let deposit = frozen_deposit info in
+  Assert.equal_tez ~loc Test_tez.Tez.(balance + deposit) info.staking_balance
+
+let run_until_deactivation () =
+  Context.init ~preserved_cycles:2 2 >>=? fun (b,accounts) ->
+  let (a1, a2) = account_pair accounts in
+
+  Context.Contract.balance (B b) a1 >>=? fun balance_start ->
+  Context.Contract.manager (B b) a1 >>=? fun m1 ->
+  Context.Contract.manager (B b) a2 >>=? fun m2 ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () ->
+
+  Context.Delegate.info (B b) m1.pkh >>=? fun info ->
+  Block.bake_until_cycle ~policy:(By_account m2.pkh) info.grace_period b >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () ->
+
+  Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1,m1) >>=? fun () ->
+  return (b, ((a1, m1), balance_start), (a2, m2))
+
+let deactivation_then_bake () =
+  run_until_deactivation () >>=?
+  fun (b, ((_deactivated_contract, deactivated_account) as deactivated, _start_balance),
+       (_a2, _m2)) ->
+
+  Block.bake ~policy:(By_account deactivated_account.pkh) b >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () ->
+  check_rolls b deactivated_account
+
+let deactivation_then_self_delegation () =
+  run_until_deactivation () >>=?
+  fun (b, ((deactivated_contract, deactivated_account) as deactivated, start_balance),
+       (_a2, m2)) ->
+
+  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation ->
+
+  Block.bake ~policy:(By_account m2.pkh) b ~operation:self_delegation >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () ->
+  Context.Contract.balance (B b) deactivated_contract >>=? fun balance ->
+  Assert.equal_tez ~loc:__LOC__ start_balance balance >>=? fun () ->
+  check_rolls b deactivated_account
+
+let deactivation_then_empty_then_self_delegation () =
+  run_until_deactivation () >>=?
+  fun (b, ((deactivated_contract, deactivated_account) as deactivated, _start_balance),
+       (_a2, m2)) ->
+  (* empty the contract *)
+  Context.Contract.balance (B b) deactivated_contract >>=? fun balance ->
+  let sink_account = Account.new_account () in
+  let sink_contract = Contract.implicit_contract sink_account.pkh in
+  Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in
+  Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract ->
+  Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b ->
+  (* self delegation *)
+  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation ->
+  Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () ->
+  Context.Contract.balance (B b) deactivated_contract >>=? fun balance ->
+  Assert.equal_tez ~loc:__LOC__ Tez.zero balance >>=? fun () ->
+  check_rolls b deactivated_account
+
+let deactivation_then_empty_then_self_delegation_then_recredit () =
+  run_until_deactivation () >>=?
+  fun (b, ((deactivated_contract, deactivated_account) as deactivated, balance),
+       (_a2, m2)) ->
+  (* empty the contract *)
+  let sink_account = Account.new_account () in
+  let sink_contract = Contract.implicit_contract sink_account.pkh in
+  Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in
+  Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract ->
+  Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b ->
+  (* self delegation *)
+  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation ->
+  Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b >>=? fun b ->
+  (* recredit *)
+  Op.transaction (B b) sink_contract deactivated_contract amount >>=? fun recredit_contract ->
+  Block.bake ~policy:(By_account m2.pkh) ~operation:recredit_contract b >>=? fun b ->
+
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () ->
+  Context.Contract.balance (B b) deactivated_contract >>=? fun balance ->
+  Assert.equal_tez ~loc:__LOC__ amount balance >>=? fun () ->
+  check_rolls b deactivated_account
+
+let delegation () =
+  Context.init 2 >>=? fun (b,accounts) ->
+  let (a1, a2) = account_pair accounts in
+  let m3 = Account.new_account () in
+  Account.add_account m3;
+
+  Context.Contract.manager (B b) a1 >>=? fun m1 ->
+  Context.Contract.manager (B b) a2 >>=? fun m2 ->
+  let a3 = Contract.implicit_contract m3.pkh in
+
+  Context.Contract.delegate_opt (B b) a1 >>=? fun delegate ->
+  begin
+    match delegate with
+    | None -> assert false
+    | Some pkh ->
+        assert (Signature.Public_key_hash.equal pkh m1.pkh)
+  end;
+
+  Op.transaction (B b) a1 a3 Tez.fifty_cents >>=? fun transact ->
+
+  Block.bake ~policy:(By_account m2.pkh) b ~operation:transact >>=? fun b ->
+
+  Context.Contract.delegate_opt (B b) a3 >>=? fun delegate ->
+  begin
+    match delegate with
+    | None -> ()
+    | Some _ -> assert false
+  end;
+  check_no_rolls b m3 >>=? fun () ->
+
+  Op.delegation (B b) a3 (Some m3.pkh) >>=? fun delegation ->
+  Block.bake ~policy:(By_account m2.pkh) b ~operation:delegation >>=? fun b ->
+
+  Context.Contract.delegate_opt (B b) a3 >>=? fun delegate ->
+  begin
+    match delegate with
+    | None -> assert false
+    | Some pkh ->
+        assert (Signature.Public_key_hash.equal pkh m3.pkh)
+  end;
+  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a3,m3) >>=? fun () ->
+  check_rolls b m3 >>=? fun () ->
+  check_rolls b m1
+
+let tests = [
+  Test.tztest "simple staking rights" `Quick (simple_staking_rights) ;
+  Test.tztest "simple staking rights after baking" `Quick (simple_staking_rights_after_baking) ;
+  Test.tztest "deactivation then bake" `Quick (deactivation_then_bake) ;
+  Test.tztest "deactivation then self delegation" `Quick (deactivation_then_self_delegation) ;
+  Test.tztest "deactivation then empty then self delegation" `Quick (deactivation_then_empty_then_self_delegation) ;
+  Test.tztest "deactivation then empty then self delegation then recredit" `Quick (deactivation_then_empty_then_self_delegation_then_recredit) ;
+  Test.tztest "delegation" `Quick (delegation) ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/seed.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/seed.ml
new file mode 100644
index 000000000..ab786e3a9
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/seed.ml
@@ -0,0 +1,216 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tests about
+    - seed_nonce_hash included in some blocks
+    - revelation operation of seed_nonce that should correspond to each
+      seed_nonce_hash
+*)
+
+open Proto_alpha
+open Test_tez
+
+(** Tests that baking [blocks_per_commitment] blocks without a
+    [seed_nonce_hash] commitment fails with [Invalid_commitment] *)
+let no_commitment () =
+  Context.init 5 >>=? fun (b,_) ->
+  Context.get_constants (B b) >>=? fun { parametric = { blocks_per_commitment } } ->
+  let blocks_per_commitment = Int32.to_int blocks_per_commitment in
+
+  (* Bake normally until before the commitment *)
+  Block.bake_n (blocks_per_commitment-2) b >>=? fun b ->
+
+  (* Forge a block with empty commitment and apply it *)
+  Block.Forge.forge_header b >>=? fun header ->
+  Block.Forge.set_seed_nonce_hash None header |>
+  Block.Forge.sign_header >>=? fun header ->
+  Block.apply header b >>= fun e ->
+
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Apply.Invalid_commitment _ -> true
+    | _ -> false
+  end
+
+(** Choose a baker, denote it by id. In the first cycle, make id bake only once.
+    Test that:
+    - after id bakes with a commitment the bond is frozen and the reward allocated
+    - when id reveals the nonce too early, there's an error
+    - when id reveals at the right time but the wrong value, there's an error
+    - when another baker reveals correctly, it receives the tip
+    - revealing twice produces an error
+    - after [preserved cycles] a committer that correctly revealed
+      receives back the bond and the reward
+*)
+let revelation_early_wrong_right_twice () =
+  let open Assert in
+
+  Context.init 5 >>=? fun (b,_) ->
+  Context.get_constants (B b) >>=? fun csts ->
+  let bond = csts.parametric.block_security_deposit in
+  let reward = csts.parametric.block_reward in
+  let tip = csts.parametric.seed_nonce_revelation_tip in
+  let blocks_per_commitment = Int32.to_int csts.parametric.blocks_per_commitment in
+  let preserved_cycles = csts.parametric.preserved_cycles in
+
+  (* get the pkh of a baker *)
+  Block.get_next_baker b >>=? fun (pkh,_,_) ->
+  let id = Alpha_context.Contract.implicit_contract pkh in
+  let policy = Block.Excluding [pkh] in
+  (* bake until commitment, excluding id *)
+  Block.bake_n ~policy (blocks_per_commitment-2) b >>=? fun b ->
+  Context.Contract.balance ~kind:Main (B b) id >>=? fun bal_main ->
+  Context.Contract.balance ~kind:Deposit (B b) id >>=? fun bal_deposit ->
+  Context.Contract.balance ~kind:Rewards (B b) id >>=? fun bal_rewards ->
+
+  (* the baker [id] will include a seed_nonce commitment *)
+  Block.bake ~policy:(Block.By_account pkh) b >>=? fun b ->
+  Context.get_level (B b) >>=? fun level_commitment ->
+  Context.get_seed_nonce_hash (B b) >>=? fun committed_hash ->
+
+  (* test that the bond was frozen and the reward allocated *)
+  balance_was_debited ~loc:__LOC__
+    (B b) id bal_main bond >>=? fun () ->
+  balance_was_credited ~loc:__LOC__
+    (B b) id ~kind:Deposit bal_deposit bond >>=? fun () ->
+  balance_was_credited ~loc:__LOC__
+    (B b) id ~kind:Rewards bal_rewards reward >>=? fun () ->
+
+  (* test that revealing too early produces an error *)
+  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation ->
+
+  Block.bake ~policy ~operation b >>= fun e ->
+  let expected = function
+    | Nonce_storage.Too_early_revelation -> true
+    | _ -> false in
+  Assert.proto_error ~loc:__LOC__ e expected >>=? fun () ->
+
+  (* finish the cycle excluding the committing baker, id *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+
+  (* test that revealing at the right time but the wrong value produces an error *)
+  let wrong_hash,_ = Nonce.generate () in
+  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) >>=? fun operation ->
+  Block.bake ~operation b >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Nonce_storage.Unexpected_nonce -> true
+    | _ -> false
+  end >>=? fun () ->
+
+  (* reveals correctly *)
+  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation ->
+  Block.get_next_baker ~policy b >>=? fun (baker_pkh,_,_) ->
+  let baker = Alpha_context.Contract.implicit_contract baker_pkh in
+  Context.Contract.balance ~kind:Main (B b) baker >>=? fun baker_bal_main ->
+  Context.Contract.balance ~kind:Deposit (B b) baker >>=? fun baker_bal_deposit ->
+  Context.Contract.balance ~kind:Rewards (B b) baker >>=? fun baker_bal_rewards ->
+
+  (* bake the operation in a block *)
+  Block.bake ~policy ~operation b >>=? fun b ->
+
+  (* test that the baker gets the tip reward *)
+  balance_was_debited ~loc:__LOC__
+    (B b) baker ~kind:Main baker_bal_main bond >>=? fun () ->
+  balance_was_credited ~loc:__LOC__
+    (B b) baker ~kind:Deposit baker_bal_deposit bond >>=? fun () ->
+  Lwt.return @@ Tez.(+?) reward tip >>=? fun expected_rewards ->
+  balance_was_credited ~loc:__LOC__
+    (B b) baker ~kind:Rewards baker_bal_rewards expected_rewards >>=? fun () ->
+
+  (* test that revealing twice produces an error *)
+  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) >>=? fun operation ->
+  Block.bake ~operation ~policy b >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Nonce_storage.Previously_revealed_nonce -> true
+    | _ -> false
+  end >>=? fun () ->
+
+  (* bake [preserved_cycles] cycles excluding [id] *)
+  Error_monad.fold_left_s (fun b _ -> Block.bake_until_cycle_end ~policy b)
+    b (1 -- preserved_cycles) >>=? fun b ->
+
+  (* test that [id] receives back the bond and the reward *)
+  (* note that in order to have that new_bal = bal_main + reward,
+     id can only bake once; this is why we exclude id from all other bake ops. *)
+  balance_was_credited ~loc:__LOC__
+    (B b) id ~kind:Main bal_main reward >>=? fun () ->
+  balance_is ~loc:__LOC__
+    (B b) id ~kind:Deposit Tez.zero >>=? fun () ->
+  balance_is ~loc:__LOC__
+    (B b) id ~kind:Rewards Tez.zero
+
+
+(** Tests that:
+    - a committer at cycle 0, which doesn't reveal at cycle 1,
+      at the end of the cycle 1 looses the bond and the reward
+    - revealing too late produces an error
+*)
+let revelation_missing_and_late () =
+  let open Context in
+  let open Assert in
+
+  Context.init 5 >>=? fun (b,_) ->
+  get_constants (B b) >>=? fun csts ->
+  let reward = csts.parametric.block_reward in
+  let blocks_per_commitment = Int32.to_int csts.parametric.blocks_per_commitment in
+
+  (* bake until commitment *)
+  Block.bake_n (blocks_per_commitment-2) b >>=? fun b ->
+  (* the next baker [id] will include a seed_nonce commitment *)
+  Block.get_next_baker b >>=? fun (pkh,_,_) ->
+  let id = Alpha_context.Contract.implicit_contract pkh in
+  Block.bake b >>=? fun b ->
+  Context.get_level (B b) >>=? fun level_commitment ->
+  Context.get_seed_nonce_hash (B b) >>=? fun committed_hash ->
+  Context.Contract.balance ~kind:Main (B b) id >>=? fun bal_main ->
+  Context.Contract.balance ~kind:Deposit (B b) id >>=? fun bal_deposit ->
+  Context.Contract.balance ~kind:Rewards (B b) id >>=? fun bal_rewards ->
+
+  (* finish cycle 0 excluding the committing baker [id] *)
+  let policy = Block.Excluding [pkh] in
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+  (* finish cycle 1 excluding the committing baker [id] *)
+  Block.bake_until_cycle_end ~policy b >>=? fun b ->
+
+  (* test that baker [id], which didn't reveal at cycle 1 like it was supposed to,
+     at the end of the cycle 1 looses the reward but not the bond *)
+  balance_is ~loc:__LOC__ (B b) id ~kind:Main bal_main >>=? fun () ->
+  balance_is ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit >>=? fun () ->
+  balance_was_debited ~loc:__LOC__
+    (B b) id ~kind:Rewards bal_rewards reward >>=? fun () ->
+
+  (* test that revealing too late (after cycle 1) produces an error *)
+  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation ->
+  Block.bake ~operation b >>= fun e ->
+  Assert.proto_error ~loc:__LOC__ e begin function
+    | Nonce_storage.Too_late_revelation -> true
+    | _ -> false
+  end
+
+
+let tests = [
+  Test.tztest "no commitment" `Quick no_commitment ;
+  Test.tztest "revelation_early_wrong_right_twice" `Quick revelation_early_wrong_right_twice ;
+  Test.tztest "revelation_missing_and_late" `Quick revelation_missing_and_late ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/transfer.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/transfer.ml
new file mode 100644
index 000000000..2d21e8808
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/transfer.ml
@@ -0,0 +1,667 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Alpha_context
+open Test_utils
+open Test_tez
+
+(*********************************************************************)
+(* Utility functions                                                 *)
+(*********************************************************************)
+
+(**
+   [transfer_and_check_balances b fee src dst amount]
+   this function takes a block, an optional parameter fee if fee does not
+   given it will be set to zero tez, a source contract, a destination contract
+   and the amount that one wants to transfer.
+
+   1- Transfer the amount of tez (w/wo fee) from a source contract to a
+       destination contract.
+
+    2- Check the equivalent of the balance of the source/destination
+       contract before and after transfer is valided.
+
+   This function returns a pair:
+   - A block that added a valid operation
+   - a valid operation
+*)
+let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee=Tez.zero) ?expect_failure src dst amount =
+  Tez.(+?) fee amount >>?= fun amount_fee ->
+  Context.Contract.balance (I b) src >>=? fun bal_src ->
+  Context.Contract.balance (I b) dst >>=? fun bal_dst ->
+  Op.transaction (I b) ~fee src dst amount >>=? fun op ->
+  Incremental.add_operation ?expect_failure b op >>=? fun b ->
+  Context.get_constants (I b) >>=? fun { parametric = { origination_size ; cost_per_byte } } ->
+  Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn ->
+  let amount_fee_maybe_burn =
+    if with_burn then
+      match Tez.(amount_fee +? origination_burn) with
+      | Ok r -> r
+      | Error _ -> assert false
+    else
+      amount_fee in
+  Assert.balance_was_debited  ~loc (I b) src bal_src amount_fee_maybe_burn >>=? fun () ->
+  Assert.balance_was_credited ~loc (I b) dst bal_dst amount >>=? fun () ->
+  return (b, op)
+
+(**
+   [transfer_to_itself_and_check_balances b fee contract amount]
+   this function takes a block, an optional parameter fee,
+   a contract that is a source and a destination contract,
+   and an amount of tez that one wants to transfer.
+
+   1- Transfer the amount of tez (w/wo transfer fee) from/to a contract itself.
+
+   2- Check the equivalent of the balance of the contract before
+       and after transfer.
+
+   This function returns a pair:
+   - a block that added the valid transaction
+   - an valid transaction
+*)
+let transfer_to_itself_and_check_balances ~loc b ?(fee=Tez.zero) contract amount =
+  Context.Contract.balance (I b) contract >>=? fun bal ->
+  Op.transaction (I b) ~fee contract contract amount >>=? fun op ->
+  Incremental.add_operation b op >>=? fun b ->
+  Assert.balance_was_debited ~loc (I b) contract bal fee >>=? fun () ->
+  return (b, op)
+
+(**
+   [n_transactions n b fee source dest amount]
+   this function takes a number of "n" that one wish to transfer,
+   a block, an optional parameter fee, a source contract,
+   a destination contract and an amount one wants to transfer.
+
+   This function will do a transaction from a source contract to
+   a destination contract with the amount "n" times.
+*)
+let n_transactions n b ?fee source dest amount =
+  fold_left_s (fun b _ ->
+      transfer_and_check_balances ~loc:__LOC__ b ?fee source dest amount >>=? fun (b,_) ->
+      return b)
+    b (1 -- n)
+
+let ten_tez = Tez.of_int 10
+
+(*********************************************************************)
+(* Tests                                                             *)
+(*********************************************************************)
+
+let register_two_contracts () =
+  Context.init 2 >>=? fun (b, contracts) ->
+  let contract_1 = List.nth contracts 0 in
+  let contract_2 = List.nth contracts 1 in
+  return (b, contract_1, contract_2)
+
+
+(** compute half of the balance and divided by nth
+    times *)
+
+let two_nth_of_balance incr contract nth =
+  Context.Contract.balance (I incr) contract >>=? fun balance ->
+  Tez.(/?) balance nth >>?= fun res ->
+  Tez.( *?) res 2L >>?= fun balance ->
+  return balance
+
+(********************)
+(** Single transfer *)
+(********************)
+
+let single_transfer ?fee ?expect_failure amount =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  transfer_and_check_balances ~loc:__LOC__ ?fee ?expect_failure
+    b contract_1 contract_2 amount >>=? fun (b,_) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** single transfer without fee *)
+let block_with_a_single_transfer () =
+  single_transfer Tez.one
+
+(** single transfer with fee *)
+let block_with_a_single_transfer_with_fee () =
+  single_transfer ~fee:Tez.one Tez.one
+
+(** single transfer without fee *)
+
+let transfer_zero_tez () =
+  single_transfer ~expect_failure:(
+    function
+    | Alpha_environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _ ->
+        return_unit
+    | _ ->
+        failwith "Empty transaction should fail")
+    Tez.zero
+
+(********************)
+(** Transfer zero tez from an originated/implicit contract *)
+(********************)
+
+let transfer_zero_originated () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun i ->
+  (* originated the first contract *)
+  Op.origination (I i) contract_1 >>=? fun (operation, orig_contract_1) ->
+  Incremental.add_operation i operation >>=? fun i ->
+  Context.Contract.balance (I i) orig_contract_1 >>=? fun balance_1 ->
+  (* transfer all the tez inside the originated contract *)
+  transfer_and_check_balances ~loc:__LOC__ i
+    orig_contract_1 contract_2 balance_1 >>=? fun (i, _) ->
+  Op.transaction (I i) orig_contract_1 contract_2 Tez.zero >>=? fun op ->
+  Incremental.add_operation i op >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Empty_transaction _ -> true
+    | _ -> false
+  end
+
+let transfer_zero_implicit () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let dest = List.nth contracts 0 in
+  let account = Account.new_account () in
+  Incremental.begin_construction b >>=? fun i ->
+  let src = Contract.implicit_contract account.Account.pkh in
+  Op.transaction (I i) src dest Tez.zero >>=? fun op ->
+  Incremental.add_operation i op >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Empty_implicit_contract _ -> true
+    | _ -> false
+  end
+
+(********************)
+(** Transfer to originted contract *)
+(********************)
+
+let transfer_to_originate_with_fee () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract = List.nth contracts 0 in
+  Incremental.begin_construction b >>=? fun b ->
+  two_nth_of_balance b contract 10L >>=? fun fee ->
+  (* originated contract, paying a fee to originated this contract *)
+  Op.origination (I b) ~fee:ten_tez contract >>=? fun (operation, new_contract) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  two_nth_of_balance b contract 3L >>=? fun amount ->
+  transfer_and_check_balances ~loc:__LOC__ b ~fee:fee contract
+    new_contract amount >>=? fun (b, _) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** Transfer from balance *)
+(********************)
+
+let transfer_amount_of_contract_balance () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Context.Contract.pkh contract_1 >>=? fun pkh1 ->
+  (* given that contract_1 no longer has a sufficient balance to bake,
+     make sure it cannot be chosen as baker *)
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b ->
+  (* get the balance of the source contract *)
+  Context.Contract.balance (I b) contract_1 >>=? fun balance ->
+  (* transfer all the tez inside contract 1 *)
+  transfer_and_check_balances ~loc:__LOC__
+    b contract_1 contract_2 balance >>=? fun (b,_) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** Transfer to itself *)
+(********************)
+
+let transfers_to_self () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract = List.nth contracts 0 in
+  Incremental.begin_construction b >>=? fun b ->
+  two_nth_of_balance b contract 3L >>=? fun amount ->
+  transfer_to_itself_and_check_balances ~loc:__LOC__ b contract amount
+  >>=? fun (b, _) ->
+  two_nth_of_balance b contract 5L >>=? fun fee ->
+  transfer_to_itself_and_check_balances ~loc:__LOC__ b ~fee:fee contract ten_tez
+  >>=? fun (b, _) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** Forgot to add the valid transaction into the block *)
+(********************)
+
+let missing_transaction () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  (* given that contract_1 no longer has a sufficient balance to bake,
+     make sure it cannot be chosen as baker *)
+  Context.Contract.pkh contract_1 >>=? fun pkh1 ->
+  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b ->
+  two_nth_of_balance b contract_1 6L >>=? fun amount ->
+  (* do the transfer 3 times from source contract to destination contract *)
+  n_transactions 3 b contract_1 contract_2 amount >>=? fun b ->
+  (* do the fourth transfer from source contract to destination contract *)
+  Op.transaction (I b) contract_1 contract_2 amount >>=? fun _ ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** These following tests are for different kind of contracts:
+    - implicit to implicit
+    - implicit to originated
+    - originated to implicit
+    - originted to originted *)
+(********************)
+
+(** Implicit to Implicit *)
+
+let transfer_from_implicit_to_implicit_contract () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let bootstrap_contract = List.nth contracts 0 in
+  let account_a = Account.new_account () in
+  let account_b = Account.new_account () in
+  Incremental.begin_construction b >>=? fun b ->
+  let src = Contract.implicit_contract account_a.Account.pkh in
+  two_nth_of_balance b bootstrap_contract 3L >>=? fun amount1 ->
+  two_nth_of_balance b bootstrap_contract 10L >>=? fun fee1 ->
+  transfer_and_check_balances ~with_burn:true ~loc:__LOC__ ~fee:fee1 b
+    bootstrap_contract src amount1 >>=? fun (b, _) ->
+  (* create an implicit contract as a destination contract *)
+  let dest = Contract.implicit_contract account_b.pkh in
+  two_nth_of_balance b bootstrap_contract 4L >>=? fun amount2 ->
+  two_nth_of_balance b bootstrap_contract 10L >>=? fun fee2 ->
+  (* transfer from implicit contract to another implicit contract *)
+  transfer_and_check_balances ~with_burn:true ~loc:__LOC__ ~fee:fee2 b
+    src dest amount2 >>=? fun (b, _) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** Implicit to originated *)
+
+let transfer_from_implicit_to_originated_contract () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let bootstrap_contract = List.nth contracts 0 in
+  let contract = List.nth contracts 0 in
+  let account = Account.new_account () in
+  let src = Contract.implicit_contract account.Account.pkh in
+  Incremental.begin_construction b >>=? fun b ->
+  two_nth_of_balance b bootstrap_contract 3L >>=? fun amount1 ->
+  (* transfer the money to implicit contract *)
+  transfer_and_check_balances ~with_burn:true ~loc:__LOC__ b bootstrap_contract src amount1
+  >>=? fun (b, _) ->
+  (* originated contract *)
+  Op.origination (I b) contract >>=? fun (operation, new_contract) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  two_nth_of_balance b bootstrap_contract 4L >>=? fun amount2 ->
+  (* transfer from implicit contract to originated contract *)
+  transfer_and_check_balances ~loc:__LOC__ b src new_contract amount2
+  >>=? fun (b, _) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** Originted to originted *)
+
+let transfer_from_originated_to_originated () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  (* originated contract 1 *)
+  Op.origination (I b) contract_1 >>=? fun (operation, orig_contract_1) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  (* originated contract 2 *)
+  Op.origination (I b) contract_2 >>=? fun (operation, orig_contract_2) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  (* transfer from originated contract 1 to originated contract 2 *)
+  transfer_and_check_balances ~loc:__LOC__ b
+    orig_contract_1 orig_contract_2 Alpha_context.Tez.one >>=? fun (b,_) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** Originted to impicit *)
+
+let transfer_from_originated_to_implicit () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let contract_1 = List.nth contracts 0 in
+  let account = Account.new_account () in
+  let src = Contract.implicit_contract account.pkh in
+  Incremental.begin_construction b >>=? fun b ->
+  (* originated contract 1*)
+  Op.origination (I b) contract_1 >>=? fun (operation, new_contract) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  (* transfer from originated contract to implicit contract *)
+  transfer_and_check_balances ~with_burn:true ~loc:__LOC__ b new_contract src Alpha_context.Tez.one_mutez
+  >>=? fun (b, _) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** Slow tests case *)
+(********************)
+
+let multiple_transfer n ?fee amount =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  n_transactions n b ?fee contract_1 contract_2 amount >>=? fun b ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** 1- Create a block with two contracts;
+    2- Apply 100 transfers. *)
+let block_with_multiple_transfers () =
+  multiple_transfer 99 (Tez.of_int 1000)
+
+(** 1- Create a block with two contracts;
+    2- Apply 100 transfers with 10tz fee. *)
+let block_with_multiple_transfers_pay_fee () =
+  multiple_transfer 10 ~fee:ten_tez (Tez.of_int 1000)
+
+(** 1- Create a block with 8 contracts;
+    2- Apply multiple transfers without fees;
+    3- Apply multiple transfers with fees. *)
+(* TODO : increase the number of operations and add a `Slow tag to it in `tests` *)
+let block_with_multiple_transfers_with_without_fee () =
+  Context.init 8 >>=? fun (b, contracts) ->
+  let contracts = Array.of_list contracts in
+  Incremental.begin_construction b >>=? fun b ->
+  let hundred = Tez.of_int 100 in
+  let ten = Tez.of_int 10 in
+  let twenty = Tez.of_int 20 in
+  n_transactions 10 b contracts.(0) contracts.(1) Tez.one >>=? fun b ->
+  n_transactions 30 b contracts.(1) contracts.(2) hundred >>=? fun b ->
+  n_transactions 30 b contracts.(1) contracts.(3) hundred >>=? fun b ->
+  n_transactions 30 b contracts.(4) contracts.(3) hundred >>=? fun b ->
+  n_transactions 20 b contracts.(0) contracts.(1) hundred >>=? fun b ->
+  n_transactions 10 b contracts.(1) contracts.(3) hundred >>=? fun b ->
+  n_transactions 10 b contracts.(1) contracts.(3) hundred >>=? fun b ->
+
+  n_transactions 20  ~fee:ten b contracts.(3) contracts.(4) ten >>=? fun b ->
+  n_transactions 10  ~fee:twenty b contracts.(4) contracts.(5) ten >>=? fun b ->
+  n_transactions 70  ~fee:twenty b contracts.(6) contracts.(0) twenty >>=? fun b ->
+  n_transactions 550 ~fee:twenty b contracts.(6) contracts.(4) twenty >>=? fun b ->
+  n_transactions 50  ~fee:ten b contracts.(7) contracts.(5) twenty >>=? fun b ->
+  n_transactions 30  ~fee:ten b contracts.(0) contracts.(7) hundred >>=? fun b ->
+  n_transactions 20  ~fee:ten b contracts.(1) contracts.(0) twenty >>=? fun b ->
+
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(********************)
+(** Build a chain that has 10 blocks. *)
+(********************)
+
+let build_a_chain () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  let ten = Tez.of_int 10 in
+  fold_left_s (fun b _ ->
+      Incremental.begin_construction b >>=? fun b ->
+      transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten
+      >>=? fun (b, _) ->
+      Incremental.finalize_block b
+    ) b (1 -- 10) >>=? fun _ ->
+  return_unit
+
+(*********************************************************************)
+(* Expected error test cases                                         *)
+(*********************************************************************)
+
+(********************)
+(** transfer zero tez is forbidden in implicit contract *)
+(********************)
+
+let empty_implicit () =
+  Context.init 1 >>=? fun (b, contracts) ->
+  let dest = List.nth contracts 0 in
+  let account = Account.new_account () in
+  Incremental.begin_construction b >>=? fun incr ->
+  let src = Contract.implicit_contract account.Account.pkh in
+  two_nth_of_balance incr dest 3L >>=? fun amount ->
+  (* transfer zero tez from an implicit contract *)
+  Op.transaction (I incr) src dest amount >>=? fun op ->
+  Incremental.add_operation incr op >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Empty_implicit_contract _ -> true
+    | _ -> false
+  end
+
+(********************)
+(** Balance is too low to transfer *)
+(********************)
+
+let balance_too_low fee () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.balance (I i) contract_1 >>=? fun balance1 ->
+  Context.Contract.balance (I i) contract_2 >>=? fun balance2 ->
+  (* transfer the amount of tez that is bigger than the balance in the source contract *)
+  Op.transaction ~fee (I i) contract_1 contract_2 Tez.max_tez >>=? fun op ->
+  let expect_failure = function
+    | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
+        return_unit
+    | _ ->
+        failwith "balance too low should fail"
+  in
+  (* the fee is higher than the balance then raise an error "Balance_too_low" *)
+  if fee > balance1 then begin
+    Incremental.add_operation ~expect_failure i op >>= fun _res ->
+    return_unit
+  end
+  (* the fee is smaller than the balance, then the transfer is accepted
+     but it is not processed, and fees are taken *)
+  else begin
+    Incremental.add_operation ~expect_failure i op >>=? fun i ->
+    (* contract_1 loses the fees *)
+    Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee >>=? fun () ->
+    (* contract_2 is not credited *)
+    Assert.balance_was_credited ~loc:__LOC__ (I i) contract_2 balance2 Tez.zero
+  end
+
+(** 1- Create a block, and three contracts;
+    2- Add a transfer that at the end the balance of a contract is
+       zero into this block;
+    3- Add another transfer that send tez from a zero balance contract;
+    4- Catch the expected error: Balance_too_low. *)
+let balance_too_low_two_transfers fee () =
+  Context.init 3 >>=? fun (b, contracts) ->
+  let contract_1 = List.nth contracts 0 in
+  let contract_2 = List.nth contracts 1 in
+  let contract_3 = List.nth contracts 2 in
+  Incremental.begin_construction b >>=? fun i ->
+  Context.Contract.balance (I i) contract_1 >>=? fun balance ->
+  Tez.(/?) balance  3L >>?= fun res ->
+  Tez.( *?) res 2L >>?= fun two_third_of_balance ->
+  transfer_and_check_balances ~loc:__LOC__ i
+    contract_1 contract_2 two_third_of_balance >>=? fun (i, _) ->
+  Context.Contract.balance (I i) contract_1 >>=? fun balance1 ->
+  Context.Contract.balance (I i) contract_3 >>=? fun balance3 ->
+  Op.transaction ~fee (I i) contract_1 contract_3
+    two_third_of_balance >>=? fun operation ->
+  let expect_failure = function
+    | Alpha_environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
+        return_unit
+    | _ ->
+        failwith "balance too low should fail"
+  in
+  Incremental.add_operation ~expect_failure i operation >>=? fun i ->
+  (* contract_1 loses the fees *)
+  Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee >>=? fun () ->
+  (* contract_3 is not credited *)
+  Assert.balance_was_credited ~loc:__LOC__ (I i) contract_3 balance3 Tez.zero
+
+(********************)
+(** The counter is already used for the previous operation *)
+(********************)
+
+let invalid_counter () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  Op.transaction (I b) contract_1 contract_2
+    Tez.one >>=? fun op1 ->
+  Op.transaction (I b) contract_1 contract_2
+    Tez.one >>=? fun op2 ->
+  Incremental.add_operation b op1 >>=? fun b ->
+  Incremental.add_operation b op2 >>= fun b ->
+  Assert.proto_error ~loc:__LOC__ b begin function
+    | Contract_storage.Counter_in_the_past _ -> true
+    | _ -> false
+  end
+
+(* same as before but different way to perform this error *)
+
+let add_the_same_operation_twice () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten_tez
+  >>=? fun (b, op_transfer) ->
+  Op.transaction (I b) contract_1 contract_2 ten_tez >>=? fun _ ->
+  Incremental.add_operation b op_transfer >>= fun b ->
+  Assert.proto_error ~loc:__LOC__ b begin function
+    | Contract_storage.Counter_in_the_past _ -> true
+    | _ -> false
+  end
+
+(********************)
+(** Do the transfer from an "unspendable" contract *)
+(********************)
+
+let unspendable_contract () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  Op.origination ~spendable:false (I b) contract_1 >>=? fun (operation, unspendable_contract) ->
+  Incremental.add_operation b operation >>=? fun b ->
+  Op.transaction (I b) unspendable_contract contract_2 Alpha_context.Tez.one_cent >>=? fun operation ->
+  Incremental.add_operation b operation >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Contract_storage.Unspendable_contract _ -> true
+    | _ -> false
+  end
+
+(********************)
+(** check ownership *)
+(********************)
+
+let ownership_sender () =
+  register_two_contracts () >>=? fun (b, contract_1, contract_2) ->
+  Incremental.begin_construction b >>=? fun b ->
+  (* get the manager of the contract_1 as a sender *)
+  Context.Contract.manager (I b) contract_1 >>=? fun manager ->
+  (* create an implicit_contract *)
+  let imcontract_1 = Alpha_context.Contract.implicit_contract manager.pkh in
+  transfer_and_check_balances ~loc:__LOC__ b imcontract_1 contract_2 Tez.one
+  >>=? fun (b,_) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(*********************************************************************)
+(** Random transfer *)
+
+(** Return a pair of minimum and maximum random number *)
+let random_range (min, max) =
+  let interv = max - min + 1 in
+  let init =
+    Random.self_init ();
+    (Random.int interv) + min
+  in init
+
+(** Return a random contract *)
+let random_contract contract_array =
+  let i = Random.int (Array.length contract_array) in
+  contract_array.(i)
+
+(** Transfer by randomly choose amount 10 contracts, and randomly
+    choose the amount in the source contract *)
+let random_transfer () =
+  Context.init 10 >>=? fun (b, contracts) ->
+  let contracts = Array.of_list contracts in
+  let source = random_contract contracts in
+  let dest = random_contract contracts in
+  Context.Contract.pkh source >>=? fun source_pkh ->
+  (* given that source may not have a sufficient balance for the transfer + to bake, 
+     make sure it cannot be chosen as baker *)
+  Incremental.begin_construction b ~policy:(Block.Excluding [source_pkh]) >>=? fun b ->
+  Context.Contract.balance (I b) source >>=? fun amount ->
+  begin
+    if source = dest
+    then
+      transfer_to_itself_and_check_balances ~loc:__LOC__ b source amount
+    else
+      transfer_and_check_balances ~loc:__LOC__ b source dest amount
+  end >>=? fun (b,_) ->
+  Incremental.finalize_block b >>=? fun _ ->
+  return_unit
+
+(** Transfer random transactions *)
+let random_multi_transactions () =
+  let n = random_range (1, 100) in
+  multiple_transfer n (Tez.of_int 100)
+
+(*********************************************************************)
+
+let tests = [
+  (* single transfer *)
+  Test.tztest "single transfer" `Quick block_with_a_single_transfer ;
+  Test.tztest "single transfer with fee" `Quick block_with_a_single_transfer_with_fee ;
+
+  (* transfer zero tez *)
+  Test.tztest "single transfer zero tez" `Quick transfer_zero_tez ;
+  Test.tztest "transfer zero tez from originated contract" `Quick transfer_zero_originated;
+  Test.tztest "transfer zero tez from implicit contract" `Quick transfer_zero_implicit;
+
+  (* transfer to originated contract *)
+  Test.tztest "transfer to originated contract paying transaction fee" `Quick transfer_to_originate_with_fee ;
+
+  (* transfer by the balance of contract *)
+  Test.tztest "transfer the amount from source contract balance" `Quick transfer_amount_of_contract_balance ;
+
+  (* transfer to itself *)
+  Test.tztest "transfers to itself" `Quick transfers_to_self ;
+
+  (* missing operation *)
+
+  Test.tztest "missing transaction" `Quick missing_transaction ;
+
+  (* transfer from/to implicit/originted contracts*)
+  Test.tztest "transfer from an implicit to implicit contract " `Quick transfer_from_implicit_to_implicit_contract ;
+  Test.tztest "transfer from an implicit to an originated contract" `Quick transfer_from_implicit_to_originated_contract ;
+  Test.tztest "transfer from an originated to an originated contract" `Quick transfer_from_originated_to_originated ;
+  Test.tztest "transfer from an originated to an implicit contract" `Quick transfer_from_originated_to_implicit ;
+
+  (* Slow tests *)
+  Test.tztest "block with multiple transfers" `Slow block_with_multiple_transfers ;
+  (* TODO increase the number of transaction times *)
+  Test.tztest "block with multiple transfer paying fee" `Slow block_with_multiple_transfers_pay_fee ;
+  Test.tztest "block with multiple transfer without paying fee" `Slow block_with_multiple_transfers_with_without_fee ;
+
+  (* build the chain *)
+  Test.tztest "build a chain" `Quick build_a_chain ;
+
+  (* Erroneous *)
+  Test.tztest "empty implicit" `Quick empty_implicit;
+  Test.tztest "balance too low - transfer zero" `Quick (balance_too_low Tez.zero);
+  Test.tztest "balance too low" `Quick (balance_too_low Tez.one);
+  Test.tztest "balance too low (max fee)" `Quick (balance_too_low Tez.max_tez);
+  Test.tztest "balance too low with two transfers - transfer zero" `Quick (balance_too_low_two_transfers Tez.zero);
+  Test.tztest "balance too low with two transfers" `Quick (balance_too_low_two_transfers Tez.one);
+  Test.tztest "invalid_counter" `Quick invalid_counter ;
+  Test.tztest "add the same operation twice" `Quick  add_the_same_operation_twice ;
+  Test.tztest "unspendable contract" `Quick unspendable_contract ;
+
+  Test.tztest "ownership sender" `Quick  ownership_sender ;
+  (* Random tests *)
+  Test.tztest "random transfer" `Quick random_transfer ;
+  Test.tztest "random multi transfer" `Quick  random_multi_transactions ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/voting.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/voting.ml
new file mode 100644
index 000000000..0186bafc1
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/test/voting.ml
@@ -0,0 +1,778 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_alpha
+open Test_utils
+
+(* missing stuff in Alpha_context.Vote *)
+let ballots_zero = Alpha_context.Vote.{ yay = 0l ; nay = 0l ; pass = 0l }
+let ballots_equal b1 b2 =
+  Alpha_context.Vote.(b1.yay = b2.yay && b1.nay = b2.nay && b1.pass = b2.pass)
+let ballots_pp ppf v = Alpha_context.Vote.(
+    Format.fprintf ppf "{ yay = %ld ; nay = %ld ; pass = %ld" v.yay v.nay v.pass)
+
+(* constantans and ratios used in voting:
+   percent_mul denotes the percent multiplier
+   initial_qr is 8000 that is, 8/10 * percent_mul
+   the quorum ratio qr_num / den = 8 / 10
+   the participation ration pr_num / den = 2 / 10
+   note: we use the same denominator for both quorum and participation rate.
+   supermajority rate is s_num / s_den = 8 / 10 *)
+let percent_mul = 100_00
+let initial_qr = 8 * percent_mul / 10
+let qr_num = 8
+let den = 10
+let pr_num = den - qr_num
+let s_num = 8
+let s_den = 10
+
+(* Protocol_hash.zero is "PrihK96nBAFSxVL1GLJTVhu9YnzkMFiBeuJRPA8NwuZVZCE1L6i" *)
+let protos = Array.map (fun s -> Protocol_hash.of_b58check_exn s)
+    [| "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha84efbeiF6cm" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha91249Z65tWS" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha537f5h25LnN" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha5c8fefgDYkr" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha3f31feSSarC" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphabe31ahnkxSC" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphabab3bgRb7zQ" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphaf8d39cctbpk" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha3b981byuYxD" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphaa116bccYowi" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphacce68eHqboj" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha225c7YrWwR7" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha58743cJL6FG" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphac91bcdvmJFR" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha1faaadhV7oW" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha98232gD94QJ" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha9d1d8cijvAh" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx" ;
+       "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" ; |]
+
+(** helper functions *)
+let mk_contracts_from_pkh pkh_list =
+  List.map (Alpha_context.Contract.implicit_contract) pkh_list
+
+(* get the list of delegates and the list of their rolls from listings *)
+let get_delegates_and_rolls_from_listings b =
+  Context.Vote.get_listings (B b) >>=? fun l ->
+  return ((mk_contracts_from_pkh (List.map fst l)), List.map snd l)
+
+(* compute the rolls of each delegate *)
+let get_rolls b delegates loc =
+  map_s (fun delegate ->
+      Context.Contract.pkh delegate >>=? fun pkh ->
+      Context.Vote.get_listings (B b) >>=? fun l ->
+      match List.find_opt (fun (del,_) -> del = pkh) l with
+      | None -> failwith "%s - Missing delegate" loc
+      | Some (_, rolls) -> return rolls
+    ) delegates
+
+let test_successful_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,_) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  (* no ballots in proposal period *)
+  Context.Vote.get_ballots (B b) >>=? fun v ->
+  Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp
+    v ballots_zero >>=? fun () ->
+
+  (* no ballots in proposal period *)
+  Context.Vote.get_ballot_list (B b) >>=? begin function
+    | [] -> return_unit
+    | _ -> failwith "%s - Unexpected ballot list" __LOC__
+  end >>=? fun () ->
+
+  (* period 1 *)
+  Context.Vote.get_voting_period (B b) >>=? fun v ->
+  let open Alpha_context in
+  Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period"
+    Voting_period.pp v Voting_period.(succ root)
+  >>=? fun () ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* quorum starts at initial_qr *)
+  Context.Vote.get_current_quorum (B b) >>=? fun v ->
+  Assert.equal_int ~loc:__LOC__ initial_qr (Int32.to_int v) >>=? fun () ->
+
+  (* listings must be populated in proposal period *)
+  Context.Vote.get_listings (B b) >>=? begin function
+    | [] -> failwith "%s - Unexpected empty listings" __LOC__
+    | _ -> return_unit
+  end >>=? fun () ->
+
+  (* beginning of proposal, denoted by _p1;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, rolls_p1) ->
+
+  (* no proposals at the beginning of proposal period *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+  begin if Alpha_environment.Protocol_hash.Map.is_empty ps
+    then return_unit
+    else failwith "%s - Unexpected proposals" __LOC__
+  end >>=? fun () ->
+
+  (* no current proposal during proposal period *)
+  Context.Vote.get_current_proposal (B b) >>=? begin function
+    | None -> return_unit
+    | Some _ -> failwith "%s - Unexpected proposal" __LOC__
+  end >>=? fun () ->
+
+  let del1 = List.nth delegates_p1 0 in
+  let del2 = List.nth delegates_p1 1 in
+  let props = List.map (fun i -> protos.(i))
+      (2 -- Constants.max_proposals_per_delegate) in
+  Op.proposals (B b) del1 (Protocol_hash.zero::props) >>=? fun ops1 ->
+  Op.proposals (B b) del2 [Protocol_hash.zero] >>=? fun ops2 ->
+  Block.bake ~operations:[ops1;ops2] b >>=? fun b ->
+
+  (* proposals are now populated *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+
+  (* correctly count the double proposal for zero *)
+  begin
+    let weight = Int32.add (List.nth rolls_p1 0) (List.nth rolls_p1 1) in
+    match Alpha_environment.Protocol_hash.(Map.find_opt zero ps) with
+    | Some v -> if v = weight then return_unit
+        else failwith "%s - Wrong count %ld is not %ld" __LOC__ v weight
+    | None -> failwith "%s - Missing proposal" __LOC__
+  end >>=? fun () ->
+
+  (* proposing more than maximum_proposals fails *)
+  Op.proposals (B b) del1 (Protocol_hash.zero::props) >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Amendment.Too_many_proposals -> true
+    | _ -> false
+  end >>=? fun () ->
+
+  (* proposing less than one proposal fails *)
+  Op.proposals (B b) del1 [] >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Amendment.Empty_proposal -> true
+    | _ -> false
+  end >>=? fun () ->
+
+  (* skip to testing_vote period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we moved to a testing_vote period with one proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* period 2 *)
+  Context.Vote.get_voting_period (B b) >>=? fun v ->
+  let open Alpha_context in
+  Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period"
+    Voting_period.pp v Voting_period.(succ (succ root))
+  >>=? fun () ->
+
+  (* listings must be populated in testing_vote period *)
+  Context.Vote.get_listings (B b) >>=? begin function
+    | [] -> failwith "%s - Unexpected empty listings" __LOC__
+    | _ -> return_unit
+  end >>=? fun () ->
+
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
+  (* no proposals during testing_vote period *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+  begin if Alpha_environment.Protocol_hash.Map.is_empty ps
+    then return_unit
+    else failwith "%s - Unexpected proposals" __LOC__
+  end >>=? fun () ->
+
+  (* current proposal must be set during testing_vote period *)
+  Context.Vote.get_current_proposal (B b) >>=? begin function
+    | Some v -> if Protocol_hash.(equal zero v) then return_unit
+        else failwith "%s - Wrong proposal" __LOC__
+    | None -> failwith "%s - Missing proposal" __LOC__
+  end >>=? fun () ->
+
+  (* unanimous vote: all delegates --active when p2 started-- vote *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    delegates_p2 >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  Op.ballot (B b) del1 Protocol_hash.zero Vote.Nay >>=? fun op ->
+  Block.bake ~operations:[op] b >>= fun res ->
+  Assert.proto_error ~loc:__LOC__ res begin function
+    | Amendment.Unauthorized_ballot -> true
+    | _ -> false
+  end >>=? fun () ->
+
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l rolls_p2 >>=? fun rolls_sum ->
+
+  (* # of Yays in ballots matches rolls of the delegate *)
+  Context.Vote.get_ballots (B b) >>=? fun v ->
+  Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp
+    v Vote.{ yay = rolls_sum ; nay = 0l ; pass = 0l } >>=? fun () ->
+
+  (* One Yay ballot per delegate *)
+  Context.Vote.get_ballot_list (B b) >>=? begin function
+    | [] -> failwith "%s - Unexpected empty ballot list" __LOC__
+    | l ->
+        iter_s (fun delegate ->
+            Context.Contract.pkh delegate >>=? fun pkh ->
+            match List.find_opt (fun (del,_) -> del = pkh) l with
+            | None -> failwith "%s - Missing delegate" __LOC__
+            | Some (_, Vote.Yay) -> return_unit
+            | Some _ -> failwith "%s - Wrong ballot" __LOC__
+          ) delegates_p2
+  end >>=? fun () ->
+
+
+  (* skip to testing period
+     -1 because we already baked one block with the ballot *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* period 3 *)
+  Context.Vote.get_voting_period (B b) >>=? fun v ->
+  let open Alpha_context in
+  Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period"
+    Voting_period.pp v Voting_period.(succ (succ (succ root)))
+  >>=? fun () ->
+
+  (* no ballots in testing period *)
+  Context.Vote.get_ballots (B b) >>=? fun v ->
+  Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp
+    v ballots_zero >>=? fun () ->
+
+  (* listings must be empty in testing period *)
+  Context.Vote.get_listings (B b) >>=? begin function
+    | [] -> return_unit
+    | _ -> failwith "%s - Unexpected listings" __LOC__
+  end >>=? fun () ->
+
+
+  (* skip to promotion_vote period *)
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Promotion_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* period 4 *)
+  Context.Vote.get_voting_period (B b) >>=? fun v ->
+  let open Alpha_context in
+  Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period"
+    Voting_period.pp v Voting_period.(succ (succ (succ (succ root))))
+  >>=? fun () ->
+
+  (* listings must be populated in promotion_vote period *)
+  Context.Vote.get_listings (B b) >>=? begin function
+    | [] -> failwith "%s - Unexpected empty listings" __LOC__
+    | _ -> return_unit
+  end >>=? fun () ->
+
+  (* beginning of promotion_vote period, denoted by _p4;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) ->
+
+  (* no proposals during promotion_vote period *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+  begin if Alpha_environment.Protocol_hash.Map.is_empty ps
+    then return_unit
+    else failwith "%s - Unexpected proposals" __LOC__
+  end >>=? fun () ->
+
+  (* current proposal must be set during promotion_vote period *)
+  Context.Vote.get_current_proposal (B b) >>=? begin function
+    | Some v -> if Protocol_hash.(equal zero v) then return_unit
+        else failwith "%s - Wrong proposal" __LOC__
+    | None -> failwith "%s - Missing proposal" __LOC__
+  end >>=? fun () ->
+
+  (* unanimous vote: all delegates --active when p4 started-- vote *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    delegates_p4 >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l rolls_p4 >>=? fun rolls_sum ->
+
+  (* # of Yays in ballots matches rolls of the delegate *)
+  Context.Vote.get_ballots (B b) >>=? fun v ->
+  Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp
+    v Vote.{ yay = rolls_sum ; nay = 0l ; pass = 0l } >>=? fun () ->
+
+  (* One Yay ballot per delegate *)
+  Context.Vote.get_ballot_list (B b) >>=? begin function
+    | [] -> failwith "%s - Unexpected empty ballot list" __LOC__
+    | l ->
+        iter_s (fun delegate ->
+            Context.Contract.pkh delegate >>=? fun pkh ->
+            match List.find_opt (fun (del,_) -> del = pkh) l with
+            | None -> failwith "%s - Missing delegate" __LOC__
+            | Some (_, Vote.Yay) -> return_unit
+            | Some _ -> failwith "%s - Wrong ballot" __LOC__
+          ) delegates_p4
+  end >>=? fun () ->
+
+  (* skip to end of promotion_vote period and activation*)
+  Block.bake_n Int32.((to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* zero is the new protocol (before the vote this value is unset) *)
+  Context.Vote.get_protocol b >>= fun p ->
+  Assert.equal ~loc:__LOC__ Protocol_hash.equal "Unexpected proposal"
+    Protocol_hash.pp p Protocol_hash.zero >>=? fun () ->
+
+  return_unit
+
+(* given a list of active delegates,
+   return the first k active delegates with which one can have quorum, that is:
+   their roll sum divided by the total roll sum is bigger than qr_num/qr_den *)
+let get_smallest_prefix_voters_for_quorum active_delegates active_rolls =
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l active_rolls >>=? fun active_rolls_sum ->
+  let rec loop delegates rolls sum selected =
+    match delegates, rolls with
+    | [], [] -> selected
+    | del :: delegates, del_rolls :: rolls ->
+        if den * sum < qr_num * (Int32.to_int active_rolls_sum) then
+          loop delegates rolls (sum + (Int32.to_int del_rolls)) (del :: selected)
+        else selected
+    | _, _ -> [] in
+  return (loop active_delegates active_rolls 0 [])
+
+let get_expected_quorum ?(min_participation=0) rolls voter_rolls old_quorum =
+  (* formula to compute the updated quorum as in the whitepaper *)
+  let get_updated_quorum old_quorum participation =
+    (* if not enough participation, don't update the quorum *)
+    if participation < min_participation
+    then (Int32.to_int old_quorum)
+    else (qr_num * (Int32.to_int old_quorum) +
+          pr_num * participation) / den
+  in
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l rolls >>=? fun rolls_sum ->
+  fold_left_s (fun v acc -> return Int32.(add v acc))
+    0l voter_rolls >>=? fun voter_rolls_sum ->
+  let participation = (Int32.to_int voter_rolls_sum) * percent_mul /
+                      (Int32.to_int rolls_sum) in
+  return (get_updated_quorum old_quorum participation)
+
+(* if not enough quorum -- get_updated_quorum < qr_num/qr_den -- in testing vote,
+   go back to proposal period *)
+let test_not_enough_quorum_in_testing_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,delegates) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  (* proposal period *)
+  let open Alpha_context in
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  let proposer = List.nth delegates 0 in
+  Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+
+  (* skip to vote_testing period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we moved to a testing_vote period with one proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun initial_quorum ->
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
+  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters ->
+  (* take the first voter out so there cannot be quorum *)
+  let voters_without_quorum = List.tl voters in
+  get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote ->
+
+  (* all voters_without_quorum vote, for yays;
+     no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters_without_quorum >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to testing period *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* we move back to the proposal period because not enough quorum *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* check quorum update *)
+  get_expected_quorum rolls_p2
+    voters_rolls_in_testing_vote initial_quorum >>=? fun expected_quorum ->
+  Context.Vote.get_current_quorum (B b) >>=? fun new_quorum ->
+  (* assert the formula to calculate quorum is correct *)
+  Assert.equal_int ~loc:__LOC__ expected_quorum
+    (Int32.to_int new_quorum) >>=? fun () ->
+
+  return_unit
+
+(* if not enough quorum -- get_updated_quorum < qr_num/qr_den -- in promotion vote,
+   go back to proposal period *)
+let test_not_enough_quorum_in_promotion_vote num_delegates () =
+  Context.init num_delegates >>=? fun (b,delegates) ->
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  let proposer = List.nth delegates 0 in
+  Op.proposals (B b) proposer (Protocol_hash.zero::[]) >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+
+  (* skip to vote_testing period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we moved to a testing_vote period with one proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) ->
+
+  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters ->
+
+  let open Alpha_context in
+
+  (* all voters vote, for yays;
+       no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters >>=? fun operations ->
+
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to testing period *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* we move to testing because we have supermajority and enough quorum *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* skip to promotion_vote period *)
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Promotion_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun initial_quorum ->
+  (* beginning of promotion period, denoted by _p4;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) ->
+  get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 >>=? fun voters ->
+
+  (* take the first voter out so there cannot be quorum *)
+  let voters_without_quorum = List.tl voters in
+  get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls ->
+
+  (* all voters_without_quorum vote, for yays;
+     no nays, so supermajority is satisfied *)
+  map_s (fun del ->
+      Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
+    voters_without_quorum >>=? fun operations ->
+  Block.bake ~operations b >>=? fun b ->
+
+  (* skip to end of promotion_vote period *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  get_expected_quorum rolls_p4 voter_rolls
+    initial_quorum >>=? fun expected_quorum ->
+
+  Context.Vote.get_current_quorum (B b) >>=? fun new_quorum ->
+
+  (* assert the formula to calculate quorum is correct *)
+  Assert.equal_int ~loc:__LOC__ expected_quorum
+    (Int32.to_int new_quorum) >>=? fun () ->
+
+  (* we move back to the proposal period because not enough quorum *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
+
+let test_multiple_identical_proposals_count_as_one () =
+  Context.init 1 >>=? fun (b,delegates) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  let proposer = List.hd delegates in
+  Op.proposals (B b) proposer
+    [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops ->
+  Block.bake ~operations:[ops] b >>=? fun b ->
+  (* compute the weight of proposals *)
+  Context.Vote.get_proposals (B b) >>=? fun ps ->
+
+  (* compute the rolls of proposer *)
+  Context.Contract.pkh proposer >>=? fun pkh ->
+  Context.Vote.get_listings (B b) >>=? fun l ->
+  begin match List.find_opt (fun (del,_) -> del = pkh) l with
+    | None -> failwith "%s - Missing delegate" __LOC__
+    | Some (_, proposer_rolls) -> return proposer_rolls
+  end >>=? fun proposer_rolls ->
+
+  (* correctly count the double proposal for zero as one proposal *)
+  let expected_weight_proposer = proposer_rolls in
+  match Alpha_environment.Protocol_hash.(Map.find_opt zero ps) with
+  | Some v -> if v = expected_weight_proposer then return_unit
+      else failwith
+          "%s - Wrong count %ld is not %ld; identical proposals count as one"
+          __LOC__ v expected_weight_proposer
+  | None -> failwith "%s - Missing proposal" __LOC__
+
+
+(* assumes the initial balance of allocated by Context.init is at
+   least 4 time the value of the tokens_per_roll constant *)
+let test_supermajority_in_proposal there_is_a_winner () =
+  Context.init ~initial_balances:[1L; 1L; 1L] 10 >>=? fun (b,delegates) ->
+  Context.get_constants (B b)
+  >>=? fun { parametric = {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll} } ->
+
+  let del1 = List.nth delegates 0 in
+  let del2 = List.nth delegates 1 in
+  let del3 = List.nth delegates 2 in
+
+  map_s (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs ->
+  let policy = Block.Excluding pkhs in
+
+  Op.transaction (B b) (List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 ->
+  Op.transaction (B b) (List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 ->
+  begin
+    if there_is_a_winner
+    then Test_tez.Tez.( *? ) tokens_per_roll 3L
+    else Test_tez.Tez.( *? ) tokens_per_roll 2L
+  end >>?= fun bal3 ->
+  Op.transaction (B b) (List.nth delegates 5) del3 bal3 >>=? fun op3 ->
+
+  Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b ->
+
+  (* to avoid the bug where the listings are not initialized, we let
+     one voting period pass; we make sure that the three selected
+     delegates remain active and their number of rolls do not change *)
+  let amount = let open Test_tez in Tez.of_int 10 in
+  fold_left_s (fun b _ ->
+      Op.transaction (B b) del1 del2 amount >>=? fun op1 ->
+      Op.transaction (B b) del2 del3 amount >>=? fun op2 ->
+      Op.transaction (B b) del3 del1 amount >>=? fun op3 ->
+      Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b ->
+      Block.bake_until_cycle_end ~policy b
+    ) b (1 --
+         (Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))) >>=? fun b ->
+
+  (* make the proposals *)
+  Op.proposals (B b) del1 [protos.(0)] >>=? fun ops1 ->
+  Op.proposals (B b) del2 [protos.(0)] >>=? fun ops2 ->
+  Op.proposals (B b) del3 [protos.(1)] >>=? fun ops3 ->
+  Block.bake ~policy ~operations:[ops1;ops2;ops3] b >>=? fun b ->
+  Block.bake_n ~policy ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* we remain in the proposal period when there is no winner,
+     otherwise we move to the testing vote period *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote ->
+        if there_is_a_winner then return_unit
+        else failwith "%s - Expected period kind Proposal, obtained Testing_vote" __LOC__
+    | Proposal ->
+        if not there_is_a_winner then return_unit
+        else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
+
+
+let test_supermajority_in_testing_vote supermajority () =
+  Context.init 100 >>=? fun (b,delegates) ->
+
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  let del1 = List.nth delegates 0 in
+  let proposal = protos.(0) in
+
+  Op.proposals (B b) del1 [proposal] >>=? fun ops1 ->
+  Block.bake ~operations:[ops1] b >>=? fun b ->
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  (* move to testing_vote *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing_vote -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  (* assert our proposal won *)
+  Context.Vote.get_current_proposal (B b) >>=? begin function
+    | Some v -> if Protocol_hash.(equal proposal v) then return_unit
+        else failwith "%s - Wrong proposal" __LOC__
+    | None -> failwith "%s - Missing proposal" __LOC__
+  end >>=? fun () ->
+
+  (* beginning of testing_vote period, denoted by _p2;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, _olls_p2) ->
+
+  (* supermajority means [num_yays / (num_yays + num_nays) >= s_num / s_den],
+     which is equivalent with [num_yays >= num_nays * s_num / (s_den - s_num)] *)
+  let num_delegates = List.length delegates_p2 in
+  let num_nays = num_delegates / 5 in (* any smaller number will do as well *)
+  let num_yays = num_nays * s_num / (s_den - s_num) in
+  (* majority/minority vote depending on the [supermajority] parameter *)
+  let num_yays = if supermajority then num_yays else num_yays - 1 in
+
+  let open Alpha_context in
+
+  let nays_delegates, rest = List.split_n num_nays delegates_p2 in
+  let yays_delegates, _ = List.split_n num_yays rest in
+  map_s (fun del ->
+      Op.ballot (B b) del proposal Vote.Yay)
+    yays_delegates >>=? fun operations_yays ->
+  map_s (fun del ->
+      Op.ballot (B b) del proposal Vote.Nay)
+    nays_delegates >>=? fun operations_nays ->
+  let operations = operations_yays @ operations_nays in
+
+  Block.bake ~operations b >>=? fun b ->
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b ->
+
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Testing ->
+        if supermajority then return_unit
+        else failwith "%s - Expected period kind Proposal, obtained Testing" __LOC__
+    | Proposal ->
+        if not supermajority then return_unit
+        else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
+
+(* test also how the selection scales: all delegates propose max proposals *)
+let test_no_winning_proposal num_delegates () =
+  Context.init num_delegates >>=? fun (b,_) ->
+
+  (* Because of a minor bug in the initialization of the voting state, the
+     listings are not populated in the very first period. After that they get
+     correctly populated. An empty listing means no proposals will be accepted. *)
+  Context.get_constants (B b) >>=? fun { parametric = {blocks_per_voting_period} } ->
+  Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b ->
+
+  (* beginning of proposal, denoted by _p1;
+     take a snapshot of the active delegates and their rolls from listings *)
+  get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, _rolls_p1) ->
+
+  let open Alpha_context in
+  let props = List.map (fun i -> protos.(i))
+      (1 -- Constants.max_proposals_per_delegate) in
+  (* all delegates active in p1 propose the same proposals *)
+  map_s
+    (fun del -> Op.proposals (B b) del props)
+    delegates_p1 >>=? fun ops_list ->
+  Block.bake ~operations:ops_list b >>=? fun b ->
+
+  (* skip to testing_vote period
+     -1 because we already baked one block with the proposal *)
+  Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b ->
+
+  (* we stay in the same proposal period because no winning proposal *)
+  Context.Vote.get_current_period_kind (B b) >>=? begin function
+    | Proposal -> return_unit
+    | _ -> failwith "%s - Unexpected period kind" __LOC__
+  end >>=? fun () ->
+
+  return_unit
+
+let tests = [
+  Test.tztest "voting successful_vote" `Quick (test_successful_vote 137) ;
+  Test.tztest "voting testing vote, not enough quorum" `Quick (test_not_enough_quorum_in_testing_vote 245) ;
+  Test.tztest "voting promotion vote, not enough quorum" `Quick (test_not_enough_quorum_in_promotion_vote 432) ;
+  Test.tztest "voting counting double proposal" `Quick test_multiple_identical_proposals_count_as_one;
+  Test.tztest "voting proposal, with supermajority" `Quick (test_supermajority_in_proposal true) ;
+  Test.tztest "voting proposal, without supermajority" `Quick (test_supermajority_in_proposal false) ;
+  Test.tztest "voting testing vote, with supermajority" `Quick (test_supermajority_in_testing_vote true) ;
+  Test.tztest "voting testing vote, without supermajority" `Quick (test_supermajority_in_testing_vote false) ;
+  Test.tztest "voting proposal, no winning proposal" `Quick (test_no_winning_proposal 400) ;
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.ml
new file mode 100644
index 000000000..aa8da3282
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.ml
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Qty_repr.Make (struct let id = "tez" end)
+
+type t = qty
+type tez = qty
+
+let encoding =
+  Data_encoding.def "mutez" @@
+  encoding
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.mli
new file mode 100644
index 000000000..80eb6dbed
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tez_repr.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+type tez = t
+
+include (Qty_repr.S with type qty := t)
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-embedded-protocol-alpha.opam b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-embedded-protocol-alpha.opam
new file mode 100644
index 000000000..b2304f250
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-embedded-protocol-alpha.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-compiler"
+  "tezos-protocol-updater"
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "alpha" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam
new file mode 100644
index 000000000..c40ec5934
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam
@@ -0,0 +1,27 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-protocol-compiler"
+  "alcotest-lwt" { with-test }
+  "tezos-stdlib-unix" { with-test }
+  "tezos-protocol-environment" { with-test }
+  "tezos-shell-services" { with-test }
+  "bip39" { with-test }
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "alpha" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.ml
new file mode 100644
index 000000000..cf81a0019
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.ml
@@ -0,0 +1,54 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include Time
+type time = t
+
+type error += Timestamp_add (* `Permanent *)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"timestamp_add"
+    ~title:"Timestamp add"
+    ~description:"Overflow when adding timestamps."
+    ~pp:(fun ppf () ->
+        Format.fprintf ppf "Overflow when adding timestamps.")
+    Data_encoding.empty
+    (function Timestamp_add -> Some () | _ -> None)
+    (fun () -> Timestamp_add)
+
+let of_seconds s =
+  try Some (of_seconds (Int64.of_string s))
+  with _ -> None
+let to_seconds = to_seconds
+let to_seconds_string s = Int64.to_string (to_seconds s)
+
+let pp = pp_hum
+
+let (+?) x y =
+  (* TODO check overflow *)
+  try ok (add x (Period_repr.to_seconds y))
+  with _exn -> Error [ Timestamp_add ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.mli
new file mode 100644
index 000000000..4269fe68c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/time_repr.mli
@@ -0,0 +1,34 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+include module type of (struct include Time end)
+type time = t
+
+val pp: Format.formatter -> t -> unit
+val of_seconds: string -> time option
+val to_seconds_string: time -> string
+
+val (+?) : time -> Period_repr.t -> time tzresult
+
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.ml
new file mode 100644
index 000000000..cb1eecf70
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.ml
@@ -0,0 +1,53 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(* a protocol change proposal *)
+type proposal = Protocol_hash.t
+
+(* votes can be for, against or neutral.
+   Neutral serves to count towards a quorum *)
+type ballot = Yay | Nay | Pass
+
+let ballot_encoding =
+  let of_int8 = function
+    | 0 -> Yay
+    | 1 -> Nay
+    | 2 -> Pass
+    | _ -> invalid_arg "ballot_of_int8"
+  in
+  let to_int8 = function
+    | Yay -> 0
+    | Nay -> 1
+    | Pass -> 2
+  in
+  let open Data_encoding in
+  (* union *)
+  splitted
+    ~binary: (conv to_int8 of_int8 int8)
+    ~json: (string_enum [
+        "yay", Yay ;
+        "nay", Nay ;
+        "pass", Pass ;
+      ])
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.mli
new file mode 100644
index 000000000..0e36ea4f6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_repr.mli
@@ -0,0 +1,29 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type proposal = Protocol_hash.t
+
+type ballot = Yay | Nay | Pass
+val ballot_encoding: ballot Data_encoding.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.ml
new file mode 100644
index 000000000..e2ec27815
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.ml
@@ -0,0 +1,137 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 recorded_proposal_count_for_delegate ctxt proposer =
+  Storage.Vote.Proposals_count.get_option ctxt proposer >>=? function
+  | None -> return 0
+  | Some count -> return count
+
+let record_proposal ctxt proposal proposer =
+  recorded_proposal_count_for_delegate ctxt proposer >>=? fun count ->
+  Storage.Vote.Proposals_count.init_set ctxt proposer (count + 1) >>= fun ctxt ->
+  Storage.Vote.Proposals.add ctxt (proposal, proposer) >>= fun ctxt ->
+  return ctxt
+
+let get_proposals ctxt =
+  Storage.Vote.Proposals.fold ctxt
+    ~init:(ok Protocol_hash.Map.empty)
+    ~f:(fun (proposal, delegate) acc ->
+        (* Assuming the same listings is used at votings *)
+        Storage.Vote.Listings.get ctxt delegate >>=? fun weight ->
+        Lwt.return begin acc >>? fun acc ->
+          let previous =
+            match Protocol_hash.Map.find_opt proposal acc with
+            | None -> 0l
+            | Some x -> x
+          in
+          ok (Protocol_hash.Map.add proposal (Int32.add weight previous) acc)
+        end)
+
+let clear_proposals ctxt =
+  Storage.Vote.Proposals_count.clear ctxt >>= fun ctxt ->
+  Storage.Vote.Proposals.clear ctxt
+
+type ballots = {
+  yay: int32 ;
+  nay: int32 ;
+  pass: int32 ;
+}
+
+let ballots_encoding =
+  let open Data_encoding in
+  conv
+    (fun { yay ; nay ; pass } -> ( yay , nay , pass ))
+    (fun ( yay , nay , pass ) -> { yay ; nay ; pass })
+  @@ obj3
+    (req "yay"  int32)
+    (req "nay"  int32)
+    (req "pass" int32)
+
+let has_recorded_ballot = Storage.Vote.Ballots.mem
+let record_ballot = Storage.Vote.Ballots.init
+
+let get_ballots ctxt =
+  Storage.Vote.Ballots.fold ctxt
+    ~f:(fun delegate ballot (ballots: ballots tzresult) ->
+        (* Assuming the same listings is used at votings *)
+        Storage.Vote.Listings.get ctxt delegate >>=? fun weight ->
+        let count = Int32.add weight in
+        Lwt.return begin
+          ballots >>? fun ballots ->
+          match ballot with
+          | Yay  -> ok { ballots with yay = count ballots.yay }
+          | Nay  -> ok { ballots with nay = count ballots.nay }
+          | Pass  -> ok { ballots with pass = count ballots.pass }
+        end)
+    ~init:(ok { yay = 0l ; nay = 0l; pass = 0l })
+
+let get_ballot_list = Storage.Vote.Ballots.bindings
+
+let clear_ballots = Storage.Vote.Ballots.clear
+
+let listings_encoding =
+  Data_encoding.(list (obj2
+                         (req "pkh" Signature.Public_key_hash.encoding)
+                         (req "rolls" int32)))
+
+let freeze_listings ctxt =
+  Roll_storage.fold ctxt (ctxt, 0l)
+    ~f:(fun _roll delegate (ctxt, total) ->
+        (* TODO use snapshots *)
+        let delegate = Signature.Public_key.hash delegate in
+        begin
+          Storage.Vote.Listings.get_option ctxt delegate >>=? function
+          | None -> return 0l
+          | Some count -> return count
+        end >>=? fun count ->
+        Storage.Vote.Listings.init_set
+          ctxt delegate (Int32.succ count) >>= fun ctxt ->
+        return (ctxt, Int32.succ total)) >>=? fun (ctxt, total) ->
+  Storage.Vote.Listings_size.init ctxt total >>=? fun ctxt ->
+  return ctxt
+
+let listing_size = Storage.Vote.Listings_size.get
+let in_listings = Storage.Vote.Listings.mem
+let get_listings = Storage.Vote.Listings.bindings
+
+let clear_listings ctxt =
+  Storage.Vote.Listings.clear ctxt >>= fun ctxt ->
+  Storage.Vote.Listings_size.remove ctxt >>= fun ctxt ->
+  return ctxt
+
+let get_current_period_kind = Storage.Vote.Current_period_kind.get
+let set_current_period_kind = Storage.Vote.Current_period_kind.set
+
+let get_current_quorum = Storage.Vote.Current_quorum.get
+let set_current_quorum = Storage.Vote.Current_quorum.set
+
+let get_current_proposal = Storage.Vote.Current_proposal.get
+let init_current_proposal = Storage.Vote.Current_proposal.init
+let clear_current_proposal = Storage.Vote.Current_proposal.delete
+
+let init ctxt =
+  Storage.Vote.Current_quorum.init ctxt 80_00l >>=? fun ctxt ->
+  Storage.Vote.Current_period_kind.init ctxt Proposal >>=? fun ctxt ->
+  return ctxt
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.mli
new file mode 100644
index 000000000..86994bfdb
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/vote_storage.mli
@@ -0,0 +1,81 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Records a proposal per delegate *)
+val record_proposal:
+  Raw_context.t -> Protocol_hash.t -> Signature.Public_key_hash.t ->
+  Raw_context.t tzresult Lwt.t
+
+val recorded_proposal_count_for_delegate:
+  Raw_context.t -> Signature.Public_key_hash.t ->
+  int tzresult Lwt.t
+
+val get_proposals:
+  Raw_context.t -> int32 Protocol_hash.Map.t tzresult Lwt.t
+
+val clear_proposals: Raw_context.t -> Raw_context.t Lwt.t
+
+type ballots = {
+  yay: int32 ;
+  nay: int32 ;
+  pass: int32 ;
+}
+
+val ballots_encoding : ballots Data_encoding.t
+
+val has_recorded_ballot : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t
+val record_ballot:
+  Raw_context.t -> Signature.Public_key_hash.t -> Vote_repr.ballot ->
+  Raw_context.t tzresult Lwt.t
+val get_ballots: Raw_context.t -> ballots tzresult Lwt.t
+val get_ballot_list :
+  Raw_context.t -> (Signature.Public_key_hash.t * Vote_repr.ballot) list Lwt.t
+val clear_ballots: Raw_context.t -> Raw_context.t Lwt.t
+
+val listings_encoding : (Signature.Public_key_hash.t * int32) list Data_encoding.t
+
+val freeze_listings: Raw_context.t -> Raw_context.t tzresult Lwt.t
+val clear_listings: Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val listing_size: Raw_context.t -> int32 tzresult Lwt.t
+val in_listings:
+  Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t
+val get_listings : Raw_context.t -> (Signature.Public_key_hash.t * int32) list Lwt.t
+
+val get_current_quorum: Raw_context.t -> int32 tzresult Lwt.t
+val set_current_quorum: Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t
+
+val get_current_period_kind:
+  Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t
+val set_current_period_kind:
+  Raw_context.t -> Voting_period_repr.kind -> Raw_context.t tzresult Lwt.t
+
+val get_current_proposal:
+  Raw_context.t -> Protocol_hash.t tzresult Lwt.t
+val init_current_proposal:
+  Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t
+val clear_current_proposal: Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+val init: Raw_context.t -> Raw_context.t tzresult Lwt.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.ml
new file mode 100644
index 000000000..8124e10a0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.ml
@@ -0,0 +1,82 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = int32
+type voting_period = t
+include (Compare.Int32 : Compare.S with type t := t)
+let encoding = Data_encoding.int32
+let pp ppf level = Format.fprintf ppf "%ld" level
+let rpc_arg =
+  let construct voting_period = Int32.to_string voting_period in
+  let destruct str =
+    match Int32.of_string str with
+    | exception _ -> Error "Cannot parse voting period"
+    | voting_period -> Ok voting_period in
+  RPC_arg.make
+    ~descr:"A voting period"
+    ~name: "voting_period"
+    ~construct
+    ~destruct
+    ()
+
+let root = 0l
+let succ = Int32.succ
+
+let to_int32 l = l
+let of_int32_exn l =
+  if Compare.Int32.(l >= 0l)
+  then l
+  else invalid_arg "Voting_period_repr.of_int32"
+
+type kind =
+  | Proposal
+  | Testing_vote
+  | Testing
+  | Promotion_vote
+
+let kind_encoding =
+  let open Data_encoding in
+  union ~tag_size:`Uint8 [
+    case (Tag 0)
+      ~title:"Proposal"
+      (constant "proposal")
+      (function Proposal -> Some () | _ -> None)
+      (fun () -> Proposal) ;
+    case (Tag 1)
+      ~title:"Testing_vote"
+      (constant "testing_vote")
+      (function Testing_vote -> Some () | _ -> None)
+      (fun () -> Testing_vote) ;
+    case (Tag 2)
+      ~title:"Testing"
+      (constant "testing")
+      (function Testing -> Some () | _ -> None)
+      (fun () -> Testing) ;
+    case (Tag 3)
+      ~title:"Promotion_vote"
+      (constant "promotion_vote")
+      (function Promotion_vote -> Some () | _ -> None)
+      (fun () -> Promotion_vote) ;
+  ]
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.mli
new file mode 100644
index 000000000..0d5f0b7dd
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_period_repr.mli
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t
+type voting_period = t
+val encoding: voting_period Data_encoding.t
+val rpc_arg: voting_period RPC_arg.arg
+val pp: Format.formatter -> voting_period -> unit
+include Compare.S with type t := voting_period
+
+val to_int32: voting_period -> int32
+val of_int32_exn: int32 -> voting_period
+
+val root: voting_period
+val succ: voting_period -> voting_period
+
+type kind =
+  | Proposal
+  | Testing_vote
+  | Testing
+  | Promotion_vote
+
+val kind_encoding: kind Data_encoding.t
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.ml b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.ml
new file mode 100644
index 000000000..f4588caac
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.ml
@@ -0,0 +1,138 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+module S = struct
+
+  let path = RPC_path.(open_root / "votes")
+
+  let ballots =
+    RPC_service.get_service
+      ~description:"Sum of ballots casted so far during a voting period."
+      ~query: RPC_query.empty
+      ~output: Vote.ballots_encoding
+      RPC_path.(path / "ballots")
+
+  let ballot_list =
+    RPC_service.get_service
+      ~description:"Ballots casted so far during a voting period."
+      ~query: RPC_query.empty
+      ~output: Data_encoding.(list (obj2
+                                      (req "pkh" Signature.Public_key_hash.encoding)
+                                      (req "ballot" Vote.ballot_encoding)))
+      RPC_path.(path / "ballot_list")
+
+  let current_period_kind =
+    RPC_service.get_service
+      ~description:"Current period kind."
+      ~query: RPC_query.empty
+      ~output: Voting_period.kind_encoding
+      RPC_path.(path / "current_period_kind")
+
+  let current_quorum =
+    RPC_service.get_service
+      ~description:"Current expected quorum."
+      ~query: RPC_query.empty
+      ~output: Data_encoding.int32
+      RPC_path.(path / "current_quorum")
+
+  let listings =
+    RPC_service.get_service
+      ~description:"List of delegates with their voting weight, in number of rolls."
+      ~query: RPC_query.empty
+      ~output: Vote.listings_encoding
+      RPC_path.(path / "listings")
+
+  let proposals =
+    RPC_service.get_service
+      ~description:"List of proposals with number of supporters."
+      ~query: RPC_query.empty
+      ~output: (Protocol_hash.Map.encoding Data_encoding.int32)
+      RPC_path.(path / "proposals")
+
+  let current_proposal =
+    RPC_service.get_service
+      ~description:"Current proposal under evaluation."
+      ~query: RPC_query.empty
+      ~output: (Data_encoding.option Protocol_hash.encoding)
+      RPC_path.(path / "current_proposal")
+end
+
+let register () =
+  let open Services_registration in
+
+  register0 S.ballots begin fun ctxt () () ->
+    Vote.get_ballots ctxt
+  end;
+
+  register0 S.ballot_list begin fun ctxt () () ->
+    Vote.get_ballot_list ctxt >|= ok
+  end;
+
+  register0 S.current_period_kind begin fun ctxt () () ->
+    Vote.get_current_period_kind ctxt
+  end;
+
+  register0 S.current_quorum begin fun ctxt () () ->
+    Vote.get_current_quorum ctxt
+  end;
+
+  register0 S.proposals begin fun ctxt () () ->
+    Vote.get_proposals ctxt
+  end;
+
+  register0 S.listings begin fun ctxt () () ->
+    Vote.get_listings ctxt >|= ok
+  end;
+
+  register0 S.current_proposal begin fun ctxt () () ->
+    (* this would be better implemented using get_option in get_current_proposal *)
+    Vote.get_current_proposal ctxt >>= function
+    | Ok p -> return (Some p)
+    | Error [Raw_context.Storage_error (Missing_key _)] -> return None
+    | (Error _ as e) -> Lwt.return e
+  end
+
+let ballots ctxt block =
+  RPC_context.make_call0 S.ballots ctxt block () ()
+
+let ballot_list ctxt block =
+  RPC_context.make_call0 S.ballot_list ctxt block () ()
+
+let current_period_kind ctxt block =
+  RPC_context.make_call0 S.current_period_kind ctxt block () ()
+
+let current_quorum ctxt block =
+  RPC_context.make_call0 S.current_quorum ctxt block () ()
+
+let listings ctxt block =
+  RPC_context.make_call0 S.listings ctxt block () ()
+
+let proposals ctxt block =
+  RPC_context.make_call0 S.proposals ctxt block () ()
+
+let current_proposal ctxt block =
+  RPC_context.make_call0 S.current_proposal ctxt block () ()
diff --git a/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.mli b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.mli
new file mode 100644
index 000000000..0cb4599d7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_alpha/lib_protocol/voting_services.mli
@@ -0,0 +1,49 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Alpha_context
+
+val ballots :
+  'a #RPC_context.simple -> 'a -> Vote.ballots shell_tzresult Lwt.t
+
+val ballot_list :
+  'a #RPC_context.simple -> 'a -> (Signature.Public_key_hash.t * Vote.ballot) list shell_tzresult Lwt.t
+
+val current_period_kind :
+  'a #RPC_context.simple -> 'a -> Voting_period.kind shell_tzresult Lwt.t
+
+val current_quorum :
+  'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t
+
+val listings :
+  'a #RPC_context.simple -> 'a -> (Signature.Public_key_hash.t * int32) list shell_tzresult Lwt.t
+
+val proposals :
+  'a #RPC_context.simple -> 'a -> Int32.t Protocol_hash.Map.t shell_tzresult Lwt.t
+
+val current_proposal :
+  'a #RPC_context.simple -> 'a -> Protocol_hash.t option shell_tzresult Lwt.t
+
+val register : unit -> unit
diff --git a/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.ml b/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.ml
new file mode 100644
index 000000000..507a185b7
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.ml
@@ -0,0 +1,77 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_demo
+
+let protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9"
+
+let bake (cctxt : full) : unit tzresult Lwt.t =
+  let protocol_data = MBytes.create 0 in
+  Demo_block_services.Helpers.Preapply.block cctxt [] ~protocol_data >>=? fun (shell, _) ->
+  let block : Block_header.t = { shell = shell; protocol_data } in
+  Demo_block_services.Helpers.Forge.block_header cctxt block >>=? fun encoded_header ->
+  Shell_services.Injection.block cctxt encoded_header [] >>=? fun block_hash ->
+  cctxt#message "Injected block %a" Block_hash.pp_short block_hash >>= fun () ->
+  return_unit
+
+let demo (cctxt : full) : unit tzresult Lwt.t =
+  let block = cctxt#block in
+  let chain = `Main in
+  let msg = "test" in
+  cctxt#message "Calling the 'echo' RPC with value %s." msg >>= fun () ->
+  Services.echo cctxt (chain, block) msg >>=? fun reply ->
+  cctxt#message "Received value: %s" reply >>= fun () ->
+  return_unit
+
+let error (cctxt : full) : unit tzresult Lwt.t =
+  let block = cctxt#block in
+  let chain = `Main in
+  Services.failing cctxt (chain, block) 42 >>=? fun () ->
+  return_unit
+
+let commands () : full Clic.command list =
+  let open Clic in
+  let group = {name = "demo" ; title = "Some demo command" } in
+  [
+    command ~group ~desc: "A demo command"
+      no_options
+      (fixed [ "demo" ])
+      (fun () (cctxt : full) -> demo cctxt) ;
+    command ~group ~desc: "A failing command"
+      no_options
+      (fixed [ "fail" ])
+      (fun () (cctxt : full) -> error cctxt) ;
+    command ~group ~desc: "Bake an empty block"
+      no_options
+      (fixed [ "bake" ])
+      (fun () cctxt -> bake cctxt) ;
+  ]
+
+let () =
+  Client_commands.register protocol @@ fun _network ->
+  List.map (Clic.map_command (new wrap_full)) @@
+  commands ()
diff --git a/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.mli b/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.mli
new file mode 100644
index 000000000..87e22816f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_client/client_proto_main.mli
@@ -0,0 +1,25 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
diff --git a/vendors/tezos-modded/src/proto_demo/lib_client/dune b/vendors/tezos-modded/src/proto_demo/lib_client/dune
new file mode 100644
index 000000000..002451be3
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_client/dune
@@ -0,0 +1,21 @@
+(library
+ (name tezos_client_demo)
+ (public_name tezos-client-demo)
+ (libraries tezos-base
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-commands
+            tezos-protocol-environment
+            tezos-protocol-demo)
+ (library_flags (:standard -linkall))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_commands)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_demo/lib_client/proto_demo.ml b/vendors/tezos-modded/src/proto_demo/lib_client/proto_demo.ml
new file mode 100644
index 000000000..fc2552119
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_client/proto_demo.ml
@@ -0,0 +1,47 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Name = struct let name = "demo" end
+module Demo_environment = Tezos_protocol_environment_faked.MakeV1(Name)()
+module Proto = Tezos_protocol_demo.Functor.Make(Demo_environment)
+module Demo_block_services = Block_services.Make(Proto)(Proto)
+include Proto
+
+class type rpc_context = object
+  inherit RPC_context.json
+  inherit [Shell_services.chain * Shell_services.block] Demo_environment.RPC_context.simple
+end
+
+class type full = object
+  inherit Client_context.full
+  inherit [Shell_services.chain * Shell_services.block] Demo_environment.RPC_context.simple
+end
+
+class wrap_full (t : Client_context.full) : full = object
+  inherit Client_context.proxy_context t
+  inherit [Shell_services.chain, Shell_services.block] Demo_environment.proto_rpc_context
+      (t :> RPC_context.t)
+      Shell_services.Blocks.path
+end
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_demo/lib_client/tezos-client-demo.opam b/vendors/tezos-modded/src/proto_demo/lib_client/tezos-client-demo.opam
new file mode 100644
index 000000000..04fb56fbe
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_client/tezos-client-demo.opam
@@ -0,0 +1,24 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-protocol-environment"
+  "tezos-protocol-demo"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/TEZOS_PROTOCOL b/vendors/tezos-modded/src/proto_demo/lib_protocol/TEZOS_PROTOCOL
new file mode 100644
index 000000000..f8b496a9f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/TEZOS_PROTOCOL
@@ -0,0 +1,4 @@
+{
+    "hash": "ProtoDemoDemoDemoDemoDemoDemoDemoDemoDemoDemoD3c8k9",
+    "modules": ["Error", "Services", "Main"]
+}
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/dune b/vendors/tezos-modded/src/proto_demo/lib_protocol/dune
new file mode 120000
index 000000000..235c3740e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/dune
@@ -0,0 +1 @@
+../../lib_protocol_compiler/dune_protocol
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/dune.inc b/vendors/tezos-modded/src/proto_demo/lib_protocol/dune.inc
new file mode 100644
index 000000000..4bc1af4d6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/dune.inc
@@ -0,0 +1,78 @@
+
+
+;
+;        /!\ /!\ Do not modify this file /!\ /!\
+;
+; but the original template in `tezos-protocol-compiler`
+;
+
+
+(rule
+ (targets environment.ml)
+ (action
+  (write-file %{targets}
+              "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"demo\" end)()
+      module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
+")))
+
+(rule
+ (targets registerer.ml)
+ (deps tezos_embedded_protocol_environment_demo.cmxa
+       (:src_dir TEZOS_PROTOCOL))
+ (action
+  (with-stdout-to %{targets}
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "demo")))))
+
+
+(rule
+ (targets functor.ml)
+ (deps error.ml services.mli services.ml main.mli main.ml
+       (:src_dir TEZOS_PROTOCOL))
+ (action (with-stdout-to %{targets}
+                         (chdir %{workspace_root}
+                                (run %{bin:tezos-protocol-compiler.tezos-protocol-packer} %{src_dir})))))
+
+(library
+ (name tezos_protocol_demo)
+ (public_name tezos-protocol-demo)
+ (libraries tezos-protocol-environment-sigs)
+ (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
+        -warn-error "-a+8"
+        -safe-string -nopervasives)
+ (modules Functor))
+
+(library
+ (name tezos_embedded_protocol_environment_demo)
+ (public_name tezos-embedded-protocol-demo.environment)
+ (library_flags (:standard -linkall))
+ (libraries tezos-protocol-environment-shell)
+ (modules Environment))
+
+(library
+ (name tezos_embedded_raw_protocol_demo)
+ (public_name tezos-embedded-protocol-demo.raw)
+ (libraries tezos_embedded_protocol_environment_demo)
+ (library_flags (:standard -linkall))
+ (flags (:standard -nopervasives -nostdlib -safe-string
+                   -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8
+                   -open Tezos_embedded_protocol_environment_demo__Environment
+                   -open Pervasives
+                   -open Error_monad))
+ (modules Error Services Main))
+
+(library
+ (name tezos_embedded_protocol_demo)
+ (public_name tezos-embedded-protocol-demo)
+ (library_flags (:standard -linkall))
+ (libraries tezos_embedded_raw_protocol_demo
+            tezos-protocol-updater
+            tezos-protocol-environment-shell)
+ (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8))
+ (modules Registerer))
+
+(alias
+ (name runtest_sandbox)
+ (deps .tezos_protocol_demo.objs/tezos_protocol_demo.cmx))
+
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/error.ml b/vendors/tezos-modded/src/proto_demo/lib_protocol/error.ml
new file mode 100644
index 000000000..80574ea1d
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/error.ml
@@ -0,0 +1,39 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Demo_error of int
+
+let () =
+  Error_monad.register_error_kind
+    `Temporary
+    ~id:"unique.error.id"
+    ~title:"Short error description"
+    ~description:"Exhaustive error description"
+    ~pp:(fun ppf i -> Format.fprintf ppf "Expected demo error: %d." i)
+    Data_encoding.(obj1 (req "data" int31))
+    (function Demo_error x -> Some x | _ -> None)
+    (fun x -> Demo_error x)
+
+let demo_error x : unit tzresult Lwt.t = fail (Demo_error x)
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/main.ml b/vendors/tezos-modded/src/proto_demo/lib_protocol/main.ml
new file mode 100644
index 000000000..0d0f20c6c
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/main.ml
@@ -0,0 +1,131 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+
+type block_header_data = MBytes.t
+type block_header = {
+  shell : Block_header.shell_header ;
+  protocol_data : block_header_data ;
+}
+
+let block_header_data_encoding =
+  Data_encoding.(obj1 (req "random_data" Variable.bytes))
+
+type block_header_metadata = unit
+let block_header_metadata_encoding = Data_encoding.unit
+
+type operation_data = unit
+let operation_data_encoding = Data_encoding.unit
+
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
+type operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+let max_block_length = 42
+let max_operation_data_length = 0
+let validation_passes = []
+let acceptable_passes _op = []
+
+let compare_operations _ _ = 0
+
+type validation_state = {
+  context : Context.t ;
+  fitness : Fitness.t ;
+}
+
+let current_context { context ; _ } =
+  return context
+
+let begin_application
+    ~chain_id:_
+    ~predecessor_context:context
+    ~predecessor_timestamp:_
+    ~predecessor_fitness:_
+    (raw_block: block_header) =
+  return { context ; fitness = raw_block.shell.fitness }
+
+let begin_partial_application
+    ~chain_id
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header =
+  begin_application
+    ~chain_id
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header
+
+let begin_construction
+    ~chain_id:_
+    ~predecessor_context:context
+    ~predecessor_timestamp:_
+    ~predecessor_level:_
+    ~predecessor_fitness:pred_fitness
+    ~predecessor:_
+    ~timestamp:_
+    ?protocol_data:_ () =
+
+  let increase_fitness = function
+    | [ v ; b ] ->
+        let f = MBytes.get_int64 b 0 in
+        let b' = MBytes.copy b in
+        MBytes.set_int64 b' 0 (Int64.succ f) ;
+        return [ v ;  b' ]
+    | [ ] -> return MBytes.[create 0; create 0]
+    | _ -> assert false
+  in
+  increase_fitness pred_fitness >>=? fun fitness ->
+  return { context ; fitness }
+
+let apply_operation ctxt _ =
+  return (ctxt, ())
+
+let finalize_block ctxt =
+  let fitness = ctxt.fitness in
+  let message = Some (Format.asprintf "fitness <- %a" Fitness.pp fitness) in
+  return ({ Updater.message ; context = ctxt.context ; fitness ;
+            max_operations_ttl = 0 ; last_allowed_fork_level = 0l ;
+          }, ())
+
+let init context block_header =
+  return { Updater.message = None ; context ;
+           fitness = block_header.Block_header.fitness ;
+           max_operations_ttl = 0 ;
+           last_allowed_fork_level = block_header.level ;
+         }
+
+let rpc_services = Services.rpc_services
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/main.mli b/vendors/tezos-modded/src/proto_demo/lib_protocol/main.mli
new file mode 100644
index 000000000..41c6506ec
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/main.mli
@@ -0,0 +1,28 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Protocol Signature Instance *)
+
+include Updater.PROTOCOL with type block_header_data = MBytes.t
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/services.ml b/vendors/tezos-modded/src/proto_demo/lib_protocol/services.ml
new file mode 100644
index 000000000..38abcbcf0
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/services.ml
@@ -0,0 +1,68 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module S = struct
+
+  let path = RPC_path.open_root
+
+  let echo_service =
+    RPC_service.post_service
+      ~description: "A dummy echo service"
+      ~query: RPC_query.empty
+      ~input: Data_encoding.(obj1 (req "msg" string))
+      ~output: Data_encoding.(obj1 (req "msg" string))
+      RPC_path.(path / "echo")
+
+  let failing_service =
+    RPC_service.post_service
+      ~description: "A failing service"
+      ~query: RPC_query.empty
+      ~input: Data_encoding.(obj1 (req "arg" int31))
+      ~output: Data_encoding.empty
+      RPC_path.(path / "failing")
+
+end
+
+let echo ctxt block msg =
+  RPC_context.make_call0 S.echo_service ctxt block () msg
+
+let failing ctxt block n =
+  RPC_context.make_call0 S.failing_service ctxt block () n
+
+let rpc_services : Updater.rpc_context RPC_directory.t =
+  let dir = RPC_directory.empty in
+  let dir =
+    RPC_directory.register
+      dir
+      S.failing_service
+      (fun _ctxt () x -> Error.demo_error x)
+  in
+  let dir =
+    RPC_directory.register
+      dir
+      S.echo_service
+      (fun _ctxt () x -> return x)
+  in
+  dir
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/services.mli b/vendors/tezos-modded/src/proto_demo/lib_protocol/services.mli
new file mode 100644
index 000000000..395a3fd76
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/services.mli
@@ -0,0 +1,32 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 failing:
+  'a #RPC_context.simple -> 'a -> int -> unit shell_tzresult Lwt.t
+
+val echo :
+  'a #RPC_context.simple -> 'a -> string -> string shell_tzresult Lwt.t
+
+val rpc_services : Updater.rpc_context RPC_directory.t
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-embedded-protocol-demo.opam b/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-embedded-protocol-demo.opam
new file mode 100644
index 000000000..1ba87b5a6
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-embedded-protocol-demo.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-protocol-compiler"
+  "tezos-protocol-updater"
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "demo" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-protocol-demo.opam b/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-protocol-demo.opam
new file mode 100644
index 000000000..2041e462f
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_demo/lib_protocol/tezos-protocol-demo.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-protocol-compiler"
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "demo" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.ml b/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.ml
new file mode 100644
index 000000000..9924187ac
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.ml
@@ -0,0 +1,133 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_genesis
+
+let protocol =
+  Protocol_hash.of_b58check_exn
+    "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
+
+let bake cctxt ?(timestamp = Time.now ()) block command sk =
+  let protocol_data = { command ; signature = Signature.zero } in
+  Genesis_block_services.Helpers.Preapply.block
+    cctxt ~block ~timestamp ~protocol_data
+    [] >>=? fun (shell_header, _) ->
+  let blk = Data.Command.forge shell_header command in
+  Shell_services.Chain.chain_id cctxt ~chain:`Main () >>=? fun chain_id ->
+  Client_keys.append cctxt sk ~watermark:(Block_header chain_id) blk >>=? fun signed_blk ->
+  Shell_services.Injection.block cctxt signed_blk []
+
+let int64_parameter =
+  (Clic.parameter (fun _ p ->
+       try return (Int64.of_string p)
+       with _ -> failwith "Cannot read int64"))
+
+let int_parameter =
+  (Clic.parameter (fun _ p ->
+       try return (int_of_string p)
+       with _ -> failwith "Cannot read int"))
+
+let file_parameter =
+  Clic.parameter (fun _ p ->
+      if not (Sys.file_exists p) then
+        failwith "File doesn't exist: '%s'" p
+      else
+        return p)
+
+let fitness_from_int64 fitness =
+  (* definition taken from src/proto_alpha/lib_protocol/src/constants_repr.ml *)
+  let version_number = "\000" in
+  (* definitions taken from src/proto_alpha/lib_protocol/src/fitness_repr.ml *)
+  let int64_to_bytes i =
+    let b = MBytes.create 8 in
+    MBytes.set_int64 b 0 i;
+    b
+  in
+  [ MBytes.of_string version_number ;
+    int64_to_bytes fitness ]
+
+let commands () =
+  let open Clic in
+  let args =
+    args1
+      (arg
+         ~long:"timestamp"
+         ~placeholder:"date"
+         ~doc:"Set the timestamp of the block (and initial time of the chain)"
+         (parameter (fun _ t ->
+              match (Time.of_notation t) with
+              | None -> Error_monad.failwith "Could not parse value provided to -timestamp option"
+              | Some t -> return t))) in
+  [
+
+    command ~desc: "Activate a protocol"
+      args
+      (prefixes [ "activate" ; "protocol" ]
+       @@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
+       @@ prefixes [ "with" ; "fitness" ]
+       @@ param ~name:"fitness"
+         ~desc:"Hardcoded fitness of the first block (integer)"
+         int64_parameter
+       @@ prefixes [ "and" ; "key" ]
+       @@ Client_keys.Secret_key.source_param
+         ~name:"password" ~desc:"Activator's key"
+       @@ prefixes [ "and" ; "parameters" ]
+       @@ param ~name:"parameters"
+         ~desc:"Protocol parameters (as JSON file)"
+         file_parameter
+       @@ stop)
+      begin fun timestamp hash fitness sk param_json_file (cctxt : Client_context.full) ->
+        let fitness = fitness_from_int64 fitness in
+        Tezos_stdlib_unix.Lwt_utils_unix.Json.read_file param_json_file >>=? fun json ->
+        let protocol_parameters = Data_encoding.Binary.to_bytes_exn Data_encoding.json json in
+        bake cctxt ?timestamp cctxt#block
+          (Activate { protocol = hash ; fitness ; protocol_parameters })
+          sk >>=? fun hash ->
+        cctxt#answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
+        return_unit
+      end ;
+
+    command ~desc: "Fork a test protocol"
+      args
+      (prefixes [ "fork" ; "test" ; "protocol" ]
+       @@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
+       @@ prefixes [ "with" ; "key" ]
+       @@ Client_keys.Secret_key.source_param
+         ~name:"password" ~desc:"Activator's key"
+       @@ stop)
+      begin fun timestamp hash sk cctxt ->
+        bake cctxt ?timestamp cctxt#block
+          (Activate_testchain { protocol = hash ;
+                                delay = Int64.mul 24L 3600L })
+          sk >>=? fun hash ->
+        cctxt#answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
+        return_unit
+      end ;
+
+  ]
+
+let () =
+  Client_commands.register protocol @@ fun _network ->
+  commands ()
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.mli b/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.mli
new file mode 100644
index 000000000..f7d66f601
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_client/client_proto_main.mli
@@ -0,0 +1,35 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Proto_genesis
+
+val bake:
+  #Client_context.full ->
+  ?timestamp: Time.t ->
+  Shell_services.block ->
+  Data.Command.t ->
+  Client_keys.sk_uri ->
+  Block_hash.t tzresult Lwt.t
+
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_client/dune b/vendors/tezos-modded/src/proto_genesis/lib_client/dune
new file mode 100644
index 000000000..fd23c5039
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_client/dune
@@ -0,0 +1,21 @@
+(library
+ (name tezos_client_genesis)
+ (public_name tezos-client-genesis)
+ (libraries tezos-base
+            tezos-shell-services
+            tezos-client-base
+            tezos-client-commands
+            tezos-protocol-environment
+            tezos-protocol-genesis)
+ (library_flags (:standard -linkall))
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+                   -open Tezos_shell_services
+                   -open Tezos_client_base
+                   -open Tezos_client_commands)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_client/proto_genesis.ml b/vendors/tezos-modded/src/proto_genesis/lib_client/proto_genesis.ml
new file mode 100644
index 000000000..0da3c2953
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_client/proto_genesis.ml
@@ -0,0 +1,30 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Name = struct let name = "genesis" end
+module Genesis_environment = Tezos_protocol_environment_faked.MakeV1(Name)()
+module Proto = Tezos_protocol_genesis.Functor.Make(Genesis_environment)
+module Genesis_block_services = Block_services.Make(Proto)(Proto)
+include Proto
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_client/tezos-client-genesis.opam b/vendors/tezos-modded/src/proto_genesis/lib_client/tezos-client-genesis.opam
new file mode 100644
index 000000000..25cb6084e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_client/tezos-client-genesis.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-base"
+  "tezos-shell-services"
+  "tezos-client-base"
+  "tezos-client-commands"
+  "tezos-protocol-environment"
+  "tezos-protocol-genesis"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/TEZOS_PROTOCOL b/vendors/tezos-modded/src/proto_genesis/lib_protocol/TEZOS_PROTOCOL
new file mode 100644
index 000000000..c58b2f113
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/TEZOS_PROTOCOL
@@ -0,0 +1,4 @@
+{
+    "hash": "ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im",
+    "modules": ["Data", "Services", "Main"]
+}
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/data.ml b/vendors/tezos-modded/src/proto_genesis/lib_protocol/data.ml
new file mode 100644
index 000000000..e2386da29
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/data.ml
@@ -0,0 +1,158 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Command = struct
+
+  type t =
+    (* Activate a protocol *)
+    | Activate of {
+        protocol: Protocol_hash.t ;
+        fitness: Fitness.t ;
+        protocol_parameters : MBytes.t ;
+      }
+
+    (* Activate a protocol as a testchain *)
+    | Activate_testchain of {
+        protocol: Protocol_hash.t ;
+        delay: Int64.t ;
+      }
+
+  let mk_case name args =
+    let open Data_encoding in
+    conv
+      (fun o -> ((), o))
+      (fun ((), o) -> o)
+      (merge_objs
+         (obj1 (req "command" (constant name)))
+         args)
+
+  let encoding =
+    let open Data_encoding in
+    union ~tag_size:`Uint8 [
+      case (Tag 0)
+        ~title:"Activate"
+        (mk_case "activate"
+           (obj3
+              (req "hash" Protocol_hash.encoding)
+              (req "fitness" Fitness.encoding)
+              (req "protocol_parameters" Variable.bytes)
+           ))
+        (function
+          | Activate { protocol ; fitness ; protocol_parameters} ->
+              Some (protocol, fitness, protocol_parameters)
+          | _ -> None)
+        (fun (protocol, fitness, protocol_parameters) ->
+           Activate { protocol ; fitness ; protocol_parameters }) ;
+      case (Tag 1)
+        ~title:"Activate_testchain"
+        (mk_case "activate_testchain"
+           (obj2
+              (req "hash" Protocol_hash.encoding)
+              (req "validity_time" int64)))
+        (function
+          | Activate_testchain { protocol ; delay } ->
+              Some (protocol, delay)
+          | _ -> None)
+        (fun (protocol, delay) ->
+           Activate_testchain { protocol ; delay }) ;
+    ]
+
+  let signed_encoding =
+    let open Data_encoding in
+    obj2
+      (req "content" encoding)
+      (req "signature" Signature.encoding)
+
+  let forge shell command =
+    Data_encoding.Binary.to_bytes_exn
+      (Data_encoding.tup2 Block_header.shell_header_encoding encoding)
+      (shell, command)
+
+end
+
+module Pubkey = struct
+
+  let pubkey_key = ["genesis_key"]
+
+  let default =
+    Signature.Public_key.of_b58check_exn
+      "edpkvVCdQtDJHPnkmfRZuuHWKzFetH9N9nGP8F7zkwM2BJpjbvAU1N"
+
+  let get_pubkey ctxt =
+    Context.get ctxt pubkey_key >>= function
+    | None -> Lwt.return default
+    | Some b ->
+        match Data_encoding.Binary.of_bytes Signature.Public_key.encoding b with
+        | None -> Lwt.return default
+        | Some pk -> Lwt.return pk
+
+  let set_pubkey ctxt v =
+    Context.set ctxt pubkey_key @@
+    Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding v
+
+  let sandbox_encoding =
+    let open Data_encoding in
+    merge_objs
+      (obj1 (req "genesis_pubkey" Signature.Public_key.encoding))
+      Data_encoding.unit
+
+  let may_change_default ctxt json =
+    match Data_encoding.Json.destruct sandbox_encoding json with
+    | exception _ ->
+        Lwt.return ctxt
+    | (pubkey, ()) ->
+        set_pubkey ctxt pubkey >>= fun ctxt ->
+        Lwt.return ctxt
+
+end
+
+module Init = struct
+
+  type error += Incompatible_protocol_version
+
+  let version_key = ["version"]
+
+  (* This key should always be populated for every version of the
+     protocol.  It's absence meaning that the context is empty. *)
+  let version_value = "genesis"
+
+  let check_inited ctxt =
+    Context.get ctxt version_key >>= function
+    | None -> failwith "Internal error: uninitialized context."
+    | Some version ->
+        if Compare.String.(version_value <> MBytes.to_string version) then
+          failwith "Internal error: incompatible protocol version" ;
+        return_unit
+
+  let tag_first_block ctxt =
+    Context.get ctxt version_key >>= function
+    | None ->
+        Context.set
+          ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
+        return ctxt
+    | Some _version ->
+        failwith "Internal error: previously initialized context." ;
+
+end
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune b/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune
new file mode 120000
index 000000000..235c3740e
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune
@@ -0,0 +1 @@
+../../lib_protocol_compiler/dune_protocol
\ No newline at end of file
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune.inc b/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune.inc
new file mode 100644
index 000000000..3b1045f41
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/dune.inc
@@ -0,0 +1,78 @@
+
+
+;
+;        /!\ /!\ Do not modify this file /!\ /!\
+;
+; but the original template in `tezos-protocol-compiler`
+;
+
+
+(rule
+ (targets environment.ml)
+ (action
+  (write-file %{targets}
+              "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"genesis\" end)()
+      module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
+")))
+
+(rule
+ (targets registerer.ml)
+ (deps tezos_embedded_protocol_environment_genesis.cmxa
+       (:src_dir TEZOS_PROTOCOL))
+ (action
+  (with-stdout-to %{targets}
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "genesis")))))
+
+
+(rule
+ (targets functor.ml)
+ (deps data.ml services.ml main.mli main.ml
+       (:src_dir TEZOS_PROTOCOL))
+ (action (with-stdout-to %{targets}
+                         (chdir %{workspace_root}
+                                (run %{bin:tezos-protocol-compiler.tezos-protocol-packer} %{src_dir})))))
+
+(library
+ (name tezos_protocol_genesis)
+ (public_name tezos-protocol-genesis)
+ (libraries tezos-protocol-environment-sigs)
+ (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
+        -warn-error "-a+8"
+        -safe-string -nopervasives)
+ (modules Functor))
+
+(library
+ (name tezos_embedded_protocol_environment_genesis)
+ (public_name tezos-embedded-protocol-genesis.environment)
+ (library_flags (:standard -linkall))
+ (libraries tezos-protocol-environment-shell)
+ (modules Environment))
+
+(library
+ (name tezos_embedded_raw_protocol_genesis)
+ (public_name tezos-embedded-protocol-genesis.raw)
+ (libraries tezos_embedded_protocol_environment_genesis)
+ (library_flags (:standard -linkall))
+ (flags (:standard -nopervasives -nostdlib -safe-string
+                   -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8
+                   -open Tezos_embedded_protocol_environment_genesis__Environment
+                   -open Pervasives
+                   -open Error_monad))
+ (modules Data Services Main))
+
+(library
+ (name tezos_embedded_protocol_genesis)
+ (public_name tezos-embedded-protocol-genesis)
+ (library_flags (:standard -linkall))
+ (libraries tezos_embedded_raw_protocol_genesis
+            tezos-protocol-updater
+            tezos-protocol-environment-shell)
+ (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
+                   -warn-error -a+8))
+ (modules Registerer))
+
+(alias
+ (name runtest_sandbox)
+ (deps .tezos_protocol_genesis.objs/tezos_protocol_genesis.cmx))
+
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.ml b/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.ml
new file mode 100644
index 000000000..a49e8d68b
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.ml
@@ -0,0 +1,212 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type error += Parsing_error
+type error += Invalid_signature
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"parsing_error"
+    ~title:"Parsing error"
+    ~description:"Raised when a block header has not been parsed correctly"
+    ~pp:(fun ppf () -> Format.fprintf ppf "Block header parsing error")
+    Data_encoding.empty
+    (function Parsing_error -> Some () | _ -> None)
+    (fun () -> Parsing_error)
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"invalid_signature"
+    ~title:"Invalid signature"
+    ~description:"Raised when the provided signature is invalid"
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid signature")
+    Data_encoding.empty
+    (function Invalid_signature -> Some () | _ -> None)
+    (fun () -> Invalid_signature)
+
+type operation_data = unit
+let operation_data_encoding = Data_encoding.unit
+
+type operation_receipt = unit
+let operation_receipt_encoding = Data_encoding.unit
+
+let operation_data_and_receipt_encoding =
+  Data_encoding.conv
+    (function ((), ()) -> ())
+    (fun () -> ((), ()))
+    Data_encoding.unit
+
+type operation = {
+  shell: Operation.shell_header ;
+  protocol_data: operation_data ;
+}
+
+let acceptable_passes _op = []
+let compare_operations _ _ = 0
+let validation_passes = []
+
+type block_header_data = {
+  command: Data.Command.t ;
+  signature: Signature.t ;
+}
+type block_header = {
+  shell: Block_header.shell_header ;
+  protocol_data: block_header_data ;
+}
+
+let block_header_data_encoding =
+  Data_encoding.conv
+    (fun { command ; signature } -> (command, signature))
+    (fun (command, signature) ->  { command ; signature })
+    Data.Command.signed_encoding
+
+type block_header_metadata = unit
+let block_header_metadata_encoding = Data_encoding.unit
+
+let max_block_length =
+  Data_encoding.Binary.length
+    Data.Command.encoding
+    (Activate_testchain { protocol = Protocol_hash.zero ;
+                          delay = 0L })
+  + Signature.size
+
+let max_operation_data_length = 0
+
+let check_signature ctxt ~chain_id { shell ; protocol_data = { command ; signature } } =
+  let bytes = Data.Command.forge shell command in
+  Data.Pubkey.get_pubkey ctxt >>= fun public_key ->
+  fail_unless
+    (Signature.check ~watermark:(Block_header chain_id) public_key signature bytes)
+    Invalid_signature
+
+type validation_state = Updater.validation_result
+
+let current_context ({ context ; _ } : validation_state) =
+  return context
+
+(* temporary hardcoded key to be removed... *)
+let protocol_parameters_key = [ "protocol_parameters" ]
+
+let prepare_application ctxt command level timestamp fitness =
+  match command with
+  | Data.Command.Activate { protocol = hash ; fitness ; protocol_parameters } ->
+      let message =
+        Some (Format.asprintf "activate %a" Protocol_hash.pp_short hash) in
+      Context.set ctxt protocol_parameters_key protocol_parameters >>= fun ctxt ->
+      Updater.activate ctxt hash >>= fun ctxt ->
+      return { Updater.message ; context = ctxt ;
+               fitness ; max_operations_ttl = 0 ;
+               last_allowed_fork_level = level ;
+             }
+  | Activate_testchain { protocol = hash ; delay } ->
+      let message =
+        Some (Format.asprintf "activate testchain %a" Protocol_hash.pp_short hash) in
+      let expiration = Time.add timestamp delay in
+      Updater.fork_test_chain ctxt ~protocol:hash ~expiration >>= fun ctxt ->
+      return { Updater.message ; context = ctxt ; fitness ;
+               max_operations_ttl = 0 ;
+               last_allowed_fork_level = Int32.succ level ;
+             }
+
+let begin_application
+    ~chain_id
+    ~predecessor_context:ctxt
+    ~predecessor_timestamp:_
+    ~predecessor_fitness:_
+    block_header =
+  Data.Init.check_inited ctxt >>=? fun () ->
+  check_signature ctxt ~chain_id block_header >>=? fun () ->
+  prepare_application ctxt block_header.protocol_data.command
+    block_header.shell.level block_header.shell.timestamp block_header.shell.fitness
+
+let begin_partial_application
+    ~chain_id
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header =
+  begin_application
+    ~chain_id
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header
+
+let begin_construction
+    ~chain_id:_
+    ~predecessor_context:ctxt
+    ~predecessor_timestamp:_
+    ~predecessor_level:level
+    ~predecessor_fitness:fitness
+    ~predecessor:_
+    ~timestamp
+    ?protocol_data
+    () =
+  match protocol_data with
+  | None ->
+      (* Dummy result. *)
+      return { Updater.message = None ; context = ctxt ;
+               fitness ; max_operations_ttl = 0 ;
+               last_allowed_fork_level = 0l ;
+             }
+  | Some { command ; _ }->
+      Data.Init.check_inited ctxt >>=? fun () ->
+      prepare_application ctxt command level timestamp fitness
+
+let apply_operation _vctxt _ =
+  Lwt.return (Error []) (* absurd *)
+
+let finalize_block state = return (state, ())
+
+let rpc_services = Services.rpc_services
+
+(* temporary hardcoded key to be removed... *)
+let sandbox_param_key = [ "sandbox_parameter" ]
+let get_sandbox_param ctxt =
+  Context.get ctxt sandbox_param_key >>= function
+  | None -> return_none
+  | Some bytes ->
+      match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
+      | None ->
+          failwith "Internal error: failed to parse the sandbox parameter."
+      | Some json -> return_some json
+
+let init ctxt block_header =
+  Data.Init.tag_first_block ctxt >>=? fun ctxt ->
+  get_sandbox_param ctxt >>=? fun sandbox_param ->
+  begin
+    match sandbox_param with
+    | None -> return ctxt
+    | Some json ->
+        Data.Pubkey.may_change_default ctxt json >>= fun ctxt ->
+        return ctxt
+  end >>=? fun ctxt ->
+  return { Updater.message = None ; context = ctxt ;
+           fitness = block_header.Block_header.fitness ;
+           max_operations_ttl = 0 ;
+           last_allowed_fork_level = block_header.level ;
+         }
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.mli b/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.mli
new file mode 100644
index 000000000..46075970a
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/main.mli
@@ -0,0 +1,33 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+(** Tezos Protocol Implementation - Protocol Signature Instance *)
+
+type block_header_data = {
+  command: Data.Command.t ;
+  signature: Signature.t ;
+}
+
+include Updater.PROTOCOL with type block_header_data := block_header_data
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/services.ml b/vendors/tezos-modded/src/proto_genesis/lib_protocol/services.ml
new file mode 100644
index 000000000..7ee2a9998
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/services.ml
@@ -0,0 +1,67 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+module Forge = struct
+  let block custom_root =
+    let open Data_encoding in
+    RPC_service.post_service
+      ~description: "Forge a block"
+      ~query: RPC_query.empty
+      ~input:
+        (merge_objs
+           (obj6
+              (req "level" int32)
+              (req "proto_level" uint8)
+              (req "predecessor" Block_hash.encoding)
+              (req "timestamp" Time.encoding)
+              (req "fitness" Fitness.encoding)
+              (req "context" Context_hash.encoding))
+           Data.Command.encoding)
+      ~output: (obj1 (req "payload" bytes))
+      RPC_path.(custom_root / "helpers" / "forge" / "block")
+end
+
+let int64_to_bytes i =
+  let b = MBytes.create 8 in
+  MBytes.set_int64 b 0 i;
+  b
+
+let operations_hash =
+  Operation_list_list_hash.compute []
+
+let rpc_services : Updater.rpc_context RPC_directory.t =
+  let dir = RPC_directory.empty in
+  let dir =
+    RPC_directory.register
+      dir
+      (Forge.block RPC_path.open_root)
+      (fun _ctxt () ((level, proto_level, predecessor,
+                      timestamp, fitness, context), command) ->
+        let shell = { Block_header.level ; proto_level ; predecessor ;
+                      timestamp ; fitness ; validation_passes = 0 ;
+                      operations_hash ; context } in
+        let bytes = Data.Command.forge shell command in
+        return bytes) in
+  dir
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-embedded-protocol-genesis.opam b/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-embedded-protocol-genesis.opam
new file mode 100644
index 000000000..c70918612
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-embedded-protocol-genesis.opam
@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-protocol-compiler"
+  "tezos-protocol-updater"
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "genesis" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-protocol-genesis.opam b/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-protocol-genesis.opam
new file mode 100644
index 000000000..814411243
--- /dev/null
+++ b/vendors/tezos-modded/src/proto_genesis/lib_protocol/tezos-protocol-genesis.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & >= "1.0.1" }
+  "tezos-protocol-compiler"
+]
+build: [
+  [ "%{tezos-protocol-compiler:lib}%/replace"
+      "%{tezos-protocol-compiler:lib}%/dune_protocol.template"
+      "dune" "genesis" ]
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
diff --git a/vendors/tezos-modded/vendors/irmin-lmdb/dune b/vendors/tezos-modded/vendors/irmin-lmdb/dune
new file mode 100644
index 000000000..ab0458feb
--- /dev/null
+++ b/vendors/tezos-modded/vendors/irmin-lmdb/dune
@@ -0,0 +1,5 @@
+(library
+ (name        irmin_lmdb)
+ (public_name irmin-lmdb)
+ (libraries   irmin lmdb)
+ (flags (:standard -safe-string)))
diff --git a/vendors/tezos-modded/vendors/irmin-lmdb/irmin-lmdb.opam b/vendors/tezos-modded/vendors/irmin-lmdb/irmin-lmdb.opam
new file mode 100644
index 000000000..35f0de1ec
--- /dev/null
+++ b/vendors/tezos-modded/vendors/irmin-lmdb/irmin-lmdb.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+maintainer:   "gregoire.henry@tezos.com"
+authors:      ["Grégoire Henry"]
+license:      "ISC"
+homepage:     "https://gitlab.com/tezos/irmin-lmdb"
+bug-reports:  "https://gitlab.com/tezos/irmin-lmdb/issues"
+dev-repo:     "git+https://gitlab.com/tezos/irmin-lmdb.git"
+doc:          "https://tezos.gitlab.io/irmin-lmdb/"
+synopsis:     "LMDB backend for Irmin"
+
+build: [
+ ["dune" "subst"] {pinned}
+ ["dune" "build" "-p" name "-j" jobs]
+]
+run-test: ["dune" "runtest" "-p" name]
+
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "irmin"    {>= "1.4.0"}
+  "lmdb"     {>= "0.1"}
+]
diff --git a/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.ml b/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.ml
new file mode 100644
index 000000000..276e29f9f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.ml
@@ -0,0 +1,708 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+module Option = struct
+  let of_result = function
+    | Ok v -> Some v
+    | _ -> None
+
+  let value_map ~default ~f = function
+    | None -> default
+    | Some v -> f v
+end
+
+module Result = struct
+  let map ~f = function
+    | Ok v -> Ok (f v)
+    | Error err -> Error err
+end
+
+let cstruct_of_ba_copy ba =
+  let cs = Cstruct.of_bigarray ba in
+  let len = Cstruct.len cs in
+  let cs_copy = Cstruct.create_unsafe len in
+  Cstruct.blit cs 0 cs_copy 0 len ;
+  cs_copy
+
+open Lwt.Infix
+
+type t = {
+  db: Lmdb.t ;
+  root: string ;
+  mutable wtxn: (Lmdb.rw Lmdb.txn * Lmdb.db) option;
+}
+
+let of_result = function
+  | Ok v -> Lwt.return v
+  | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
+
+let (|>>) v f =
+  match v with
+  | Ok v -> f v
+  | Error e -> Error e
+
+let get_wtxn db =
+  match db.wtxn with
+  | Some t -> Ok t
+  | None ->
+      Lmdb.create_rw_txn db.db |>> fun txn ->
+      Lmdb.opendb txn |>> fun ddb ->
+      db.wtxn <- Some (txn, ddb);
+      Ok (txn, ddb)
+
+let commit_wtxn db =
+  match db.wtxn with
+  | None -> Ok ()
+  | Some (t, _ddb) ->
+      db.wtxn <- None;
+      Lmdb.commit_txn t
+
+let add db k v =
+  get_wtxn db |>> fun (txn, ddb) ->
+  Lmdb.put_string txn ddb k v
+
+let add db k v =
+  of_result @@ add db k v
+
+let add_cstruct db k v =
+  get_wtxn db |>> fun (txn, ddb) ->
+  Lmdb.put txn ddb k (Cstruct.to_bigarray v)
+
+let add_cstruct db k v =
+  of_result @@ add_cstruct db k v
+
+let src = Logs.Src.create "irmin.lmdb" ~doc:"Irmin in a Lmdb store"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let int64_of_string s =
+  try Ok (Int64.of_string s)
+  with Failure _ ->
+    Error (`Msg (Printf.sprintf "%s is not the representation of an int64" s))
+
+let bool_of_string s =
+  try Ok (bool_of_string s)
+  with Failure _ ->
+    Error (`Msg (Printf.sprintf "%s is not the representation of a boolean" s))
+
+let int64_converter = int64_of_string, Fmt.uint64
+let bool_converter = bool_of_string, Fmt.bool
+
+module Conf = struct
+
+  let root = Irmin.Private.Conf.root
+  let mapsize =
+    Irmin.Private.Conf.key "mapsize" int64_converter 409_600_000_000L
+  let readonly = 
+    Irmin.Private.Conf.key "readonly" bool_converter false 
+
+end
+
+let config
+    ?(config=Irmin.Private.Conf.empty) ?mapsize ?(readonly=false) file =
+  let module C = Irmin.Private.Conf in
+  let config = C.add config Conf.root (Some file) in
+  let config = C.add config Conf.readonly readonly in
+  Option.value_map mapsize ~default:config ~f:(C.add config Conf.mapsize)
+
+type ('r) reader = { f : 'k. 'k Lmdb.txn -> Lmdb.db -> ('r, Lmdb.error) result } [@@unboxed]
+
+let with_read_db db ~f =
+  match db.wtxn with
+  | None ->
+      Lmdb.with_ro_db db.db ~f:f.f
+  | Some (txn, ddb) ->
+      f.f txn ddb
+
+let mem db k =
+  with_read_db db ~f:{ f = fun txn db -> Lmdb.mem txn db k } |>
+  of_result
+
+let find_bind db k ~f =
+  match with_read_db db ~f:{ f = fun txn db -> Result.map ~f (Lmdb.get txn db k) } with
+  | Error KeyNotFound -> Lwt.return_none
+  | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
+  | Ok v -> Lwt.return v
+
+module Irmin_value_store
+    (M: Irmin.Metadata.S)
+    (H: Irmin.Hash.S)
+    (C: Irmin.Contents.S)
+    (P: Irmin.Path.S) = struct
+
+  module XContents = struct
+
+    type nonrec t = t
+    type key = H.t
+    type value = C.t
+
+    let lmdb_of_key h =
+      "contents/" ^ Cstruct.to_string (H.to_raw h)
+
+    let mem db key =
+      let key = lmdb_of_key key in
+      mem db key
+
+    let find db key =
+      let key = lmdb_of_key key in
+      find_bind db key ~f:begin fun v ->
+        Option.of_result (C.of_string Cstruct.(to_string (of_bigarray v)))
+      end
+
+    let to_string = Fmt.to_to_string C.pp
+
+    let add db v =
+      let k = H.digest C.t v in
+      let k_lmdb = lmdb_of_key k in
+      let v = to_string v in
+      add db k_lmdb v >|= fun () -> k
+
+    module Val = C
+    module Key = H
+  end
+
+  module Contents = Irmin.Contents.Store(XContents)
+
+  module XNode = struct
+    module Key = H
+    module Path = P
+
+    module Val = struct
+      module Metadata = M
+
+      type kind = [ `Node | `Contents of M.t ]
+      type metadata = M.t
+      type entry = { kind : kind; name : string; node : H.t; }
+      type t = entry list
+      type contents = Contents.key
+      type node = Key.t
+      type step = Path.step
+      type value = [`Node of node | `Contents of contents * metadata ]
+      let metadata_t = M.t
+      let contents_t = Contents.Key.t
+      let node_t = Key.t
+      let step_t = Path.step_t
+
+      let entry_t =
+        let open Irmin.Type in
+        record "Tree.entry"
+          (fun kind name node ->
+             let kind =
+               match kind with
+               | None -> `Node
+               | Some m -> `Contents m in
+             { kind ; name ; node } )
+        |+ field "kind" (option M.t) (function
+            | { kind = `Node ; _ } -> None
+            | { kind = `Contents m ; _ } -> Some m)
+        |+ field "name" string (fun { name ; _ } -> name)
+        |+ field "node" H.t (fun { node ; _ } -> node)
+        |> sealr
+
+      let value_t =
+        let open Irmin.Type in
+        variant "Tree.value" (fun node contents -> function
+            | `Node n          -> node n
+            | `Contents (c, m) -> contents (c, m))
+        |~ case1 "node"     node_t     (fun n -> `Node n)
+        |~ case1 "contents" (pair contents_t M.t) (fun (c, m) -> `Contents (c, m))
+        |> sealv
+
+      let of_step = Fmt.to_to_string P.pp_step
+
+      let to_step str = match P.step_of_string str with
+        | Ok x           -> x
+        | Error (`Msg e) -> failwith e
+
+      let to_entry kind (name, node) =
+        { kind; name = of_step name; node }
+
+      let list t  =
+        List.fold_left (fun acc { kind; name; node } ->
+            let name = to_step name in
+            match kind with
+            | `Node       -> (name, `Node node) :: acc
+            | `Contents m -> (name, `Contents (node, m)) :: acc
+          ) [] t
+        |> List.rev
+
+      let find t s =
+        let s = of_step s in
+        let rec aux = function
+          | [] -> None
+          | x::xs when x.name <> s -> aux xs
+          | { kind; node; _ } :: _ ->
+              match kind with
+              | `Node     -> Some (`Node node)
+              | `Contents m -> Some (`Contents (node, m))
+        in
+        aux t
+
+      type compare_result = LT | EQ | GT
+
+      module Sort_key: sig
+        type t
+        val of_entry: entry -> t
+        val of_contents: string -> t
+        val of_node: string -> t
+        val order: t -> t -> compare_result
+        val compare: t -> t -> int
+      end = struct
+
+        type t =
+          | Contents: string -> t
+          | Node    : string -> t
+
+        exception Result of int
+
+        let str = function Contents s | Node s -> s
+
+        let compare x y = match x, y with
+          | Contents x, Contents y -> String.compare x y
+          | _  ->
+              let xs = str x and ys = str y in
+              let lenx = String.length xs in
+              let leny = String.length ys in
+              let i = ref 0 in
+              try
+                while !i < lenx && !i < leny do
+                  match
+                    Char.compare
+                      (String.unsafe_get xs !i) (String.unsafe_get ys !i)
+                  with
+                  | 0 -> incr i
+                  | i -> raise (Result i)
+                done;
+                let get len s i =
+                  if i < len then String.unsafe_get (str s) i
+                  else if i = len then match s with
+                    | Node _     -> '/'
+                    | Contents _ -> '\000'
+                  else '\000'
+                in
+                match Char.compare (get lenx x !i) (get leny y !i) with
+                | 0 -> Char.compare (get lenx x (!i + 1)) (get leny y (!i + 1))
+                | i -> i
+              with Result i ->
+                i
+
+        let order a b = match compare a b with
+          | 0 -> EQ
+          | x when x > 0 -> GT
+          | _ -> LT
+
+        let of_contents c = Contents c
+        let of_node n = Node n
+
+        let of_entry = function
+          | {name = n; kind = `Node; _} -> of_node n
+          | {name = n; kind = `Contents _; _} -> of_contents n
+      end
+
+      let compare_entries a b =
+        Sort_key.(compare (of_entry a) (of_entry b))
+
+      (* the order is always:
+
+         [ ...; foo (content key); ...; foo/ (node key);  ... ]
+
+         So always scan until the 'node' key.
+      *)
+
+      let remove t step =
+        let step = of_step step in
+        let node_key = Sort_key.of_node step in
+        let contents_key = Sort_key.of_contents step in
+        let return ~acc rest = List.rev_append acc rest in
+        let rec aux acc = function
+          | []     -> t
+          | h :: l ->
+              let entry_key = Sort_key.of_entry h in
+              if Sort_key.order contents_key entry_key = EQ then
+                return ~acc l
+              else match Sort_key.order node_key entry_key with
+                | GT -> aux (h :: acc) l
+                | EQ -> return ~acc l
+                | LT -> t
+        in
+        aux [] t
+
+      let hash_of_v = function
+        | `Contents (x, _) | `Node x -> x
+
+      let update t step v =
+        let step = of_step step in
+        let node_key = Sort_key.of_node step in
+        let contents_key = Sort_key.of_contents step in
+        let return ~acc rest =
+          let kind, node = match v with
+            | `Node n          -> `Node, n
+            | `Contents (c, m) -> `Contents m, c
+          in
+          let e = { kind; name = step; node} in
+          List.rev_append acc (e :: rest)
+        in
+        let rec aux acc = function
+          | [] -> return ~acc []
+          | { node; _ } as h :: l ->
+              let entry_key = Sort_key.of_entry h in
+              (* Remove any contents entry with the same name. This will always
+                 come before the new succ entry. *)
+              if Sort_key.order contents_key entry_key = EQ then
+                aux acc l
+              else match Sort_key.order node_key entry_key with
+                | GT -> aux (h :: acc) l
+                | LT -> return ~acc (h::l)
+                | EQ when Cstruct.equal (H.to_raw (hash_of_v v)) (H.to_raw node) -> t
+                | EQ -> return ~acc l
+        in
+        aux [] t
+
+      let empty = []
+
+      let is_empty = function
+        | [] -> true
+        | _  -> false
+
+      let v alist =
+        let alist = List.map (fun (l, x) ->
+            let v k = l, k in
+            match x with
+            | `Node n             -> to_entry `Node (v n)
+            | `Contents (c, m) -> to_entry (`Contents m) (v c)
+          ) alist
+        in
+        List.fast_sort compare_entries alist
+
+      let alist t =
+        let mk_n k = `Node k in
+        let mk_c k m= `Contents (k, m) in
+        List.map (function
+            | { kind = `Node; name; node } -> (to_step name, mk_n node)
+            | { kind = `Contents m; name; node; _ } ->
+                (to_step name, mk_c node m)
+          ) t
+
+      module N = Irmin.Private.Node.Make (H)(H)(P)(M)
+      let to_n t = N.v (alist t)
+      let of_n n = v (N.list n)
+      let t = Irmin.Type.like N.t of_n to_n
+    end
+
+    module AO = struct
+
+      type nonrec t = t
+      type key = H.t
+      type value = Val.t
+
+      let lmdb_of_key h =
+        "node/" ^ Cstruct.to_string (H.to_raw h)
+
+      let mem db key =
+        let key = lmdb_of_key key in
+        mem db key
+
+      let of_cstruct v =
+        Irmin.Type.decode_cstruct (Irmin.Type.list Val.entry_t) v |>
+        Option.of_result
+
+      let find db key =
+        let key = lmdb_of_key key in
+        find_bind db key ~f:(fun v -> of_cstruct (cstruct_of_ba_copy v))
+
+      let add db v =
+        let v = Irmin.Type.encode_cstruct (Irmin.Type.list Val.entry_t) v in
+        let k = H.digest Irmin.Type.cstruct v in
+        let k_lmdb = lmdb_of_key k in
+        add_cstruct db k_lmdb v >|= fun () -> k
+    end
+    include AO
+
+  end
+  module Node = Irmin.Private.Node.Store(Contents)(P)(M)(XNode)
+
+  module XCommit = struct
+    module Val = struct
+      type t = {
+        node: H.t ;
+        parents: H.t list ;
+        info: Irmin.Info.t ;
+      }
+      type commit = H.t
+      type node = H.t
+
+      let commit_t = H.t
+      let node_t = H.t
+
+      let v ~info ~node ~parents = { info ; node ; parents }
+      let xnode { node; _ } = node
+      let node t = xnode t
+      let parents { parents; _ } = parents
+      let info { info; _ } = info
+
+      module C = Irmin.Private.Commit.Make(H)(H)
+
+      let of_c c = v ~info:(C.info c) ~node:(C.node c) ~parents:(C.parents c)
+
+      let to_c { info ; node ; parents } =
+        C.v ~info ~node ~parents
+
+      let t = Irmin.Type.like C.t of_c to_c
+    end
+
+    module Key = H
+
+    module AO = struct
+
+      let lmdb_of_key h =
+        "commit/" ^ Cstruct.to_string (H.to_raw h)
+
+      type nonrec t = t
+      type key = H.t
+      type value = Val.t
+
+      let mem db key =
+        let key = lmdb_of_key key in
+        mem db key
+
+      let of_cstruct v =
+        Irmin.Type.decode_cstruct Val.t v |>
+        Option.of_result
+
+      let find db key =
+        let key = lmdb_of_key key in
+        find_bind db key ~f:(fun v -> of_cstruct (cstruct_of_ba_copy v))
+
+      let add db v =
+        let v = Irmin.Type.encode_cstruct Val.t v in
+        let k = H.digest Irmin.Type.cstruct v in
+        let k_lmdb = lmdb_of_key k in
+        add_cstruct db k_lmdb v >>= fun () ->
+        of_result @@ commit_wtxn db >|= fun () -> k
+
+    end
+    include AO
+
+  end
+  module Commit = Irmin.Private.Commit.Store(Node)(XCommit)
+
+end
+
+module type Branch = sig
+  include Irmin.Branch.S
+  val pp_ref: t Fmt.t
+  val of_ref: string -> (t, [`Msg of string]) result
+end
+
+module Branch (B: Irmin.Branch.S): Branch with type t = B.t = struct
+  open Astring
+  include B
+  let pp_ref ppf b = Fmt.pf ppf "heads/%a" B.pp b
+
+  let of_ref str = match String.cuts ~sep:"/" str with
+    | "heads" :: b -> B.of_string (String.concat ~sep:"/" b)
+    | _ -> Error (`Msg (Fmt.strf "%s is not a valid branch" str))
+end
+
+
+module Irmin_branch_store (B: Branch) (H: Irmin.Hash.S) = struct
+
+  module Key = B
+  module Val = H
+
+  module W = Irmin.Private.Watch.Make(Key)(Val)
+
+  type nonrec t = {
+    db: t;
+    w: W.t;
+  }
+
+  let watches = Hashtbl.create 10
+
+  type key = Key.t
+  type value = Val.t
+  type watch = W.watch * (unit -> unit Lwt.t)
+
+  (* let branch_of_lmdb r = *)
+  (* let str = String.trim @@ Git.Reference.to_raw r in *)
+  (* match B.of_ref str with *)
+  (* | Ok r           -> Some r *)
+  (* | Error (`Msg _) -> None *)
+
+  let lmdb_of_branch r = Fmt.to_to_string B.pp_ref r
+
+  let mem db r =
+    mem db.db (lmdb_of_branch r)
+
+  let find db r =
+    find_bind db.db (lmdb_of_branch r)
+      ~f:(fun v -> Some (H.of_raw (cstruct_of_ba_copy v)))
+
+  let listen_dir _ =
+    Lwt.return (fun () -> Lwt.return_unit)
+
+  let watch_key t key ?init f =
+    listen_dir t >>= fun stop ->
+    W.watch_key t.w key ?init f >|= fun w ->
+    (w, stop)
+
+  let watch t ?init f =
+    listen_dir t >>= fun stop ->
+    W.watch t.w ?init f >|= fun w ->
+    (w, stop)
+
+  let unwatch t (w, stop) =
+    stop () >>= fun () ->
+    W.unwatch t.w w
+
+  let v db (* ~head *) =
+    let w =
+      try Hashtbl.find watches db.root
+      with Not_found ->
+        let w = W.v () in
+        (* FIXME: we might want to use a weak table *)
+        Hashtbl.add watches db.root w;
+        w
+    in
+    Lwt.return { db ; w }
+
+  let list _ = Lwt.return_nil (* TODO, or not *)
+
+  (* let write_index _t _gr _gk = *)
+  (* Lwt.return_unit *)
+
+  let set _t r _k =
+    Log.debug (fun f -> f "update %a" B.pp r);
+    Lwt.return_unit
+  (* let gr = git_of_branch r in *)
+  (* let gk = git_of_commit k in *)
+  (* G.write_reference t.t gr gk >>= fun () -> *)
+  (* W.notify t.w r (Some k) >>= fun () -> *)
+  (* write_index t gr (Git.Hash.to_commit gk) *)
+
+  let remove _t r =
+    Log.debug (fun f -> f "remove %a" B.pp r);
+    Lwt.return_unit
+  (* G.remove_reference t.t (git_of_branch r) >>= fun () -> *)
+  (* W.notify t.w r None *)
+
+  let test_and_set _t _r ~test:_ ~set:_ =
+    Log.debug (fun f -> f "test_and_set");
+    Lwt.return_true
+    (* let gr = git_of_branch r in *)
+    (* let c = function None -> None | Some h -> Some (git_of_commit h) in *)
+    (* G.test_and_set_reference t.t gr ~test:(c test) ~set:(c set) >>= fun b -> *)
+    (* (if b then W.notify t.w r set else Lwt.return_unit) >>= fun () -> *)
+    (* begin *)
+    (* We do not protect [write_index] because it can take a log
+       time and we don't want to hold the lock for too long. Would
+       be safer to grab a lock, although the expanded filesystem
+       is not critical for Irmin consistency (it's only a
+       convenience for the user). *)
+    (* if b then match set with *)
+    (* | None   -> Lwt.return_unit *)
+    (* | Some v -> write_index t gr (Git.Hash.to_commit (git_of_commit v)) *)
+    (* else *)
+    (* Lwt.return_unit *)
+    (* end >|= fun () -> *)
+    (* b *)
+
+end
+
+
+module Make
+    (M: Irmin.Metadata.S)
+    (C: Irmin.Contents.S)
+    (P: Irmin.Path.S)
+    (B: Irmin.Branch.S)
+    (H: Irmin.Hash.S) = struct
+
+  module P = struct
+
+    module Branch = Irmin_branch_store(Branch(B))(H)
+    include Irmin_value_store(M)(H)(C)(P)
+    module Slice = Irmin.Private.Slice.Make(Contents)(Node)(Commit)
+    module Sync = struct
+      type t = unit
+      type commit = H.t
+      type branch = B.t
+      let fetch _ ?depth:_ ~uri:_  _ = Lwt.return_error `Not_available
+      let push _ ?depth:_ ~uri:_ _ = Lwt.return_error `Not_available
+      let v _ = Lwt.return_unit
+    end
+
+    module Repo = struct
+      type nonrec t = {
+        config: Irmin.config ;
+        db: t ;
+        branch: Branch.t ;
+      }
+      let branch_t t : Branch.t = t.branch
+      let contents_t t : Contents.t = t.db
+      let node_t t : Node.t = contents_t t, t.db
+      let commit_t t : Commit.t = node_t t, t.db
+
+      type config = {
+        root   : string option ;
+        mapsize : int64 ;
+        readonly : bool ;
+        (* TODO *)
+        (* ?write_buffer_size:int -> *)
+        (* ?max_open_files:int -> *)
+        (* ?block_size:int -> *)
+        (* ?block_restart_interval:int -> *)
+        (* ?cache_size:int *)
+      }
+
+      let config c =
+        let root = Irmin.Private.Conf.get c Conf.root in
+        let mapsize = Irmin.Private.Conf.get c Conf.mapsize in
+        let readonly = Irmin.Private.Conf.get c Conf.readonly in
+        { root ; mapsize ; readonly }
+
+      let v conf =
+        let { root ; mapsize ; readonly } = config conf in
+        let root = match root with None -> "irmin.ldb" | Some root -> root in
+        if not (Sys.file_exists root) then Unix.mkdir root 0o755 ;
+        let flags = if readonly then [ Lmdb.RdOnly ] else [] in
+        let sync_flag =
+          match Sys.getenv_opt "TEZOS_CONTEXT_SYNC" with
+          | None -> []
+          | Some s ->
+              match String.lowercase_ascii s with
+              | "nosync" -> [ Lmdb.NoSync ]
+              | "nometasync" -> [ Lmdb.NoMetaSync ]
+              | _ ->
+                  Printf.eprintf "Unrecognized TEZOS_SYNC option : %s\n\
+                                  allowed: nosync nometasync" s;
+                  []
+        in
+        let flags = sync_flag @ Lmdb.NoRdAhead :: Lmdb.NoTLS :: flags in
+        let file_flags = if readonly then 0o444 else 0o644 in
+        match Lmdb.opendir ~mapsize ~flags root file_flags with
+        | Error err -> Lwt.fail_with (Lmdb.string_of_error err)
+        | Ok db ->
+            let db = { db ; root ; wtxn = None } in
+            Branch.v db >|= fun branch ->
+            { db; branch; config = conf }
+
+    end
+  end
+
+  include Irmin.Make_ext(P)
+
+end
+
+include Conf
diff --git a/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.mli b/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.mli
new file mode 100644
index 000000000..34a1a3cbd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/irmin-lmdb/irmin_lmdb.mli
@@ -0,0 +1,23 @@
+(*
+ * Copyright (c) 2013-2017 Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (c) 2017 Dynamic Ledger Solutions <contact@tezos.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Quick-and-dirty LevelDB backend for Irmin. *)
+
+val config:
+  ?config:Irmin.config -> ?mapsize:int64 -> ?readonly:bool -> string -> Irmin.config
+
+module Make : Irmin.S_MAKER
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/LICENSE.md b/vendors/tezos-modded/vendors/ocaml-bip39/LICENSE.md
new file mode 100644
index 000000000..52b5f8cd7
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/LICENSE.md
@@ -0,0 +1,13 @@
+Copyright (c) 2017 Vincent Bernardoff
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/bip39.opam b/vendors/tezos-modded/vendors/ocaml-bip39/bip39.opam
new file mode 100644
index 000000000..ab0d7dbc6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/bip39.opam
@@ -0,0 +1,23 @@
+opam-version: "2.0"
+name: "bip39"
+version: "1.0"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+authors: ["Vincent Bernardoff <vb@luminar.eu.org>"]
+homepage: "https://github.com/vbmithr/ocaml-bip39"
+doc: "https://vbmithr.github.io/ocaml-bip39/doc"
+synopsis: "Bitcoin's BIP39 implementation"
+license: "ISC"
+dev-repo: "git+https://github.com/vbmithr/ocaml-bip39.git"
+bug-reports: "https://github.com/vbmithr/ocaml-bip39/issues"
+tags: []
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "base" {build & >= "v0.10.0"}
+  "stdio" {build & >= "v0.10.0"}
+  "hacl"
+  "bigstring" {>= "0.2"}
+  "pbkdf" {>= "0.2.0"}
+  "hex" {with-test & >= "1.2.0"}
+  "alcotest" {with-test & >= "0.8.1"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/gen/english.txt b/vendors/tezos-modded/vendors/ocaml-bip39/gen/english.txt
new file mode 100644
index 000000000..942040ed5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/gen/english.txt
@@ -0,0 +1,2048 @@
+abandon
+ability
+able
+about
+above
+absent
+absorb
+abstract
+absurd
+abuse
+access
+accident
+account
+accuse
+achieve
+acid
+acoustic
+acquire
+across
+act
+action
+actor
+actress
+actual
+adapt
+add
+addict
+address
+adjust
+admit
+adult
+advance
+advice
+aerobic
+affair
+afford
+afraid
+again
+age
+agent
+agree
+ahead
+aim
+air
+airport
+aisle
+alarm
+album
+alcohol
+alert
+alien
+all
+alley
+allow
+almost
+alone
+alpha
+already
+also
+alter
+always
+amateur
+amazing
+among
+amount
+amused
+analyst
+anchor
+ancient
+anger
+angle
+angry
+animal
+ankle
+announce
+annual
+another
+answer
+antenna
+antique
+anxiety
+any
+apart
+apology
+appear
+apple
+approve
+april
+arch
+arctic
+area
+arena
+argue
+arm
+armed
+armor
+army
+around
+arrange
+arrest
+arrive
+arrow
+art
+artefact
+artist
+artwork
+ask
+aspect
+assault
+asset
+assist
+assume
+asthma
+athlete
+atom
+attack
+attend
+attitude
+attract
+auction
+audit
+august
+aunt
+author
+auto
+autumn
+average
+avocado
+avoid
+awake
+aware
+away
+awesome
+awful
+awkward
+axis
+baby
+bachelor
+bacon
+badge
+bag
+balance
+balcony
+ball
+bamboo
+banana
+banner
+bar
+barely
+bargain
+barrel
+base
+basic
+basket
+battle
+beach
+bean
+beauty
+because
+become
+beef
+before
+begin
+behave
+behind
+believe
+below
+belt
+bench
+benefit
+best
+betray
+better
+between
+beyond
+bicycle
+bid
+bike
+bind
+biology
+bird
+birth
+bitter
+black
+blade
+blame
+blanket
+blast
+bleak
+bless
+blind
+blood
+blossom
+blouse
+blue
+blur
+blush
+board
+boat
+body
+boil
+bomb
+bone
+bonus
+book
+boost
+border
+boring
+borrow
+boss
+bottom
+bounce
+box
+boy
+bracket
+brain
+brand
+brass
+brave
+bread
+breeze
+brick
+bridge
+brief
+bright
+bring
+brisk
+broccoli
+broken
+bronze
+broom
+brother
+brown
+brush
+bubble
+buddy
+budget
+buffalo
+build
+bulb
+bulk
+bullet
+bundle
+bunker
+burden
+burger
+burst
+bus
+business
+busy
+butter
+buyer
+buzz
+cabbage
+cabin
+cable
+cactus
+cage
+cake
+call
+calm
+camera
+camp
+can
+canal
+cancel
+candy
+cannon
+canoe
+canvas
+canyon
+capable
+capital
+captain
+car
+carbon
+card
+cargo
+carpet
+carry
+cart
+case
+cash
+casino
+castle
+casual
+cat
+catalog
+catch
+category
+cattle
+caught
+cause
+caution
+cave
+ceiling
+celery
+cement
+census
+century
+cereal
+certain
+chair
+chalk
+champion
+change
+chaos
+chapter
+charge
+chase
+chat
+cheap
+check
+cheese
+chef
+cherry
+chest
+chicken
+chief
+child
+chimney
+choice
+choose
+chronic
+chuckle
+chunk
+churn
+cigar
+cinnamon
+circle
+citizen
+city
+civil
+claim
+clap
+clarify
+claw
+clay
+clean
+clerk
+clever
+click
+client
+cliff
+climb
+clinic
+clip
+clock
+clog
+close
+cloth
+cloud
+clown
+club
+clump
+cluster
+clutch
+coach
+coast
+coconut
+code
+coffee
+coil
+coin
+collect
+color
+column
+combine
+come
+comfort
+comic
+common
+company
+concert
+conduct
+confirm
+congress
+connect
+consider
+control
+convince
+cook
+cool
+copper
+copy
+coral
+core
+corn
+correct
+cost
+cotton
+couch
+country
+couple
+course
+cousin
+cover
+coyote
+crack
+cradle
+craft
+cram
+crane
+crash
+crater
+crawl
+crazy
+cream
+credit
+creek
+crew
+cricket
+crime
+crisp
+critic
+crop
+cross
+crouch
+crowd
+crucial
+cruel
+cruise
+crumble
+crunch
+crush
+cry
+crystal
+cube
+culture
+cup
+cupboard
+curious
+current
+curtain
+curve
+cushion
+custom
+cute
+cycle
+dad
+damage
+damp
+dance
+danger
+daring
+dash
+daughter
+dawn
+day
+deal
+debate
+debris
+decade
+december
+decide
+decline
+decorate
+decrease
+deer
+defense
+define
+defy
+degree
+delay
+deliver
+demand
+demise
+denial
+dentist
+deny
+depart
+depend
+deposit
+depth
+deputy
+derive
+describe
+desert
+design
+desk
+despair
+destroy
+detail
+detect
+develop
+device
+devote
+diagram
+dial
+diamond
+diary
+dice
+diesel
+diet
+differ
+digital
+dignity
+dilemma
+dinner
+dinosaur
+direct
+dirt
+disagree
+discover
+disease
+dish
+dismiss
+disorder
+display
+distance
+divert
+divide
+divorce
+dizzy
+doctor
+document
+dog
+doll
+dolphin
+domain
+donate
+donkey
+donor
+door
+dose
+double
+dove
+draft
+dragon
+drama
+drastic
+draw
+dream
+dress
+drift
+drill
+drink
+drip
+drive
+drop
+drum
+dry
+duck
+dumb
+dune
+during
+dust
+dutch
+duty
+dwarf
+dynamic
+eager
+eagle
+early
+earn
+earth
+easily
+east
+easy
+echo
+ecology
+economy
+edge
+edit
+educate
+effort
+egg
+eight
+either
+elbow
+elder
+electric
+elegant
+element
+elephant
+elevator
+elite
+else
+embark
+embody
+embrace
+emerge
+emotion
+employ
+empower
+empty
+enable
+enact
+end
+endless
+endorse
+enemy
+energy
+enforce
+engage
+engine
+enhance
+enjoy
+enlist
+enough
+enrich
+enroll
+ensure
+enter
+entire
+entry
+envelope
+episode
+equal
+equip
+era
+erase
+erode
+erosion
+error
+erupt
+escape
+essay
+essence
+estate
+eternal
+ethics
+evidence
+evil
+evoke
+evolve
+exact
+example
+excess
+exchange
+excite
+exclude
+excuse
+execute
+exercise
+exhaust
+exhibit
+exile
+exist
+exit
+exotic
+expand
+expect
+expire
+explain
+expose
+express
+extend
+extra
+eye
+eyebrow
+fabric
+face
+faculty
+fade
+faint
+faith
+fall
+false
+fame
+family
+famous
+fan
+fancy
+fantasy
+farm
+fashion
+fat
+fatal
+father
+fatigue
+fault
+favorite
+feature
+february
+federal
+fee
+feed
+feel
+female
+fence
+festival
+fetch
+fever
+few
+fiber
+fiction
+field
+figure
+file
+film
+filter
+final
+find
+fine
+finger
+finish
+fire
+firm
+first
+fiscal
+fish
+fit
+fitness
+fix
+flag
+flame
+flash
+flat
+flavor
+flee
+flight
+flip
+float
+flock
+floor
+flower
+fluid
+flush
+fly
+foam
+focus
+fog
+foil
+fold
+follow
+food
+foot
+force
+forest
+forget
+fork
+fortune
+forum
+forward
+fossil
+foster
+found
+fox
+fragile
+frame
+frequent
+fresh
+friend
+fringe
+frog
+front
+frost
+frown
+frozen
+fruit
+fuel
+fun
+funny
+furnace
+fury
+future
+gadget
+gain
+galaxy
+gallery
+game
+gap
+garage
+garbage
+garden
+garlic
+garment
+gas
+gasp
+gate
+gather
+gauge
+gaze
+general
+genius
+genre
+gentle
+genuine
+gesture
+ghost
+giant
+gift
+giggle
+ginger
+giraffe
+girl
+give
+glad
+glance
+glare
+glass
+glide
+glimpse
+globe
+gloom
+glory
+glove
+glow
+glue
+goat
+goddess
+gold
+good
+goose
+gorilla
+gospel
+gossip
+govern
+gown
+grab
+grace
+grain
+grant
+grape
+grass
+gravity
+great
+green
+grid
+grief
+grit
+grocery
+group
+grow
+grunt
+guard
+guess
+guide
+guilt
+guitar
+gun
+gym
+habit
+hair
+half
+hammer
+hamster
+hand
+happy
+harbor
+hard
+harsh
+harvest
+hat
+have
+hawk
+hazard
+head
+health
+heart
+heavy
+hedgehog
+height
+hello
+helmet
+help
+hen
+hero
+hidden
+high
+hill
+hint
+hip
+hire
+history
+hobby
+hockey
+hold
+hole
+holiday
+hollow
+home
+honey
+hood
+hope
+horn
+horror
+horse
+hospital
+host
+hotel
+hour
+hover
+hub
+huge
+human
+humble
+humor
+hundred
+hungry
+hunt
+hurdle
+hurry
+hurt
+husband
+hybrid
+ice
+icon
+idea
+identify
+idle
+ignore
+ill
+illegal
+illness
+image
+imitate
+immense
+immune
+impact
+impose
+improve
+impulse
+inch
+include
+income
+increase
+index
+indicate
+indoor
+industry
+infant
+inflict
+inform
+inhale
+inherit
+initial
+inject
+injury
+inmate
+inner
+innocent
+input
+inquiry
+insane
+insect
+inside
+inspire
+install
+intact
+interest
+into
+invest
+invite
+involve
+iron
+island
+isolate
+issue
+item
+ivory
+jacket
+jaguar
+jar
+jazz
+jealous
+jeans
+jelly
+jewel
+job
+join
+joke
+journey
+joy
+judge
+juice
+jump
+jungle
+junior
+junk
+just
+kangaroo
+keen
+keep
+ketchup
+key
+kick
+kid
+kidney
+kind
+kingdom
+kiss
+kit
+kitchen
+kite
+kitten
+kiwi
+knee
+knife
+knock
+know
+lab
+label
+labor
+ladder
+lady
+lake
+lamp
+language
+laptop
+large
+later
+latin
+laugh
+laundry
+lava
+law
+lawn
+lawsuit
+layer
+lazy
+leader
+leaf
+learn
+leave
+lecture
+left
+leg
+legal
+legend
+leisure
+lemon
+lend
+length
+lens
+leopard
+lesson
+letter
+level
+liar
+liberty
+library
+license
+life
+lift
+light
+like
+limb
+limit
+link
+lion
+liquid
+list
+little
+live
+lizard
+load
+loan
+lobster
+local
+lock
+logic
+lonely
+long
+loop
+lottery
+loud
+lounge
+love
+loyal
+lucky
+luggage
+lumber
+lunar
+lunch
+luxury
+lyrics
+machine
+mad
+magic
+magnet
+maid
+mail
+main
+major
+make
+mammal
+man
+manage
+mandate
+mango
+mansion
+manual
+maple
+marble
+march
+margin
+marine
+market
+marriage
+mask
+mass
+master
+match
+material
+math
+matrix
+matter
+maximum
+maze
+meadow
+mean
+measure
+meat
+mechanic
+medal
+media
+melody
+melt
+member
+memory
+mention
+menu
+mercy
+merge
+merit
+merry
+mesh
+message
+metal
+method
+middle
+midnight
+milk
+million
+mimic
+mind
+minimum
+minor
+minute
+miracle
+mirror
+misery
+miss
+mistake
+mix
+mixed
+mixture
+mobile
+model
+modify
+mom
+moment
+monitor
+monkey
+monster
+month
+moon
+moral
+more
+morning
+mosquito
+mother
+motion
+motor
+mountain
+mouse
+move
+movie
+much
+muffin
+mule
+multiply
+muscle
+museum
+mushroom
+music
+must
+mutual
+myself
+mystery
+myth
+naive
+name
+napkin
+narrow
+nasty
+nation
+nature
+near
+neck
+need
+negative
+neglect
+neither
+nephew
+nerve
+nest
+net
+network
+neutral
+never
+news
+next
+nice
+night
+noble
+noise
+nominee
+noodle
+normal
+north
+nose
+notable
+note
+nothing
+notice
+novel
+now
+nuclear
+number
+nurse
+nut
+oak
+obey
+object
+oblige
+obscure
+observe
+obtain
+obvious
+occur
+ocean
+october
+odor
+off
+offer
+office
+often
+oil
+okay
+old
+olive
+olympic
+omit
+once
+one
+onion
+online
+only
+open
+opera
+opinion
+oppose
+option
+orange
+orbit
+orchard
+order
+ordinary
+organ
+orient
+original
+orphan
+ostrich
+other
+outdoor
+outer
+output
+outside
+oval
+oven
+over
+own
+owner
+oxygen
+oyster
+ozone
+pact
+paddle
+page
+pair
+palace
+palm
+panda
+panel
+panic
+panther
+paper
+parade
+parent
+park
+parrot
+party
+pass
+patch
+path
+patient
+patrol
+pattern
+pause
+pave
+payment
+peace
+peanut
+pear
+peasant
+pelican
+pen
+penalty
+pencil
+people
+pepper
+perfect
+permit
+person
+pet
+phone
+photo
+phrase
+physical
+piano
+picnic
+picture
+piece
+pig
+pigeon
+pill
+pilot
+pink
+pioneer
+pipe
+pistol
+pitch
+pizza
+place
+planet
+plastic
+plate
+play
+please
+pledge
+pluck
+plug
+plunge
+poem
+poet
+point
+polar
+pole
+police
+pond
+pony
+pool
+popular
+portion
+position
+possible
+post
+potato
+pottery
+poverty
+powder
+power
+practice
+praise
+predict
+prefer
+prepare
+present
+pretty
+prevent
+price
+pride
+primary
+print
+priority
+prison
+private
+prize
+problem
+process
+produce
+profit
+program
+project
+promote
+proof
+property
+prosper
+protect
+proud
+provide
+public
+pudding
+pull
+pulp
+pulse
+pumpkin
+punch
+pupil
+puppy
+purchase
+purity
+purpose
+purse
+push
+put
+puzzle
+pyramid
+quality
+quantum
+quarter
+question
+quick
+quit
+quiz
+quote
+rabbit
+raccoon
+race
+rack
+radar
+radio
+rail
+rain
+raise
+rally
+ramp
+ranch
+random
+range
+rapid
+rare
+rate
+rather
+raven
+raw
+razor
+ready
+real
+reason
+rebel
+rebuild
+recall
+receive
+recipe
+record
+recycle
+reduce
+reflect
+reform
+refuse
+region
+regret
+regular
+reject
+relax
+release
+relief
+rely
+remain
+remember
+remind
+remove
+render
+renew
+rent
+reopen
+repair
+repeat
+replace
+report
+require
+rescue
+resemble
+resist
+resource
+response
+result
+retire
+retreat
+return
+reunion
+reveal
+review
+reward
+rhythm
+rib
+ribbon
+rice
+rich
+ride
+ridge
+rifle
+right
+rigid
+ring
+riot
+ripple
+risk
+ritual
+rival
+river
+road
+roast
+robot
+robust
+rocket
+romance
+roof
+rookie
+room
+rose
+rotate
+rough
+round
+route
+royal
+rubber
+rude
+rug
+rule
+run
+runway
+rural
+sad
+saddle
+sadness
+safe
+sail
+salad
+salmon
+salon
+salt
+salute
+same
+sample
+sand
+satisfy
+satoshi
+sauce
+sausage
+save
+say
+scale
+scan
+scare
+scatter
+scene
+scheme
+school
+science
+scissors
+scorpion
+scout
+scrap
+screen
+script
+scrub
+sea
+search
+season
+seat
+second
+secret
+section
+security
+seed
+seek
+segment
+select
+sell
+seminar
+senior
+sense
+sentence
+series
+service
+session
+settle
+setup
+seven
+shadow
+shaft
+shallow
+share
+shed
+shell
+sheriff
+shield
+shift
+shine
+ship
+shiver
+shock
+shoe
+shoot
+shop
+short
+shoulder
+shove
+shrimp
+shrug
+shuffle
+shy
+sibling
+sick
+side
+siege
+sight
+sign
+silent
+silk
+silly
+silver
+similar
+simple
+since
+sing
+siren
+sister
+situate
+six
+size
+skate
+sketch
+ski
+skill
+skin
+skirt
+skull
+slab
+slam
+sleep
+slender
+slice
+slide
+slight
+slim
+slogan
+slot
+slow
+slush
+small
+smart
+smile
+smoke
+smooth
+snack
+snake
+snap
+sniff
+snow
+soap
+soccer
+social
+sock
+soda
+soft
+solar
+soldier
+solid
+solution
+solve
+someone
+song
+soon
+sorry
+sort
+soul
+sound
+soup
+source
+south
+space
+spare
+spatial
+spawn
+speak
+special
+speed
+spell
+spend
+sphere
+spice
+spider
+spike
+spin
+spirit
+split
+spoil
+sponsor
+spoon
+sport
+spot
+spray
+spread
+spring
+spy
+square
+squeeze
+squirrel
+stable
+stadium
+staff
+stage
+stairs
+stamp
+stand
+start
+state
+stay
+steak
+steel
+stem
+step
+stereo
+stick
+still
+sting
+stock
+stomach
+stone
+stool
+story
+stove
+strategy
+street
+strike
+strong
+struggle
+student
+stuff
+stumble
+style
+subject
+submit
+subway
+success
+such
+sudden
+suffer
+sugar
+suggest
+suit
+summer
+sun
+sunny
+sunset
+super
+supply
+supreme
+sure
+surface
+surge
+surprise
+surround
+survey
+suspect
+sustain
+swallow
+swamp
+swap
+swarm
+swear
+sweet
+swift
+swim
+swing
+switch
+sword
+symbol
+symptom
+syrup
+system
+table
+tackle
+tag
+tail
+talent
+talk
+tank
+tape
+target
+task
+taste
+tattoo
+taxi
+teach
+team
+tell
+ten
+tenant
+tennis
+tent
+term
+test
+text
+thank
+that
+theme
+then
+theory
+there
+they
+thing
+this
+thought
+three
+thrive
+throw
+thumb
+thunder
+ticket
+tide
+tiger
+tilt
+timber
+time
+tiny
+tip
+tired
+tissue
+title
+toast
+tobacco
+today
+toddler
+toe
+together
+toilet
+token
+tomato
+tomorrow
+tone
+tongue
+tonight
+tool
+tooth
+top
+topic
+topple
+torch
+tornado
+tortoise
+toss
+total
+tourist
+toward
+tower
+town
+toy
+track
+trade
+traffic
+tragic
+train
+transfer
+trap
+trash
+travel
+tray
+treat
+tree
+trend
+trial
+tribe
+trick
+trigger
+trim
+trip
+trophy
+trouble
+truck
+true
+truly
+trumpet
+trust
+truth
+try
+tube
+tuition
+tumble
+tuna
+tunnel
+turkey
+turn
+turtle
+twelve
+twenty
+twice
+twin
+twist
+two
+type
+typical
+ugly
+umbrella
+unable
+unaware
+uncle
+uncover
+under
+undo
+unfair
+unfold
+unhappy
+uniform
+unique
+unit
+universe
+unknown
+unlock
+until
+unusual
+unveil
+update
+upgrade
+uphold
+upon
+upper
+upset
+urban
+urge
+usage
+use
+used
+useful
+useless
+usual
+utility
+vacant
+vacuum
+vague
+valid
+valley
+valve
+van
+vanish
+vapor
+various
+vast
+vault
+vehicle
+velvet
+vendor
+venture
+venue
+verb
+verify
+version
+very
+vessel
+veteran
+viable
+vibrant
+vicious
+victory
+video
+view
+village
+vintage
+violin
+virtual
+virus
+visa
+visit
+visual
+vital
+vivid
+vocal
+voice
+void
+volcano
+volume
+vote
+voyage
+wage
+wagon
+wait
+walk
+wall
+walnut
+want
+warfare
+warm
+warrior
+wash
+wasp
+waste
+water
+wave
+way
+wealth
+weapon
+wear
+weasel
+weather
+web
+wedding
+weekend
+weird
+welcome
+west
+wet
+whale
+what
+wheat
+wheel
+when
+where
+whip
+whisper
+wide
+width
+wife
+wild
+will
+win
+window
+wine
+wing
+wink
+winner
+winter
+wire
+wisdom
+wise
+wish
+witness
+wolf
+woman
+wonder
+wood
+wool
+word
+work
+world
+worry
+worth
+wrap
+wreck
+wrestle
+wrist
+write
+wrong
+yard
+year
+yellow
+you
+young
+youth
+zebra
+zero
+zone
+zoo
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.ml b/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.ml
new file mode 100644
index 000000000..45232ec0e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.ml
@@ -0,0 +1,140 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open StdLabels
+
+let acceptable_num_words = [12 ; 15 ; 18 ; 21 ; 24]
+
+type entropy = {
+  bytes : Bigstring.t ;
+  length : int ;
+  digest_length : int ;
+  num_words : int ;
+}
+
+let entropy_of_bytes bytes =
+  match Bigstring.length bytes with
+  | 16 -> Some { bytes ; length = 16 ; digest_length = 4 ; num_words = 12 }
+  | 20 -> Some { bytes ; length = 20 ; digest_length = 5 ; num_words = 15 }
+  | 24 -> Some { bytes ; length = 24 ; digest_length = 6 ; num_words = 18 }
+  | 28 -> Some { bytes ; length = 28 ; digest_length = 7 ; num_words = 21 }
+  | 32 -> Some { bytes ; length = 32 ; digest_length = 8 ; num_words = 24 }
+  | _ -> None
+
+type t = int list
+
+let index_of_word word =
+  let index = ref (-1) in
+  try
+    List.iteri English.words ~f:begin fun i w ->
+      if String.compare word w = 0 then (index := i ; raise Exit)
+    end ;
+    None
+  with Exit -> Some !index
+
+let of_words words =
+  try
+    List.fold_right words ~init:(0, []) ~f:begin fun word (count, acc) ->
+      match index_of_word word with
+      | Some i -> (succ count, i :: acc)
+      | _ -> raise Exit
+    end |> fun (count, x) ->
+    if List.(mem count ~set:acceptable_num_words) then Some x
+    else None
+  with Exit -> None
+
+let of_indices idxs =
+  try
+    List.fold_right idxs ~init:(0, []) ~f:begin fun i (count, acc) ->
+      if i < 0 || i > 2047 then raise Exit
+      else (succ count, i :: acc)
+    end |> fun (count, x) ->
+    if List.(mem count ~set:acceptable_num_words) then Some x
+    else None
+  with Exit -> None
+
+let to_words = List.map ~f:(List.nth English.words)
+let to_indices t = t
+
+let pp ppf t =
+  let open Format in
+  let words = to_words t in
+  let pp_mnemonic =
+    pp_print_list
+      ~pp_sep:(fun fmt () -> fprintf fmt " ")
+      pp_print_string in
+  fprintf ppf "%a" pp_mnemonic words
+
+let show t =
+  Format.asprintf "%a" pp t
+
+let int_of_bits bits =
+  snd @@ List.fold_right bits ~init:(0, 0) ~f:begin fun b (i, res) ->
+    succ i, if b then res lor (1 lsl i) else res
+  end
+
+let bits_of_char c =
+  let b = Char.code c in
+  let res = ref [] in
+  for i = 0 to 7 do
+    res := (b land (1 lsl i) <> 0) :: !res
+  done ;
+  !res
+
+let bits_of_bytes bytes =
+  let acc = ref [] in
+  String.iter bytes ~f:begin fun c ->
+    acc := List.rev_append (bits_of_char c) !acc
+  end ;
+  List.rev !acc
+
+let list_sub l n =
+  let rec inner acc n l =
+    if n > 0 then match l with
+      | h :: tl -> inner (h :: acc) (pred n) tl
+      | _ -> invalid_arg "Bip39.list_sub"
+    else List.rev acc
+  in inner [] n l
+
+let pack l pack_len =
+  let rec inner (sub_acc_len, sub_acc, acc) = function
+    | [] -> if sub_acc <> [] then List.rev sub_acc :: acc else acc
+    | h :: tl ->
+        if sub_acc_len = pack_len then
+          inner (1, [h], List.rev sub_acc :: acc) tl
+        else inner (succ sub_acc_len, h :: sub_acc, acc) tl
+  in
+  List.rev (inner (0, [], []) l)
+
+let of_entropy entropy =
+  match entropy_of_bytes entropy with
+  | None -> invalid_arg "Bip39.of_entropy: wrong entropy length"
+  | Some { bytes ; digest_length ; _ } ->
+      let digest = Bigstring.get (Hacl.Hash.SHA256.digest entropy) 0 in
+      let digest = list_sub (bits_of_char digest) digest_length in
+      let entropy = bits_of_bytes (Bigstring.to_string bytes) @ digest in
+      List.map (pack entropy 11) ~f:int_of_bits
+
+let to_seed ?(passphrase=Bigstring.empty) t =
+  let words = to_words t in
+  let password = Bigstring.of_string (String.concat ~sep:" " words) in
+  let salt = Bigstring.(concat "" [of_string "mnemonic" ; passphrase]) in
+  Pbkdf.SHA512.pbkdf2 ~password ~salt ~count:2048 ~dk_len:64l
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.mli b/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.mli
new file mode 100644
index 000000000..87f7236b5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/src/bip39.mli
@@ -0,0 +1,56 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+type t
+(** Abstract type of a mnemonic *)
+
+val pp : Format.formatter -> t -> unit
+val show : t -> string
+
+val index_of_word : string -> int option
+(** [find_index word] is [Some i] where is is the index of [word] in
+    the BIP39 word list, or [None] if no such word is in the list. *)
+
+val of_indices : int list -> t option
+(** [of_indices idxs] is [Some mnemonic] if indices are all in range
+    [0-2047] or [None] otherwise. *)
+
+val to_indices : t -> int list
+(** [to_indices t] is the list of indices corresponding to [t]. *)
+
+val of_words : string list -> t option
+(** [of_words words] is [Some mnemonic] if [words] is a list
+    containing a valids number of valid english words. *)
+
+val to_words : t -> string list
+(** [to_words mnemonic] is the list of words corresponding to
+    [mnemonic]. *)
+
+val of_entropy : Bigstring.t -> t
+(** [of_entropy bytes] is the mnemonic derived from [bytes].
+
+    @raises [Invalid_argument] is [List.length bytes] is not in { 16,
+    20, 24, 28, 32 }. *)
+
+val to_seed : ?passphrase:Bigstring.t -> t -> Bigstring.t
+(** [to_seed ?passphrase mnemonic] is 64 bytes derived from a BIP39
+    mnemonic [mnemonic], using the optional passphrase [passphrase] if
+    provided. *)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/src/dune b/vendors/tezos-modded/vendors/ocaml-bip39/src/dune
new file mode 100644
index 000000000..06bda597c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/src/dune
@@ -0,0 +1,16 @@
+(library
+ (name        bip39)
+ (public_name bip39)
+ (modules english bip39)
+ (libraries bigstring hacl pbkdf))
+
+(rule
+ (targets english.ml)
+ (deps    (:exe generator.exe)
+          (source_tree ../gen))
+ (action  (run %{exe} %{targets})))
+
+(executable
+ (name generator)
+ (modules generator)
+ (libraries stdio))
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/src/generator.ml b/vendors/tezos-modded/vendors/ocaml-bip39/src/generator.ml
new file mode 100644
index 000000000..cc1c51c61
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/src/generator.ml
@@ -0,0 +1,44 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Base
+open Stdio
+
+let pp_print_quoted_string ppf str =
+  let open Caml.Format in
+  fprintf ppf "\"%s\"" str
+
+let pp_print_quoted_string_list ppf strs =
+  let open Caml.Format in
+  pp_print_list ~pp_sep:(fun ppf () -> pp_print_string ppf ";")
+    pp_print_quoted_string ppf strs
+
+let gen ml =
+  let txt = "../gen/" ^ (Caml.Filename.remove_extension ml) ^ ".txt" in
+  let words = In_channel.read_lines txt in
+  Out_channel.with_file
+    ~binary:false ~append:false ~fail_if_exists:false ml ~f:begin fun oc ->
+    let ppf = Caml.Format.formatter_of_out_channel oc in
+    Caml.Format.fprintf ppf "let words = [%a]@." pp_print_quoted_string_list words
+  end
+
+let () =
+  Array.to_list Caml.Sys.argv |> List.tl_exn |> List.iter ~f:gen
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/test/dune b/vendors/tezos-modded/vendors/ocaml-bip39/test/dune
new file mode 100644
index 000000000..f1044c68a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/test/dune
@@ -0,0 +1,8 @@
+(executable
+ (name test)
+ (libraries bip39 hex alcotest))
+
+(alias
+ (name    runtest-bip39)
+ (deps    (:exe test.exe))
+ (action  (run %{exe})))
diff --git a/vendors/tezos-modded/vendors/ocaml-bip39/test/test.ml b/vendors/tezos-modded/vendors/ocaml-bip39/test/test.ml
new file mode 100644
index 000000000..efb30cbb7
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-bip39/test/test.ml
@@ -0,0 +1,139 @@
+open Alcotest
+
+type vector = {
+  entropy : Hex.t ;
+  words : string ;
+  seed : Hex.t ;
+}
+
+let vectors = [
+  { entropy = `Hex "00000000000000000000000000000000" ;
+    words = "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about" ;
+    seed = `Hex "c55257c360c07c72029aebc1b53c05ed0362ada38ead3e3e9efa3708e53495531f09a6987599d18264c1e1c92f2cf141630c7a3c4ab7c81b2f001698e7463b04" ;
+  } ;
+  { entropy = `Hex "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f" ;
+    words = "legal winner thank year wave sausage worth useful legal winner thank yellow" ;
+    seed = `Hex "2e8905819b8723fe2c1d161860e5ee1830318dbf49a83bd451cfb8440c28bd6fa457fe1296106559a3c80937a1c1069be3a3a5bd381ee6260e8d9739fce1f607" ;
+  } ;
+  { entropy = `Hex "80808080808080808080808080808080" ;
+    words = "letter advice cage absurd amount doctor acoustic avoid letter advice cage above" ;
+    seed = `Hex "d71de856f81a8acc65e6fc851a38d4d7ec216fd0796d0a6827a3ad6ed5511a30fa280f12eb2e47ed2ac03b5c462a0358d18d69fe4f985ec81778c1b370b652a8" ;
+  } ;
+  { entropy = `Hex "ffffffffffffffffffffffffffffffff" ;
+    words = "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong" ;
+    seed = `Hex "ac27495480225222079d7be181583751e86f571027b0497b5b5d11218e0a8a13332572917f0f8e5a589620c6f15b11c61dee327651a14c34e18231052e48c069" ;
+  } ;
+  { entropy = `Hex "000000000000000000000000000000000000000000000000" ;
+    words = "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon agent" ;
+    seed = `Hex "035895f2f481b1b0f01fcf8c289c794660b289981a78f8106447707fdd9666ca06da5a9a565181599b79f53b844d8a71dd9f439c52a3d7b3e8a79c906ac845fa" ;
+  } ;
+  { entropy = `Hex "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f" ;
+    words = "legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth useful legal will" ;
+    seed = `Hex "f2b94508732bcbacbcc020faefecfc89feafa6649a5491b8c952cede496c214a0c7b3c392d168748f2d4a612bada0753b52a1c7ac53c1e93abd5c6320b9e95dd" ;
+  } ;
+  { entropy = `Hex "808080808080808080808080808080808080808080808080" ;
+    words = "letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic avoid letter always" ;
+    seed = `Hex "107d7c02a5aa6f38c58083ff74f04c607c2d2c0ecc55501dadd72d025b751bc27fe913ffb796f841c49b1d33b610cf0e91d3aa239027f5e99fe4ce9e5088cd65" ;
+  } ;
+  { entropy = `Hex "ffffffffffffffffffffffffffffffffffffffffffffffff" ;
+    words = "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo when" ;
+    seed = `Hex "0cd6e5d827bb62eb8fc1e262254223817fd068a74b5b449cc2f667c3f1f985a76379b43348d952e2265b4cd129090758b3e3c2c49103b5051aac2eaeb890a528" ;
+  } ;
+  { entropy = `Hex "0000000000000000000000000000000000000000000000000000000000000000" ;
+    words = "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon art" ;
+    seed = `Hex "bda85446c68413707090a52022edd26a1c9462295029f2e60cd7c4f2bbd3097170af7a4d73245cafa9c3cca8d561a7c3de6f5d4a10be8ed2a5e608d68f92fcc8" ;
+  } ;
+  { entropy = `Hex "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f" ;
+    words = "legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth title" ;
+    seed = `Hex "bc09fca1804f7e69da93c2f2028eb238c227f2e9dda30cd63699232578480a4021b146ad717fbb7e451ce9eb835f43620bf5c514db0f8add49f5d121449d3e87" ;
+  } ;
+  { entropy = `Hex "8080808080808080808080808080808080808080808080808080808080808080" ;
+    words = "letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic avoid letter advice cage absurd amount doctor acoustic bless" ;
+    seed = `Hex "c0c519bd0e91a2ed54357d9d1ebef6f5af218a153624cf4f2da911a0ed8f7a09e2ef61af0aca007096df430022f7a2b6fb91661a9589097069720d015e4e982f" ;
+  } ;
+  { entropy = `Hex "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" ;
+    words = "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo vote" ;
+    seed = `Hex "dd48c104698c30cfe2b6142103248622fb7bb0ff692eebb00089b32d22484e1613912f0a5b694407be899ffd31ed3992c456cdf60f5d4564b8ba3f05a69890ad" ;
+  } ;
+  { entropy = `Hex "9e885d952ad362caeb4efe34a8e91bd2" ;
+    words = "ozone drill grab fiber curtain grace pudding thank cruise elder eight picnic" ;
+    seed = `Hex "274ddc525802f7c828d8ef7ddbcdc5304e87ac3535913611fbbfa986d0c9e5476c91689f9c8a54fd55bd38606aa6a8595ad213d4c9c9f9aca3fb217069a41028" ;
+  } ;
+  { entropy = `Hex "6610b25967cdcca9d59875f5cb50b0ea75433311869e930b" ;
+    words = "gravity machine north sort system female filter attitude volume fold club stay feature office ecology stable narrow fog" ;
+    seed = `Hex "628c3827a8823298ee685db84f55caa34b5cc195a778e52d45f59bcf75aba68e4d7590e101dc414bc1bbd5737666fbbef35d1f1903953b66624f910feef245ac" ;
+  } ;
+  { entropy = `Hex "68a79eaca2324873eacc50cb9c6eca8cc68ea5d936f98787c60c7ebc74e6ce7c" ;
+    words = "hamster diagram private dutch cause delay private meat slide toddler razor book happy fancy gospel tennis maple dilemma loan word shrug inflict delay length" ;
+    seed = `Hex "64c87cde7e12ecf6704ab95bb1408bef047c22db4cc7491c4271d170a1b213d20b385bc1588d9c7b38f1b39d415665b8a9030c9ec653d75e65f847d8fc1fc440" ;
+  } ;
+  { entropy = `Hex "c0ba5a8e914111210f2bd131f3d5e08d" ;
+    words = "scheme spot photo card baby mountain device kick cradle pact join borrow" ;
+    seed = `Hex "ea725895aaae8d4c1cf682c1bfd2d358d52ed9f0f0591131b559e2724bb234fca05aa9c02c57407e04ee9dc3b454aa63fbff483a8b11de949624b9f1831a9612" ;
+  } ;
+  { entropy = `Hex "6d9be1ee6ebd27a258115aad99b7317b9c8d28b6d76431c3" ;
+    words = "horn tenant knee talent sponsor spell gate clip pulse soap slush warm silver nephew swap uncle crack brave" ;
+    seed = `Hex "fd579828af3da1d32544ce4db5c73d53fc8acc4ddb1e3b251a31179cdb71e853c56d2fcb11aed39898ce6c34b10b5382772db8796e52837b54468aeb312cfc3d" ;
+  } ;
+  { entropy = `Hex "9f6a2878b2520799a44ef18bc7df394e7061a224d2c33cd015b157d746869863" ;
+    words = "panda eyebrow bullet gorilla call smoke muffin taste mesh discover soft ostrich alcohol speed nation flash devote level hobby quick inner drive ghost inside" ;
+    seed = `Hex "72be8e052fc4919d2adf28d5306b5474b0069df35b02303de8c1729c9538dbb6fc2d731d5f832193cd9fb6aeecbc469594a70e3dd50811b5067f3b88b28c3e8d" ;
+  } ;
+  { entropy = `Hex "23db8160a31d3e0dca3688ed941adbf3" ;
+    words = "cat swing flag economy stadium alone churn speed unique patch report train" ;
+    seed = `Hex "deb5f45449e615feff5640f2e49f933ff51895de3b4381832b3139941c57b59205a42480c52175b6efcffaa58a2503887c1e8b363a707256bdd2b587b46541f5" ;
+  } ;
+  { entropy = `Hex "8197a4a47f0425faeaa69deebc05ca29c0a5b5cc76ceacc0" ;
+    words = "light rule cinnamon wrap drastic word pride squirrel upgrade then income fatal apart sustain crack supply proud access" ;
+    seed = `Hex "4cbdff1ca2db800fd61cae72a57475fdc6bab03e441fd63f96dabd1f183ef5b782925f00105f318309a7e9c3ea6967c7801e46c8a58082674c860a37b93eda02" ;
+  } ;
+  { entropy = `Hex "066dca1a2bb7e8a1db2832148ce9933eea0f3ac9548d793112d9a95c9407efad" ;
+    words = "all hour make first leader extend hole alien behind guard gospel lava path output census museum junior mass reopen famous sing advance salt reform" ;
+    seed = `Hex "26e975ec644423f4a4c4f4215ef09b4bd7ef924e85d1d17c4cf3f136c2863cf6df0a475045652c57eb5fb41513ca2a2d67722b77e954b4b3fc11f7590449191d" ;
+  } ;
+  { entropy = `Hex "f30f8c1da665478f49b001d94c5fc452" ;
+    words = "vessel ladder alter error federal sibling chat ability sun glass valve picture" ;
+    seed = `Hex "2aaa9242daafcee6aa9d7269f17d4efe271e1b9a529178d7dc139cd18747090bf9d60295d0ce74309a78852a9caadf0af48aae1c6253839624076224374bc63f" ;
+  } ;
+  { entropy = `Hex "c10ec20dc3cd9f652c7fac2f1230f7a3c828389a14392f05" ;
+    words = "scissors invite lock maple supreme raw rapid void congress muscle digital elegant little brisk hair mango congress clump" ;
+    seed = `Hex "7b4a10be9d98e6cba265566db7f136718e1398c71cb581e1b2f464cac1ceedf4f3e274dc270003c670ad8d02c4558b2f8e39edea2775c9e232c7cb798b069e88" ;
+  } ;
+  { entropy = `Hex "f585c11aec520db57dd353c69554b21a89b20fb0650966fa0a9d6f74fd989d8f" ;
+    words = "void come effort suffer camp survey warrior heavy shoot primary clutch crush open amazing screen patrol group space point ten exist slush involve unfold" ;
+    seed = `Hex "01f5bced59dec48e362f2c45b5de68b9fd6c92c6634f44d6d40aab69056506f0e35524a518034ddc1192e1dacd32c1ed3eaa3c3b131c88ed8e7e54c49a5d0998" ;
+  } ;
+]
+
+let pp_diff ppf (l1, l2) =
+  match List.length l1, List.length l2 with
+  | n, m when n <> m ->
+      Format.fprintf ppf "Mnemonic size differs: %d vs %d" n m ;
+  | _ ->
+      ignore @@ ListLabels.fold_left2 l1 l2 ~init:0 ~f:begin fun i w1 w2 ->
+        if w1 <> w2 then begin
+          Format.fprintf ppf "At position %d, words differ: %s <> %s"
+            i w1 w2
+        end ;
+        succ i
+      end
+
+let vectors () =
+  ListLabels.iteri vectors ~f:begin fun i { entropy ; words ; seed } ->
+    let words = String.split_on_char ' ' words in
+    let mnemonic = Bip39.of_entropy (Cstruct.to_bigarray (Hex.to_cstruct entropy)) in
+    let words_computed = Bip39.to_words mnemonic in
+    assert (words = words_computed) ;
+    let seed_computed =
+      Bip39.to_seed ~passphrase:(Bigstring.of_string "TREZOR") mnemonic in
+    assert (Cstruct.to_bigarray (Hex.to_cstruct seed) = seed_computed)
+  end
+
+let basic = [
+  "vectors", `Quick, vectors ;
+]
+
+let () =
+  Alcotest.run "bip39" [
+    "basic", basic ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/LICENSE.md b/vendors/tezos-modded/vendors/ocaml-blake2/LICENSE.md
new file mode 100644
index 000000000..52b5f8cd7
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/LICENSE.md
@@ -0,0 +1,13 @@
+Copyright (c) 2017 Vincent Bernardoff
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/blake2.opam b/vendors/tezos-modded/vendors/ocaml-blake2/blake2.opam
new file mode 100644
index 000000000..65f013cc0
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/blake2.opam
@@ -0,0 +1,17 @@
+opam-version: "2.0"
+name: "blake2"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+license: "ISC"
+synopsis: "Cryptography for Tezos"
+homepage: "https://github.com/vbmithr/ocaml-blake2"
+bug-reports: "https://github.com/vbmithr/ocaml-blake2/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-blake2"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "bigstring" {>= "0.1.1"}
+  "alcotest" { with-test }
+  "hex" {with-test & >= "1.2.0"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2-impl.h b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2-impl.h
new file mode 100644
index 000000000..5dff7fc7a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2-impl.h
@@ -0,0 +1,160 @@
+/*
+   BLAKE2 reference source code package - reference C implementations
+
+   Copyright 2012, Samuel Neves <sneves@dei.uc.pt>.  You may use this under the
+   terms of the CC0, the OpenSSL Licence, or the Apache Public License 2.0, at
+   your option.  The terms of these licenses can be found at:
+
+   - CC0 1.0 Universal : http://creativecommons.org/publicdomain/zero/1.0
+   - OpenSSL license   : https://www.openssl.org/source/license.html
+   - Apache 2.0        : http://www.apache.org/licenses/LICENSE-2.0
+
+   More information about the BLAKE2 hash function can be found at
+   https://blake2.net.
+*/
+#ifndef BLAKE2_IMPL_H
+#define BLAKE2_IMPL_H
+
+#include <stdint.h>
+#include <string.h>
+
+#if !defined(__cplusplus) && (!defined(__STDC_VERSION__) || __STDC_VERSION__ < 199901L)
+  #if   defined(_MSC_VER)
+    #define BLAKE2_INLINE __inline
+  #elif defined(__GNUC__)
+    #define BLAKE2_INLINE __inline__
+  #else
+    #define BLAKE2_INLINE
+  #endif
+#else
+  #define BLAKE2_INLINE inline
+#endif
+
+static BLAKE2_INLINE uint32_t load32( const void *src )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  uint32_t w;
+  memcpy(&w, src, sizeof w);
+  return w;
+#else
+  const uint8_t *p = ( const uint8_t * )src;
+  return (( uint32_t )( p[0] ) <<  0) |
+         (( uint32_t )( p[1] ) <<  8) |
+         (( uint32_t )( p[2] ) << 16) |
+         (( uint32_t )( p[3] ) << 24) ;
+#endif
+}
+
+static BLAKE2_INLINE uint64_t load64( const void *src )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  uint64_t w;
+  memcpy(&w, src, sizeof w);
+  return w;
+#else
+  const uint8_t *p = ( const uint8_t * )src;
+  return (( uint64_t )( p[0] ) <<  0) |
+         (( uint64_t )( p[1] ) <<  8) |
+         (( uint64_t )( p[2] ) << 16) |
+         (( uint64_t )( p[3] ) << 24) |
+         (( uint64_t )( p[4] ) << 32) |
+         (( uint64_t )( p[5] ) << 40) |
+         (( uint64_t )( p[6] ) << 48) |
+         (( uint64_t )( p[7] ) << 56) ;
+#endif
+}
+
+static BLAKE2_INLINE uint16_t load16( const void *src )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  uint16_t w;
+  memcpy(&w, src, sizeof w);
+  return w;
+#else
+  const uint8_t *p = ( const uint8_t * )src;
+  return (( uint16_t )( p[0] ) <<  0) |
+         (( uint16_t )( p[1] ) <<  8) ;
+#endif
+}
+
+static BLAKE2_INLINE void store16( void *dst, uint16_t w )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  memcpy(dst, &w, sizeof w);
+#else
+  uint8_t *p = ( uint8_t * )dst;
+  *p++ = ( uint8_t )w; w >>= 8;
+  *p++ = ( uint8_t )w;
+#endif
+}
+
+static BLAKE2_INLINE void store32( void *dst, uint32_t w )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  memcpy(dst, &w, sizeof w);
+#else
+  uint8_t *p = ( uint8_t * )dst;
+  p[0] = (uint8_t)(w >>  0);
+  p[1] = (uint8_t)(w >>  8);
+  p[2] = (uint8_t)(w >> 16);
+  p[3] = (uint8_t)(w >> 24);
+#endif
+}
+
+static BLAKE2_INLINE void store64( void *dst, uint64_t w )
+{
+#if defined(NATIVE_LITTLE_ENDIAN)
+  memcpy(dst, &w, sizeof w);
+#else
+  uint8_t *p = ( uint8_t * )dst;
+  p[0] = (uint8_t)(w >>  0);
+  p[1] = (uint8_t)(w >>  8);
+  p[2] = (uint8_t)(w >> 16);
+  p[3] = (uint8_t)(w >> 24);
+  p[4] = (uint8_t)(w >> 32);
+  p[5] = (uint8_t)(w >> 40);
+  p[6] = (uint8_t)(w >> 48);
+  p[7] = (uint8_t)(w >> 56);
+#endif
+}
+
+static BLAKE2_INLINE uint64_t load48( const void *src )
+{
+  const uint8_t *p = ( const uint8_t * )src;
+  return (( uint64_t )( p[0] ) <<  0) |
+         (( uint64_t )( p[1] ) <<  8) |
+         (( uint64_t )( p[2] ) << 16) |
+         (( uint64_t )( p[3] ) << 24) |
+         (( uint64_t )( p[4] ) << 32) |
+         (( uint64_t )( p[5] ) << 40) ;
+}
+
+static BLAKE2_INLINE void store48( void *dst, uint64_t w )
+{
+  uint8_t *p = ( uint8_t * )dst;
+  p[0] = (uint8_t)(w >>  0);
+  p[1] = (uint8_t)(w >>  8);
+  p[2] = (uint8_t)(w >> 16);
+  p[3] = (uint8_t)(w >> 24);
+  p[4] = (uint8_t)(w >> 32);
+  p[5] = (uint8_t)(w >> 40);
+}
+
+static BLAKE2_INLINE uint32_t rotr32( const uint32_t w, const unsigned c )
+{
+  return ( w >> c ) | ( w << ( 32 - c ) );
+}
+
+static BLAKE2_INLINE uint64_t rotr64( const uint64_t w, const unsigned c )
+{
+  return ( w >> c ) | ( w << ( 64 - c ) );
+}
+
+/* prevents compiler optimizing out memset() */
+static BLAKE2_INLINE void secure_zero_memory(void *v, size_t n)
+{
+  static void *(*const volatile memset_v)(void *, int, size_t) = &memset;
+  memset_v(v, 0, n);
+}
+
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.h b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.h
new file mode 100644
index 000000000..ad62f260e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.h
@@ -0,0 +1,195 @@
+/*
+   BLAKE2 reference source code package - reference C implementations
+
+   Copyright 2012, Samuel Neves <sneves@dei.uc.pt>.  You may use this under the
+   terms of the CC0, the OpenSSL Licence, or the Apache Public License 2.0, at
+   your option.  The terms of these licenses can be found at:
+
+   - CC0 1.0 Universal : http://creativecommons.org/publicdomain/zero/1.0
+   - OpenSSL license   : https://www.openssl.org/source/license.html
+   - Apache 2.0        : http://www.apache.org/licenses/LICENSE-2.0
+
+   More information about the BLAKE2 hash function can be found at
+   https://blake2.net.
+*/
+#ifndef BLAKE2_H
+#define BLAKE2_H
+
+#include <stddef.h>
+#include <stdint.h>
+
+#if defined(_MSC_VER)
+#define BLAKE2_PACKED(x) __pragma(pack(push, 1)) x __pragma(pack(pop))
+#else
+#define BLAKE2_PACKED(x) x __attribute__((packed))
+#endif
+
+#if defined(__cplusplus)
+extern "C" {
+#endif
+
+  enum blake2s_constant
+  {
+    BLAKE2S_BLOCKBYTES = 64,
+    BLAKE2S_OUTBYTES   = 32,
+    BLAKE2S_KEYBYTES   = 32,
+    BLAKE2S_SALTBYTES  = 8,
+    BLAKE2S_PERSONALBYTES = 8
+  };
+
+  enum blake2b_constant
+  {
+    BLAKE2B_BLOCKBYTES = 128,
+    BLAKE2B_OUTBYTES   = 64,
+    BLAKE2B_KEYBYTES   = 64,
+    BLAKE2B_SALTBYTES  = 16,
+    BLAKE2B_PERSONALBYTES = 16
+  };
+
+  typedef struct blake2s_state__
+  {
+    uint32_t h[8];
+    uint32_t t[2];
+    uint32_t f[2];
+    uint8_t  buf[BLAKE2S_BLOCKBYTES];
+    size_t   buflen;
+    size_t   outlen;
+    uint8_t  last_node;
+  } blake2s_state;
+
+  typedef struct blake2b_state__
+  {
+    uint64_t h[8];
+    uint64_t t[2];
+    uint64_t f[2];
+    uint8_t  buf[BLAKE2B_BLOCKBYTES];
+    size_t   buflen;
+    size_t   outlen;
+    uint8_t  last_node;
+  } blake2b_state;
+
+  typedef struct blake2sp_state__
+  {
+    blake2s_state S[8][1];
+    blake2s_state R[1];
+    uint8_t       buf[8 * BLAKE2S_BLOCKBYTES];
+    size_t        buflen;
+    size_t        outlen;
+  } blake2sp_state;
+
+  typedef struct blake2bp_state__
+  {
+    blake2b_state S[4][1];
+    blake2b_state R[1];
+    uint8_t       buf[4 * BLAKE2B_BLOCKBYTES];
+    size_t        buflen;
+    size_t        outlen;
+  } blake2bp_state;
+
+
+  BLAKE2_PACKED(struct blake2s_param__
+  {
+    uint8_t  digest_length; /* 1 */
+    uint8_t  key_length;    /* 2 */
+    uint8_t  fanout;        /* 3 */
+    uint8_t  depth;         /* 4 */
+    uint32_t leaf_length;   /* 8 */
+    uint32_t node_offset;  /* 12 */
+    uint16_t xof_length;    /* 14 */
+    uint8_t  node_depth;    /* 15 */
+    uint8_t  inner_length;  /* 16 */
+    /* uint8_t  reserved[0]; */
+    uint8_t  salt[BLAKE2S_SALTBYTES]; /* 24 */
+    uint8_t  personal[BLAKE2S_PERSONALBYTES];  /* 32 */
+  });
+
+  typedef struct blake2s_param__ blake2s_param;
+
+  BLAKE2_PACKED(struct blake2b_param__
+  {
+    uint8_t  digest_length; /* 1 */
+    uint8_t  key_length;    /* 2 */
+    uint8_t  fanout;        /* 3 */
+    uint8_t  depth;         /* 4 */
+    uint32_t leaf_length;   /* 8 */
+    uint32_t node_offset;   /* 12 */
+    uint32_t xof_length;    /* 16 */
+    uint8_t  node_depth;    /* 17 */
+    uint8_t  inner_length;  /* 18 */
+    uint8_t  reserved[14];  /* 32 */
+    uint8_t  salt[BLAKE2B_SALTBYTES]; /* 48 */
+    uint8_t  personal[BLAKE2B_PERSONALBYTES];  /* 64 */
+  });
+
+  typedef struct blake2b_param__ blake2b_param;
+
+  typedef struct blake2xs_state__
+  {
+    blake2s_state S[1];
+    blake2s_param P[1];
+  } blake2xs_state;
+
+  typedef struct blake2xb_state__
+  {
+    blake2b_state S[1];
+    blake2b_param P[1];
+  } blake2xb_state;
+
+  /* Padded structs result in a compile-time error */
+  enum {
+    BLAKE2_DUMMY_1 = 1/(sizeof(blake2s_param) == BLAKE2S_OUTBYTES),
+    BLAKE2_DUMMY_2 = 1/(sizeof(blake2b_param) == BLAKE2B_OUTBYTES)
+  };
+
+  /* Streaming API */
+  int blake2s_init( blake2s_state *S, size_t outlen );
+  int blake2s_init_key( blake2s_state *S, size_t outlen, const void *key, size_t keylen );
+  int blake2s_init_param( blake2s_state *S, const blake2s_param *P );
+  int blake2s_update( blake2s_state *S, const void *in, size_t inlen );
+  int blake2s_final( blake2s_state *S, void *out, size_t outlen );
+
+  int blake2b_init( blake2b_state *S, size_t outlen );
+  int blake2b_init_key( blake2b_state *S, size_t outlen, const void *key, size_t keylen );
+  int blake2b_init_param( blake2b_state *S, const blake2b_param *P );
+  int blake2b_update( blake2b_state *S, const void *in, size_t inlen );
+  int blake2b_final( blake2b_state *S, void *out, size_t outlen );
+
+  int blake2sp_init( blake2sp_state *S, size_t outlen );
+  int blake2sp_init_key( blake2sp_state *S, size_t outlen, const void *key, size_t keylen );
+  int blake2sp_update( blake2sp_state *S, const void *in, size_t inlen );
+  int blake2sp_final( blake2sp_state *S, void *out, size_t outlen );
+
+  int blake2bp_init( blake2bp_state *S, size_t outlen );
+  int blake2bp_init_key( blake2bp_state *S, size_t outlen, const void *key, size_t keylen );
+  int blake2bp_update( blake2bp_state *S, const void *in, size_t inlen );
+  int blake2bp_final( blake2bp_state *S, void *out, size_t outlen );
+
+  /* Variable output length API */
+  int blake2xs_init( blake2xs_state *S, const size_t outlen );
+  int blake2xs_init_key( blake2xs_state *S, const size_t outlen, const void *key, size_t keylen );
+  int blake2xs_update( blake2xs_state *S, const void *in, size_t inlen );
+  int blake2xs_final(blake2xs_state *S, void *out, size_t outlen);
+
+  int blake2xb_init( blake2xb_state *S, const size_t outlen );
+  int blake2xb_init_key( blake2xb_state *S, const size_t outlen, const void *key, size_t keylen );
+  int blake2xb_update( blake2xb_state *S, const void *in, size_t inlen );
+  int blake2xb_final(blake2xb_state *S, void *out, size_t outlen);
+
+  /* Simple API */
+  int blake2s( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+  int blake2b( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+
+  int blake2sp( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+  int blake2bp( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+
+  int blake2xs( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+  int blake2xb( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+
+  /* This is simply an alias for blake2b */
+  int blake2( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen );
+
+#if defined(__cplusplus)
+}
+#endif
+
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.ml b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.ml
new file mode 100644
index 000000000..56dba1f21
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.ml
@@ -0,0 +1,87 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+module Blake2b = struct
+  type t = Bigstring.t
+
+  external sizeof_state : unit -> int =
+    "sizeof_blake2b_state" [@@noalloc]
+
+  let bytes = sizeof_state ()
+
+  external init : Bigstring.t -> int -> int =
+    "ml_blake2b_init" [@@noalloc]
+
+  external outlen : Bigstring.t -> int =
+    "blake2b_state_outlen" [@@noalloc]
+
+  let outlen t = outlen t
+
+  external init_key : Bigstring.t -> int -> Bigstring.t -> int =
+    "ml_blake2b_init_key" [@@noalloc]
+
+  external update : Bigstring.t -> Bigstring.t -> int =
+    "ml_blake2b_update" [@@noalloc]
+
+  external final : Bigstring.t -> Bigstring.t -> int =
+    "ml_blake2b_final" [@@noalloc]
+
+  external direct :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> int =
+    "ml_blake2b" [@@noalloc]
+
+  let or_fail ~msg f =
+    match f () with
+    | 0 -> ()
+    | _ -> failwith msg
+
+  let init ?key size =
+    if size < 1 || size > 64 then
+      invalid_arg "Blake2b.init: size must be between 1 and 64" ;
+    let t = Bigstring.create bytes in
+    begin match key with
+      | Some key ->
+          or_fail ~msg:"Blake2b.init"
+            (fun () -> init_key t size key)
+      | None ->
+          or_fail ~msg:"Blake2b.init"
+            (fun () -> init t size)
+    end ;
+    t
+
+  let update t buf =
+    or_fail ~msg:"Blake2b.update" (fun () -> update t buf)
+
+  type hash = Hash of Bigstring.t
+
+  let final t =
+    let len = outlen t in
+    let buf = Bigstring.create len in
+    or_fail ~msg:"Blake2b.final" (fun () -> final t buf) ;
+    Hash buf
+
+  let direct ?(key=Bigstring.create 0) inbuf len =
+    if len < 1 || len > 64 then
+      invalid_arg "Blake2b.direct: size must be between 1 and 64" ;
+    let outbuf = Bigstring.create len in
+    or_fail ~msg:"Blake2b.direct" (fun () -> direct outbuf inbuf key) ;
+    Hash outbuf
+end
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.mli b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.mli
new file mode 100644
index 000000000..7c47e8b19
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2.mli
@@ -0,0 +1,40 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+module Blake2b : sig
+  type t
+  type hash = Hash of Bigstring.t
+
+  val init : ?key:Bigstring.t -> int -> t
+  (** [init ?key size] is a blake2b context for hashes of size [size],
+      using [key] if present. *)
+
+  val update : t -> Bigstring.t -> unit
+  (** [update t buf] updates [t] with the data in [buf]. *)
+
+  val final : t -> hash
+  (** [final t] is the blake2b hash of all data updated in [t] so
+      far. *)
+
+  val direct : ?key:Bigstring.t -> Bigstring.t -> int -> hash
+  (** [direct ?key inbuf len] is the blake2b hash of length [len],
+      using [key] is present. *)
+end
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2b-ref.c b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2b-ref.c
new file mode 100644
index 000000000..32fbacb0e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/blake2b-ref.c
@@ -0,0 +1,423 @@
+/*
+   BLAKE2 reference source code package - reference C implementations
+
+   Copyright 2012, Samuel Neves <sneves@dei.uc.pt>.  You may use this under the
+   terms of the CC0, the OpenSSL Licence, or the Apache Public License 2.0, at
+   your option.  The terms of these licenses can be found at:
+
+   - CC0 1.0 Universal : http://creativecommons.org/publicdomain/zero/1.0
+   - OpenSSL license   : https://www.openssl.org/source/license.html
+   - Apache 2.0        : http://www.apache.org/licenses/LICENSE-2.0
+
+   More information about the BLAKE2 hash function can be found at
+   https://blake2.net.
+*/
+
+#include <stdint.h>
+#include <string.h>
+#include <stdio.h>
+
+#include "blake2.h"
+#include "blake2-impl.h"
+
+static const uint64_t blake2b_IV[8] =
+{
+  0x6a09e667f3bcc908ULL, 0xbb67ae8584caa73bULL,
+  0x3c6ef372fe94f82bULL, 0xa54ff53a5f1d36f1ULL,
+  0x510e527fade682d1ULL, 0x9b05688c2b3e6c1fULL,
+  0x1f83d9abfb41bd6bULL, 0x5be0cd19137e2179ULL
+};
+
+static const uint8_t blake2b_sigma[12][16] =
+{
+  {  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15 } ,
+  { 14, 10,  4,  8,  9, 15, 13,  6,  1, 12,  0,  2, 11,  7,  5,  3 } ,
+  { 11,  8, 12,  0,  5,  2, 15, 13, 10, 14,  3,  6,  7,  1,  9,  4 } ,
+  {  7,  9,  3,  1, 13, 12, 11, 14,  2,  6,  5, 10,  4,  0, 15,  8 } ,
+  {  9,  0,  5,  7,  2,  4, 10, 15, 14,  1, 11, 12,  6,  8,  3, 13 } ,
+  {  2, 12,  6, 10,  0, 11,  8,  3,  4, 13,  7,  5, 15, 14,  1,  9 } ,
+  { 12,  5,  1, 15, 14, 13,  4, 10,  0,  7,  6,  3,  9,  2,  8, 11 } ,
+  { 13, 11,  7, 14, 12,  1,  3,  9,  5,  0, 15,  4,  8,  6,  2, 10 } ,
+  {  6, 15, 14,  9, 11,  3,  0,  8, 12,  2, 13,  7,  1,  4, 10,  5 } ,
+  { 10,  2,  8,  4,  7,  6,  1,  5, 15, 11,  9, 14,  3, 12, 13 , 0 } ,
+  {  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15 } ,
+  { 14, 10,  4,  8,  9, 15, 13,  6,  1, 12,  0,  2, 11,  7,  5,  3 }
+};
+
+
+static void blake2b_set_lastnode( blake2b_state *S )
+{
+  S->f[1] = (uint64_t)-1;
+}
+
+/* Some helper functions, not necessarily useful */
+static int blake2b_is_lastblock( const blake2b_state *S )
+{
+  return S->f[0] != 0;
+}
+
+static void blake2b_set_lastblock( blake2b_state *S )
+{
+  if( S->last_node ) blake2b_set_lastnode( S );
+
+  S->f[0] = (uint64_t)-1;
+}
+
+static void blake2b_increment_counter( blake2b_state *S, const uint64_t inc )
+{
+  S->t[0] += inc;
+  S->t[1] += ( S->t[0] < inc );
+}
+
+static void blake2b_init0( blake2b_state *S )
+{
+  size_t i;
+  memset( S, 0, sizeof( blake2b_state ) );
+
+  for( i = 0; i < 8; ++i ) S->h[i] = blake2b_IV[i];
+}
+
+/* init xors IV with input parameter block */
+int blake2b_init_param( blake2b_state *S, const blake2b_param *P )
+{
+  const uint8_t *p = ( const uint8_t * )( P );
+  size_t i;
+
+  blake2b_init0( S );
+
+  /* IV XOR ParamBlock */
+  for( i = 0; i < 8; ++i )
+    S->h[i] ^= load64( p + sizeof( S->h[i] ) * i );
+
+  S->outlen = P->digest_length;
+  return 0;
+}
+
+
+
+int blake2b_init( blake2b_state *S, size_t outlen )
+{
+  blake2b_param P[1];
+
+  if ( ( !outlen ) || ( outlen > BLAKE2B_OUTBYTES ) ) return -1;
+
+  P->digest_length = (uint8_t)outlen;
+  P->key_length    = 0;
+  P->fanout        = 1;
+  P->depth         = 1;
+  store32( &P->leaf_length, 0 );
+  store32( &P->node_offset, 0 );
+  store32( &P->xof_length, 0 );
+  P->node_depth    = 0;
+  P->inner_length  = 0;
+  memset( P->reserved, 0, sizeof( P->reserved ) );
+  memset( P->salt,     0, sizeof( P->salt ) );
+  memset( P->personal, 0, sizeof( P->personal ) );
+  return blake2b_init_param( S, P );
+}
+
+
+int blake2b_init_key( blake2b_state *S, size_t outlen, const void *key, size_t keylen )
+{
+  blake2b_param P[1];
+
+  if ( ( !outlen ) || ( outlen > BLAKE2B_OUTBYTES ) ) return -1;
+
+  if ( !key || !keylen || keylen > BLAKE2B_KEYBYTES ) return -1;
+
+  P->digest_length = (uint8_t)outlen;
+  P->key_length    = (uint8_t)keylen;
+  P->fanout        = 1;
+  P->depth         = 1;
+  store32( &P->leaf_length, 0 );
+  store32( &P->node_offset, 0 );
+  store32( &P->xof_length, 0 );
+  P->node_depth    = 0;
+  P->inner_length  = 0;
+  memset( P->reserved, 0, sizeof( P->reserved ) );
+  memset( P->salt,     0, sizeof( P->salt ) );
+  memset( P->personal, 0, sizeof( P->personal ) );
+
+  if( blake2b_init_param( S, P ) < 0 ) return -1;
+
+  {
+    uint8_t block[BLAKE2B_BLOCKBYTES];
+    memset( block, 0, BLAKE2B_BLOCKBYTES );
+    memcpy( block, key, keylen );
+    blake2b_update( S, block, BLAKE2B_BLOCKBYTES );
+    secure_zero_memory( block, BLAKE2B_BLOCKBYTES ); /* Burn the key from stack */
+  }
+  return 0;
+}
+
+#define G(r,i,a,b,c,d)                      \
+  do {                                      \
+    a = a + b + m[blake2b_sigma[r][2*i+0]]; \
+    d = rotr64(d ^ a, 32);                  \
+    c = c + d;                              \
+    b = rotr64(b ^ c, 24);                  \
+    a = a + b + m[blake2b_sigma[r][2*i+1]]; \
+    d = rotr64(d ^ a, 16);                  \
+    c = c + d;                              \
+    b = rotr64(b ^ c, 63);                  \
+  } while(0)
+
+#define ROUND(r)                    \
+  do {                              \
+    G(r,0,v[ 0],v[ 4],v[ 8],v[12]); \
+    G(r,1,v[ 1],v[ 5],v[ 9],v[13]); \
+    G(r,2,v[ 2],v[ 6],v[10],v[14]); \
+    G(r,3,v[ 3],v[ 7],v[11],v[15]); \
+    G(r,4,v[ 0],v[ 5],v[10],v[15]); \
+    G(r,5,v[ 1],v[ 6],v[11],v[12]); \
+    G(r,6,v[ 2],v[ 7],v[ 8],v[13]); \
+    G(r,7,v[ 3],v[ 4],v[ 9],v[14]); \
+  } while(0)
+
+static void blake2b_compress( blake2b_state *S, const uint8_t block[BLAKE2B_BLOCKBYTES] )
+{
+  uint64_t m[16];
+  uint64_t v[16];
+  size_t i;
+
+  for( i = 0; i < 16; ++i ) {
+    m[i] = load64( block + i * sizeof( m[i] ) );
+  }
+
+  for( i = 0; i < 8; ++i ) {
+    v[i] = S->h[i];
+  }
+
+  v[ 8] = blake2b_IV[0];
+  v[ 9] = blake2b_IV[1];
+  v[10] = blake2b_IV[2];
+  v[11] = blake2b_IV[3];
+  v[12] = blake2b_IV[4] ^ S->t[0];
+  v[13] = blake2b_IV[5] ^ S->t[1];
+  v[14] = blake2b_IV[6] ^ S->f[0];
+  v[15] = blake2b_IV[7] ^ S->f[1];
+
+  ROUND( 0 );
+  ROUND( 1 );
+  ROUND( 2 );
+  ROUND( 3 );
+  ROUND( 4 );
+  ROUND( 5 );
+  ROUND( 6 );
+  ROUND( 7 );
+  ROUND( 8 );
+  ROUND( 9 );
+  ROUND( 10 );
+  ROUND( 11 );
+
+  for( i = 0; i < 8; ++i ) {
+    S->h[i] = S->h[i] ^ v[i] ^ v[i + 8];
+  }
+}
+
+#undef G
+#undef ROUND
+
+int blake2b_update( blake2b_state *S, const void *pin, size_t inlen )
+{
+  const unsigned char * in = (const unsigned char *)pin;
+  if( inlen > 0 )
+  {
+    size_t left = S->buflen;
+    size_t fill = BLAKE2B_BLOCKBYTES - left;
+    if( inlen > fill )
+    {
+      S->buflen = 0;
+      memcpy( S->buf + left, in, fill ); /* Fill buffer */
+      blake2b_increment_counter( S, BLAKE2B_BLOCKBYTES );
+      blake2b_compress( S, S->buf ); /* Compress */
+      in += fill; inlen -= fill;
+      while(inlen > BLAKE2B_BLOCKBYTES) {
+        blake2b_increment_counter(S, BLAKE2B_BLOCKBYTES);
+        blake2b_compress( S, in );
+        in += BLAKE2B_BLOCKBYTES;
+        inlen -= BLAKE2B_BLOCKBYTES;
+      }
+    }
+    memcpy( S->buf + S->buflen, in, inlen );
+    S->buflen += inlen;
+  }
+  return 0;
+}
+
+int blake2b_final( blake2b_state *S, void *out, size_t outlen )
+{
+  uint8_t buffer[BLAKE2B_OUTBYTES] = {0};
+  size_t i;
+
+  if( out == NULL || outlen < S->outlen )
+    return -1;
+
+  if( blake2b_is_lastblock( S ) )
+    return -1;
+
+  blake2b_increment_counter( S, S->buflen );
+  blake2b_set_lastblock( S );
+  memset( S->buf + S->buflen, 0, BLAKE2B_BLOCKBYTES - S->buflen ); /* Padding */
+  blake2b_compress( S, S->buf );
+
+  for( i = 0; i < 8; ++i ) /* Output full hash to temp buffer */
+    store64( buffer + sizeof( S->h[i] ) * i, S->h[i] );
+
+  memcpy( out, buffer, S->outlen );
+  secure_zero_memory(buffer, sizeof(buffer));
+  return 0;
+}
+
+/* inlen, at least, should be uint64_t. Others can be size_t. */
+int blake2b( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen )
+{
+  blake2b_state S[1];
+
+  /* Verify parameters */
+  if ( NULL == in && inlen > 0 ) return -1;
+
+  if ( NULL == out ) return -1;
+
+  if( NULL == key && keylen > 0 ) return -1;
+
+  if( !outlen || outlen > BLAKE2B_OUTBYTES ) return -1;
+
+  if( keylen > BLAKE2B_KEYBYTES ) return -1;
+
+  if( keylen > 0 )
+  {
+    if( blake2b_init_key( S, outlen, key, keylen ) < 0 ) return -1;
+  }
+  else
+  {
+    if( blake2b_init( S, outlen ) < 0 ) return -1;
+  }
+
+  blake2b_update( S, ( const uint8_t * )in, inlen );
+  blake2b_final( S, out, outlen );
+  return 0;
+}
+
+int blake2( void *out, size_t outlen, const void *in, size_t inlen, const void *key, size_t keylen ) {
+  return blake2b(out, outlen, in, inlen, key, keylen);
+}
+
+#if defined(SUPERCOP)
+int crypto_hash( unsigned char *out, unsigned char *in, unsigned long long inlen )
+{
+  return blake2b( out, BLAKE2B_OUTBYTES, in, inlen, NULL, 0 );
+}
+#endif
+
+#if defined(BLAKE2B_SELFTEST)
+#include <string.h>
+#include "blake2-kat.h"
+int main( void )
+{
+  uint8_t key[BLAKE2B_KEYBYTES];
+  uint8_t buf[BLAKE2_KAT_LENGTH];
+  size_t i, step;
+
+  for( i = 0; i < BLAKE2B_KEYBYTES; ++i )
+    key[i] = ( uint8_t )i;
+
+  for( i = 0; i < BLAKE2_KAT_LENGTH; ++i )
+    buf[i] = ( uint8_t )i;
+
+  /* Test simple API */
+  for( i = 0; i < BLAKE2_KAT_LENGTH; ++i )
+  {
+    uint8_t hash[BLAKE2B_OUTBYTES];
+    blake2b( hash, BLAKE2B_OUTBYTES, buf, i, key, BLAKE2B_KEYBYTES );
+
+    if( 0 != memcmp( hash, blake2b_keyed_kat[i], BLAKE2B_OUTBYTES ) )
+    {
+      goto fail;
+    }
+  }
+
+  /* Test streaming API */
+  for(step = 1; step < BLAKE2B_BLOCKBYTES; ++step) {
+    for (i = 0; i < BLAKE2_KAT_LENGTH; ++i) {
+      uint8_t hash[BLAKE2B_OUTBYTES];
+      blake2b_state S;
+      uint8_t * p = buf;
+      size_t mlen = i;
+      int err = 0;
+
+      if( (err = blake2b_init_key(&S, BLAKE2B_OUTBYTES, key, BLAKE2B_KEYBYTES)) < 0 ) {
+        goto fail;
+      }
+
+      while (mlen >= step) {
+        if ( (err = blake2b_update(&S, p, step)) < 0 ) {
+          goto fail;
+        }
+        mlen -= step;
+        p += step;
+      }
+      if ( (err = blake2b_update(&S, p, mlen)) < 0) {
+        goto fail;
+      }
+      if ( (err = blake2b_final(&S, hash, BLAKE2B_OUTBYTES)) < 0) {
+        goto fail;
+      }
+
+      if (0 != memcmp(hash, blake2b_keyed_kat[i], BLAKE2B_OUTBYTES)) {
+        goto fail;
+      }
+    }
+  }
+
+  puts( "ok" );
+  return 0;
+fail:
+  puts("error");
+  return -1;
+}
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+CAMLprim value sizeof_blake2b_state(value unit) {
+    return Val_int(sizeof(blake2b_state));
+}
+
+CAMLprim value blake2b_state_outlen(value S) {
+    blake2b_state *s = Caml_ba_data_val(S);
+    return Val_int(s->outlen);
+}
+
+CAMLprim value ml_blake2b_init(value S, value outlen) {
+    return Val_int(blake2b_init(Caml_ba_data_val(S), Int_val(outlen)));
+}
+
+CAMLprim value ml_blake2b_init_key(value S, value outlen, value key) {
+    return Val_int(blake2b_init_key(Caml_ba_data_val(S),
+                                    Int_val(outlen),
+                                    Caml_ba_data_val(key),
+                                    Caml_ba_array_val(key)->dim[0]));
+}
+
+CAMLprim value ml_blake2b_update(value S, value in) {
+    return Val_int(blake2b_update(Caml_ba_data_val(S),
+                                  Caml_ba_data_val(in),
+                                  Caml_ba_array_val(in)->dim[0]));
+}
+
+CAMLprim value ml_blake2b_final(value S, value out) {
+    return Val_int(blake2b_final(Caml_ba_data_val(S),
+                                 Caml_ba_data_val(out),
+                                 Caml_ba_array_val(out)->dim[0]));
+}
+
+CAMLprim value ml_blake2b(value out, value in, value key) {
+    return Val_int(blake2b(Caml_ba_data_val(out),
+                           Caml_ba_array_val(out)->dim[0],
+                           Caml_ba_data_val(in),
+                           Caml_ba_array_val(in)->dim[0],
+                           Caml_ba_data_val(key),
+                           Caml_ba_array_val(key)->dim[0]));
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/src/dune b/vendors/tezos-modded/vendors/ocaml-blake2/src/dune
new file mode 100644
index 000000000..8151c2fa4
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/src/dune
@@ -0,0 +1,6 @@
+(library
+ (name            blake2)
+ (public_name     blake2)
+ (libraries       bigstring)
+ (c_names         blake2b-ref)
+ (c_flags         (-O3)))
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/test/dune b/vendors/tezos-modded/vendors/ocaml-blake2/test/dune
new file mode 100644
index 000000000..e31a08db2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/test/dune
@@ -0,0 +1,11 @@
+(executable
+ (name test)
+ (libraries blake2 hex alcotest))
+
+(alias
+ (name    runtest-blake2)
+ (action  (run %{exe:test.exe})))
+
+(alias
+ (name    runtest)
+ (deps    (alias runtest-blake2)))
diff --git a/vendors/tezos-modded/vendors/ocaml-blake2/test/test.ml b/vendors/tezos-modded/vendors/ocaml-blake2/test/test.ml
new file mode 100644
index 000000000..6c715520e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-blake2/test/test.ml
@@ -0,0 +1,55 @@
+
+open Blake2
+
+type vector = {
+  data_in : Bigstring.t list ;
+  data_key : Bigstring.t option ;
+  data_out : Bigstring.t ;
+}
+
+let hex s =
+  Cstruct.to_bigarray (Hex.to_cstruct (`Hex s))
+
+let vectors = [
+  { data_in = [ hex "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f" ] ;
+    data_key = None ;
+    data_out = hex "1c077e279de6548523502b6df800ffdab5e2c3e9442eb838f58c295f3b147cef9d701c41c321283f00c71affa0619310399126295b78dd4d1a74572ef9ed5135" ;
+  } ;
+  { data_in = [ hex "000102030405060708090a0b0c0d0e0f101112131415" ; hex "161718"; hex "191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f" ] ;
+    data_key = None ;
+    data_out = hex "1c077e279de6548523502b6df800ffdab5e2c3e9442eb838f58c295f3b147cef9d701c41c321283f00c71affa0619310399126295b78dd4d1a74572ef9ed5135" ;
+  } ;
+  { data_in = [ hex "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3" ] ;
+    data_key = Some (hex "000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f") ;
+    data_out = hex "b39614268fdd8781515e2cfebf89b4d5402bab10c226e6344e6b9ae000fb0d6c79cb2f3ec80e80eaeb1980d2f8698916bd2e9f747236655116649cd3ca23a837" ;
+  } ;
+]
+
+let test_update { data_in ; data_key ; data_out } =
+  let d = Blake2b.init ?key:data_key (Bigstring.length data_out) in
+  List.iter (Blake2b.update d) data_in ;
+  let Blake2b.Hash h = Blake2b.final d in
+  assert Bigstring.(equal data_out h)
+
+let test_direct { data_in ; data_key ; data_out } =
+  let Blake2b.Hash h =
+    Blake2b.direct ?key:data_key
+      (Bigstring.concat "" data_in) (Bigstring.length data_out) in
+  assert Bigstring.(equal data_out h)
+
+let update_tests =
+  List.mapi
+    (fun i v -> string_of_int i, `Quick, fun () -> test_update v)
+    vectors
+
+let direct_tests =
+  List.mapi
+    (fun i v -> string_of_int i, `Quick, fun () -> test_direct v)
+    vectors
+
+let () =
+  Alcotest.run "blake2b" [
+    "update", update_tests ;
+    "direct", direct_tests ;
+  ]
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/hacl.opam b/vendors/tezos-modded/vendors/ocaml-hacl/hacl.opam
new file mode 100644
index 000000000..33d63d480
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/hacl.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+name: "hacl"
+authors: [ "Vincent Bernardoff <vb@luminar.eu.org>" "Marco Stronati <marco@stronati.org>" ]
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+synopsis: "Tezos binding for Hacl*"
+homepage: "https://gitlab.com/tezos/tezos"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "git+https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "bigstring" {>= "0.1.1"}
+  "ocplib-endian" {>= "1.0"}
+  "zarith" {>= "1.7"}
+  "alcotest" {with-test & >= "0.8.1"}
+  "hex" {with-test & >= "1.2.0"}
+  "base"
+  "stdio"
+]
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/readme.md b/vendors/tezos-modded/vendors/ocaml-hacl/readme.md
new file mode 100644
index 000000000..cb1cd5db0
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/readme.md
@@ -0,0 +1,3 @@
+Tezos binding for Hacl*
+https://github.com/mitls/hacl-star/tree/master/snapshots/tezos
+commit b69319a0d3b71af8042f487d6a5bac8101edf2d0
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.c
new file mode 100644
index 000000000..9ef06502b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.c
@@ -0,0 +1,461 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "AEAD_Poly1305_64.h"
+
+inline static void Hacl_Bignum_Modulo_reduce(uint64_t *b)
+{
+  uint64_t b0 = b[0U];
+  b[0U] = (b0 << (uint32_t)4U) + (b0 << (uint32_t)2U);
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top(uint64_t *b)
+{
+  uint64_t b2 = b[2U];
+  uint64_t b0 = b[0U];
+  uint64_t b2_42 = b2 >> (uint32_t)42U;
+  b[2U] = b2 & (uint64_t)0x3ffffffffffU;
+  b[0U] = (b2_42 << (uint32_t)2U) + b2_42 + b0;
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top_wide(FStar_UInt128_t *b)
+{
+  FStar_UInt128_t b2 = b[2U];
+  FStar_UInt128_t b0 = b[0U];
+  FStar_UInt128_t
+  b2_ = FStar_UInt128_logand(b2, FStar_UInt128_uint64_to_uint128((uint64_t)0x3ffffffffffU));
+  uint64_t b2_42 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b2, (uint32_t)42U));
+  FStar_UInt128_t
+  b0_ = FStar_UInt128_add(b0, FStar_UInt128_uint64_to_uint128((b2_42 << (uint32_t)2U) + b2_42));
+  b[2U] = b2_;
+  b[0U] = b0_;
+}
+
+inline static void
+Hacl_Bignum_Fproduct_copy_from_wide_(uint64_t *output, FStar_UInt128_t *input)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    FStar_UInt128_t xi = input[i];
+    output[i] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+}
+
+inline static void
+Hacl_Bignum_Fproduct_sum_scalar_multiplication_(
+  FStar_UInt128_t *output,
+  uint64_t *input,
+  uint64_t s
+)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    FStar_UInt128_t xi = output[i];
+    uint64_t yi = input[i];
+    output[i] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_wide_(FStar_UInt128_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0xfffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)44U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_limb_(uint64_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    uint64_t tctr = tmp[ctr];
+    uint64_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = tctr & (uint64_t)0xfffffffffffU;
+    uint64_t c = tctr >> (uint32_t)44U;
+    tmp[ctr] = r0;
+    tmp[ctr + (uint32_t)1U] = tctrp1 + c;
+  }
+}
+
+inline static void Hacl_Bignum_Fmul_shift_reduce(uint64_t *output)
+{
+  uint64_t tmp = output[2U];
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = (uint32_t)3U - i - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  output[0U] = tmp;
+  Hacl_Bignum_Modulo_reduce(output);
+}
+
+static void
+Hacl_Bignum_Fmul_mul_shift_reduce_(FStar_UInt128_t *output, uint64_t *input, uint64_t *input2)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint64_t input2i = input2[i];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  uint32_t i = (uint32_t)2U;
+  uint64_t input2i = input2[i];
+  Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+}
+
+inline static void Hacl_Bignum_Fmul_fmul(uint64_t *output, uint64_t *input, uint64_t *input2)
+{
+  uint64_t tmp[3U] = { 0U };
+  memcpy(tmp, input, (uint32_t)3U * sizeof input[0U]);
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)3U);
+  FStar_UInt128_t t[3U];
+  for (uint32_t _i = 0U; _i < (uint32_t)3U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fmul_mul_shift_reduce_(t, tmp, input2);
+  Hacl_Bignum_Fproduct_carry_wide_(t);
+  Hacl_Bignum_Modulo_carry_top_wide(t);
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, t);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0xfffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)44U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+inline static void
+Hacl_Bignum_AddAndMultiply_add_and_multiply(uint64_t *acc, uint64_t *block, uint64_t *r)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = acc[i];
+    uint64_t yi = block[i];
+    acc[i] = xi + yi;
+  }
+  Hacl_Bignum_Fmul_fmul(acc, acc, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_update(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m
+)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  uint64_t *r3 = r;
+  uint64_t tmp[3U] = { 0U };
+  FStar_UInt128_t m0 = load128_le(m);
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(m0) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)88U));
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  uint64_t b2 = tmp[2U];
+  uint64_t b2_ = (uint64_t)0x10000000000U | b2;
+  tmp[2U] = b2_;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(acc, tmp, r3);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_process_last_block_(
+  uint8_t *block,
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint64_t tmp[3U] = { 0U };
+  FStar_UInt128_t m0 = load128_le(block);
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(m0) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)88U));
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(h, tmp, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_process_last_block(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint8_t zero1 = (uint8_t)0U;
+  KRML_CHECK_SIZE(zero1, (uint32_t)16U);
+  uint8_t block[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    block[_i] = zero1;
+  uint32_t i0 = (uint32_t)rem_;
+  uint32_t i = (uint32_t)rem_;
+  memcpy(block, m, i * sizeof m[0U]);
+  block[i0] = (uint8_t)1U;
+  Hacl_Impl_Poly1305_64_poly1305_process_last_block_(block, st, m, rem_);
+}
+
+static void Hacl_Impl_Poly1305_64_poly1305_last_pass(uint64_t *acc)
+{
+  Hacl_Bignum_Fproduct_carry_limb_(acc);
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint64_t a0 = acc[0U];
+  uint64_t a10 = acc[1U];
+  uint64_t a20 = acc[2U];
+  uint64_t a0_ = a0 & (uint64_t)0xfffffffffffU;
+  uint64_t r0 = a0 >> (uint32_t)44U;
+  uint64_t a1_ = (a10 + r0) & (uint64_t)0xfffffffffffU;
+  uint64_t r1 = (a10 + r0) >> (uint32_t)44U;
+  uint64_t a2_ = a20 + r1;
+  acc[0U] = a0_;
+  acc[1U] = a1_;
+  acc[2U] = a2_;
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint64_t i0 = acc[0U];
+  uint64_t i1 = acc[1U];
+  uint64_t i0_ = i0 & (uint64_t)0xfffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)44U);
+  acc[0U] = i0_;
+  acc[1U] = i1_;
+  uint64_t a00 = acc[0U];
+  uint64_t a1 = acc[1U];
+  uint64_t a2 = acc[2U];
+  uint64_t mask0 = FStar_UInt64_gte_mask(a00, (uint64_t)0xffffffffffbU);
+  uint64_t mask1 = FStar_UInt64_eq_mask(a1, (uint64_t)0xfffffffffffU);
+  uint64_t mask2 = FStar_UInt64_eq_mask(a2, (uint64_t)0x3ffffffffffU);
+  uint64_t mask = (mask0 & mask1) & mask2;
+  uint64_t a0_0 = a00 - ((uint64_t)0xffffffffffbU & mask);
+  uint64_t a1_0 = a1 - ((uint64_t)0xfffffffffffU & mask);
+  uint64_t a2_0 = a2 - ((uint64_t)0x3ffffffffffU & mask);
+  acc[0U] = a0_0;
+  acc[1U] = a1_0;
+  acc[2U] = a2_0;
+}
+
+static Hacl_Impl_Poly1305_64_State_poly1305_state
+Hacl_Impl_Poly1305_64_mk_state(uint64_t *r, uint64_t *h)
+{
+  return ((Hacl_Impl_Poly1305_64_State_poly1305_state){ .r = r, .h = h });
+}
+
+static void
+Hacl_Standalone_Poly1305_64_poly1305_blocks(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t len1
+)
+{
+  if (!(len1 == (uint64_t)0U))
+  {
+    uint8_t *block = m;
+    uint8_t *tail1 = m + (uint32_t)16U;
+    Hacl_Impl_Poly1305_64_poly1305_update(st, block);
+    uint64_t len2 = len1 - (uint64_t)1U;
+    Hacl_Standalone_Poly1305_64_poly1305_blocks(st, tail1, len2);
+  }
+}
+
+static void
+Hacl_Standalone_Poly1305_64_poly1305_partial(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *kr
+)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  uint64_t *x0 = r;
+  FStar_UInt128_t k1 = load128_le(kr);
+  FStar_UInt128_t
+  k_clamped =
+    FStar_UInt128_logand(k1,
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0ffffffcU),
+          (uint32_t)64U),
+        FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0fffffffU)));
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(k_clamped) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)88U));
+  x0[0U] = r0;
+  x0[1U] = r1;
+  x0[2U] = r2;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  uint64_t *x00 = h;
+  x00[0U] = (uint64_t)0U;
+  x00[1U] = (uint64_t)0U;
+  x00[2U] = (uint64_t)0U;
+  Hacl_Standalone_Poly1305_64_poly1305_blocks(st, input, len1);
+}
+
+Prims_nat AEAD_Poly1305_64_seval(void *b)
+{
+  printf("KreMLin abort at %s:%d\n%s\n", __FILE__, __LINE__, "noextract flag");
+  exit(255U);
+}
+
+Prims_int AEAD_Poly1305_64_selem(void *s)
+{
+  printf("KreMLin abort at %s:%d\n%s\n", __FILE__, __LINE__, "noextract flag");
+  exit(255U);
+}
+
+Hacl_Impl_Poly1305_64_State_poly1305_state
+AEAD_Poly1305_64_mk_state(uint64_t *r, uint64_t *acc)
+{
+  return Hacl_Impl_Poly1305_64_mk_state(r, acc);
+}
+
+uint32_t AEAD_Poly1305_64_mul_div_16(uint32_t len1)
+{
+  return (uint32_t)16U * (len1 >> (uint32_t)4U);
+}
+
+void
+AEAD_Poly1305_64_pad_last(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint8_t b[16U];
+  if (!(len1 == (uint32_t)0U))
+  {
+    memset(b, 0U, (uint32_t)16U * sizeof b[0U]);
+    memcpy(b, input, len1 * sizeof input[0U]);
+    uint8_t *b0 = b;
+    Hacl_Impl_Poly1305_64_poly1305_update(st, b0);
+  }
+}
+
+void
+AEAD_Poly1305_64_poly1305_blocks_init(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1,
+  uint8_t *k1
+)
+{
+  uint32_t len_16 = len1 >> (uint32_t)4U;
+  uint32_t rem_16 = len1 & (uint32_t)15U;
+  uint8_t *kr = k1;
+  uint32_t len_ = (uint32_t)16U * (len1 >> (uint32_t)4U);
+  uint8_t *part_input = input;
+  uint8_t *last_block = input + len_;
+  Hacl_Standalone_Poly1305_64_poly1305_partial(st, part_input, (uint64_t)len_16, kr);
+  AEAD_Poly1305_64_pad_last(st, last_block, rem_16);
+}
+
+void
+AEAD_Poly1305_64_poly1305_blocks_continue(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint32_t len_16 = len1 >> (uint32_t)4U;
+  uint32_t rem_16 = len1 & (uint32_t)15U;
+  uint32_t len_ = (uint32_t)16U * (len1 >> (uint32_t)4U);
+  uint8_t *part_input = input;
+  uint8_t *last_block = input + len_;
+  Hacl_Standalone_Poly1305_64_poly1305_blocks(st, part_input, (uint64_t)len_16);
+  AEAD_Poly1305_64_pad_last(st, last_block, rem_16);
+}
+
+void
+AEAD_Poly1305_64_poly1305_blocks_finish_(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input
+)
+{
+  Hacl_Impl_Poly1305_64_poly1305_update(st, input);
+  uint8_t *x2 = input + (uint32_t)16U;
+  if (!((uint64_t)0U == (uint64_t)0U))
+    Hacl_Impl_Poly1305_64_poly1305_process_last_block(st, x2, (uint64_t)0U);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h = scrut.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_poly1305_last_pass(acc);
+}
+
+void
+AEAD_Poly1305_64_poly1305_blocks_finish(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint8_t *mac,
+  uint8_t *key_s
+)
+{
+  Hacl_Impl_Poly1305_64_poly1305_update(st, input);
+  uint8_t *x2 = input + (uint32_t)16U;
+  if (!((uint64_t)0U == (uint64_t)0U))
+    Hacl_Impl_Poly1305_64_poly1305_process_last_block(st, x2, (uint64_t)0U);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h = scrut.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_poly1305_last_pass(acc);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h3 = scrut0.h;
+  uint64_t *acc0 = h3;
+  FStar_UInt128_t k_ = load128_le(key_s);
+  uint64_t h0 = acc0[0U];
+  uint64_t h1 = acc0[1U];
+  uint64_t h2 = acc0[2U];
+  FStar_UInt128_t
+  acc_ =
+    FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128(h2
+          << (uint32_t)24U
+          | h1 >> (uint32_t)20U),
+        (uint32_t)64U),
+      FStar_UInt128_uint64_to_uint128(h1 << (uint32_t)44U | h0));
+  FStar_UInt128_t mac_ = FStar_UInt128_add_mod(acc_, k_);
+  store128_le(mac, mac_);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.h
new file mode 100644
index 000000000..bcc850dcf
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/AEAD_Poly1305_64.h
@@ -0,0 +1,123 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __AEAD_Poly1305_64_H
+#define __AEAD_Poly1305_64_H
+
+
+
+
+
+typedef uint64_t Hacl_Bignum_Constants_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Constants_wide;
+
+typedef FStar_UInt128_t Hacl_Bignum_Wide_t;
+
+typedef uint64_t Hacl_Bignum_Limb_t;
+
+typedef void *Hacl_Impl_Poly1305_64_State_log_t;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_State_bigint;
+
+typedef void *Hacl_Impl_Poly1305_64_State_seqelem;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_State_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_wordB_16;
+
+typedef struct 
+{
+  uint64_t *r;
+  uint64_t *h;
+}
+Hacl_Impl_Poly1305_64_State_poly1305_state;
+
+typedef void *Hacl_Impl_Poly1305_64_log_t;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_bigint;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_wordB_16;
+
+typedef uint8_t *AEAD_Poly1305_64_uint8_p;
+
+typedef uint8_t *AEAD_Poly1305_64_key;
+
+Prims_nat AEAD_Poly1305_64_seval(void *b);
+
+Prims_int AEAD_Poly1305_64_selem(void *s);
+
+typedef Hacl_Impl_Poly1305_64_State_poly1305_state AEAD_Poly1305_64_state;
+
+Hacl_Impl_Poly1305_64_State_poly1305_state
+AEAD_Poly1305_64_mk_state(uint64_t *r, uint64_t *acc);
+
+uint32_t AEAD_Poly1305_64_mul_div_16(uint32_t len1);
+
+void
+AEAD_Poly1305_64_pad_last(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1
+);
+
+void
+AEAD_Poly1305_64_poly1305_blocks_init(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1,
+  uint8_t *k1
+);
+
+void
+AEAD_Poly1305_64_poly1305_blocks_continue(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint32_t len1
+);
+
+void
+AEAD_Poly1305_64_poly1305_blocks_finish_(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input
+);
+
+void
+AEAD_Poly1305_64_poly1305_blocks_finish(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint8_t *mac,
+  uint8_t *key_s
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.c
new file mode 100644
index 000000000..8f2ff4b0c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.c
@@ -0,0 +1,281 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+/* This file was auto-generated by KreMLin! */
+
+#include "FStar.h"
+
+static uint64_t FStar_UInt128_constant_time_carry(uint64_t a, uint64_t b)
+{
+  return (a ^ ((a ^ b) | ((a - b) ^ b))) >> (uint32_t)63U;
+}
+
+static uint64_t FStar_UInt128_carry(uint64_t a, uint64_t b)
+{
+  return FStar_UInt128_constant_time_carry(a, b);
+}
+
+FStar_UInt128_uint128 FStar_UInt128_add(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = a.low + b.low,
+        .high = a.high + b.high + FStar_UInt128_carry(a.low + b.low, b.low)
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_add_mod(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = a.low + b.low,
+        .high = a.high + b.high + FStar_UInt128_carry(a.low + b.low, b.low)
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_sub(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = a.low - b.low,
+        .high = a.high - b.high - FStar_UInt128_carry(a.low, a.low - b.low)
+      }
+    );
+}
+
+static FStar_UInt128_uint128
+FStar_UInt128_sub_mod_impl(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = a.low - b.low,
+        .high = a.high - b.high - FStar_UInt128_carry(a.low, a.low - b.low)
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_sub_mod(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return FStar_UInt128_sub_mod_impl(a, b);
+}
+
+FStar_UInt128_uint128 FStar_UInt128_logand(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return ((FStar_UInt128_uint128){ .low = a.low & b.low, .high = a.high & b.high });
+}
+
+FStar_UInt128_uint128 FStar_UInt128_logxor(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return ((FStar_UInt128_uint128){ .low = a.low ^ b.low, .high = a.high ^ b.high });
+}
+
+FStar_UInt128_uint128 FStar_UInt128_logor(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return ((FStar_UInt128_uint128){ .low = a.low | b.low, .high = a.high | b.high });
+}
+
+FStar_UInt128_uint128 FStar_UInt128_lognot(FStar_UInt128_uint128 a)
+{
+  return ((FStar_UInt128_uint128){ .low = ~a.low, .high = ~a.high });
+}
+
+static uint32_t FStar_UInt128_u32_64 = (uint32_t)64U;
+
+static uint64_t FStar_UInt128_add_u64_shift_left(uint64_t hi, uint64_t lo, uint32_t s)
+{
+  return (hi << s) + (lo >> (FStar_UInt128_u32_64 - s));
+}
+
+static uint64_t FStar_UInt128_add_u64_shift_left_respec(uint64_t hi, uint64_t lo, uint32_t s)
+{
+  return FStar_UInt128_add_u64_shift_left(hi, lo, s);
+}
+
+static FStar_UInt128_uint128
+FStar_UInt128_shift_left_small(FStar_UInt128_uint128 a, uint32_t s)
+{
+  if (s == (uint32_t)0U)
+    return a;
+  else
+    return
+      (
+        (FStar_UInt128_uint128){
+          .low = a.low << s,
+          .high = FStar_UInt128_add_u64_shift_left_respec(a.high, a.low, s)
+        }
+      );
+}
+
+static FStar_UInt128_uint128
+FStar_UInt128_shift_left_large(FStar_UInt128_uint128 a, uint32_t s)
+{
+  return
+    ((FStar_UInt128_uint128){ .low = (uint64_t)0U, .high = a.low << (s - FStar_UInt128_u32_64) });
+}
+
+FStar_UInt128_uint128 FStar_UInt128_shift_left(FStar_UInt128_uint128 a, uint32_t s)
+{
+  if (s < FStar_UInt128_u32_64)
+    return FStar_UInt128_shift_left_small(a, s);
+  else
+    return FStar_UInt128_shift_left_large(a, s);
+}
+
+static uint64_t FStar_UInt128_add_u64_shift_right(uint64_t hi, uint64_t lo, uint32_t s)
+{
+  return (lo >> s) + (hi << (FStar_UInt128_u32_64 - s));
+}
+
+static uint64_t FStar_UInt128_add_u64_shift_right_respec(uint64_t hi, uint64_t lo, uint32_t s)
+{
+  return FStar_UInt128_add_u64_shift_right(hi, lo, s);
+}
+
+static FStar_UInt128_uint128
+FStar_UInt128_shift_right_small(FStar_UInt128_uint128 a, uint32_t s)
+{
+  if (s == (uint32_t)0U)
+    return a;
+  else
+    return
+      (
+        (FStar_UInt128_uint128){
+          .low = FStar_UInt128_add_u64_shift_right_respec(a.high, a.low, s),
+          .high = a.high >> s
+        }
+      );
+}
+
+static FStar_UInt128_uint128
+FStar_UInt128_shift_right_large(FStar_UInt128_uint128 a, uint32_t s)
+{
+  return
+    ((FStar_UInt128_uint128){ .low = a.high >> (s - FStar_UInt128_u32_64), .high = (uint64_t)0U });
+}
+
+FStar_UInt128_uint128 FStar_UInt128_shift_right(FStar_UInt128_uint128 a, uint32_t s)
+{
+  if (s < FStar_UInt128_u32_64)
+    return FStar_UInt128_shift_right_small(a, s);
+  else
+    return FStar_UInt128_shift_right_large(a, s);
+}
+
+FStar_UInt128_uint128 FStar_UInt128_eq_mask(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = FStar_UInt64_eq_mask(a.low, b.low) & FStar_UInt64_eq_mask(a.high, b.high),
+        .high = FStar_UInt64_eq_mask(a.low, b.low) & FStar_UInt64_eq_mask(a.high, b.high)
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_gte_mask(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b)
+{
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = (FStar_UInt64_gte_mask(a.high, b.high) & ~FStar_UInt64_eq_mask(a.high, b.high))
+        | (FStar_UInt64_eq_mask(a.high, b.high) & FStar_UInt64_gte_mask(a.low, b.low)),
+        .high = (FStar_UInt64_gte_mask(a.high, b.high) & ~FStar_UInt64_eq_mask(a.high, b.high))
+        | (FStar_UInt64_eq_mask(a.high, b.high) & FStar_UInt64_gte_mask(a.low, b.low))
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_uint64_to_uint128(uint64_t a)
+{
+  return ((FStar_UInt128_uint128){ .low = a, .high = (uint64_t)0U });
+}
+
+uint64_t FStar_UInt128_uint128_to_uint64(FStar_UInt128_uint128 a)
+{
+  return a.low;
+}
+
+static uint64_t FStar_UInt128_u64_l32_mask = (uint64_t)0xffffffffU;
+
+static uint64_t FStar_UInt128_u64_mod_32(uint64_t a)
+{
+  return a & FStar_UInt128_u64_l32_mask;
+}
+
+static uint32_t FStar_UInt128_u32_32 = (uint32_t)32U;
+
+static K___uint64_t_uint64_t_uint64_t_uint64_t
+FStar_UInt128_mul_wide_impl_t_(uint64_t x, uint64_t y)
+{
+  return
+    (
+      (K___uint64_t_uint64_t_uint64_t_uint64_t){
+        .fst = FStar_UInt128_u64_mod_32(x),
+        .snd = FStar_UInt128_u64_mod_32(FStar_UInt128_u64_mod_32(x) * FStar_UInt128_u64_mod_32(y)),
+        .thd = x >> FStar_UInt128_u32_32,
+        .f3 = (x >> FStar_UInt128_u32_32)
+        * FStar_UInt128_u64_mod_32(y)
+        + (FStar_UInt128_u64_mod_32(x) * FStar_UInt128_u64_mod_32(y) >> FStar_UInt128_u32_32)
+      }
+    );
+}
+
+static uint64_t FStar_UInt128_u32_combine_(uint64_t hi, uint64_t lo)
+{
+  return lo + (hi << FStar_UInt128_u32_32);
+}
+
+static FStar_UInt128_uint128 FStar_UInt128_mul_wide_impl(uint64_t x, uint64_t y)
+{
+  K___uint64_t_uint64_t_uint64_t_uint64_t scrut = FStar_UInt128_mul_wide_impl_t_(x, y);
+  uint64_t u1 = scrut.fst;
+  uint64_t w3 = scrut.snd;
+  uint64_t x_ = scrut.thd;
+  uint64_t t_ = scrut.f3;
+  return
+    (
+      (FStar_UInt128_uint128){
+        .low = FStar_UInt128_u32_combine_(u1
+          * (y >> FStar_UInt128_u32_32)
+          + FStar_UInt128_u64_mod_32(t_),
+          w3),
+        .high = x_
+        * (y >> FStar_UInt128_u32_32)
+        + (t_ >> FStar_UInt128_u32_32)
+        +
+          ((u1 * (y >> FStar_UInt128_u32_32) + FStar_UInt128_u64_mod_32(t_))
+          >> FStar_UInt128_u32_32)
+      }
+    );
+}
+
+FStar_UInt128_uint128 FStar_UInt128_mul_wide(uint64_t x, uint64_t y)
+{
+  return FStar_UInt128_mul_wide_impl(x, y);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.h
new file mode 100644
index 000000000..6791a2d57
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/FStar.h
@@ -0,0 +1,79 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+/* This file was auto-generated by KreMLin! */
+#ifndef __FStar_H
+#define __FStar_H
+
+#include "kremlib_base.h"
+
+
+typedef struct
+{
+  uint64_t low;
+  uint64_t high;
+}
+FStar_UInt128_uint128;
+
+typedef FStar_UInt128_uint128 FStar_UInt128_t;
+
+extern void FStar_UInt128_constant_time_carry_ok(uint64_t x0, uint64_t x1);
+
+FStar_UInt128_uint128 FStar_UInt128_add(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_add_mod(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_sub(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_sub_mod(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_logand(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_logxor(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_logor(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_lognot(FStar_UInt128_uint128 a);
+
+FStar_UInt128_uint128 FStar_UInt128_shift_left(FStar_UInt128_uint128 a, uint32_t s);
+
+FStar_UInt128_uint128 FStar_UInt128_shift_right(FStar_UInt128_uint128 a, uint32_t s);
+
+FStar_UInt128_uint128 FStar_UInt128_eq_mask(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_gte_mask(FStar_UInt128_uint128 a, FStar_UInt128_uint128 b);
+
+FStar_UInt128_uint128 FStar_UInt128_uint64_to_uint128(uint64_t a);
+
+uint64_t FStar_UInt128_uint128_to_uint64(FStar_UInt128_uint128 a);
+
+typedef struct
+{
+  uint64_t fst;
+  uint64_t snd;
+  uint64_t thd;
+  uint64_t f3;
+}
+K___uint64_t_uint64_t_uint64_t_uint64_t;
+
+FStar_UInt128_uint128 FStar_UInt128_mul_wide(uint64_t x, uint64_t y);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/HACL.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/HACL.h
new file mode 100644
index 000000000..29d9a3019
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/HACL.h
@@ -0,0 +1,41 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2018 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#ifndef __HACL_H
+#define __HACL_H
+
+#include "Hacl_Unverified_Random.h"
+
+#include "NaCl.h"
+#include "Hacl_Chacha20.h"
+#include "Hacl_Curve25519.h"
+#include "Hacl_Ed25519.h"
+#include "Hacl_HMAC_SHA2_256.h"
+#include "Hacl_Salsa20.h"
+#include "Hacl_SHA2_256.h"
+#include "Hacl_SHA2_384.h"
+#include "Hacl_SHA2_512.h"
+#include "Hacl_Policies.h"
+#include "Hacl_Poly1305_32.h"
+#include "Hacl_Poly1305_64.h"
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.c
new file mode 100644
index 000000000..1ebe6bdd6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.c
@@ -0,0 +1,283 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Chacha20.h"
+
+static void
+Hacl_Lib_LoadStore32_uint32s_from_le_bytes(uint32_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)4U * i;
+    uint32_t inputi = load32_le(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Lib_LoadStore32_uint32s_to_le_bytes(uint8_t *output, uint32_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint32_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)4U * i;
+    store32_le(x0, hd1);
+  }
+}
+
+inline static uint32_t Hacl_Impl_Chacha20_rotate_left(uint32_t a, uint32_t s)
+{
+  return a << s | a >> ((uint32_t)32U - s);
+}
+
+inline static void
+Hacl_Impl_Chacha20_quarter_round(uint32_t *st, uint32_t a, uint32_t b, uint32_t c, uint32_t d)
+{
+  uint32_t sa = st[a];
+  uint32_t sb0 = st[b];
+  st[a] = sa + sb0;
+  uint32_t sd = st[d];
+  uint32_t sa10 = st[a];
+  uint32_t sda = sd ^ sa10;
+  st[d] = Hacl_Impl_Chacha20_rotate_left(sda, (uint32_t)16U);
+  uint32_t sa0 = st[c];
+  uint32_t sb1 = st[d];
+  st[c] = sa0 + sb1;
+  uint32_t sd0 = st[b];
+  uint32_t sa11 = st[c];
+  uint32_t sda0 = sd0 ^ sa11;
+  st[b] = Hacl_Impl_Chacha20_rotate_left(sda0, (uint32_t)12U);
+  uint32_t sa2 = st[a];
+  uint32_t sb2 = st[b];
+  st[a] = sa2 + sb2;
+  uint32_t sd1 = st[d];
+  uint32_t sa12 = st[a];
+  uint32_t sda1 = sd1 ^ sa12;
+  st[d] = Hacl_Impl_Chacha20_rotate_left(sda1, (uint32_t)8U);
+  uint32_t sa3 = st[c];
+  uint32_t sb = st[d];
+  st[c] = sa3 + sb;
+  uint32_t sd2 = st[b];
+  uint32_t sa1 = st[c];
+  uint32_t sda2 = sd2 ^ sa1;
+  st[b] = Hacl_Impl_Chacha20_rotate_left(sda2, (uint32_t)7U);
+}
+
+inline static void Hacl_Impl_Chacha20_double_round(uint32_t *st)
+{
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)0U, (uint32_t)4U, (uint32_t)8U, (uint32_t)12U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)1U, (uint32_t)5U, (uint32_t)9U, (uint32_t)13U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)2U, (uint32_t)6U, (uint32_t)10U, (uint32_t)14U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)3U, (uint32_t)7U, (uint32_t)11U, (uint32_t)15U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)0U, (uint32_t)5U, (uint32_t)10U, (uint32_t)15U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)1U, (uint32_t)6U, (uint32_t)11U, (uint32_t)12U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)2U, (uint32_t)7U, (uint32_t)8U, (uint32_t)13U);
+  Hacl_Impl_Chacha20_quarter_round(st, (uint32_t)3U, (uint32_t)4U, (uint32_t)9U, (uint32_t)14U);
+}
+
+inline static void Hacl_Impl_Chacha20_rounds(uint32_t *st)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)10U; i = i + (uint32_t)1U)
+    Hacl_Impl_Chacha20_double_round(st);
+}
+
+inline static void Hacl_Impl_Chacha20_sum_states(uint32_t *st, uint32_t *st_)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = st[i];
+    uint32_t yi = st_[i];
+    st[i] = xi + yi;
+  }
+}
+
+inline static void Hacl_Impl_Chacha20_copy_state(uint32_t *st, uint32_t *st_)
+{
+  memcpy(st, st_, (uint32_t)16U * sizeof st_[0U]);
+}
+
+inline static void Hacl_Impl_Chacha20_chacha20_core(uint32_t *k, uint32_t *st, uint32_t ctr)
+{
+  st[12U] = ctr;
+  Hacl_Impl_Chacha20_copy_state(k, st);
+  Hacl_Impl_Chacha20_rounds(k);
+  Hacl_Impl_Chacha20_sum_states(k, st);
+}
+
+inline static void
+Hacl_Impl_Chacha20_chacha20_block(uint8_t *stream_block, uint32_t *st, uint32_t ctr)
+{
+  uint32_t st_[16U] = { 0U };
+  Hacl_Impl_Chacha20_chacha20_core(st_, st, ctr);
+  Hacl_Lib_LoadStore32_uint32s_to_le_bytes(stream_block, st_, (uint32_t)16U);
+}
+
+inline static void Hacl_Impl_Chacha20_init(uint32_t *st, uint8_t *k, uint8_t *n1)
+{
+  uint32_t *stcst = st;
+  uint32_t *stk = st + (uint32_t)4U;
+  uint32_t *stc = st + (uint32_t)12U;
+  uint32_t *stn = st + (uint32_t)13U;
+  stcst[0U] = (uint32_t)0x61707865U;
+  stcst[1U] = (uint32_t)0x3320646eU;
+  stcst[2U] = (uint32_t)0x79622d32U;
+  stcst[3U] = (uint32_t)0x6b206574U;
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(stk, k, (uint32_t)8U);
+  stc[0U] = (uint32_t)0U;
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(stn, n1, (uint32_t)3U);
+}
+
+static void
+Hacl_Impl_Chacha20_update(uint8_t *output, uint8_t *plain, uint32_t *st, uint32_t ctr)
+{
+  uint32_t b[48U] = { 0U };
+  uint32_t *k = b;
+  uint32_t *ib = b + (uint32_t)16U;
+  uint32_t *ob = b + (uint32_t)32U;
+  Hacl_Impl_Chacha20_chacha20_core(k, st, ctr);
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(ib, plain, (uint32_t)16U);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = ib[i];
+    uint32_t yi = k[i];
+    ob[i] = xi ^ yi;
+  }
+  Hacl_Lib_LoadStore32_uint32s_to_le_bytes(output, ob, (uint32_t)16U);
+}
+
+static void
+Hacl_Impl_Chacha20_update_last(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint32_t *st,
+  uint32_t ctr
+)
+{
+  uint8_t block[64U] = { 0U };
+  Hacl_Impl_Chacha20_chacha20_block(block, st, ctr);
+  uint8_t *mask = block;
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t xi = plain[i];
+    uint8_t yi = mask[i];
+    output[i] = xi ^ yi;
+  }
+}
+
+static void
+Hacl_Impl_Chacha20_chacha20_counter_mode_blocks(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t num_blocks,
+  uint32_t *st,
+  uint32_t ctr
+)
+{
+  for (uint32_t i = (uint32_t)0U; i < num_blocks; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = plain + (uint32_t)64U * i;
+    uint8_t *o = output + (uint32_t)64U * i;
+    Hacl_Impl_Chacha20_update(o, b, st, ctr + i);
+  }
+}
+
+static void
+Hacl_Impl_Chacha20_chacha20_counter_mode(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint32_t *st,
+  uint32_t ctr
+)
+{
+  uint32_t blocks_len = len >> (uint32_t)6U;
+  uint32_t part_len = len & (uint32_t)0x3fU;
+  uint8_t *output_ = output;
+  uint8_t *plain_ = plain;
+  uint8_t *output__ = output + (uint32_t)64U * blocks_len;
+  uint8_t *plain__ = plain + (uint32_t)64U * blocks_len;
+  Hacl_Impl_Chacha20_chacha20_counter_mode_blocks(output_, plain_, blocks_len, st, ctr);
+  if (part_len > (uint32_t)0U)
+    Hacl_Impl_Chacha20_update_last(output__, plain__, part_len, st, ctr + blocks_len);
+}
+
+static void
+Hacl_Impl_Chacha20_chacha20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint32_t ctr
+)
+{
+  uint32_t buf[16U] = { 0U };
+  uint32_t *st = buf;
+  Hacl_Impl_Chacha20_init(st, k, n1);
+  Hacl_Impl_Chacha20_chacha20_counter_mode(output, plain, len, st, ctr);
+}
+
+void Hacl_Chacha20_chacha20_key_block(uint8_t *block, uint8_t *k, uint8_t *n1, uint32_t ctr)
+{
+  uint32_t buf[16U] = { 0U };
+  uint32_t *st = buf;
+  Hacl_Impl_Chacha20_init(st, k, n1);
+  Hacl_Impl_Chacha20_chacha20_block(block, st, ctr);
+}
+
+/*
+  This function implements Chacha20
+
+  val chacha20 :
+  output:uint8_p ->
+  plain:uint8_p{ disjoint output plain } ->
+  len:uint32_t{ v len = length output /\ v len = length plain } ->
+  key:uint8_p{ length key = 32 } ->
+  nonce:uint8_p{ length nonce = 12 } ->
+  ctr:uint32_t{ v ctr + length plain / 64 < pow2 32 } ->
+  Stack unit
+    (requires
+      fun h -> live h output /\ live h plain /\ live h nonce /\ live h key)
+    (ensures
+      fun h0 _ h1 ->
+        live h1 output /\ live h0 plain /\ modifies_1 output h0 h1 /\
+        live h0 nonce /\
+        live h0 key /\
+        h1.[ output ] ==
+        chacha20_encrypt_bytes h0.[ key ] h0.[ nonce ] (v ctr) h0.[ plain ])
+*/
+void
+Hacl_Chacha20_chacha20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint32_t ctr
+)
+{
+  Hacl_Impl_Chacha20_chacha20(output, plain, len, k, n1, ctr);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.h
new file mode 100644
index 000000000..9cd669b4e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20.h
@@ -0,0 +1,95 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Chacha20_H
+#define __Hacl_Chacha20_H
+
+
+
+
+
+typedef uint32_t Hacl_Impl_Xor_Lemmas_u32;
+
+typedef uint8_t Hacl_Impl_Xor_Lemmas_u8;
+
+typedef uint8_t *Hacl_Lib_LoadStore32_uint8_p;
+
+typedef uint32_t Hacl_Impl_Chacha20_u32;
+
+typedef uint32_t Hacl_Impl_Chacha20_h32;
+
+typedef uint8_t *Hacl_Impl_Chacha20_uint8_p;
+
+typedef uint32_t *Hacl_Impl_Chacha20_state;
+
+typedef uint32_t Hacl_Impl_Chacha20_idx;
+
+typedef struct 
+{
+  void *k;
+  void *n;
+}
+Hacl_Impl_Chacha20_log_t_;
+
+typedef void *Hacl_Impl_Chacha20_log_t;
+
+typedef uint32_t Hacl_Lib_Create_h32;
+
+typedef uint8_t *Hacl_Chacha20_uint8_p;
+
+typedef uint32_t Hacl_Chacha20_uint32_t;
+
+void Hacl_Chacha20_chacha20_key_block(uint8_t *block, uint8_t *k, uint8_t *n1, uint32_t ctr);
+
+/*
+  This function implements Chacha20
+
+  val chacha20 :
+  output:uint8_p ->
+  plain:uint8_p{ disjoint output plain } ->
+  len:uint32_t{ v len = length output /\ v len = length plain } ->
+  key:uint8_p{ length key = 32 } ->
+  nonce:uint8_p{ length nonce = 12 } ->
+  ctr:uint32_t{ v ctr + length plain / 64 < pow2 32 } ->
+  Stack unit
+    (requires
+      fun h -> live h output /\ live h plain /\ live h nonce /\ live h key)
+    (ensures
+      fun h0 _ h1 ->
+        live h1 output /\ live h0 plain /\ modifies_1 output h0 h1 /\
+        live h0 nonce /\
+        live h0 key /\
+        h1.[ output ] ==
+        chacha20_encrypt_bytes h0.[ key ] h0.[ nonce ] (v ctr) h0.[ plain ])
+*/
+void
+Hacl_Chacha20_chacha20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint32_t ctr
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.c
new file mode 100644
index 000000000..7b1ee3073
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.c
@@ -0,0 +1,131 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Chacha20Poly1305.h"
+
+Prims_int Hacl_Chacha20Poly1305_noncelen = (krml_checked_int_t)12;
+
+Prims_int Hacl_Chacha20Poly1305_keylen = (krml_checked_int_t)32;
+
+Prims_int Hacl_Chacha20Poly1305_maclen = (krml_checked_int_t)16;
+
+static void
+Hacl_Chacha20Poly1305_aead_encrypt_poly(
+  uint8_t *c,
+  uint32_t mlen,
+  uint8_t *mac,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *tmp
+)
+{
+  uint8_t *b = tmp;
+  uint8_t *lb = tmp + (uint32_t)64U;
+  uint8_t *mk = b;
+  uint8_t *key_s = mk + (uint32_t)16U;
+  uint64_t tmp1[6U] = { 0U };
+  Hacl_Impl_Poly1305_64_State_poly1305_state
+  st = AEAD_Poly1305_64_mk_state(tmp1, tmp1 + (uint32_t)3U);
+  (void)AEAD_Poly1305_64_poly1305_blocks_init(st, aad1, aadlen, mk);
+  (void)AEAD_Poly1305_64_poly1305_blocks_continue(st, c, mlen);
+  AEAD_Poly1305_64_poly1305_blocks_finish(st, lb, mac, key_s);
+}
+
+void Hacl_Chacha20Poly1305_encode_length(uint8_t *lb, uint32_t aad_len, uint32_t mlen)
+{
+  store64_le(lb, (uint64_t)aad_len);
+  uint8_t *x0 = lb + (uint32_t)8U;
+  store64_le(x0, (uint64_t)mlen);
+}
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_encrypt_(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint32_t mlen,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+)
+{
+  uint8_t tmp[80U] = { 0U };
+  uint8_t *b = tmp;
+  uint8_t *lb = tmp + (uint32_t)64U;
+  Hacl_Chacha20Poly1305_encode_length(lb, aadlen, mlen);
+  Hacl_Chacha20_chacha20(c, m, mlen, k1, n1, (uint32_t)1U);
+  Hacl_Chacha20_chacha20_key_block(b, k1, n1, (uint32_t)0U);
+  Hacl_Chacha20Poly1305_aead_encrypt_poly(c, mlen, mac, aad1, aadlen, tmp);
+  return (uint32_t)0U;
+}
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_encrypt(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint32_t mlen,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+)
+{
+  uint32_t z = Hacl_Chacha20Poly1305_aead_encrypt_(c, mac, m, mlen, aad1, aadlen, k1, n1);
+  return z;
+}
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_decrypt(
+  uint8_t *m,
+  uint8_t *c,
+  uint32_t mlen,
+  uint8_t *mac,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+)
+{
+  uint8_t tmp[96U] = { 0U };
+  uint8_t *b = tmp;
+  uint8_t *lb = tmp + (uint32_t)64U;
+  Hacl_Chacha20Poly1305_encode_length(lb, aadlen, mlen);
+  uint8_t *rmac = tmp + (uint32_t)80U;
+  Hacl_Chacha20_chacha20_key_block(b, k1, n1, (uint32_t)0U);
+  Hacl_Chacha20Poly1305_aead_encrypt_poly(c, mlen, rmac, aad1, aadlen, tmp);
+  uint8_t result = Hacl_Policies_cmp_bytes(mac, rmac, (uint32_t)16U);
+  uint8_t verify = result;
+  uint32_t res;
+  if (verify == (uint8_t)0U)
+  {
+    Hacl_Chacha20_chacha20(m, c, mlen, k1, n1, (uint32_t)1U);
+    res = (uint32_t)0U;
+  }
+  else
+    res = (uint32_t)1U;
+  return res;
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.h
new file mode 100644
index 000000000..487acd399
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Chacha20Poly1305.h
@@ -0,0 +1,80 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Chacha20Poly1305_H
+#define __Hacl_Chacha20Poly1305_H
+
+
+#include "Hacl_Policies.h"
+#include "Hacl_Chacha20.h"
+#include "AEAD_Poly1305_64.h"
+
+extern Prims_int Hacl_Chacha20Poly1305_noncelen;
+
+extern Prims_int Hacl_Chacha20Poly1305_keylen;
+
+extern Prims_int Hacl_Chacha20Poly1305_maclen;
+
+typedef Hacl_Impl_Poly1305_64_State_poly1305_state Hacl_Chacha20Poly1305_state;
+
+typedef void *Hacl_Chacha20Poly1305_log_t;
+
+void Hacl_Chacha20Poly1305_encode_length(uint8_t *lb, uint32_t aad_len, uint32_t mlen);
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_encrypt_(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint32_t mlen,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+);
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_encrypt(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint32_t mlen,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+);
+
+uint32_t
+Hacl_Chacha20Poly1305_aead_decrypt(
+  uint8_t *m,
+  uint8_t *c,
+  uint32_t mlen,
+  uint8_t *mac,
+  uint8_t *aad1,
+  uint32_t aadlen,
+  uint8_t *k1,
+  uint8_t *n1
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.c
new file mode 100644
index 000000000..7709213d9
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.c
@@ -0,0 +1,837 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Curve25519.h"
+
+static void Hacl_Bignum_Modulo_carry_top(uint64_t *b)
+{
+  uint64_t b4 = b[4U];
+  uint64_t b0 = b[0U];
+  uint64_t b4_ = b4 & (uint64_t)0x7ffffffffffffU;
+  uint64_t b0_ = b0 + (uint64_t)19U * (b4 >> (uint32_t)51U);
+  b[4U] = b4_;
+  b[0U] = b0_;
+}
+
+inline static void
+Hacl_Bignum_Fproduct_copy_from_wide_(uint64_t *output, FStar_UInt128_t *input)
+{
+  {
+    FStar_UInt128_t xi = input[0U];
+    output[0U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[1U];
+    output[1U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[2U];
+    output[2U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[3U];
+    output[3U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[4U];
+    output[4U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+}
+
+inline static void
+Hacl_Bignum_Fproduct_sum_scalar_multiplication_(
+  FStar_UInt128_t *output,
+  uint64_t *input,
+  uint64_t s
+)
+{
+  {
+    FStar_UInt128_t xi = output[0U];
+    uint64_t yi = input[0U];
+    output[0U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[1U];
+    uint64_t yi = input[1U];
+    output[1U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[2U];
+    uint64_t yi = input[2U];
+    output[2U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[3U];
+    uint64_t yi = input[3U];
+    output[3U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[4U];
+    uint64_t yi = input[4U];
+    output[4U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_wide_(FStar_UInt128_t *tmp)
+{
+  {
+    uint32_t ctr = (uint32_t)0U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)1U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)2U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)3U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+}
+
+inline static void Hacl_Bignum_Fmul_shift_reduce(uint64_t *output)
+{
+  uint64_t tmp = output[4U];
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)0U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)1U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)2U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)3U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  output[0U] = tmp;
+  uint64_t b0 = output[0U];
+  output[0U] = (uint64_t)19U * b0;
+}
+
+static void
+Hacl_Bignum_Fmul_mul_shift_reduce_(FStar_UInt128_t *output, uint64_t *input, uint64_t *input21)
+{
+  {
+    uint64_t input2i = input21[0U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[1U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[2U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[3U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  uint32_t i = (uint32_t)4U;
+  uint64_t input2i = input21[i];
+  Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+}
+
+inline static void Hacl_Bignum_Fmul_fmul(uint64_t *output, uint64_t *input, uint64_t *input21)
+{
+  uint64_t tmp[5U] = { 0U };
+  memcpy(tmp, input, (uint32_t)5U * sizeof input[0U]);
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fmul_mul_shift_reduce_(t, tmp, input21);
+  Hacl_Bignum_Fproduct_carry_wide_(t);
+  FStar_UInt128_t b4 = t[4U];
+  FStar_UInt128_t b0 = t[0U];
+  FStar_UInt128_t
+  b4_ = FStar_UInt128_logand(b4, FStar_UInt128_uint64_to_uint128((uint64_t)0x7ffffffffffffU));
+  FStar_UInt128_t
+  b0_ =
+    FStar_UInt128_add(b0,
+      FStar_UInt128_mul_wide((uint64_t)19U,
+        FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b4, (uint32_t)51U))));
+  t[4U] = b4_;
+  t[0U] = b0_;
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, t);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare__(FStar_UInt128_t *tmp, uint64_t *output)
+{
+  uint64_t r0 = output[0U];
+  uint64_t r1 = output[1U];
+  uint64_t r2 = output[2U];
+  uint64_t r3 = output[3U];
+  uint64_t r4 = output[4U];
+  uint64_t d0 = r0 * (uint64_t)2U;
+  uint64_t d1 = r1 * (uint64_t)2U;
+  uint64_t d2 = r2 * (uint64_t)2U * (uint64_t)19U;
+  uint64_t d419 = r4 * (uint64_t)19U;
+  uint64_t d4 = d419 * (uint64_t)2U;
+  FStar_UInt128_t
+  s0 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(r0, r0),
+        FStar_UInt128_mul_wide(d4, r1)),
+      FStar_UInt128_mul_wide(d2, r3));
+  FStar_UInt128_t
+  s1 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r1),
+        FStar_UInt128_mul_wide(d4, r2)),
+      FStar_UInt128_mul_wide(r3 * (uint64_t)19U, r3));
+  FStar_UInt128_t
+  s2 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r2),
+        FStar_UInt128_mul_wide(r1, r1)),
+      FStar_UInt128_mul_wide(d4, r3));
+  FStar_UInt128_t
+  s3 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r3),
+        FStar_UInt128_mul_wide(d1, r2)),
+      FStar_UInt128_mul_wide(r4, d419));
+  FStar_UInt128_t
+  s4 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r4),
+        FStar_UInt128_mul_wide(d1, r3)),
+      FStar_UInt128_mul_wide(r2, r2));
+  tmp[0U] = s0;
+  tmp[1U] = s1;
+  tmp[2U] = s2;
+  tmp[3U] = s3;
+  tmp[4U] = s4;
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare_(FStar_UInt128_t *tmp, uint64_t *output)
+{
+  Hacl_Bignum_Fsquare_fsquare__(tmp, output);
+  Hacl_Bignum_Fproduct_carry_wide_(tmp);
+  FStar_UInt128_t b4 = tmp[4U];
+  FStar_UInt128_t b0 = tmp[0U];
+  FStar_UInt128_t
+  b4_ = FStar_UInt128_logand(b4, FStar_UInt128_uint64_to_uint128((uint64_t)0x7ffffffffffffU));
+  FStar_UInt128_t
+  b0_ =
+    FStar_UInt128_add(b0,
+      FStar_UInt128_mul_wide((uint64_t)19U,
+        FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b4, (uint32_t)51U))));
+  tmp[4U] = b4_;
+  tmp[0U] = b0_;
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, tmp);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+static void
+Hacl_Bignum_Fsquare_fsquare_times_(uint64_t *input, FStar_UInt128_t *tmp, uint32_t count1)
+{
+  Hacl_Bignum_Fsquare_fsquare_(tmp, input);
+  for (uint32_t i = (uint32_t)1U; i < count1; i = i + (uint32_t)1U)
+    Hacl_Bignum_Fsquare_fsquare_(tmp, input);
+}
+
+inline static void
+Hacl_Bignum_Fsquare_fsquare_times(uint64_t *output, uint64_t *input, uint32_t count1)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  memcpy(output, input, (uint32_t)5U * sizeof input[0U]);
+  Hacl_Bignum_Fsquare_fsquare_times_(output, t, count1);
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare_times_inplace(uint64_t *output, uint32_t count1)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fsquare_fsquare_times_(output, t, count1);
+}
+
+inline static void Hacl_Bignum_Crecip_crecip(uint64_t *out, uint64_t *z)
+{
+  uint64_t buf[20U] = { 0U };
+  uint64_t *a = buf;
+  uint64_t *t00 = buf + (uint32_t)5U;
+  uint64_t *b0 = buf + (uint32_t)10U;
+  Hacl_Bignum_Fsquare_fsquare_times(a, z, (uint32_t)1U);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)2U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, z);
+  Hacl_Bignum_Fmul_fmul(a, b0, a);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)1U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, b0);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, b0, (uint32_t)5U);
+  uint64_t *t01 = buf + (uint32_t)5U;
+  uint64_t *b1 = buf + (uint32_t)10U;
+  uint64_t *c0 = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(c0, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, c0, (uint32_t)20U);
+  Hacl_Bignum_Fmul_fmul(t01, t01, c0);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t01, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)50U);
+  uint64_t *a0 = buf;
+  uint64_t *t0 = buf + (uint32_t)5U;
+  uint64_t *b = buf + (uint32_t)10U;
+  uint64_t *c = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(c, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times(t0, c, (uint32_t)100U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, c);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)50U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)5U);
+  Hacl_Bignum_Fmul_fmul(out, t0, a0);
+}
+
+inline static void Hacl_Bignum_fsum(uint64_t *a, uint64_t *b)
+{
+  {
+    uint64_t xi = a[0U];
+    uint64_t yi = b[0U];
+    a[0U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[1U];
+    uint64_t yi = b[1U];
+    a[1U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[2U];
+    uint64_t yi = b[2U];
+    a[2U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[3U];
+    uint64_t yi = b[3U];
+    a[3U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[4U];
+    uint64_t yi = b[4U];
+    a[4U] = xi + yi;
+  }
+}
+
+inline static void Hacl_Bignum_fdifference(uint64_t *a, uint64_t *b)
+{
+  uint64_t tmp[5U] = { 0U };
+  memcpy(tmp, b, (uint32_t)5U * sizeof b[0U]);
+  uint64_t b0 = tmp[0U];
+  uint64_t b1 = tmp[1U];
+  uint64_t b2 = tmp[2U];
+  uint64_t b3 = tmp[3U];
+  uint64_t b4 = tmp[4U];
+  tmp[0U] = b0 + (uint64_t)0x3fffffffffff68U;
+  tmp[1U] = b1 + (uint64_t)0x3ffffffffffff8U;
+  tmp[2U] = b2 + (uint64_t)0x3ffffffffffff8U;
+  tmp[3U] = b3 + (uint64_t)0x3ffffffffffff8U;
+  tmp[4U] = b4 + (uint64_t)0x3ffffffffffff8U;
+  {
+    uint64_t xi = a[0U];
+    uint64_t yi = tmp[0U];
+    a[0U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[1U];
+    uint64_t yi = tmp[1U];
+    a[1U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[2U];
+    uint64_t yi = tmp[2U];
+    a[2U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[3U];
+    uint64_t yi = tmp[3U];
+    a[3U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[4U];
+    uint64_t yi = tmp[4U];
+    a[4U] = yi - xi;
+  }
+}
+
+inline static void Hacl_Bignum_fscalar(uint64_t *output, uint64_t *b, uint64_t s)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t tmp[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    tmp[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  {
+    uint64_t xi = b[0U];
+    tmp[0U] = FStar_UInt128_mul_wide(xi, s);
+  }
+  {
+    uint64_t xi = b[1U];
+    tmp[1U] = FStar_UInt128_mul_wide(xi, s);
+  }
+  {
+    uint64_t xi = b[2U];
+    tmp[2U] = FStar_UInt128_mul_wide(xi, s);
+  }
+  {
+    uint64_t xi = b[3U];
+    tmp[3U] = FStar_UInt128_mul_wide(xi, s);
+  }
+  {
+    uint64_t xi = b[4U];
+    tmp[4U] = FStar_UInt128_mul_wide(xi, s);
+  }
+  Hacl_Bignum_Fproduct_carry_wide_(tmp);
+  FStar_UInt128_t b4 = tmp[4U];
+  FStar_UInt128_t b0 = tmp[0U];
+  FStar_UInt128_t
+  b4_ = FStar_UInt128_logand(b4, FStar_UInt128_uint64_to_uint128((uint64_t)0x7ffffffffffffU));
+  FStar_UInt128_t
+  b0_ =
+    FStar_UInt128_add(b0,
+      FStar_UInt128_mul_wide((uint64_t)19U,
+        FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b4, (uint32_t)51U))));
+  tmp[4U] = b4_;
+  tmp[0U] = b0_;
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, tmp);
+}
+
+inline static void Hacl_Bignum_fmul(uint64_t *output, uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum_Fmul_fmul(output, a, b);
+}
+
+inline static void Hacl_Bignum_crecip(uint64_t *output, uint64_t *input)
+{
+  Hacl_Bignum_Crecip_crecip(output, input);
+}
+
+static void
+Hacl_EC_Point_swap_conditional_step(uint64_t *a, uint64_t *b, uint64_t swap1, uint32_t ctr)
+{
+  uint32_t i = ctr - (uint32_t)1U;
+  uint64_t ai = a[i];
+  uint64_t bi = b[i];
+  uint64_t x = swap1 & (ai ^ bi);
+  uint64_t ai1 = ai ^ x;
+  uint64_t bi1 = bi ^ x;
+  a[i] = ai1;
+  b[i] = bi1;
+}
+
+static void
+Hacl_EC_Point_swap_conditional_(uint64_t *a, uint64_t *b, uint64_t swap1, uint32_t ctr)
+{
+  if (!(ctr == (uint32_t)0U))
+  {
+    Hacl_EC_Point_swap_conditional_step(a, b, swap1, ctr);
+    uint32_t i = ctr - (uint32_t)1U;
+    Hacl_EC_Point_swap_conditional_(a, b, swap1, i);
+  }
+}
+
+static void Hacl_EC_Point_swap_conditional(uint64_t *a, uint64_t *b, uint64_t iswap)
+{
+  uint64_t swap1 = (uint64_t)0U - iswap;
+  Hacl_EC_Point_swap_conditional_(a, b, swap1, (uint32_t)5U);
+  Hacl_EC_Point_swap_conditional_(a + (uint32_t)5U, b + (uint32_t)5U, swap1, (uint32_t)5U);
+}
+
+static void Hacl_EC_Point_copy(uint64_t *output, uint64_t *input)
+{
+  memcpy(output, input, (uint32_t)5U * sizeof input[0U]);
+  memcpy(output + (uint32_t)5U,
+    input + (uint32_t)5U,
+    (uint32_t)5U * sizeof (input + (uint32_t)5U)[0U]);
+}
+
+static void
+Hacl_EC_AddAndDouble_fmonty(
+  uint64_t *pp,
+  uint64_t *ppq,
+  uint64_t *p,
+  uint64_t *pq,
+  uint64_t *qmqp
+)
+{
+  uint64_t *qx = qmqp;
+  uint64_t *x2 = pp;
+  uint64_t *z2 = pp + (uint32_t)5U;
+  uint64_t *x3 = ppq;
+  uint64_t *z3 = ppq + (uint32_t)5U;
+  uint64_t *x = p;
+  uint64_t *z = p + (uint32_t)5U;
+  uint64_t *xprime = pq;
+  uint64_t *zprime = pq + (uint32_t)5U;
+  uint64_t buf[40U] = { 0U };
+  uint64_t *origx = buf;
+  uint64_t *origxprime = buf + (uint32_t)5U;
+  uint64_t *xxprime0 = buf + (uint32_t)25U;
+  uint64_t *zzprime0 = buf + (uint32_t)30U;
+  memcpy(origx, x, (uint32_t)5U * sizeof x[0U]);
+  Hacl_Bignum_fsum(x, z);
+  Hacl_Bignum_fdifference(z, origx);
+  memcpy(origxprime, xprime, (uint32_t)5U * sizeof xprime[0U]);
+  Hacl_Bignum_fsum(xprime, zprime);
+  Hacl_Bignum_fdifference(zprime, origxprime);
+  Hacl_Bignum_fmul(xxprime0, xprime, z);
+  Hacl_Bignum_fmul(zzprime0, x, zprime);
+  uint64_t *origxprime0 = buf + (uint32_t)5U;
+  uint64_t *xx0 = buf + (uint32_t)15U;
+  uint64_t *zz0 = buf + (uint32_t)20U;
+  uint64_t *xxprime = buf + (uint32_t)25U;
+  uint64_t *zzprime = buf + (uint32_t)30U;
+  uint64_t *zzzprime = buf + (uint32_t)35U;
+  memcpy(origxprime0, xxprime, (uint32_t)5U * sizeof xxprime[0U]);
+  Hacl_Bignum_fsum(xxprime, zzprime);
+  Hacl_Bignum_fdifference(zzprime, origxprime0);
+  Hacl_Bignum_Fsquare_fsquare_times(x3, xxprime, (uint32_t)1U);
+  Hacl_Bignum_Fsquare_fsquare_times(zzzprime, zzprime, (uint32_t)1U);
+  Hacl_Bignum_fmul(z3, zzzprime, qx);
+  Hacl_Bignum_Fsquare_fsquare_times(xx0, x, (uint32_t)1U);
+  Hacl_Bignum_Fsquare_fsquare_times(zz0, z, (uint32_t)1U);
+  uint64_t *zzz = buf + (uint32_t)10U;
+  uint64_t *xx = buf + (uint32_t)15U;
+  uint64_t *zz = buf + (uint32_t)20U;
+  Hacl_Bignum_fmul(x2, xx, zz);
+  Hacl_Bignum_fdifference(zz, xx);
+  uint64_t scalar = (uint64_t)121665U;
+  Hacl_Bignum_fscalar(zzz, zz, scalar);
+  Hacl_Bignum_fsum(zzz, xx);
+  Hacl_Bignum_fmul(z2, zzz, zz);
+}
+
+static void
+Hacl_EC_Ladder_SmallLoop_cmult_small_loop_step(
+  uint64_t *nq,
+  uint64_t *nqpq,
+  uint64_t *nq2,
+  uint64_t *nqpq2,
+  uint64_t *q,
+  uint8_t byt
+)
+{
+  uint64_t bit = (uint64_t)(byt >> (uint32_t)7U);
+  Hacl_EC_Point_swap_conditional(nq, nqpq, bit);
+  Hacl_EC_AddAndDouble_fmonty(nq2, nqpq2, nq, nqpq, q);
+  uint64_t bit0 = (uint64_t)(byt >> (uint32_t)7U);
+  Hacl_EC_Point_swap_conditional(nq2, nqpq2, bit0);
+}
+
+static void
+Hacl_EC_Ladder_SmallLoop_cmult_small_loop_double_step(
+  uint64_t *nq,
+  uint64_t *nqpq,
+  uint64_t *nq2,
+  uint64_t *nqpq2,
+  uint64_t *q,
+  uint8_t byt
+)
+{
+  Hacl_EC_Ladder_SmallLoop_cmult_small_loop_step(nq, nqpq, nq2, nqpq2, q, byt);
+  uint8_t byt1 = byt << (uint32_t)1U;
+  Hacl_EC_Ladder_SmallLoop_cmult_small_loop_step(nq2, nqpq2, nq, nqpq, q, byt1);
+}
+
+static void
+Hacl_EC_Ladder_SmallLoop_cmult_small_loop(
+  uint64_t *nq,
+  uint64_t *nqpq,
+  uint64_t *nq2,
+  uint64_t *nqpq2,
+  uint64_t *q,
+  uint8_t byt,
+  uint32_t i
+)
+{
+  if (!(i == (uint32_t)0U))
+  {
+    uint32_t i_ = i - (uint32_t)1U;
+    Hacl_EC_Ladder_SmallLoop_cmult_small_loop_double_step(nq, nqpq, nq2, nqpq2, q, byt);
+    uint8_t byt_ = byt << (uint32_t)2U;
+    Hacl_EC_Ladder_SmallLoop_cmult_small_loop(nq, nqpq, nq2, nqpq2, q, byt_, i_);
+  }
+}
+
+static void
+Hacl_EC_Ladder_BigLoop_cmult_big_loop(
+  uint8_t *n1,
+  uint64_t *nq,
+  uint64_t *nqpq,
+  uint64_t *nq2,
+  uint64_t *nqpq2,
+  uint64_t *q,
+  uint32_t i
+)
+{
+  if (!(i == (uint32_t)0U))
+  {
+    uint32_t i1 = i - (uint32_t)1U;
+    uint8_t byte = n1[i1];
+    Hacl_EC_Ladder_SmallLoop_cmult_small_loop(nq, nqpq, nq2, nqpq2, q, byte, (uint32_t)4U);
+    Hacl_EC_Ladder_BigLoop_cmult_big_loop(n1, nq, nqpq, nq2, nqpq2, q, i1);
+  }
+}
+
+static void Hacl_EC_Ladder_cmult(uint64_t *result, uint8_t *n1, uint64_t *q)
+{
+  uint64_t point_buf[40U] = { 0U };
+  uint64_t *nq = point_buf;
+  uint64_t *nqpq = point_buf + (uint32_t)10U;
+  uint64_t *nq2 = point_buf + (uint32_t)20U;
+  uint64_t *nqpq2 = point_buf + (uint32_t)30U;
+  Hacl_EC_Point_copy(nqpq, q);
+  nq[0U] = (uint64_t)1U;
+  Hacl_EC_Ladder_BigLoop_cmult_big_loop(n1, nq, nqpq, nq2, nqpq2, q, (uint32_t)32U);
+  Hacl_EC_Point_copy(result, nq);
+}
+
+static void Hacl_EC_Format_fexpand(uint64_t *output, uint8_t *input)
+{
+  uint64_t i0 = load64_le(input);
+  uint8_t *x00 = input + (uint32_t)6U;
+  uint64_t i1 = load64_le(x00);
+  uint8_t *x01 = input + (uint32_t)12U;
+  uint64_t i2 = load64_le(x01);
+  uint8_t *x02 = input + (uint32_t)19U;
+  uint64_t i3 = load64_le(x02);
+  uint8_t *x0 = input + (uint32_t)24U;
+  uint64_t i4 = load64_le(x0);
+  uint64_t output0 = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t output1 = i1 >> (uint32_t)3U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output2 = i2 >> (uint32_t)6U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output3 = i3 >> (uint32_t)1U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output4 = i4 >> (uint32_t)12U & (uint64_t)0x7ffffffffffffU;
+  output[0U] = output0;
+  output[1U] = output1;
+  output[2U] = output2;
+  output[3U] = output3;
+  output[4U] = output4;
+}
+
+static void Hacl_EC_Format_fcontract_first_carry_pass(uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t t1_ = t1 + (t0 >> (uint32_t)51U);
+  uint64_t t0_ = t0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t t2_ = t2 + (t1_ >> (uint32_t)51U);
+  uint64_t t1__ = t1_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t3_ = t3 + (t2_ >> (uint32_t)51U);
+  uint64_t t2__ = t2_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t4_ = t4 + (t3_ >> (uint32_t)51U);
+  uint64_t t3__ = t3_ & (uint64_t)0x7ffffffffffffU;
+  input[0U] = t0_;
+  input[1U] = t1__;
+  input[2U] = t2__;
+  input[3U] = t3__;
+  input[4U] = t4_;
+}
+
+static void Hacl_EC_Format_fcontract_first_carry_full(uint64_t *input)
+{
+  Hacl_EC_Format_fcontract_first_carry_pass(input);
+  Hacl_Bignum_Modulo_carry_top(input);
+}
+
+static void Hacl_EC_Format_fcontract_second_carry_pass(uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t t1_ = t1 + (t0 >> (uint32_t)51U);
+  uint64_t t0_ = t0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t t2_ = t2 + (t1_ >> (uint32_t)51U);
+  uint64_t t1__ = t1_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t3_ = t3 + (t2_ >> (uint32_t)51U);
+  uint64_t t2__ = t2_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t4_ = t4 + (t3_ >> (uint32_t)51U);
+  uint64_t t3__ = t3_ & (uint64_t)0x7ffffffffffffU;
+  input[0U] = t0_;
+  input[1U] = t1__;
+  input[2U] = t2__;
+  input[3U] = t3__;
+  input[4U] = t4_;
+}
+
+static void Hacl_EC_Format_fcontract_second_carry_full(uint64_t *input)
+{
+  Hacl_EC_Format_fcontract_second_carry_pass(input);
+  Hacl_Bignum_Modulo_carry_top(input);
+  uint64_t i0 = input[0U];
+  uint64_t i1 = input[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  input[0U] = i0_;
+  input[1U] = i1_;
+}
+
+static void Hacl_EC_Format_fcontract_trim(uint64_t *input)
+{
+  uint64_t a0 = input[0U];
+  uint64_t a1 = input[1U];
+  uint64_t a2 = input[2U];
+  uint64_t a3 = input[3U];
+  uint64_t a4 = input[4U];
+  uint64_t mask0 = FStar_UInt64_gte_mask(a0, (uint64_t)0x7ffffffffffedU);
+  uint64_t mask1 = FStar_UInt64_eq_mask(a1, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask2 = FStar_UInt64_eq_mask(a2, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask3 = FStar_UInt64_eq_mask(a3, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask4 = FStar_UInt64_eq_mask(a4, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask = (((mask0 & mask1) & mask2) & mask3) & mask4;
+  uint64_t a0_ = a0 - ((uint64_t)0x7ffffffffffedU & mask);
+  uint64_t a1_ = a1 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a2_ = a2 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a3_ = a3 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a4_ = a4 - ((uint64_t)0x7ffffffffffffU & mask);
+  input[0U] = a0_;
+  input[1U] = a1_;
+  input[2U] = a2_;
+  input[3U] = a3_;
+  input[4U] = a4_;
+}
+
+static void Hacl_EC_Format_fcontract_store(uint8_t *output, uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t o0 = t1 << (uint32_t)51U | t0;
+  uint64_t o1 = t2 << (uint32_t)38U | t1 >> (uint32_t)13U;
+  uint64_t o2 = t3 << (uint32_t)25U | t2 >> (uint32_t)26U;
+  uint64_t o3 = t4 << (uint32_t)12U | t3 >> (uint32_t)39U;
+  uint8_t *b0 = output;
+  uint8_t *b1 = output + (uint32_t)8U;
+  uint8_t *b2 = output + (uint32_t)16U;
+  uint8_t *b3 = output + (uint32_t)24U;
+  store64_le(b0, o0);
+  store64_le(b1, o1);
+  store64_le(b2, o2);
+  store64_le(b3, o3);
+}
+
+static void Hacl_EC_Format_fcontract(uint8_t *output, uint64_t *input)
+{
+  Hacl_EC_Format_fcontract_first_carry_full(input);
+  Hacl_EC_Format_fcontract_second_carry_full(input);
+  Hacl_EC_Format_fcontract_trim(input);
+  Hacl_EC_Format_fcontract_store(output, input);
+}
+
+static void Hacl_EC_Format_scalar_of_point(uint8_t *scalar, uint64_t *point)
+{
+  uint64_t *x = point;
+  uint64_t *z = point + (uint32_t)5U;
+  uint64_t buf[10U] = { 0U };
+  uint64_t *zmone = buf;
+  uint64_t *sc = buf + (uint32_t)5U;
+  Hacl_Bignum_crecip(zmone, z);
+  Hacl_Bignum_fmul(sc, x, zmone);
+  Hacl_EC_Format_fcontract(scalar, sc);
+}
+
+void Hacl_EC_crypto_scalarmult(uint8_t *mypublic, uint8_t *secret, uint8_t *basepoint)
+{
+  uint64_t buf0[10U] = { 0U };
+  uint64_t *x0 = buf0;
+  uint64_t *z = buf0 + (uint32_t)5U;
+  Hacl_EC_Format_fexpand(x0, basepoint);
+  z[0U] = (uint64_t)1U;
+  uint64_t *q = buf0;
+  uint8_t e[32U] = { 0U };
+  memcpy(e, secret, (uint32_t)32U * sizeof secret[0U]);
+  uint8_t e0 = e[0U];
+  uint8_t e31 = e[31U];
+  uint8_t e01 = e0 & (uint8_t)248U;
+  uint8_t e311 = e31 & (uint8_t)127U;
+  uint8_t e312 = e311 | (uint8_t)64U;
+  e[0U] = e01;
+  e[31U] = e312;
+  uint8_t *scalar = e;
+  uint64_t buf[15U] = { 0U };
+  uint64_t *nq = buf;
+  uint64_t *x = nq;
+  x[0U] = (uint64_t)1U;
+  Hacl_EC_Ladder_cmult(nq, scalar, q);
+  Hacl_EC_Format_scalar_of_point(mypublic, nq);
+}
+
+void Hacl_Curve25519_crypto_scalarmult(uint8_t *mypublic, uint8_t *secret, uint8_t *basepoint)
+{
+  Hacl_EC_crypto_scalarmult(mypublic, secret, basepoint);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.h
new file mode 100644
index 000000000..181c2e600
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Curve25519.h
@@ -0,0 +1,69 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Curve25519_H
+#define __Hacl_Curve25519_H
+
+
+
+
+
+typedef uint64_t Hacl_Bignum_Constants_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Constants_wide;
+
+typedef uint64_t Hacl_Bignum_Parameters_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Parameters_wide;
+
+typedef uint32_t Hacl_Bignum_Parameters_ctr;
+
+typedef uint64_t *Hacl_Bignum_Parameters_felem;
+
+typedef FStar_UInt128_t *Hacl_Bignum_Parameters_felem_wide;
+
+typedef void *Hacl_Bignum_Parameters_seqelem;
+
+typedef void *Hacl_Bignum_Parameters_seqelem_wide;
+
+typedef FStar_UInt128_t Hacl_Bignum_Wide_t;
+
+typedef uint64_t Hacl_Bignum_Limb_t;
+
+extern void Hacl_Bignum_lemma_diff(Prims_int x0, Prims_int x1, Prims_pos x2);
+
+typedef uint64_t *Hacl_EC_Point_point;
+
+typedef uint8_t *Hacl_EC_Ladder_SmallLoop_uint8_p;
+
+typedef uint8_t *Hacl_EC_Ladder_uint8_p;
+
+typedef uint8_t *Hacl_EC_Format_uint8_p;
+
+void Hacl_EC_crypto_scalarmult(uint8_t *mypublic, uint8_t *secret, uint8_t *basepoint);
+
+typedef uint8_t *Hacl_Curve25519_uint8_p;
+
+void Hacl_Curve25519_crypto_scalarmult(uint8_t *mypublic, uint8_t *secret, uint8_t *basepoint);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.c
new file mode 100644
index 000000000..a1f3aa286
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.c
@@ -0,0 +1,2828 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Ed25519.h"
+
+static void Hacl_Bignum_Modulo_carry_top(uint64_t *b)
+{
+  uint64_t b4 = b[4U];
+  uint64_t b0 = b[0U];
+  uint64_t b4_ = b4 & (uint64_t)0x7ffffffffffffU;
+  uint64_t b0_ = b0 + (uint64_t)19U * (b4 >> (uint32_t)51U);
+  b[4U] = b4_;
+  b[0U] = b0_;
+}
+
+inline static void
+Hacl_Bignum_Fproduct_copy_from_wide_(uint64_t *output, FStar_UInt128_t *input)
+{
+  {
+    FStar_UInt128_t xi = input[0U];
+    output[0U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[1U];
+    output[1U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[2U];
+    output[2U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[3U];
+    output[3U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+  {
+    FStar_UInt128_t xi = input[4U];
+    output[4U] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+}
+
+inline static void
+Hacl_Bignum_Fproduct_sum_scalar_multiplication_(
+  FStar_UInt128_t *output,
+  uint64_t *input,
+  uint64_t s
+)
+{
+  {
+    FStar_UInt128_t xi = output[0U];
+    uint64_t yi = input[0U];
+    output[0U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[1U];
+    uint64_t yi = input[1U];
+    output[1U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[2U];
+    uint64_t yi = input[2U];
+    output[2U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[3U];
+    uint64_t yi = input[3U];
+    output[3U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+  {
+    FStar_UInt128_t xi = output[4U];
+    uint64_t yi = input[4U];
+    output[4U] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_wide_(FStar_UInt128_t *tmp)
+{
+  {
+    uint32_t ctr = (uint32_t)0U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)1U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)2U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+  {
+    uint32_t ctr = (uint32_t)3U;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0x7ffffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)51U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+}
+
+inline static void Hacl_Bignum_Fmul_shift_reduce(uint64_t *output)
+{
+  uint64_t tmp = output[4U];
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)0U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)1U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)2U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  {
+    uint32_t ctr = (uint32_t)5U - (uint32_t)3U - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  output[0U] = tmp;
+  uint64_t b0 = output[0U];
+  output[0U] = (uint64_t)19U * b0;
+}
+
+static void
+Hacl_Bignum_Fmul_mul_shift_reduce_(FStar_UInt128_t *output, uint64_t *input, uint64_t *input21)
+{
+  {
+    uint64_t input2i = input21[0U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[1U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[2U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  {
+    uint64_t input2i = input21[3U];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  uint32_t i = (uint32_t)4U;
+  uint64_t input2i = input21[i];
+  Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+}
+
+inline static void Hacl_Bignum_Fmul_fmul(uint64_t *output, uint64_t *input, uint64_t *input21)
+{
+  uint64_t tmp[5U] = { 0U };
+  memcpy(tmp, input, (uint32_t)5U * sizeof input[0U]);
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fmul_mul_shift_reduce_(t, tmp, input21);
+  Hacl_Bignum_Fproduct_carry_wide_(t);
+  FStar_UInt128_t b4 = t[4U];
+  FStar_UInt128_t b0 = t[0U];
+  FStar_UInt128_t
+  b4_ = FStar_UInt128_logand(b4, FStar_UInt128_uint64_to_uint128((uint64_t)0x7ffffffffffffU));
+  FStar_UInt128_t
+  b0_ =
+    FStar_UInt128_add(b0,
+      FStar_UInt128_mul_wide((uint64_t)19U,
+        FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b4, (uint32_t)51U))));
+  t[4U] = b4_;
+  t[0U] = b0_;
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, t);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare__(FStar_UInt128_t *tmp, uint64_t *output)
+{
+  uint64_t r0 = output[0U];
+  uint64_t r1 = output[1U];
+  uint64_t r2 = output[2U];
+  uint64_t r3 = output[3U];
+  uint64_t r4 = output[4U];
+  uint64_t d0 = r0 * (uint64_t)2U;
+  uint64_t d1 = r1 * (uint64_t)2U;
+  uint64_t d2 = r2 * (uint64_t)2U * (uint64_t)19U;
+  uint64_t d419 = r4 * (uint64_t)19U;
+  uint64_t d4 = d419 * (uint64_t)2U;
+  FStar_UInt128_t
+  s0 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(r0, r0),
+        FStar_UInt128_mul_wide(d4, r1)),
+      FStar_UInt128_mul_wide(d2, r3));
+  FStar_UInt128_t
+  s1 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r1),
+        FStar_UInt128_mul_wide(d4, r2)),
+      FStar_UInt128_mul_wide(r3 * (uint64_t)19U, r3));
+  FStar_UInt128_t
+  s2 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r2),
+        FStar_UInt128_mul_wide(r1, r1)),
+      FStar_UInt128_mul_wide(d4, r3));
+  FStar_UInt128_t
+  s3 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r3),
+        FStar_UInt128_mul_wide(d1, r2)),
+      FStar_UInt128_mul_wide(r4, d419));
+  FStar_UInt128_t
+  s4 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_mul_wide(d0, r4),
+        FStar_UInt128_mul_wide(d1, r3)),
+      FStar_UInt128_mul_wide(r2, r2));
+  tmp[0U] = s0;
+  tmp[1U] = s1;
+  tmp[2U] = s2;
+  tmp[3U] = s3;
+  tmp[4U] = s4;
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare_(FStar_UInt128_t *tmp, uint64_t *output)
+{
+  Hacl_Bignum_Fsquare_fsquare__(tmp, output);
+  Hacl_Bignum_Fproduct_carry_wide_(tmp);
+  FStar_UInt128_t b4 = tmp[4U];
+  FStar_UInt128_t b0 = tmp[0U];
+  FStar_UInt128_t
+  b4_ = FStar_UInt128_logand(b4, FStar_UInt128_uint64_to_uint128((uint64_t)0x7ffffffffffffU));
+  FStar_UInt128_t
+  b0_ =
+    FStar_UInt128_add(b0,
+      FStar_UInt128_mul_wide((uint64_t)19U,
+        FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b4, (uint32_t)51U))));
+  tmp[4U] = b4_;
+  tmp[0U] = b0_;
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, tmp);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+static void
+Hacl_Bignum_Fsquare_fsquare_times_(uint64_t *input, FStar_UInt128_t *tmp, uint32_t count1)
+{
+  Hacl_Bignum_Fsquare_fsquare_(tmp, input);
+  for (uint32_t i = (uint32_t)1U; i < count1; i = i + (uint32_t)1U)
+    Hacl_Bignum_Fsquare_fsquare_(tmp, input);
+}
+
+inline static void
+Hacl_Bignum_Fsquare_fsquare_times(uint64_t *output, uint64_t *input, uint32_t count1)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  memcpy(output, input, (uint32_t)5U * sizeof input[0U]);
+  Hacl_Bignum_Fsquare_fsquare_times_(output, t, count1);
+}
+
+inline static void Hacl_Bignum_Fsquare_fsquare_times_inplace(uint64_t *output, uint32_t count1)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t t[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fsquare_fsquare_times_(output, t, count1);
+}
+
+inline static void Hacl_Bignum_Crecip_crecip(uint64_t *out, uint64_t *z)
+{
+  uint64_t buf[20U] = { 0U };
+  uint64_t *a = buf;
+  uint64_t *t00 = buf + (uint32_t)5U;
+  uint64_t *b0 = buf + (uint32_t)10U;
+  Hacl_Bignum_Fsquare_fsquare_times(a, z, (uint32_t)1U);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)2U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, z);
+  Hacl_Bignum_Fmul_fmul(a, b0, a);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)1U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, b0);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, b0, (uint32_t)5U);
+  uint64_t *t01 = buf + (uint32_t)5U;
+  uint64_t *b1 = buf + (uint32_t)10U;
+  uint64_t *c0 = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(c0, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, c0, (uint32_t)20U);
+  Hacl_Bignum_Fmul_fmul(t01, t01, c0);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t01, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)50U);
+  uint64_t *a0 = buf;
+  uint64_t *t0 = buf + (uint32_t)5U;
+  uint64_t *b = buf + (uint32_t)10U;
+  uint64_t *c = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(c, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times(t0, c, (uint32_t)100U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, c);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)50U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)5U);
+  Hacl_Bignum_Fmul_fmul(out, t0, a0);
+}
+
+inline static void Hacl_Bignum_Crecip_crecip_(uint64_t *out, uint64_t *z)
+{
+  uint64_t buf[20U] = { 0U };
+  uint64_t *a = buf;
+  uint64_t *t00 = buf + (uint32_t)5U;
+  uint64_t *b0 = buf + (uint32_t)10U;
+  Hacl_Bignum_Fsquare_fsquare_times(a, z, (uint32_t)1U);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)2U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, z);
+  Hacl_Bignum_Fmul_fmul(a, b0, a);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, a, (uint32_t)1U);
+  Hacl_Bignum_Fmul_fmul(b0, t00, b0);
+  Hacl_Bignum_Fsquare_fsquare_times(t00, b0, (uint32_t)5U);
+  uint64_t *t01 = buf + (uint32_t)5U;
+  uint64_t *b1 = buf + (uint32_t)10U;
+  uint64_t *c0 = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(c0, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, c0, (uint32_t)20U);
+  Hacl_Bignum_Fmul_fmul(t01, t01, c0);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t01, (uint32_t)10U);
+  Hacl_Bignum_Fmul_fmul(b1, t01, b1);
+  Hacl_Bignum_Fsquare_fsquare_times(t01, b1, (uint32_t)50U);
+  uint64_t *a0 = buf;
+  Hacl_Bignum_Fsquare_fsquare_times(a0, z, (uint32_t)1U);
+  uint64_t *a1 = buf;
+  uint64_t *t0 = buf + (uint32_t)5U;
+  uint64_t *b = buf + (uint32_t)10U;
+  uint64_t *c = buf + (uint32_t)15U;
+  Hacl_Bignum_Fmul_fmul(c, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times(t0, c, (uint32_t)100U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, c);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)50U);
+  Hacl_Bignum_Fmul_fmul(t0, t0, b);
+  Hacl_Bignum_Fsquare_fsquare_times_inplace(t0, (uint32_t)2U);
+  Hacl_Bignum_Fmul_fmul(out, t0, a1);
+}
+
+inline static void Hacl_Bignum_fsum(uint64_t *a, uint64_t *b)
+{
+  {
+    uint64_t xi = a[0U];
+    uint64_t yi = b[0U];
+    a[0U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[1U];
+    uint64_t yi = b[1U];
+    a[1U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[2U];
+    uint64_t yi = b[2U];
+    a[2U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[3U];
+    uint64_t yi = b[3U];
+    a[3U] = xi + yi;
+  }
+  {
+    uint64_t xi = a[4U];
+    uint64_t yi = b[4U];
+    a[4U] = xi + yi;
+  }
+}
+
+inline static void Hacl_Bignum_fdifference(uint64_t *a, uint64_t *b)
+{
+  uint64_t tmp[5U] = { 0U };
+  memcpy(tmp, b, (uint32_t)5U * sizeof b[0U]);
+  uint64_t b0 = tmp[0U];
+  uint64_t b1 = tmp[1U];
+  uint64_t b2 = tmp[2U];
+  uint64_t b3 = tmp[3U];
+  uint64_t b4 = tmp[4U];
+  tmp[0U] = b0 + (uint64_t)0x3fffffffffff68U;
+  tmp[1U] = b1 + (uint64_t)0x3ffffffffffff8U;
+  tmp[2U] = b2 + (uint64_t)0x3ffffffffffff8U;
+  tmp[3U] = b3 + (uint64_t)0x3ffffffffffff8U;
+  tmp[4U] = b4 + (uint64_t)0x3ffffffffffff8U;
+  {
+    uint64_t xi = a[0U];
+    uint64_t yi = tmp[0U];
+    a[0U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[1U];
+    uint64_t yi = tmp[1U];
+    a[1U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[2U];
+    uint64_t yi = tmp[2U];
+    a[2U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[3U];
+    uint64_t yi = tmp[3U];
+    a[3U] = yi - xi;
+  }
+  {
+    uint64_t xi = a[4U];
+    uint64_t yi = tmp[4U];
+    a[4U] = yi - xi;
+  }
+}
+
+inline static void Hacl_Bignum_fmul(uint64_t *output, uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum_Fmul_fmul(output, a, b);
+}
+
+static void Hacl_EC_Format_fexpand(uint64_t *output, uint8_t *input)
+{
+  uint64_t i0 = load64_le(input);
+  uint8_t *x00 = input + (uint32_t)6U;
+  uint64_t i1 = load64_le(x00);
+  uint8_t *x01 = input + (uint32_t)12U;
+  uint64_t i2 = load64_le(x01);
+  uint8_t *x02 = input + (uint32_t)19U;
+  uint64_t i3 = load64_le(x02);
+  uint8_t *x0 = input + (uint32_t)24U;
+  uint64_t i4 = load64_le(x0);
+  uint64_t output0 = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t output1 = i1 >> (uint32_t)3U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output2 = i2 >> (uint32_t)6U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output3 = i3 >> (uint32_t)1U & (uint64_t)0x7ffffffffffffU;
+  uint64_t output4 = i4 >> (uint32_t)12U & (uint64_t)0x7ffffffffffffU;
+  output[0U] = output0;
+  output[1U] = output1;
+  output[2U] = output2;
+  output[3U] = output3;
+  output[4U] = output4;
+}
+
+static void Hacl_EC_Format_fcontract_first_carry_pass(uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t t1_ = t1 + (t0 >> (uint32_t)51U);
+  uint64_t t0_ = t0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t t2_ = t2 + (t1_ >> (uint32_t)51U);
+  uint64_t t1__ = t1_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t3_ = t3 + (t2_ >> (uint32_t)51U);
+  uint64_t t2__ = t2_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t4_ = t4 + (t3_ >> (uint32_t)51U);
+  uint64_t t3__ = t3_ & (uint64_t)0x7ffffffffffffU;
+  input[0U] = t0_;
+  input[1U] = t1__;
+  input[2U] = t2__;
+  input[3U] = t3__;
+  input[4U] = t4_;
+}
+
+static void Hacl_EC_Format_fcontract_first_carry_full(uint64_t *input)
+{
+  Hacl_EC_Format_fcontract_first_carry_pass(input);
+  Hacl_Bignum_Modulo_carry_top(input);
+}
+
+static void Hacl_EC_Format_fcontract_second_carry_pass(uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t t1_ = t1 + (t0 >> (uint32_t)51U);
+  uint64_t t0_ = t0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t t2_ = t2 + (t1_ >> (uint32_t)51U);
+  uint64_t t1__ = t1_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t3_ = t3 + (t2_ >> (uint32_t)51U);
+  uint64_t t2__ = t2_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t4_ = t4 + (t3_ >> (uint32_t)51U);
+  uint64_t t3__ = t3_ & (uint64_t)0x7ffffffffffffU;
+  input[0U] = t0_;
+  input[1U] = t1__;
+  input[2U] = t2__;
+  input[3U] = t3__;
+  input[4U] = t4_;
+}
+
+static void Hacl_EC_Format_fcontract_second_carry_full(uint64_t *input)
+{
+  Hacl_EC_Format_fcontract_second_carry_pass(input);
+  Hacl_Bignum_Modulo_carry_top(input);
+  uint64_t i0 = input[0U];
+  uint64_t i1 = input[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  input[0U] = i0_;
+  input[1U] = i1_;
+}
+
+static void Hacl_EC_Format_fcontract_trim(uint64_t *input)
+{
+  uint64_t a0 = input[0U];
+  uint64_t a1 = input[1U];
+  uint64_t a2 = input[2U];
+  uint64_t a3 = input[3U];
+  uint64_t a4 = input[4U];
+  uint64_t mask0 = FStar_UInt64_gte_mask(a0, (uint64_t)0x7ffffffffffedU);
+  uint64_t mask1 = FStar_UInt64_eq_mask(a1, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask2 = FStar_UInt64_eq_mask(a2, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask3 = FStar_UInt64_eq_mask(a3, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask4 = FStar_UInt64_eq_mask(a4, (uint64_t)0x7ffffffffffffU);
+  uint64_t mask = (((mask0 & mask1) & mask2) & mask3) & mask4;
+  uint64_t a0_ = a0 - ((uint64_t)0x7ffffffffffedU & mask);
+  uint64_t a1_ = a1 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a2_ = a2 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a3_ = a3 - ((uint64_t)0x7ffffffffffffU & mask);
+  uint64_t a4_ = a4 - ((uint64_t)0x7ffffffffffffU & mask);
+  input[0U] = a0_;
+  input[1U] = a1_;
+  input[2U] = a2_;
+  input[3U] = a3_;
+  input[4U] = a4_;
+}
+
+static void Hacl_EC_Format_reduce(uint64_t *out)
+{
+  Hacl_EC_Format_fcontract_first_carry_full(out);
+  Hacl_EC_Format_fcontract_second_carry_full(out);
+  Hacl_EC_Format_fcontract_trim(out);
+}
+
+static void
+Hacl_Lib_Create64_make_h64_5(
+  uint64_t *b,
+  uint64_t s0,
+  uint64_t s1,
+  uint64_t s2,
+  uint64_t s3,
+  uint64_t s4
+)
+{
+  b[0U] = s0;
+  b[1U] = s1;
+  b[2U] = s2;
+  b[3U] = s3;
+  b[4U] = s4;
+}
+
+static void
+Hacl_Lib_Create64_make_h64_10(
+  uint64_t *b,
+  uint64_t s0,
+  uint64_t s1,
+  uint64_t s2,
+  uint64_t s3,
+  uint64_t s4,
+  uint64_t s5,
+  uint64_t s6,
+  uint64_t s7,
+  uint64_t s8,
+  uint64_t s9
+)
+{
+  b[0U] = s0;
+  b[1U] = s1;
+  b[2U] = s2;
+  b[3U] = s3;
+  b[4U] = s4;
+  b[5U] = s5;
+  b[6U] = s6;
+  b[7U] = s7;
+  b[8U] = s8;
+  b[9U] = s9;
+}
+
+static void Hacl_Bignum25519_fsum(uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum_fsum(a, b);
+}
+
+static void Hacl_Bignum25519_fdifference(uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum_fdifference(a, b);
+}
+
+static void Hacl_Bignum25519_reduce_513(uint64_t *a)
+{
+  uint64_t t0 = a[0U];
+  uint64_t t1 = a[1U];
+  uint64_t t2 = a[2U];
+  uint64_t t3 = a[3U];
+  uint64_t t4 = a[4U];
+  uint64_t t1_ = t1 + (t0 >> (uint32_t)51U);
+  uint64_t t0_ = t0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t t2_ = t2 + (t1_ >> (uint32_t)51U);
+  uint64_t t1__ = t1_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t3_ = t3 + (t2_ >> (uint32_t)51U);
+  uint64_t t2__ = t2_ & (uint64_t)0x7ffffffffffffU;
+  uint64_t t4_ = t4 + (t3_ >> (uint32_t)51U);
+  uint64_t t3__ = t3_ & (uint64_t)0x7ffffffffffffU;
+  Hacl_Lib_Create64_make_h64_5(a, t0_, t1__, t2__, t3__, t4_);
+  Hacl_Bignum_Modulo_carry_top(a);
+  uint64_t i0 = a[0U];
+  uint64_t i1 = a[1U];
+  uint64_t i0_ = i0 & (uint64_t)0x7ffffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)51U);
+  a[0U] = i0_;
+  a[1U] = i1_;
+}
+
+static void Hacl_Bignum25519_fdifference_reduced(uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum25519_fdifference(a, b);
+  Hacl_Bignum25519_reduce_513(a);
+}
+
+static void Hacl_Bignum25519_fmul(uint64_t *out, uint64_t *a, uint64_t *b)
+{
+  Hacl_Bignum_fmul(out, a, b);
+}
+
+static void Hacl_Bignum25519_times_2(uint64_t *out, uint64_t *a)
+{
+  uint64_t a0 = a[0U];
+  uint64_t a1 = a[1U];
+  uint64_t a2 = a[2U];
+  uint64_t a3 = a[3U];
+  uint64_t a4 = a[4U];
+  uint64_t o0 = (uint64_t)2U * a0;
+  uint64_t o1 = (uint64_t)2U * a1;
+  uint64_t o2 = (uint64_t)2U * a2;
+  uint64_t o3 = (uint64_t)2U * a3;
+  uint64_t o4 = (uint64_t)2U * a4;
+  Hacl_Lib_Create64_make_h64_5(out, o0, o1, o2, o3, o4);
+}
+
+static void Hacl_Bignum25519_times_d(uint64_t *out, uint64_t *a)
+{
+  uint64_t d1[5U] = { 0U };
+  Hacl_Lib_Create64_make_h64_5(d1,
+    (uint64_t)0x00034dca135978a3U,
+    (uint64_t)0x0001a8283b156ebdU,
+    (uint64_t)0x0005e7a26001c029U,
+    (uint64_t)0x000739c663a03cbbU,
+    (uint64_t)0x00052036cee2b6ffU);
+  Hacl_Bignum25519_fmul(out, d1, a);
+}
+
+static void Hacl_Bignum25519_times_2d(uint64_t *out, uint64_t *a)
+{
+  uint64_t d2[5U] = { 0U };
+  Hacl_Lib_Create64_make_h64_5(d2,
+    (uint64_t)0x00069b9426b2f159U,
+    (uint64_t)0x00035050762add7aU,
+    (uint64_t)0x0003cf44c0038052U,
+    (uint64_t)0x0006738cc7407977U,
+    (uint64_t)0x0002406d9dc56dffU);
+  Hacl_Bignum25519_fmul(out, a, d2);
+}
+
+static void Hacl_Bignum25519_fsquare(uint64_t *out, uint64_t *a)
+{
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)5U);
+  FStar_UInt128_t tmp[5U];
+  for (uint32_t _i = 0U; _i < (uint32_t)5U; ++_i)
+    tmp[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  memcpy(out, a, (uint32_t)5U * sizeof a[0U]);
+  Hacl_Bignum_Fsquare_fsquare_(tmp, out);
+}
+
+static void Hacl_Bignum25519_inverse(uint64_t *out, uint64_t *a)
+{
+  Hacl_Bignum_Crecip_crecip(out, a);
+}
+
+static void Hacl_Bignum25519_reduce(uint64_t *out)
+{
+  Hacl_EC_Format_reduce(out);
+}
+
+static uint64_t *Hacl_Impl_Ed25519_ExtPoint_getx(uint64_t *p)
+{
+  return p;
+}
+
+static uint64_t *Hacl_Impl_Ed25519_ExtPoint_gety(uint64_t *p)
+{
+  return p + (uint32_t)5U;
+}
+
+static uint64_t *Hacl_Impl_Ed25519_ExtPoint_getz(uint64_t *p)
+{
+  return p + (uint32_t)10U;
+}
+
+static uint64_t *Hacl_Impl_Ed25519_ExtPoint_gett(uint64_t *p)
+{
+  return p + (uint32_t)15U;
+}
+
+static void Hacl_Impl_Ed25519_G_make_g(uint64_t *g1)
+{
+  uint64_t *gx = Hacl_Impl_Ed25519_ExtPoint_getx(g1);
+  uint64_t *gy = Hacl_Impl_Ed25519_ExtPoint_gety(g1);
+  uint64_t *gz = Hacl_Impl_Ed25519_ExtPoint_getz(g1);
+  uint64_t *gt1 = Hacl_Impl_Ed25519_ExtPoint_gett(g1);
+  Hacl_Lib_Create64_make_h64_5(gx,
+    (uint64_t)0x00062d608f25d51aU,
+    (uint64_t)0x000412a4b4f6592aU,
+    (uint64_t)0x00075b7171a4b31dU,
+    (uint64_t)0x0001ff60527118feU,
+    (uint64_t)0x000216936d3cd6e5U);
+  Hacl_Lib_Create64_make_h64_5(gy,
+    (uint64_t)0x0006666666666658U,
+    (uint64_t)0x0004ccccccccccccU,
+    (uint64_t)0x0001999999999999U,
+    (uint64_t)0x0003333333333333U,
+    (uint64_t)0x0006666666666666U);
+  Hacl_Lib_Create64_make_h64_5(gz,
+    (uint64_t)0x0000000000000001U,
+    (uint64_t)0x0000000000000000U,
+    (uint64_t)0x0000000000000000U,
+    (uint64_t)0x0000000000000000U,
+    (uint64_t)0x0000000000000000U);
+  Hacl_Lib_Create64_make_h64_5(gt1,
+    (uint64_t)0x00068ab3a5b7dda3U,
+    (uint64_t)0x00000eea2a5eadbbU,
+    (uint64_t)0x0002af8df483c27eU,
+    (uint64_t)0x000332b375274732U,
+    (uint64_t)0x00067875f0fd78b7U);
+}
+
+static void Hacl_Impl_Store51_store_51_(uint8_t *output, uint64_t *input)
+{
+  uint64_t t0 = input[0U];
+  uint64_t t1 = input[1U];
+  uint64_t t2 = input[2U];
+  uint64_t t3 = input[3U];
+  uint64_t t4 = input[4U];
+  uint64_t o0 = t1 << (uint32_t)51U | t0;
+  uint64_t o1 = t2 << (uint32_t)38U | t1 >> (uint32_t)13U;
+  uint64_t o2 = t3 << (uint32_t)25U | t2 >> (uint32_t)26U;
+  uint64_t o3 = t4 << (uint32_t)12U | t3 >> (uint32_t)39U;
+  uint8_t *b0 = output;
+  uint8_t *b1 = output + (uint32_t)8U;
+  uint8_t *b2 = output + (uint32_t)16U;
+  uint8_t *b3 = output + (uint32_t)24U;
+  store64_le(b0, o0);
+  store64_le(b1, o1);
+  store64_le(b2, o2);
+  store64_le(b3, o3);
+}
+
+static uint64_t Hacl_Impl_Ed25519_PointCompress_x_mod_2(uint64_t *x)
+{
+  uint64_t x0 = x[0U];
+  return x0 & (uint64_t)1U;
+}
+
+static void Hacl_Impl_Ed25519_PointCompress_point_compress(uint8_t *z, uint64_t *p)
+{
+  uint64_t tmp[15U] = { 0U };
+  uint64_t *x0 = tmp + (uint32_t)5U;
+  uint64_t *out0 = tmp + (uint32_t)10U;
+  uint64_t *zinv = tmp;
+  uint64_t *x = tmp + (uint32_t)5U;
+  uint64_t *out = tmp + (uint32_t)10U;
+  uint64_t *px = Hacl_Impl_Ed25519_ExtPoint_getx(p);
+  uint64_t *py = Hacl_Impl_Ed25519_ExtPoint_gety(p);
+  uint64_t *pz = Hacl_Impl_Ed25519_ExtPoint_getz(p);
+  Hacl_Bignum25519_inverse(zinv, pz);
+  Hacl_Bignum25519_fmul(x, px, zinv);
+  Hacl_Bignum25519_reduce(x);
+  Hacl_Bignum25519_fmul(out, py, zinv);
+  Hacl_Bignum25519_reduce(out);
+  uint64_t b = Hacl_Impl_Ed25519_PointCompress_x_mod_2(x0);
+  Hacl_Impl_Store51_store_51_(z, out0);
+  uint8_t xbyte = (uint8_t)b;
+  uint8_t o31 = z[31U];
+  z[31U] = o31 + (xbyte << (uint32_t)7U);
+}
+
+static void
+Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(
+  uint64_t *a_,
+  uint64_t *b_,
+  uint64_t *a,
+  uint64_t *b,
+  uint64_t swap1
+)
+{
+  uint64_t a0 = a[0U];
+  uint64_t a1 = a[1U];
+  uint64_t a2 = a[2U];
+  uint64_t a3 = a[3U];
+  uint64_t a4 = a[4U];
+  uint64_t b0 = b[0U];
+  uint64_t b1 = b[1U];
+  uint64_t b2 = b[2U];
+  uint64_t b3 = b[3U];
+  uint64_t b4 = b[4U];
+  uint64_t x0 = swap1 & (a0 ^ b0);
+  uint64_t x1 = swap1 & (a1 ^ b1);
+  uint64_t x2 = swap1 & (a2 ^ b2);
+  uint64_t x3 = swap1 & (a3 ^ b3);
+  uint64_t x4 = swap1 & (a4 ^ b4);
+  uint64_t a0_ = a0 ^ x0;
+  uint64_t b0_ = b0 ^ x0;
+  uint64_t a1_ = a1 ^ x1;
+  uint64_t b1_ = b1 ^ x1;
+  uint64_t a2_ = a2 ^ x2;
+  uint64_t b2_ = b2 ^ x2;
+  uint64_t a3_ = a3 ^ x3;
+  uint64_t b3_ = b3 ^ x3;
+  uint64_t a4_ = a4 ^ x4;
+  uint64_t b4_ = b4 ^ x4;
+  Hacl_Lib_Create64_make_h64_5(a_, a0_, a1_, a2_, a3_, a4_);
+  Hacl_Lib_Create64_make_h64_5(b_, b0_, b1_, b2_, b3_, b4_);
+}
+
+static void
+Hacl_Impl_Ed25519_SwapConditional_swap_conditional(
+  uint64_t *a_,
+  uint64_t *b_,
+  uint64_t *a,
+  uint64_t *b,
+  uint64_t iswap
+)
+{
+  uint64_t swap1 = (uint64_t)0U - iswap;
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_getx(a_),
+    Hacl_Impl_Ed25519_ExtPoint_getx(b_),
+    Hacl_Impl_Ed25519_ExtPoint_getx(a),
+    Hacl_Impl_Ed25519_ExtPoint_getx(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_gety(a_),
+    Hacl_Impl_Ed25519_ExtPoint_gety(b_),
+    Hacl_Impl_Ed25519_ExtPoint_gety(a),
+    Hacl_Impl_Ed25519_ExtPoint_gety(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_getz(a_),
+    Hacl_Impl_Ed25519_ExtPoint_getz(b_),
+    Hacl_Impl_Ed25519_ExtPoint_getz(a),
+    Hacl_Impl_Ed25519_ExtPoint_getz(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_gett(a_),
+    Hacl_Impl_Ed25519_ExtPoint_gett(b_),
+    Hacl_Impl_Ed25519_ExtPoint_gett(a),
+    Hacl_Impl_Ed25519_ExtPoint_gett(b),
+    swap1);
+}
+
+static void
+Hacl_Impl_Ed25519_SwapConditional_swap_conditional_inplace(
+  uint64_t *a,
+  uint64_t *b,
+  uint64_t iswap
+)
+{
+  uint64_t swap1 = (uint64_t)0U - iswap;
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_getx(a),
+    Hacl_Impl_Ed25519_ExtPoint_getx(b),
+    Hacl_Impl_Ed25519_ExtPoint_getx(a),
+    Hacl_Impl_Ed25519_ExtPoint_getx(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_gety(a),
+    Hacl_Impl_Ed25519_ExtPoint_gety(b),
+    Hacl_Impl_Ed25519_ExtPoint_gety(a),
+    Hacl_Impl_Ed25519_ExtPoint_gety(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_getz(a),
+    Hacl_Impl_Ed25519_ExtPoint_getz(b),
+    Hacl_Impl_Ed25519_ExtPoint_getz(a),
+    Hacl_Impl_Ed25519_ExtPoint_getz(b),
+    swap1);
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_step(Hacl_Impl_Ed25519_ExtPoint_gett(a),
+    Hacl_Impl_Ed25519_ExtPoint_gett(b),
+    Hacl_Impl_Ed25519_ExtPoint_gett(a),
+    Hacl_Impl_Ed25519_ExtPoint_gett(b),
+    swap1);
+}
+
+static void Hacl_Impl_Ed25519_SwapConditional_copy(uint64_t *output, uint64_t *input)
+{
+  memcpy(output, input, (uint32_t)20U * sizeof input[0U]);
+}
+
+static void Hacl_Impl_Ed25519_PointAdd_point_add(uint64_t *out, uint64_t *p, uint64_t *q1)
+{
+  uint64_t tmp[30U] = { 0U };
+  uint64_t *tmp1 = tmp;
+  uint64_t *tmp20 = tmp + (uint32_t)5U;
+  uint64_t *tmp30 = tmp + (uint32_t)10U;
+  uint64_t *tmp40 = tmp + (uint32_t)15U;
+  uint64_t *x1 = Hacl_Impl_Ed25519_ExtPoint_getx(p);
+  uint64_t *y1 = Hacl_Impl_Ed25519_ExtPoint_gety(p);
+  uint64_t *x2 = Hacl_Impl_Ed25519_ExtPoint_getx(q1);
+  uint64_t *y2 = Hacl_Impl_Ed25519_ExtPoint_gety(q1);
+  memcpy(tmp1, x1, (uint32_t)5U * sizeof x1[0U]);
+  memcpy(tmp20, x2, (uint32_t)5U * sizeof x2[0U]);
+  Hacl_Bignum25519_fdifference_reduced(tmp1, y1);
+  Hacl_Bignum25519_fdifference(tmp20, y2);
+  Hacl_Bignum25519_fmul(tmp30, tmp1, tmp20);
+  memcpy(tmp1, y1, (uint32_t)5U * sizeof y1[0U]);
+  memcpy(tmp20, y2, (uint32_t)5U * sizeof y2[0U]);
+  Hacl_Bignum25519_fsum(tmp1, x1);
+  Hacl_Bignum25519_fsum(tmp20, x2);
+  Hacl_Bignum25519_fmul(tmp40, tmp1, tmp20);
+  uint64_t *tmp10 = tmp;
+  uint64_t *tmp21 = tmp + (uint32_t)5U;
+  uint64_t *tmp31 = tmp + (uint32_t)10U;
+  uint64_t *tmp50 = tmp + (uint32_t)20U;
+  uint64_t *tmp60 = tmp + (uint32_t)25U;
+  uint64_t *z1 = Hacl_Impl_Ed25519_ExtPoint_getz(p);
+  uint64_t *t1 = Hacl_Impl_Ed25519_ExtPoint_gett(p);
+  uint64_t *z2 = Hacl_Impl_Ed25519_ExtPoint_getz(q1);
+  uint64_t *t2 = Hacl_Impl_Ed25519_ExtPoint_gett(q1);
+  Hacl_Bignum25519_times_2d(tmp10, t1);
+  Hacl_Bignum25519_fmul(tmp21, tmp10, t2);
+  Hacl_Bignum25519_times_2(tmp10, z1);
+  Hacl_Bignum25519_fmul(tmp50, tmp10, z2);
+  memcpy(tmp10, tmp31, (uint32_t)5U * sizeof tmp31[0U]);
+  memcpy(tmp60, tmp21, (uint32_t)5U * sizeof tmp21[0U]);
+  uint64_t *tmp11 = tmp;
+  uint64_t *tmp2 = tmp + (uint32_t)5U;
+  uint64_t *tmp3 = tmp + (uint32_t)10U;
+  uint64_t *tmp41 = tmp + (uint32_t)15U;
+  uint64_t *tmp51 = tmp + (uint32_t)20U;
+  uint64_t *tmp61 = tmp + (uint32_t)25U;
+  Hacl_Bignum25519_fdifference_reduced(tmp11, tmp41);
+  Hacl_Bignum25519_fdifference(tmp61, tmp51);
+  Hacl_Bignum25519_fsum(tmp51, tmp2);
+  Hacl_Bignum25519_fsum(tmp41, tmp3);
+  uint64_t *tmp12 = tmp;
+  uint64_t *tmp4 = tmp + (uint32_t)15U;
+  uint64_t *tmp5 = tmp + (uint32_t)20U;
+  uint64_t *tmp6 = tmp + (uint32_t)25U;
+  uint64_t *x3 = Hacl_Impl_Ed25519_ExtPoint_getx(out);
+  uint64_t *y3 = Hacl_Impl_Ed25519_ExtPoint_gety(out);
+  uint64_t *z3 = Hacl_Impl_Ed25519_ExtPoint_getz(out);
+  uint64_t *t3 = Hacl_Impl_Ed25519_ExtPoint_gett(out);
+  Hacl_Bignum25519_fmul(x3, tmp12, tmp6);
+  Hacl_Bignum25519_fmul(y3, tmp5, tmp4);
+  Hacl_Bignum25519_fmul(t3, tmp12, tmp4);
+  Hacl_Bignum25519_fmul(z3, tmp5, tmp6);
+}
+
+static void Hacl_Impl_Ed25519_PointDouble_point_double_step_1(uint64_t *p, uint64_t *tmp)
+{
+  uint64_t *tmp1 = tmp;
+  uint64_t *tmp2 = tmp + (uint32_t)5U;
+  uint64_t *tmp3 = tmp + (uint32_t)10U;
+  uint64_t *tmp4 = tmp + (uint32_t)15U;
+  uint64_t *x1 = Hacl_Impl_Ed25519_ExtPoint_getx(p);
+  uint64_t *y1 = Hacl_Impl_Ed25519_ExtPoint_gety(p);
+  uint64_t *z1 = Hacl_Impl_Ed25519_ExtPoint_getz(p);
+  Hacl_Bignum25519_fsquare(tmp1, x1);
+  Hacl_Bignum25519_fsquare(tmp2, y1);
+  Hacl_Bignum25519_fsquare(tmp3, z1);
+  Hacl_Bignum25519_times_2(tmp4, tmp3);
+  memcpy(tmp3, tmp1, (uint32_t)5U * sizeof tmp1[0U]);
+  Hacl_Bignum25519_fsum(tmp3, tmp2);
+  Hacl_Bignum25519_reduce_513(tmp3);
+}
+
+static void Hacl_Impl_Ed25519_PointDouble_point_double_step_2(uint64_t *p, uint64_t *tmp)
+{
+  uint64_t *tmp1 = tmp;
+  uint64_t *tmp2 = tmp + (uint32_t)5U;
+  uint64_t *tmp3 = tmp + (uint32_t)10U;
+  uint64_t *tmp4 = tmp + (uint32_t)15U;
+  uint64_t *tmp5 = tmp + (uint32_t)20U;
+  uint64_t *tmp6 = tmp + (uint32_t)25U;
+  uint64_t *x1 = Hacl_Impl_Ed25519_ExtPoint_getx(p);
+  uint64_t *y1 = Hacl_Impl_Ed25519_ExtPoint_gety(p);
+  memcpy(tmp5, x1, (uint32_t)5U * sizeof x1[0U]);
+  Hacl_Bignum25519_fsum(tmp5, y1);
+  Hacl_Bignum25519_fsquare(tmp6, tmp5);
+  memcpy(tmp5, tmp3, (uint32_t)5U * sizeof tmp3[0U]);
+  Hacl_Bignum25519_fdifference(tmp6, tmp5);
+  Hacl_Bignum25519_fdifference_reduced(tmp2, tmp1);
+  Hacl_Bignum25519_reduce_513(tmp4);
+  Hacl_Bignum25519_fsum(tmp4, tmp2);
+}
+
+static void
+Hacl_Impl_Ed25519_PointDouble_point_double_(uint64_t *out, uint64_t *p, uint64_t *tmp)
+{
+  uint64_t *tmp2 = tmp + (uint32_t)5U;
+  uint64_t *tmp3 = tmp + (uint32_t)10U;
+  uint64_t *tmp4 = tmp + (uint32_t)15U;
+  uint64_t *tmp6 = tmp + (uint32_t)25U;
+  uint64_t *x3 = Hacl_Impl_Ed25519_ExtPoint_getx(out);
+  uint64_t *y3 = Hacl_Impl_Ed25519_ExtPoint_gety(out);
+  uint64_t *z3 = Hacl_Impl_Ed25519_ExtPoint_getz(out);
+  uint64_t *t3 = Hacl_Impl_Ed25519_ExtPoint_gett(out);
+  Hacl_Impl_Ed25519_PointDouble_point_double_step_1(p, tmp);
+  Hacl_Impl_Ed25519_PointDouble_point_double_step_2(p, tmp);
+  Hacl_Bignum25519_fmul(x3, tmp4, tmp6);
+  Hacl_Bignum25519_fmul(y3, tmp2, tmp3);
+  Hacl_Bignum25519_fmul(t3, tmp3, tmp6);
+  Hacl_Bignum25519_fmul(z3, tmp4, tmp2);
+}
+
+static void Hacl_Impl_Ed25519_PointDouble_point_double(uint64_t *out, uint64_t *p)
+{
+  uint64_t tmp[30U] = { 0U };
+  Hacl_Impl_Ed25519_PointDouble_point_double_(out, p, tmp);
+}
+
+static uint8_t Hacl_Impl_Ed25519_Ladder_Step_ith_bit(uint8_t *k1, uint32_t i)
+{
+  uint32_t q1 = i >> (uint32_t)3U;
+  uint32_t r = i & (uint32_t)7U;
+  uint8_t kq = k1[q1];
+  return kq >> r & (uint8_t)1U;
+}
+
+static void
+Hacl_Impl_Ed25519_Ladder_Step_swap_cond_inplace(uint64_t *p, uint64_t *q1, uint64_t iswap)
+{
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional_inplace(p, q1, iswap);
+}
+
+static void
+Hacl_Impl_Ed25519_Ladder_Step_swap_cond(
+  uint64_t *p_,
+  uint64_t *q_,
+  uint64_t *p,
+  uint64_t *q1,
+  uint64_t iswap
+)
+{
+  Hacl_Impl_Ed25519_SwapConditional_swap_conditional(p_, q_, p, q1, iswap);
+}
+
+static void
+Hacl_Impl_Ed25519_Ladder_Step_loop_step_1(uint64_t *b, uint8_t *k1, uint32_t ctr, uint8_t i)
+{
+  uint64_t *nq = b;
+  uint64_t *nqpq = b + (uint32_t)20U;
+  uint64_t bit = (uint64_t)i;
+  Hacl_Impl_Ed25519_Ladder_Step_swap_cond_inplace(nq, nqpq, bit);
+}
+
+static void Hacl_Impl_Ed25519_Ladder_Step_loop_step_2(uint64_t *b, uint8_t *k1, uint32_t ctr)
+{
+  uint64_t *nq = b;
+  uint64_t *nqpq = b + (uint32_t)20U;
+  uint64_t *nq2 = b + (uint32_t)40U;
+  uint64_t *nqpq2 = b + (uint32_t)60U;
+  Hacl_Impl_Ed25519_PointDouble_point_double(nq2, nq);
+  Hacl_Impl_Ed25519_PointAdd_point_add(nqpq2, nq, nqpq);
+}
+
+static void
+Hacl_Impl_Ed25519_Ladder_Step_loop_step_3(uint64_t *b, uint8_t *k1, uint32_t ctr, uint8_t i)
+{
+  uint64_t *nq = b;
+  uint64_t *nqpq = b + (uint32_t)20U;
+  uint64_t *nq2 = b + (uint32_t)40U;
+  uint64_t *nqpq2 = b + (uint32_t)60U;
+  uint64_t bit = (uint64_t)i;
+  Hacl_Impl_Ed25519_Ladder_Step_swap_cond(nq, nqpq, nq2, nqpq2, bit);
+}
+
+static void Hacl_Impl_Ed25519_Ladder_Step_loop_step(uint64_t *b, uint8_t *k1, uint32_t ctr)
+{
+  uint8_t bit = Hacl_Impl_Ed25519_Ladder_Step_ith_bit(k1, ctr);
+  Hacl_Impl_Ed25519_Ladder_Step_loop_step_1(b, k1, ctr, bit);
+  Hacl_Impl_Ed25519_Ladder_Step_loop_step_2(b, k1, ctr);
+  Hacl_Impl_Ed25519_Ladder_Step_loop_step_3(b, k1, ctr, bit);
+}
+
+static void Hacl_Impl_Ed25519_Ladder_point_mul_(uint64_t *b, uint8_t *k1)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)256U; i = i + (uint32_t)1U)
+    Hacl_Impl_Ed25519_Ladder_Step_loop_step(b, k1, (uint32_t)256U - i - (uint32_t)1U);
+}
+
+static void Hacl_Impl_Ed25519_Ladder_make_point_inf(uint64_t *b)
+{
+  uint64_t *x = b;
+  uint64_t *y = b + (uint32_t)5U;
+  uint64_t *z = b + (uint32_t)10U;
+  uint64_t *t = b + (uint32_t)15U;
+  uint64_t zero1 = (uint64_t)0U;
+  Hacl_Lib_Create64_make_h64_5(x, zero1, zero1, zero1, zero1, zero1);
+  uint64_t zero10 = (uint64_t)0U;
+  uint64_t one10 = (uint64_t)1U;
+  Hacl_Lib_Create64_make_h64_5(y, one10, zero10, zero10, zero10, zero10);
+  uint64_t zero11 = (uint64_t)0U;
+  uint64_t one1 = (uint64_t)1U;
+  Hacl_Lib_Create64_make_h64_5(z, one1, zero11, zero11, zero11, zero11);
+  uint64_t zero12 = (uint64_t)0U;
+  Hacl_Lib_Create64_make_h64_5(t, zero12, zero12, zero12, zero12, zero12);
+}
+
+static void Hacl_Impl_Ed25519_Ladder_point_mul(uint64_t *result, uint8_t *scalar, uint64_t *q1)
+{
+  uint64_t b[80U] = { 0U };
+  uint64_t *nq = b;
+  uint64_t *nqpq = b + (uint32_t)20U;
+  Hacl_Impl_Ed25519_Ladder_make_point_inf(nq);
+  Hacl_Impl_Ed25519_SwapConditional_copy(nqpq, q1);
+  Hacl_Impl_Ed25519_Ladder_point_mul_(b, scalar);
+  Hacl_Impl_Ed25519_SwapConditional_copy(result, nq);
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(uint64_t *output, uint8_t *input, uint32_t len1)
+{
+  for (uint32_t i = (uint32_t)0U; i < len1; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)8U * i;
+    uint64_t inputi = load64_be(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(uint8_t *output, uint64_t *input, uint32_t len1)
+{
+  for (uint32_t i = (uint32_t)0U; i < len1; i = i + (uint32_t)1U)
+  {
+    uint64_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)8U * i;
+    store64_be(x0, hd1);
+  }
+}
+
+static void Hacl_Impl_SHA2_512_init(uint64_t *state)
+{
+  uint64_t *n1 = state + (uint32_t)168U;
+  uint64_t *k1 = state;
+  uint64_t *h_01 = state + (uint32_t)160U;
+  uint64_t *p10 = k1;
+  uint64_t *p20 = k1 + (uint32_t)16U;
+  uint64_t *p3 = k1 + (uint32_t)32U;
+  uint64_t *p4 = k1 + (uint32_t)48U;
+  uint64_t *p5 = k1 + (uint32_t)64U;
+  uint64_t *p11 = p10;
+  uint64_t *p21 = p10 + (uint32_t)8U;
+  uint64_t *p12 = p11;
+  uint64_t *p22 = p11 + (uint32_t)4U;
+  p12[0U] = (uint64_t)0x428a2f98d728ae22U;
+  p12[1U] = (uint64_t)0x7137449123ef65cdU;
+  p12[2U] = (uint64_t)0xb5c0fbcfec4d3b2fU;
+  p12[3U] = (uint64_t)0xe9b5dba58189dbbcU;
+  p22[0U] = (uint64_t)0x3956c25bf348b538U;
+  p22[1U] = (uint64_t)0x59f111f1b605d019U;
+  p22[2U] = (uint64_t)0x923f82a4af194f9bU;
+  p22[3U] = (uint64_t)0xab1c5ed5da6d8118U;
+  uint64_t *p13 = p21;
+  uint64_t *p23 = p21 + (uint32_t)4U;
+  p13[0U] = (uint64_t)0xd807aa98a3030242U;
+  p13[1U] = (uint64_t)0x12835b0145706fbeU;
+  p13[2U] = (uint64_t)0x243185be4ee4b28cU;
+  p13[3U] = (uint64_t)0x550c7dc3d5ffb4e2U;
+  p23[0U] = (uint64_t)0x72be5d74f27b896fU;
+  p23[1U] = (uint64_t)0x80deb1fe3b1696b1U;
+  p23[2U] = (uint64_t)0x9bdc06a725c71235U;
+  p23[3U] = (uint64_t)0xc19bf174cf692694U;
+  uint64_t *p14 = p20;
+  uint64_t *p24 = p20 + (uint32_t)8U;
+  uint64_t *p15 = p14;
+  uint64_t *p25 = p14 + (uint32_t)4U;
+  p15[0U] = (uint64_t)0xe49b69c19ef14ad2U;
+  p15[1U] = (uint64_t)0xefbe4786384f25e3U;
+  p15[2U] = (uint64_t)0x0fc19dc68b8cd5b5U;
+  p15[3U] = (uint64_t)0x240ca1cc77ac9c65U;
+  p25[0U] = (uint64_t)0x2de92c6f592b0275U;
+  p25[1U] = (uint64_t)0x4a7484aa6ea6e483U;
+  p25[2U] = (uint64_t)0x5cb0a9dcbd41fbd4U;
+  p25[3U] = (uint64_t)0x76f988da831153b5U;
+  uint64_t *p16 = p24;
+  uint64_t *p26 = p24 + (uint32_t)4U;
+  p16[0U] = (uint64_t)0x983e5152ee66dfabU;
+  p16[1U] = (uint64_t)0xa831c66d2db43210U;
+  p16[2U] = (uint64_t)0xb00327c898fb213fU;
+  p16[3U] = (uint64_t)0xbf597fc7beef0ee4U;
+  p26[0U] = (uint64_t)0xc6e00bf33da88fc2U;
+  p26[1U] = (uint64_t)0xd5a79147930aa725U;
+  p26[2U] = (uint64_t)0x06ca6351e003826fU;
+  p26[3U] = (uint64_t)0x142929670a0e6e70U;
+  uint64_t *p17 = p3;
+  uint64_t *p27 = p3 + (uint32_t)8U;
+  uint64_t *p18 = p17;
+  uint64_t *p28 = p17 + (uint32_t)4U;
+  p18[0U] = (uint64_t)0x27b70a8546d22ffcU;
+  p18[1U] = (uint64_t)0x2e1b21385c26c926U;
+  p18[2U] = (uint64_t)0x4d2c6dfc5ac42aedU;
+  p18[3U] = (uint64_t)0x53380d139d95b3dfU;
+  p28[0U] = (uint64_t)0x650a73548baf63deU;
+  p28[1U] = (uint64_t)0x766a0abb3c77b2a8U;
+  p28[2U] = (uint64_t)0x81c2c92e47edaee6U;
+  p28[3U] = (uint64_t)0x92722c851482353bU;
+  uint64_t *p19 = p27;
+  uint64_t *p29 = p27 + (uint32_t)4U;
+  p19[0U] = (uint64_t)0xa2bfe8a14cf10364U;
+  p19[1U] = (uint64_t)0xa81a664bbc423001U;
+  p19[2U] = (uint64_t)0xc24b8b70d0f89791U;
+  p19[3U] = (uint64_t)0xc76c51a30654be30U;
+  p29[0U] = (uint64_t)0xd192e819d6ef5218U;
+  p29[1U] = (uint64_t)0xd69906245565a910U;
+  p29[2U] = (uint64_t)0xf40e35855771202aU;
+  p29[3U] = (uint64_t)0x106aa07032bbd1b8U;
+  uint64_t *p110 = p4;
+  uint64_t *p210 = p4 + (uint32_t)8U;
+  uint64_t *p111 = p110;
+  uint64_t *p211 = p110 + (uint32_t)4U;
+  p111[0U] = (uint64_t)0x19a4c116b8d2d0c8U;
+  p111[1U] = (uint64_t)0x1e376c085141ab53U;
+  p111[2U] = (uint64_t)0x2748774cdf8eeb99U;
+  p111[3U] = (uint64_t)0x34b0bcb5e19b48a8U;
+  p211[0U] = (uint64_t)0x391c0cb3c5c95a63U;
+  p211[1U] = (uint64_t)0x4ed8aa4ae3418acbU;
+  p211[2U] = (uint64_t)0x5b9cca4f7763e373U;
+  p211[3U] = (uint64_t)0x682e6ff3d6b2b8a3U;
+  uint64_t *p112 = p210;
+  uint64_t *p212 = p210 + (uint32_t)4U;
+  p112[0U] = (uint64_t)0x748f82ee5defb2fcU;
+  p112[1U] = (uint64_t)0x78a5636f43172f60U;
+  p112[2U] = (uint64_t)0x84c87814a1f0ab72U;
+  p112[3U] = (uint64_t)0x8cc702081a6439ecU;
+  p212[0U] = (uint64_t)0x90befffa23631e28U;
+  p212[1U] = (uint64_t)0xa4506cebde82bde9U;
+  p212[2U] = (uint64_t)0xbef9a3f7b2c67915U;
+  p212[3U] = (uint64_t)0xc67178f2e372532bU;
+  uint64_t *p113 = p5;
+  uint64_t *p213 = p5 + (uint32_t)8U;
+  uint64_t *p1 = p113;
+  uint64_t *p214 = p113 + (uint32_t)4U;
+  p1[0U] = (uint64_t)0xca273eceea26619cU;
+  p1[1U] = (uint64_t)0xd186b8c721c0c207U;
+  p1[2U] = (uint64_t)0xeada7dd6cde0eb1eU;
+  p1[3U] = (uint64_t)0xf57d4f7fee6ed178U;
+  p214[0U] = (uint64_t)0x06f067aa72176fbaU;
+  p214[1U] = (uint64_t)0x0a637dc5a2c898a6U;
+  p214[2U] = (uint64_t)0x113f9804bef90daeU;
+  p214[3U] = (uint64_t)0x1b710b35131c471bU;
+  uint64_t *p114 = p213;
+  uint64_t *p215 = p213 + (uint32_t)4U;
+  p114[0U] = (uint64_t)0x28db77f523047d84U;
+  p114[1U] = (uint64_t)0x32caab7b40c72493U;
+  p114[2U] = (uint64_t)0x3c9ebe0a15c9bebcU;
+  p114[3U] = (uint64_t)0x431d67c49c100d4cU;
+  p215[0U] = (uint64_t)0x4cc5d4becb3e42b6U;
+  p215[1U] = (uint64_t)0x597f299cfc657e2aU;
+  p215[2U] = (uint64_t)0x5fcb6fab3ad6faecU;
+  p215[3U] = (uint64_t)0x6c44198c4a475817U;
+  uint64_t *p115 = h_01;
+  uint64_t *p2 = h_01 + (uint32_t)4U;
+  p115[0U] = (uint64_t)0x6a09e667f3bcc908U;
+  p115[1U] = (uint64_t)0xbb67ae8584caa73bU;
+  p115[2U] = (uint64_t)0x3c6ef372fe94f82bU;
+  p115[3U] = (uint64_t)0xa54ff53a5f1d36f1U;
+  p2[0U] = (uint64_t)0x510e527fade682d1U;
+  p2[1U] = (uint64_t)0x9b05688c2b3e6c1fU;
+  p2[2U] = (uint64_t)0x1f83d9abfb41bd6bU;
+  p2[3U] = (uint64_t)0x5be0cd19137e2179U;
+  n1[0U] = (uint64_t)0U;
+}
+
+static void Hacl_Impl_SHA2_512_update(uint64_t *state, uint8_t *data)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)16U);
+  uint64_t data_w[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    data_w[_i] = (uint64_t)(uint32_t)0U;
+  Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(data_w, data, (uint32_t)16U);
+  uint64_t *hash_w = state + (uint32_t)160U;
+  uint64_t *ws_w = state + (uint32_t)80U;
+  uint64_t *k_w = state;
+  uint64_t *counter_w = state + (uint32_t)168U;
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint64_t b = data_w[i];
+    ws_w[i] = b;
+  }
+  for (uint32_t i = (uint32_t)16U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t t16 = ws_w[i - (uint32_t)16U];
+    uint64_t t15 = ws_w[i - (uint32_t)15U];
+    uint64_t t7 = ws_w[i - (uint32_t)7U];
+    uint64_t t2 = ws_w[i - (uint32_t)2U];
+    ws_w[i] =
+      ((t2 >> (uint32_t)19U | t2 << ((uint32_t)64U - (uint32_t)19U))
+      ^ ((t2 >> (uint32_t)61U | t2 << ((uint32_t)64U - (uint32_t)61U)) ^ t2 >> (uint32_t)6U))
+      +
+        t7
+        +
+          ((t15 >> (uint32_t)1U | t15 << ((uint32_t)64U - (uint32_t)1U))
+          ^ ((t15 >> (uint32_t)8U | t15 << ((uint32_t)64U - (uint32_t)8U)) ^ t15 >> (uint32_t)7U))
+          + t16;
+  }
+  uint64_t hash_0[8U] = { 0U };
+  memcpy(hash_0, hash_w, (uint32_t)8U * sizeof hash_w[0U]);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t a = hash_0[0U];
+    uint64_t b = hash_0[1U];
+    uint64_t c = hash_0[2U];
+    uint64_t d1 = hash_0[3U];
+    uint64_t e = hash_0[4U];
+    uint64_t f1 = hash_0[5U];
+    uint64_t g1 = hash_0[6U];
+    uint64_t h = hash_0[7U];
+    uint64_t k_t = k_w[i];
+    uint64_t ws_t = ws_w[i];
+    uint64_t
+    t1 =
+      h
+      +
+        ((e >> (uint32_t)14U | e << ((uint32_t)64U - (uint32_t)14U))
+        ^
+          ((e >> (uint32_t)18U | e << ((uint32_t)64U - (uint32_t)18U))
+          ^ (e >> (uint32_t)41U | e << ((uint32_t)64U - (uint32_t)41U))))
+      + ((e & f1) ^ (~e & g1))
+      + k_t
+      + ws_t;
+    uint64_t
+    t2 =
+      ((a >> (uint32_t)28U | a << ((uint32_t)64U - (uint32_t)28U))
+      ^
+        ((a >> (uint32_t)34U | a << ((uint32_t)64U - (uint32_t)34U))
+        ^ (a >> (uint32_t)39U | a << ((uint32_t)64U - (uint32_t)39U))))
+      + ((a & b) ^ ((a & c) ^ (b & c)));
+    uint64_t x1 = t1 + t2;
+    uint64_t x5 = d1 + t1;
+    uint64_t *p1 = hash_0;
+    uint64_t *p2 = hash_0 + (uint32_t)4U;
+    p1[0U] = x1;
+    p1[1U] = a;
+    p1[2U] = b;
+    p1[3U] = c;
+    p2[0U] = x5;
+    p2[1U] = e;
+    p2[2U] = f1;
+    p2[3U] = g1;
+  }
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)8U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = hash_w[i];
+    uint64_t yi = hash_0[i];
+    hash_w[i] = xi + yi;
+  }
+  uint64_t c0 = counter_w[0U];
+  uint64_t one1 = (uint64_t)(uint32_t)1U;
+  counter_w[0U] = c0 + one1;
+}
+
+static void Hacl_Impl_SHA2_512_update_multi(uint64_t *state, uint8_t *data, uint32_t n1)
+{
+  for (uint32_t i = (uint32_t)0U; i < n1; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = data + i * (uint32_t)128U;
+    Hacl_Impl_SHA2_512_update(state, b);
+  }
+}
+
+static void Hacl_Impl_SHA2_512_update_last(uint64_t *state, uint8_t *data, uint64_t len1)
+{
+  uint8_t blocks[256U] = { 0U };
+  uint32_t nb;
+  if (len1 < (uint64_t)112U)
+    nb = (uint32_t)1U;
+  else
+    nb = (uint32_t)2U;
+  uint8_t *final_blocks;
+  if (len1 < (uint64_t)112U)
+    final_blocks = blocks + (uint32_t)128U;
+  else
+    final_blocks = blocks;
+  memcpy(final_blocks, data, (uint32_t)len1 * sizeof data[0U]);
+  uint64_t n1 = state[168U];
+  uint8_t *padding = final_blocks + (uint32_t)len1;
+  FStar_UInt128_t
+  encodedlen =
+    FStar_UInt128_shift_left(FStar_UInt128_add(FStar_UInt128_mul_wide(n1, (uint64_t)(uint32_t)128U),
+        FStar_UInt128_uint64_to_uint128(len1)),
+      (uint32_t)3U);
+  uint32_t
+  pad0len = ((uint32_t)256U - ((uint32_t)len1 + (uint32_t)16U + (uint32_t)1U)) % (uint32_t)128U;
+  uint8_t *buf1 = padding;
+  uint8_t *buf2 = padding + (uint32_t)1U + pad0len;
+  buf1[0U] = (uint8_t)0x80U;
+  store128_be(buf2, encodedlen);
+  Hacl_Impl_SHA2_512_update_multi(state, final_blocks, nb);
+}
+
+static void Hacl_Impl_SHA2_512_finish(uint64_t *state, uint8_t *hash1)
+{
+  uint64_t *hash_w = state + (uint32_t)160U;
+  Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(hash1, hash_w, (uint32_t)8U);
+}
+
+static void Hacl_Impl_SHA2_512_hash(uint8_t *hash1, uint8_t *input, uint32_t len1)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)169U);
+  uint64_t state[169U];
+  for (uint32_t _i = 0U; _i < (uint32_t)169U; ++_i)
+    state[_i] = (uint64_t)(uint32_t)0U;
+  uint32_t n1 = len1 / (uint32_t)128U;
+  uint32_t r = len1 % (uint32_t)128U;
+  uint8_t *input_blocks = input;
+  uint8_t *input_last = input + n1 * (uint32_t)128U;
+  Hacl_Impl_SHA2_512_init(state);
+  Hacl_Impl_SHA2_512_update_multi(state, input_blocks, n1);
+  Hacl_Impl_SHA2_512_update_last(state, input_last, (uint64_t)r);
+  Hacl_Impl_SHA2_512_finish(state, hash1);
+}
+
+static void Hacl_SHA2_512_hash(uint8_t *hash1, uint8_t *input, uint32_t len1)
+{
+  Hacl_Impl_SHA2_512_hash(hash1, input, len1);
+}
+
+static void Hacl_Impl_Ed25519_SecretExpand_secret_expand(uint8_t *expanded, uint8_t *secret)
+{
+  Hacl_SHA2_512_hash(expanded, secret, (uint32_t)32U);
+  uint8_t *h_low = expanded;
+  uint8_t h_low0 = h_low[0U];
+  uint8_t h_low31 = h_low[31U];
+  h_low[0U] = h_low0 & (uint8_t)0xf8U;
+  h_low[31U] = (h_low31 & (uint8_t)127U) | (uint8_t)64U;
+}
+
+static void Hacl_Impl_Ed25519_SecretToPublic_point_mul_g(uint64_t *result, uint8_t *scalar)
+{
+  uint64_t g1[20U] = { 0U };
+  Hacl_Impl_Ed25519_G_make_g(g1);
+  Hacl_Impl_Ed25519_Ladder_point_mul(result, scalar, g1);
+}
+
+static void
+Hacl_Impl_Ed25519_SecretToPublic_secret_to_public_(
+  uint8_t *out,
+  uint8_t *secret,
+  uint8_t *expanded_secret
+)
+{
+  uint8_t *a = expanded_secret;
+  uint64_t res[20U] = { 0U };
+  Hacl_Impl_Ed25519_SecretToPublic_point_mul_g(res, a);
+  Hacl_Impl_Ed25519_PointCompress_point_compress(out, res);
+}
+
+static void Hacl_Impl_Ed25519_SecretToPublic_secret_to_public(uint8_t *out, uint8_t *secret)
+{
+  uint8_t expanded[64U] = { 0U };
+  Hacl_Impl_Ed25519_SecretExpand_secret_expand(expanded, secret);
+  Hacl_Impl_Ed25519_SecretToPublic_secret_to_public_(out, secret, expanded);
+}
+
+static bool Hacl_Impl_Ed25519_PointEqual_gte_q(uint64_t *s)
+{
+  uint64_t s0 = s[0U];
+  uint64_t s1 = s[1U];
+  uint64_t s2 = s[2U];
+  uint64_t s3 = s[3U];
+  uint64_t s4 = s[4U];
+  if (s4 > (uint64_t)0x00000010000000U)
+    return true;
+  else if (s4 < (uint64_t)0x00000010000000U)
+    return false;
+  else if (s3 > (uint64_t)0x00000000000000U)
+    return true;
+  else if (s2 > (uint64_t)0x000000000014deU)
+    return true;
+  else if (s2 < (uint64_t)0x000000000014deU)
+    return false;
+  else if (s1 > (uint64_t)0xf9dea2f79cd658U)
+    return true;
+  else if (s1 < (uint64_t)0xf9dea2f79cd658U)
+    return false;
+  else if (s0 >= (uint64_t)0x12631a5cf5d3edU)
+    return true;
+  else
+    return false;
+}
+
+static bool Hacl_Impl_Ed25519_PointEqual_eq(uint64_t *a, uint64_t *b)
+{
+  uint64_t a0 = a[0U];
+  uint64_t a1 = a[1U];
+  uint64_t a2 = a[2U];
+  uint64_t a3 = a[3U];
+  uint64_t a4 = a[4U];
+  uint64_t b0 = b[0U];
+  uint64_t b1 = b[1U];
+  uint64_t b2 = b[2U];
+  uint64_t b3 = b[3U];
+  uint64_t b4 = b[4U];
+  bool z = a0 == b0 && a1 == b1 && a2 == b2 && a3 == b3 && a4 == b4;
+  return z;
+}
+
+static bool
+Hacl_Impl_Ed25519_PointEqual_point_equal_1(uint64_t *p, uint64_t *q1, uint64_t *tmp)
+{
+  uint64_t *pxqz = tmp;
+  uint64_t *qxpz = tmp + (uint32_t)5U;
+  Hacl_Bignum25519_fmul(pxqz,
+    Hacl_Impl_Ed25519_ExtPoint_getx(p),
+    Hacl_Impl_Ed25519_ExtPoint_getz(q1));
+  Hacl_Bignum25519_reduce(pxqz);
+  Hacl_Bignum25519_fmul(qxpz,
+    Hacl_Impl_Ed25519_ExtPoint_getx(q1),
+    Hacl_Impl_Ed25519_ExtPoint_getz(p));
+  Hacl_Bignum25519_reduce(qxpz);
+  bool b = Hacl_Impl_Ed25519_PointEqual_eq(pxqz, qxpz);
+  return b;
+}
+
+static bool
+Hacl_Impl_Ed25519_PointEqual_point_equal_2(uint64_t *p, uint64_t *q1, uint64_t *tmp)
+{
+  uint64_t *pyqz = tmp + (uint32_t)10U;
+  uint64_t *qypz = tmp + (uint32_t)15U;
+  Hacl_Bignum25519_fmul(pyqz,
+    Hacl_Impl_Ed25519_ExtPoint_gety(p),
+    Hacl_Impl_Ed25519_ExtPoint_getz(q1));
+  Hacl_Bignum25519_reduce(pyqz);
+  Hacl_Bignum25519_fmul(qypz,
+    Hacl_Impl_Ed25519_ExtPoint_gety(q1),
+    Hacl_Impl_Ed25519_ExtPoint_getz(p));
+  Hacl_Bignum25519_reduce(qypz);
+  bool b = Hacl_Impl_Ed25519_PointEqual_eq(pyqz, qypz);
+  return b;
+}
+
+static bool Hacl_Impl_Ed25519_PointEqual_point_equal_(uint64_t *p, uint64_t *q1, uint64_t *tmp)
+{
+  bool b = Hacl_Impl_Ed25519_PointEqual_point_equal_1(p, q1, tmp);
+  if (b == true)
+    return Hacl_Impl_Ed25519_PointEqual_point_equal_2(p, q1, tmp);
+  else
+    return false;
+}
+
+static bool Hacl_Impl_Ed25519_PointEqual_point_equal(uint64_t *p, uint64_t *q1)
+{
+  uint64_t tmp[20U] = { 0U };
+  bool res = Hacl_Impl_Ed25519_PointEqual_point_equal_(p, q1, tmp);
+  return res;
+}
+
+static void Hacl_Impl_Load56_load_64_bytes(uint64_t *out, uint8_t *b)
+{
+  uint8_t *b80 = b;
+  uint64_t z = load64_le(b80);
+  uint64_t z_ = z & (uint64_t)0xffffffffffffffU;
+  uint64_t b0 = z_;
+  uint8_t *b81 = b + (uint32_t)7U;
+  uint64_t z0 = load64_le(b81);
+  uint64_t z_0 = z0 & (uint64_t)0xffffffffffffffU;
+  uint64_t b1 = z_0;
+  uint8_t *b82 = b + (uint32_t)14U;
+  uint64_t z1 = load64_le(b82);
+  uint64_t z_1 = z1 & (uint64_t)0xffffffffffffffU;
+  uint64_t b2 = z_1;
+  uint8_t *b83 = b + (uint32_t)21U;
+  uint64_t z2 = load64_le(b83);
+  uint64_t z_2 = z2 & (uint64_t)0xffffffffffffffU;
+  uint64_t b3 = z_2;
+  uint8_t *b84 = b + (uint32_t)28U;
+  uint64_t z3 = load64_le(b84);
+  uint64_t z_3 = z3 & (uint64_t)0xffffffffffffffU;
+  uint64_t b4 = z_3;
+  uint8_t *b85 = b + (uint32_t)35U;
+  uint64_t z4 = load64_le(b85);
+  uint64_t z_4 = z4 & (uint64_t)0xffffffffffffffU;
+  uint64_t b5 = z_4;
+  uint8_t *b86 = b + (uint32_t)42U;
+  uint64_t z5 = load64_le(b86);
+  uint64_t z_5 = z5 & (uint64_t)0xffffffffffffffU;
+  uint64_t b6 = z_5;
+  uint8_t *b87 = b + (uint32_t)49U;
+  uint64_t z6 = load64_le(b87);
+  uint64_t z_6 = z6 & (uint64_t)0xffffffffffffffU;
+  uint64_t b7 = z_6;
+  uint8_t *b8 = b + (uint32_t)56U;
+  uint64_t z7 = load64_le(b8);
+  uint64_t z_7 = z7 & (uint64_t)0xffffffffffffffU;
+  uint64_t b88 = z_7;
+  uint8_t b63 = b[63U];
+  uint64_t b9 = (uint64_t)b63;
+  Hacl_Lib_Create64_make_h64_10(out, b0, b1, b2, b3, b4, b5, b6, b7, b88, b9);
+}
+
+static void Hacl_Impl_Load56_load_32_bytes(uint64_t *out, uint8_t *b)
+{
+  uint8_t *b80 = b;
+  uint64_t z = load64_le(b80);
+  uint64_t z_ = z & (uint64_t)0xffffffffffffffU;
+  uint64_t b0 = z_;
+  uint8_t *b81 = b + (uint32_t)7U;
+  uint64_t z0 = load64_le(b81);
+  uint64_t z_0 = z0 & (uint64_t)0xffffffffffffffU;
+  uint64_t b1 = z_0;
+  uint8_t *b82 = b + (uint32_t)14U;
+  uint64_t z1 = load64_le(b82);
+  uint64_t z_1 = z1 & (uint64_t)0xffffffffffffffU;
+  uint64_t b2 = z_1;
+  uint8_t *b8 = b + (uint32_t)21U;
+  uint64_t z2 = load64_le(b8);
+  uint64_t z_2 = z2 & (uint64_t)0xffffffffffffffU;
+  uint64_t b3 = z_2;
+  uint8_t *x0 = b + (uint32_t)28U;
+  uint32_t b4 = load32_le(x0);
+  uint64_t b41 = (uint64_t)b4;
+  Hacl_Lib_Create64_make_h64_5(out, b0, b1, b2, b3, b41);
+}
+
+inline static void Hacl_Impl_Ed25519_Pow2_252m2_pow2_252m2(uint64_t *out, uint64_t *z)
+{
+  Hacl_Bignum_Crecip_crecip_(out, z);
+}
+
+static bool Hacl_Impl_Ed25519_RecoverX_is_0(uint64_t *x)
+{
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  return
+    x0
+    == (uint64_t)0U
+    && x1 == (uint64_t)0U
+    && x2 == (uint64_t)0U
+    && x3 == (uint64_t)0U
+    && x4 == (uint64_t)0U;
+}
+
+static void
+Hacl_Impl_Ed25519_RecoverX_recover_x_step_5(uint64_t *x, uint64_t sign1, uint64_t *tmp)
+{
+  uint64_t *x3 = tmp + (uint32_t)5U;
+  uint64_t *t0 = tmp + (uint32_t)10U;
+  uint64_t x0 = x3[0U];
+  uint64_t x00 = x0 & (uint64_t)1U;
+  if (!(x00 == sign1))
+  {
+    uint64_t zero1 = (uint64_t)0U;
+    Hacl_Lib_Create64_make_h64_5(t0, zero1, zero1, zero1, zero1, zero1);
+    Hacl_Bignum25519_fdifference(x3, t0);
+    Hacl_Bignum25519_reduce_513(x3);
+    Hacl_Bignum25519_reduce(x3);
+  }
+  memcpy(x, x3, (uint32_t)5U * sizeof x3[0U]);
+}
+
+static bool
+Hacl_Impl_Ed25519_RecoverX_recover_x_(uint64_t *x, uint64_t *y, uint64_t sign1, uint64_t *tmp)
+{
+  uint64_t *x20 = tmp;
+  uint64_t x0 = y[0U];
+  uint64_t x1 = y[1U];
+  uint64_t x2 = y[2U];
+  uint64_t x30 = y[3U];
+  uint64_t x4 = y[4U];
+  bool
+  b =
+    x0
+    >= (uint64_t)0x7ffffffffffedU
+    && x1 == (uint64_t)0x7ffffffffffffU
+    && x2 == (uint64_t)0x7ffffffffffffU
+    && x30 == (uint64_t)0x7ffffffffffffU
+    && x4 == (uint64_t)0x7ffffffffffffU;
+  if (b)
+    return false;
+  else
+  {
+    uint64_t tmp0[25U] = { 0U };
+    uint64_t *one10 = tmp0;
+    uint64_t *y2 = tmp0 + (uint32_t)5U;
+    uint64_t *dyyi = tmp0 + (uint32_t)10U;
+    uint64_t *dyy = tmp0 + (uint32_t)15U;
+    uint64_t zero10 = (uint64_t)0U;
+    uint64_t one1 = (uint64_t)1U;
+    Hacl_Lib_Create64_make_h64_5(one10, one1, zero10, zero10, zero10, zero10);
+    Hacl_Bignum25519_fsquare(y2, y);
+    Hacl_Bignum25519_times_d(dyy, y2);
+    Hacl_Bignum25519_fsum(dyy, one10);
+    Hacl_Bignum25519_reduce_513(dyy);
+    Hacl_Bignum25519_inverse(dyyi, dyy);
+    Hacl_Bignum25519_fdifference(one10, y2);
+    Hacl_Bignum25519_fmul(x20, dyyi, one10);
+    Hacl_Bignum25519_reduce(x20);
+    bool x2_is_0 = Hacl_Impl_Ed25519_RecoverX_is_0(x20);
+    uint8_t z;
+    if (x2_is_0)
+    {
+      uint8_t ite;
+      if (sign1 == (uint64_t)0U)
+      {
+        uint64_t zero1 = (uint64_t)0U;
+        Hacl_Lib_Create64_make_h64_5(x, zero1, zero1, zero1, zero1, zero1);
+        ite = (uint8_t)1U;
+      }
+      else
+        ite = (uint8_t)0U;
+      z = ite;
+    }
+    else
+      z = (uint8_t)2U;
+    if (z == (uint8_t)0U)
+      return false;
+    else if (z == (uint8_t)1U)
+      return true;
+    else
+    {
+      uint64_t *x2 = tmp;
+      uint64_t *x30 = tmp + (uint32_t)5U;
+      uint64_t *t00 = tmp + (uint32_t)10U;
+      uint64_t *t10 = tmp + (uint32_t)15U;
+      Hacl_Impl_Ed25519_Pow2_252m2_pow2_252m2(x30, x2);
+      Hacl_Bignum25519_fsquare(t00, x30);
+      memcpy(t10, x2, (uint32_t)5U * sizeof x2[0U]);
+      Hacl_Bignum25519_fdifference(t10, t00);
+      Hacl_Bignum25519_reduce_513(t10);
+      Hacl_Bignum25519_reduce(t10);
+      bool t1_is_0 = Hacl_Impl_Ed25519_RecoverX_is_0(t10);
+      if (!t1_is_0)
+      {
+        uint64_t sqrt_m1[5U] = { 0U };
+        Hacl_Lib_Create64_make_h64_5(sqrt_m1,
+          (uint64_t)0x00061b274a0ea0b0U,
+          (uint64_t)0x0000d5a5fc8f189dU,
+          (uint64_t)0x0007ef5e9cbd0c60U,
+          (uint64_t)0x00078595a6804c9eU,
+          (uint64_t)0x0002b8324804fc1dU);
+        Hacl_Bignum25519_fmul(x30, x30, sqrt_m1);
+      }
+      Hacl_Bignum25519_reduce(x30);
+      uint64_t *x20 = tmp;
+      uint64_t *x3 = tmp + (uint32_t)5U;
+      uint64_t *t0 = tmp + (uint32_t)10U;
+      uint64_t *t1 = tmp + (uint32_t)15U;
+      Hacl_Bignum25519_fsquare(t0, x3);
+      memcpy(t1, x20, (uint32_t)5U * sizeof x20[0U]);
+      Hacl_Bignum25519_fdifference(t1, t0);
+      Hacl_Bignum25519_reduce_513(t1);
+      Hacl_Bignum25519_reduce(t1);
+      bool z1 = Hacl_Impl_Ed25519_RecoverX_is_0(t1);
+      if (z1 == false)
+        return false;
+      else
+      {
+        Hacl_Impl_Ed25519_RecoverX_recover_x_step_5(x, sign1, tmp);
+        return true;
+      }
+    }
+  }
+}
+
+static bool Hacl_Impl_Ed25519_RecoverX_recover_x(uint64_t *x, uint64_t *y, uint64_t sign1)
+{
+  uint64_t tmp[20U] = { 0U };
+  bool res = Hacl_Impl_Ed25519_RecoverX_recover_x_(x, y, sign1, tmp);
+  return res;
+}
+
+static void Hacl_Impl_Load51_load_51(uint64_t *output, uint8_t *input)
+{
+  Hacl_EC_Format_fexpand(output, input);
+}
+
+static bool Hacl_Impl_Ed25519_PointDecompress_point_decompress(uint64_t *out, uint8_t *s)
+{
+  uint64_t tmp[10U] = { 0U };
+  uint64_t *y0 = tmp;
+  uint64_t *x0 = tmp + (uint32_t)5U;
+  uint64_t *y = tmp;
+  uint64_t *x = tmp + (uint32_t)5U;
+  uint8_t s31 = s[31U];
+  uint64_t sign1 = (uint64_t)(s31 >> (uint32_t)7U);
+  Hacl_Impl_Load51_load_51(y, s);
+  bool z = Hacl_Impl_Ed25519_RecoverX_recover_x(x, y, sign1);
+  bool z0 = z;
+  bool res;
+  if (z0 == false)
+    res = false;
+  else
+  {
+    uint64_t *outx = Hacl_Impl_Ed25519_ExtPoint_getx(out);
+    uint64_t *outy = Hacl_Impl_Ed25519_ExtPoint_gety(out);
+    uint64_t *outz = Hacl_Impl_Ed25519_ExtPoint_getz(out);
+    uint64_t *outt = Hacl_Impl_Ed25519_ExtPoint_gett(out);
+    memcpy(outx, x0, (uint32_t)5U * sizeof x0[0U]);
+    memcpy(outy, y0, (uint32_t)5U * sizeof y0[0U]);
+    uint64_t zero1 = (uint64_t)0U;
+    uint64_t one1 = (uint64_t)1U;
+    Hacl_Lib_Create64_make_h64_5(outz, one1, zero1, zero1, zero1, zero1);
+    Hacl_Bignum25519_fmul(outt, x0, y0);
+    res = true;
+  }
+  return res;
+}
+
+static void Hacl_Impl_Store56_store_56(uint8_t *out, uint64_t *b)
+{
+  uint64_t b0 = b[0U];
+  uint64_t b1 = b[1U];
+  uint64_t b2 = b[2U];
+  uint64_t b3 = b[3U];
+  uint64_t b4 = b[4U];
+  uint32_t b41 = (uint32_t)b4;
+  uint8_t *b8 = out;
+  store64_le(b8, b0);
+  uint8_t *b80 = out + (uint32_t)7U;
+  store64_le(b80, b1);
+  uint8_t *b81 = out + (uint32_t)14U;
+  store64_le(b81, b2);
+  uint8_t *b82 = out + (uint32_t)21U;
+  store64_le(b82, b3);
+  uint8_t *x0 = out + (uint32_t)28U;
+  store32_le(x0, b41);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_2_hash_block_and_rest(
+  uint8_t *out,
+  uint8_t *block,
+  uint8_t *msg,
+  uint32_t len1
+)
+{
+  uint32_t nblocks = len1 >> (uint32_t)7U;
+  uint64_t rest = (uint64_t)(len1 & (uint32_t)127U);
+  uint64_t st[169U] = { 0U };
+  Hacl_Impl_SHA2_512_init(st);
+  Hacl_Impl_SHA2_512_update(st, block);
+  Hacl_Impl_SHA2_512_update_multi(st, msg, nblocks);
+  Hacl_Impl_SHA2_512_update_last(st, msg + (uint32_t)128U * nblocks, rest);
+  Hacl_Impl_SHA2_512_finish(st, out);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_1_copy_bytes(uint8_t *output, uint8_t *input, uint32_t len1)
+{
+  memcpy(output, input, len1 * sizeof input[0U]);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_1_concat_2(uint8_t *out, uint8_t *pre, uint8_t *msg, uint32_t len1)
+{
+  Hacl_Impl_SHA512_Ed25519_1_copy_bytes(out, pre, (uint32_t)32U);
+  Hacl_Impl_SHA512_Ed25519_1_copy_bytes(out + (uint32_t)32U, msg, len1);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_1_concat_3(
+  uint8_t *out,
+  uint8_t *pre,
+  uint8_t *pre2,
+  uint8_t *msg,
+  uint32_t len1
+)
+{
+  Hacl_Impl_SHA512_Ed25519_1_copy_bytes(out, pre, (uint32_t)32U);
+  Hacl_Impl_SHA512_Ed25519_1_copy_bytes(out + (uint32_t)32U, pre2, (uint32_t)32U);
+  Hacl_Impl_SHA512_Ed25519_1_copy_bytes(out + (uint32_t)64U, msg, len1);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_1_sha512_pre_msg_1(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint8_t block[128U] = { 0U };
+  uint8_t *block_ = block;
+  Hacl_Impl_SHA512_Ed25519_1_concat_2(block_, prefix, input, len1);
+  Hacl_Impl_SHA2_512_hash(h, block_, len1 + (uint32_t)32U);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_1_sha512_pre_pre2_msg_1(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint8_t block[128U] = { 0U };
+  uint8_t *block_ = block;
+  Hacl_Impl_SHA512_Ed25519_1_concat_3(block_, prefix, prefix2, input, len1);
+  Hacl_Impl_SHA2_512_hash(h, block_, len1 + (uint32_t)64U);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_3_sha512_pre_msg_2(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint8_t *input11 = input;
+  uint8_t *input21 = input + (uint32_t)96U;
+  uint8_t block[128U] = { 0U };
+  Hacl_Impl_SHA512_Ed25519_1_concat_2(block, prefix, input11, (uint32_t)96U);
+  Hacl_Impl_SHA512_Ed25519_2_hash_block_and_rest(h, block, input21, len1 - (uint32_t)96U);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_3_sha512_pre_msg(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  if (len1 <= (uint32_t)96U)
+    Hacl_Impl_SHA512_Ed25519_1_sha512_pre_msg_1(h, prefix, input, len1);
+  else
+    Hacl_Impl_SHA512_Ed25519_3_sha512_pre_msg_2(h, prefix, input, len1);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_3_sha512_pre_pre2_msg_2(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint8_t *input11 = input;
+  uint8_t *input21 = input + (uint32_t)64U;
+  uint8_t block[128U] = { 0U };
+  Hacl_Impl_SHA512_Ed25519_1_concat_3(block, prefix, prefix2, input11, (uint32_t)64U);
+  Hacl_Impl_SHA512_Ed25519_2_hash_block_and_rest(h, block, input21, len1 - (uint32_t)64U);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_3_sha512_pre_pre2_msg(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  if (len1 <= (uint32_t)64U)
+    Hacl_Impl_SHA512_Ed25519_1_sha512_pre_pre2_msg_1(h, prefix, prefix2, input, len1);
+  else
+    Hacl_Impl_SHA512_Ed25519_3_sha512_pre_pre2_msg_2(h, prefix, prefix2, input, len1);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_sha512_pre_msg(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  Hacl_Impl_SHA512_Ed25519_3_sha512_pre_msg(h, prefix, input, len1);
+}
+
+static void
+Hacl_Impl_SHA512_Ed25519_sha512_pre_pre2_msg(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  Hacl_Impl_SHA512_Ed25519_3_sha512_pre_pre2_msg(h, prefix, prefix2, input, len1);
+}
+
+static void
+Hacl_Impl_Sha512_sha512_pre_msg(uint8_t *h, uint8_t *prefix, uint8_t *input, uint32_t len1)
+{
+  Hacl_Impl_SHA512_Ed25519_sha512_pre_msg(h, prefix, input, len1);
+}
+
+static void
+Hacl_Impl_Sha512_sha512_pre_pre2_msg(
+  uint8_t *h,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  Hacl_Impl_SHA512_Ed25519_sha512_pre_pre2_msg(h, prefix, prefix2, input, len1);
+}
+
+static void
+Hacl_Lib_Create128_make_h128_9(
+  FStar_UInt128_t *b,
+  FStar_UInt128_t s0,
+  FStar_UInt128_t s1,
+  FStar_UInt128_t s2,
+  FStar_UInt128_t s3,
+  FStar_UInt128_t s4,
+  FStar_UInt128_t s5,
+  FStar_UInt128_t s6,
+  FStar_UInt128_t s7,
+  FStar_UInt128_t s8
+)
+{
+  b[0U] = s0;
+  b[1U] = s1;
+  b[2U] = s2;
+  b[3U] = s3;
+  b[4U] = s4;
+  b[5U] = s5;
+  b[6U] = s6;
+  b[7U] = s7;
+  b[8U] = s8;
+}
+
+static void Hacl_Impl_BignumQ_Mul_make_m(uint64_t *m1)
+{
+  Hacl_Lib_Create64_make_h64_5(m1,
+    (uint64_t)0x12631a5cf5d3edU,
+    (uint64_t)0xf9dea2f79cd658U,
+    (uint64_t)0x000000000014deU,
+    (uint64_t)0x00000000000000U,
+    (uint64_t)0x00000010000000U);
+}
+
+static void Hacl_Impl_BignumQ_Mul_make_mu(uint64_t *m1)
+{
+  Hacl_Lib_Create64_make_h64_5(m1,
+    (uint64_t)0x9ce5a30a2c131bU,
+    (uint64_t)0x215d086329a7edU,
+    (uint64_t)0xffffffffeb2106U,
+    (uint64_t)0xffffffffffffffU,
+    (uint64_t)0x00000fffffffffU);
+}
+
+static void Hacl_Impl_BignumQ_Mul_choose(uint64_t *z, uint64_t *x, uint64_t *y, uint64_t b)
+{
+  uint64_t mask = b - (uint64_t)1U;
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  uint64_t y0 = y[0U];
+  uint64_t y1 = y[1U];
+  uint64_t y2 = y[2U];
+  uint64_t y3 = y[3U];
+  uint64_t y4 = y[4U];
+  uint64_t z0 = ((y0 ^ x0) & mask) ^ x0;
+  uint64_t z1 = ((y1 ^ x1) & mask) ^ x1;
+  uint64_t z2 = ((y2 ^ x2) & mask) ^ x2;
+  uint64_t z3 = ((y3 ^ x3) & mask) ^ x3;
+  uint64_t z4 = ((y4 ^ x4) & mask) ^ x4;
+  Hacl_Lib_Create64_make_h64_5(z, z0, z1, z2, z3, z4);
+}
+
+static uint64_t Hacl_Impl_BignumQ_Mul_lt(uint64_t a, uint64_t b)
+{
+  return (a - b) >> (uint32_t)63U;
+}
+
+static uint64_t Hacl_Impl_BignumQ_Mul_shiftl_56(uint64_t b)
+{
+  return b << (uint32_t)56U;
+}
+
+static void Hacl_Impl_BignumQ_Mul_sub_mod_264(uint64_t *z, uint64_t *x, uint64_t *y)
+{
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  uint64_t y0 = y[0U];
+  uint64_t y1 = y[1U];
+  uint64_t y2 = y[2U];
+  uint64_t y3 = y[3U];
+  uint64_t y4 = y[4U];
+  uint64_t b = Hacl_Impl_BignumQ_Mul_lt(x0, y0);
+  uint64_t t0 = Hacl_Impl_BignumQ_Mul_shiftl_56(b) + x0 - y0;
+  uint64_t y11 = y1 + b;
+  uint64_t b1 = Hacl_Impl_BignumQ_Mul_lt(x1, y11);
+  uint64_t t1 = Hacl_Impl_BignumQ_Mul_shiftl_56(b1) + x1 - y11;
+  uint64_t y21 = y2 + b1;
+  uint64_t b2 = Hacl_Impl_BignumQ_Mul_lt(x2, y21);
+  uint64_t t2 = Hacl_Impl_BignumQ_Mul_shiftl_56(b2) + x2 - y21;
+  uint64_t y31 = y3 + b2;
+  uint64_t b3 = Hacl_Impl_BignumQ_Mul_lt(x3, y31);
+  uint64_t t3 = Hacl_Impl_BignumQ_Mul_shiftl_56(b3) + x3 - y31;
+  uint64_t y41 = y4 + b3;
+  uint64_t b4 = Hacl_Impl_BignumQ_Mul_lt(x4, y41);
+  uint64_t t4 = (b4 << (uint32_t)40U) + x4 - y41;
+  Hacl_Lib_Create64_make_h64_5(z, t0, t1, t2, t3, t4);
+}
+
+static void Hacl_Impl_BignumQ_Mul_subm_conditional(uint64_t *z, uint64_t *x)
+{
+  uint64_t tmp[5U] = { 0U };
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  Hacl_Lib_Create64_make_h64_5(tmp, x0, x1, x2, x3, x4);
+  uint64_t y0 = (uint64_t)0x12631a5cf5d3edU;
+  uint64_t y1 = (uint64_t)0xf9dea2f79cd658U;
+  uint64_t y2 = (uint64_t)0x000000000014deU;
+  uint64_t y3 = (uint64_t)0x00000000000000U;
+  uint64_t y4 = (uint64_t)0x00000010000000U;
+  uint64_t b = Hacl_Impl_BignumQ_Mul_lt(x0, y0);
+  uint64_t t0 = Hacl_Impl_BignumQ_Mul_shiftl_56(b) + x0 - y0;
+  uint64_t y11 = y1 + b;
+  uint64_t b1 = Hacl_Impl_BignumQ_Mul_lt(x1, y11);
+  uint64_t t1 = Hacl_Impl_BignumQ_Mul_shiftl_56(b1) + x1 - y11;
+  uint64_t y21 = y2 + b1;
+  uint64_t b2 = Hacl_Impl_BignumQ_Mul_lt(x2, y21);
+  uint64_t t2 = Hacl_Impl_BignumQ_Mul_shiftl_56(b2) + x2 - y21;
+  uint64_t y31 = y3 + b2;
+  uint64_t b3 = Hacl_Impl_BignumQ_Mul_lt(x3, y31);
+  uint64_t t3 = Hacl_Impl_BignumQ_Mul_shiftl_56(b3) + x3 - y31;
+  uint64_t y41 = y4 + b3;
+  uint64_t b4 = Hacl_Impl_BignumQ_Mul_lt(x4, y41);
+  uint64_t t4 = Hacl_Impl_BignumQ_Mul_shiftl_56(b4) + x4 - y41;
+  Hacl_Lib_Create64_make_h64_5(z, t0, t1, t2, t3, t4);
+  Hacl_Impl_BignumQ_Mul_choose(z, tmp, z, b4);
+}
+
+static void Hacl_Impl_BignumQ_Mul_low_mul_5(uint64_t *z, uint64_t *x, uint64_t *y)
+{
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  uint64_t y0 = y[0U];
+  uint64_t y1 = y[1U];
+  uint64_t y2 = y[2U];
+  uint64_t y3 = y[3U];
+  uint64_t y4 = y[4U];
+  FStar_UInt128_t xy00 = FStar_UInt128_mul_wide(x0, y0);
+  FStar_UInt128_t xy01 = FStar_UInt128_mul_wide(x0, y1);
+  FStar_UInt128_t xy02 = FStar_UInt128_mul_wide(x0, y2);
+  FStar_UInt128_t xy03 = FStar_UInt128_mul_wide(x0, y3);
+  FStar_UInt128_t xy04 = FStar_UInt128_mul_wide(x0, y4);
+  FStar_UInt128_t xy10 = FStar_UInt128_mul_wide(x1, y0);
+  FStar_UInt128_t xy11 = FStar_UInt128_mul_wide(x1, y1);
+  FStar_UInt128_t xy12 = FStar_UInt128_mul_wide(x1, y2);
+  FStar_UInt128_t xy13 = FStar_UInt128_mul_wide(x1, y3);
+  FStar_UInt128_t xy20 = FStar_UInt128_mul_wide(x2, y0);
+  FStar_UInt128_t xy21 = FStar_UInt128_mul_wide(x2, y1);
+  FStar_UInt128_t xy22 = FStar_UInt128_mul_wide(x2, y2);
+  FStar_UInt128_t xy30 = FStar_UInt128_mul_wide(x3, y0);
+  FStar_UInt128_t xy31 = FStar_UInt128_mul_wide(x3, y1);
+  FStar_UInt128_t xy40 = FStar_UInt128_mul_wide(x4, y0);
+  FStar_UInt128_t x5 = xy00;
+  FStar_UInt128_t carry1 = FStar_UInt128_shift_right(x5, (uint32_t)56U);
+  uint64_t t = FStar_UInt128_uint128_to_uint64(x5) & (uint64_t)0xffffffffffffffU;
+  uint64_t t0 = t;
+  FStar_UInt128_t x6 = FStar_UInt128_add(FStar_UInt128_add(xy01, xy10), carry1);
+  FStar_UInt128_t carry2 = FStar_UInt128_shift_right(x6, (uint32_t)56U);
+  uint64_t t1 = FStar_UInt128_uint128_to_uint64(x6) & (uint64_t)0xffffffffffffffU;
+  uint64_t t11 = t1;
+  FStar_UInt128_t
+  x7 = FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy02, xy11), xy20), carry2);
+  FStar_UInt128_t carry3 = FStar_UInt128_shift_right(x7, (uint32_t)56U);
+  uint64_t t2 = FStar_UInt128_uint128_to_uint64(x7) & (uint64_t)0xffffffffffffffU;
+  uint64_t t21 = t2;
+  FStar_UInt128_t
+  x8 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy03, xy12), xy21),
+        xy30),
+      carry3);
+  FStar_UInt128_t carry4 = FStar_UInt128_shift_right(x8, (uint32_t)56U);
+  uint64_t t3 = FStar_UInt128_uint128_to_uint64(x8) & (uint64_t)0xffffffffffffffU;
+  uint64_t t31 = t3;
+  uint64_t
+  t4 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy04,
+                xy13),
+              xy22),
+            xy31),
+          xy40),
+        carry4))
+    & (uint64_t)0xffffffffffU;
+  Hacl_Lib_Create64_make_h64_5(z, t0, t11, t21, t31, t4);
+}
+
+static void Hacl_Impl_BignumQ_Mul_mul_5(FStar_UInt128_t *z, uint64_t *x, uint64_t *y)
+{
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  uint64_t y0 = y[0U];
+  uint64_t y1 = y[1U];
+  uint64_t y2 = y[2U];
+  uint64_t y3 = y[3U];
+  uint64_t y4 = y[4U];
+  FStar_UInt128_t xy00 = FStar_UInt128_mul_wide(x0, y0);
+  FStar_UInt128_t xy01 = FStar_UInt128_mul_wide(x0, y1);
+  FStar_UInt128_t xy02 = FStar_UInt128_mul_wide(x0, y2);
+  FStar_UInt128_t xy03 = FStar_UInt128_mul_wide(x0, y3);
+  FStar_UInt128_t xy04 = FStar_UInt128_mul_wide(x0, y4);
+  FStar_UInt128_t xy10 = FStar_UInt128_mul_wide(x1, y0);
+  FStar_UInt128_t xy11 = FStar_UInt128_mul_wide(x1, y1);
+  FStar_UInt128_t xy12 = FStar_UInt128_mul_wide(x1, y2);
+  FStar_UInt128_t xy13 = FStar_UInt128_mul_wide(x1, y3);
+  FStar_UInt128_t xy14 = FStar_UInt128_mul_wide(x1, y4);
+  FStar_UInt128_t xy20 = FStar_UInt128_mul_wide(x2, y0);
+  FStar_UInt128_t xy21 = FStar_UInt128_mul_wide(x2, y1);
+  FStar_UInt128_t xy22 = FStar_UInt128_mul_wide(x2, y2);
+  FStar_UInt128_t xy23 = FStar_UInt128_mul_wide(x2, y3);
+  FStar_UInt128_t xy24 = FStar_UInt128_mul_wide(x2, y4);
+  FStar_UInt128_t xy30 = FStar_UInt128_mul_wide(x3, y0);
+  FStar_UInt128_t xy31 = FStar_UInt128_mul_wide(x3, y1);
+  FStar_UInt128_t xy32 = FStar_UInt128_mul_wide(x3, y2);
+  FStar_UInt128_t xy33 = FStar_UInt128_mul_wide(x3, y3);
+  FStar_UInt128_t xy34 = FStar_UInt128_mul_wide(x3, y4);
+  FStar_UInt128_t xy40 = FStar_UInt128_mul_wide(x4, y0);
+  FStar_UInt128_t xy41 = FStar_UInt128_mul_wide(x4, y1);
+  FStar_UInt128_t xy42 = FStar_UInt128_mul_wide(x4, y2);
+  FStar_UInt128_t xy43 = FStar_UInt128_mul_wide(x4, y3);
+  FStar_UInt128_t xy44 = FStar_UInt128_mul_wide(x4, y4);
+  FStar_UInt128_t z0 = xy00;
+  FStar_UInt128_t z1 = FStar_UInt128_add(xy01, xy10);
+  FStar_UInt128_t z2 = FStar_UInt128_add(FStar_UInt128_add(xy02, xy11), xy20);
+  FStar_UInt128_t
+  z3 = FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy03, xy12), xy21), xy30);
+  FStar_UInt128_t
+  z4 =
+    FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy04, xy13), xy22),
+        xy31),
+      xy40);
+  FStar_UInt128_t
+  z5 = FStar_UInt128_add(FStar_UInt128_add(FStar_UInt128_add(xy14, xy23), xy32), xy41);
+  FStar_UInt128_t z6 = FStar_UInt128_add(FStar_UInt128_add(xy24, xy33), xy42);
+  FStar_UInt128_t z7 = FStar_UInt128_add(xy34, xy43);
+  FStar_UInt128_t z8 = xy44;
+  Hacl_Lib_Create128_make_h128_9(z, z0, z1, z2, z3, z4, z5, z6, z7, z8);
+}
+
+static void Hacl_Impl_BignumQ_Mul_carry(uint64_t *out, FStar_UInt128_t *z)
+{
+  FStar_UInt128_t z0 = z[0U];
+  FStar_UInt128_t z1 = z[1U];
+  FStar_UInt128_t z2 = z[2U];
+  FStar_UInt128_t z3 = z[3U];
+  FStar_UInt128_t z4 = z[4U];
+  FStar_UInt128_t z5 = z[5U];
+  FStar_UInt128_t z6 = z[6U];
+  FStar_UInt128_t z7 = z[7U];
+  FStar_UInt128_t z8 = z[8U];
+  FStar_UInt128_t x = z0;
+  FStar_UInt128_t y = z1;
+  FStar_UInt128_t carry1 = FStar_UInt128_shift_right(x, (uint32_t)56U);
+  uint64_t t = FStar_UInt128_uint128_to_uint64(x) & (uint64_t)0xffffffffffffffU;
+  uint64_t x0 = t;
+  FStar_UInt128_t z1_ = FStar_UInt128_add(y, carry1);
+  FStar_UInt128_t x1 = z1_;
+  FStar_UInt128_t y1 = z2;
+  FStar_UInt128_t carry2 = FStar_UInt128_shift_right(x1, (uint32_t)56U);
+  uint64_t t1 = FStar_UInt128_uint128_to_uint64(x1) & (uint64_t)0xffffffffffffffU;
+  uint64_t x11 = t1;
+  FStar_UInt128_t z2_ = FStar_UInt128_add(y1, carry2);
+  FStar_UInt128_t x2 = z2_;
+  FStar_UInt128_t y2 = z3;
+  FStar_UInt128_t carry3 = FStar_UInt128_shift_right(x2, (uint32_t)56U);
+  uint64_t t2 = FStar_UInt128_uint128_to_uint64(x2) & (uint64_t)0xffffffffffffffU;
+  uint64_t x21 = t2;
+  FStar_UInt128_t z3_ = FStar_UInt128_add(y2, carry3);
+  FStar_UInt128_t x3 = z3_;
+  FStar_UInt128_t y3 = z4;
+  FStar_UInt128_t carry4 = FStar_UInt128_shift_right(x3, (uint32_t)56U);
+  uint64_t t3 = FStar_UInt128_uint128_to_uint64(x3) & (uint64_t)0xffffffffffffffU;
+  uint64_t x31 = t3;
+  FStar_UInt128_t z4_ = FStar_UInt128_add(y3, carry4);
+  FStar_UInt128_t x4 = z4_;
+  FStar_UInt128_t y4 = z5;
+  FStar_UInt128_t carry5 = FStar_UInt128_shift_right(x4, (uint32_t)56U);
+  uint64_t t4 = FStar_UInt128_uint128_to_uint64(x4) & (uint64_t)0xffffffffffffffU;
+  uint64_t x41 = t4;
+  FStar_UInt128_t z5_ = FStar_UInt128_add(y4, carry5);
+  FStar_UInt128_t x5 = z5_;
+  FStar_UInt128_t y5 = z6;
+  FStar_UInt128_t carry6 = FStar_UInt128_shift_right(x5, (uint32_t)56U);
+  uint64_t t5 = FStar_UInt128_uint128_to_uint64(x5) & (uint64_t)0xffffffffffffffU;
+  uint64_t x51 = t5;
+  FStar_UInt128_t z6_ = FStar_UInt128_add(y5, carry6);
+  FStar_UInt128_t x6 = z6_;
+  FStar_UInt128_t y6 = z7;
+  FStar_UInt128_t carry7 = FStar_UInt128_shift_right(x6, (uint32_t)56U);
+  uint64_t t6 = FStar_UInt128_uint128_to_uint64(x6) & (uint64_t)0xffffffffffffffU;
+  uint64_t x61 = t6;
+  FStar_UInt128_t z7_ = FStar_UInt128_add(y6, carry7);
+  FStar_UInt128_t x7 = z7_;
+  FStar_UInt128_t y7 = z8;
+  FStar_UInt128_t carry8 = FStar_UInt128_shift_right(x7, (uint32_t)56U);
+  uint64_t t7 = FStar_UInt128_uint128_to_uint64(x7) & (uint64_t)0xffffffffffffffU;
+  uint64_t x71 = t7;
+  FStar_UInt128_t z8_ = FStar_UInt128_add(y7, carry8);
+  FStar_UInt128_t x8 = z8_;
+  FStar_UInt128_t y8 = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  FStar_UInt128_t carry9 = FStar_UInt128_shift_right(x8, (uint32_t)56U);
+  uint64_t t8 = FStar_UInt128_uint128_to_uint64(x8) & (uint64_t)0xffffffffffffffU;
+  uint64_t x81 = t8;
+  FStar_UInt128_t z9_ = FStar_UInt128_add(y8, carry9);
+  uint64_t x9 = FStar_UInt128_uint128_to_uint64(z9_);
+  Hacl_Lib_Create64_make_h64_10(out, x0, x11, x21, x31, x41, x51, x61, x71, x81, x9);
+}
+
+static void Hacl_Impl_BignumQ_Mul_mod_264(uint64_t *r, uint64_t *t)
+{
+  uint64_t x0 = t[0U];
+  uint64_t x1 = t[1U];
+  uint64_t x2 = t[2U];
+  uint64_t x3 = t[3U];
+  uint64_t x4 = t[4U];
+  uint64_t x4_ = x4 & (uint64_t)0xffffffffffU;
+  Hacl_Lib_Create64_make_h64_5(r, x0, x1, x2, x3, x4_);
+}
+
+static void Hacl_Impl_BignumQ_Mul_div_248(uint64_t *out, uint64_t *t)
+{
+  uint64_t x4 = t[4U];
+  uint64_t x5 = t[5U];
+  uint64_t x6 = t[6U];
+  uint64_t x7 = t[7U];
+  uint64_t x8 = t[8U];
+  uint64_t x9 = t[9U];
+  uint64_t z0 = (x5 & (uint64_t)0xffffffU) << (uint32_t)32U | x4 >> (uint32_t)24U;
+  uint64_t z1 = (x6 & (uint64_t)0xffffffU) << (uint32_t)32U | x5 >> (uint32_t)24U;
+  uint64_t z2 = (x7 & (uint64_t)0xffffffU) << (uint32_t)32U | x6 >> (uint32_t)24U;
+  uint64_t z3 = (x8 & (uint64_t)0xffffffU) << (uint32_t)32U | x7 >> (uint32_t)24U;
+  uint64_t z4 = (x9 & (uint64_t)0xffffffU) << (uint32_t)32U | x8 >> (uint32_t)24U;
+  Hacl_Lib_Create64_make_h64_5(out, z0, z1, z2, z3, z4);
+}
+
+static void Hacl_Impl_BignumQ_Mul_div_264(uint64_t *out, uint64_t *t)
+{
+  uint64_t x4 = t[4U];
+  uint64_t x5 = t[5U];
+  uint64_t x6 = t[6U];
+  uint64_t x7 = t[7U];
+  uint64_t x8 = t[8U];
+  uint64_t x9 = t[9U];
+  uint64_t z0 = (x5 & (uint64_t)0xffffffffffU) << (uint32_t)16U | x4 >> (uint32_t)40U;
+  uint64_t z1 = (x6 & (uint64_t)0xffffffffffU) << (uint32_t)16U | x5 >> (uint32_t)40U;
+  uint64_t z2 = (x7 & (uint64_t)0xffffffffffU) << (uint32_t)16U | x6 >> (uint32_t)40U;
+  uint64_t z3 = (x8 & (uint64_t)0xffffffffffU) << (uint32_t)16U | x7 >> (uint32_t)40U;
+  uint64_t z4 = (x9 & (uint64_t)0xffffffffffU) << (uint32_t)16U | x8 >> (uint32_t)40U;
+  Hacl_Lib_Create64_make_h64_5(out, z0, z1, z2, z3, z4);
+}
+
+static void
+Hacl_Impl_BignumQ_Mul_barrett_reduction__1(
+  FStar_UInt128_t *qmu,
+  uint64_t *t,
+  uint64_t *mu1,
+  uint64_t *tmp
+)
+{
+  uint64_t *q1 = tmp;
+  uint64_t *qmu_ = tmp + (uint32_t)10U;
+  uint64_t *qmu_264 = tmp + (uint32_t)20U;
+  Hacl_Impl_BignumQ_Mul_div_248(q1, t);
+  Hacl_Impl_BignumQ_Mul_mul_5(qmu, q1, mu1);
+  Hacl_Impl_BignumQ_Mul_carry(qmu_, qmu);
+  Hacl_Impl_BignumQ_Mul_div_264(qmu_264, qmu_);
+}
+
+static void
+Hacl_Impl_BignumQ_Mul_barrett_reduction__2(uint64_t *t, uint64_t *m1, uint64_t *tmp)
+{
+  uint64_t *qmul = tmp;
+  uint64_t *r = tmp + (uint32_t)5U;
+  uint64_t *qmu_264 = tmp + (uint32_t)20U;
+  uint64_t *s = tmp + (uint32_t)25U;
+  Hacl_Impl_BignumQ_Mul_mod_264(r, t);
+  Hacl_Impl_BignumQ_Mul_low_mul_5(qmul, qmu_264, m1);
+  Hacl_Impl_BignumQ_Mul_sub_mod_264(s, r, qmul);
+}
+
+static void
+Hacl_Impl_BignumQ_Mul_barrett_reduction__(
+  uint64_t *z,
+  uint64_t *t,
+  uint64_t *m1,
+  uint64_t *mu1,
+  uint64_t *tmp
+)
+{
+  uint64_t *s = tmp + (uint32_t)25U;
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)9U);
+  FStar_UInt128_t qmu[9U];
+  for (uint32_t _i = 0U; _i < (uint32_t)9U; ++_i)
+    qmu[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction__1(qmu, t, mu1, tmp);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction__2(t, m1, tmp);
+  Hacl_Impl_BignumQ_Mul_subm_conditional(z, s);
+}
+
+static void Hacl_Impl_BignumQ_Mul_barrett_reduction_(uint64_t *z, uint64_t *t)
+{
+  uint64_t tmp[40U] = { 0U };
+  uint64_t *m1 = tmp;
+  uint64_t *mu1 = tmp + (uint32_t)5U;
+  uint64_t *tmp1 = tmp + (uint32_t)10U;
+  Hacl_Impl_BignumQ_Mul_make_m(m1);
+  Hacl_Impl_BignumQ_Mul_make_mu(mu1);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction__(z, t, m1, mu1, tmp1);
+}
+
+static void Hacl_Impl_BignumQ_Mul_barrett_reduction(uint64_t *z, uint64_t *t)
+{
+  Hacl_Impl_BignumQ_Mul_barrett_reduction_(z, t);
+}
+
+static void Hacl_Impl_BignumQ_Mul_mul_modq(uint64_t *out, uint64_t *x, uint64_t *y)
+{
+  uint64_t z_[10U] = { 0U };
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)9U);
+  FStar_UInt128_t z[9U];
+  for (uint32_t _i = 0U; _i < (uint32_t)9U; ++_i)
+    z[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Impl_BignumQ_Mul_mul_5(z, x, y);
+  Hacl_Impl_BignumQ_Mul_carry(z_, z);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction_(out, z_);
+}
+
+static void Hacl_Impl_BignumQ_Mul_add_modq_(uint64_t *out, uint64_t *x, uint64_t *y)
+{
+  uint64_t tmp[5U] = { 0U };
+  uint64_t x0 = x[0U];
+  uint64_t x1 = x[1U];
+  uint64_t x2 = x[2U];
+  uint64_t x3 = x[3U];
+  uint64_t x4 = x[4U];
+  uint64_t y0 = y[0U];
+  uint64_t y1 = y[1U];
+  uint64_t y2 = y[2U];
+  uint64_t y3 = y[3U];
+  uint64_t y4 = y[4U];
+  uint64_t z0 = x0 + y0;
+  uint64_t z1 = x1 + y1;
+  uint64_t z2 = x2 + y2;
+  uint64_t z3 = x3 + y3;
+  uint64_t z4 = x4 + y4;
+  uint64_t x5 = z0;
+  uint64_t y5 = z1;
+  uint64_t carry1 = x5 >> (uint32_t)56U;
+  uint64_t t = x5 & (uint64_t)0xffffffffffffffU;
+  uint64_t x01 = t;
+  uint64_t z1_ = y5 + carry1;
+  uint64_t x6 = z1_;
+  uint64_t y6 = z2;
+  uint64_t carry2 = x6 >> (uint32_t)56U;
+  uint64_t t1 = x6 & (uint64_t)0xffffffffffffffU;
+  uint64_t x11 = t1;
+  uint64_t z2_ = y6 + carry2;
+  uint64_t x7 = z2_;
+  uint64_t y7 = z3;
+  uint64_t carry3 = x7 >> (uint32_t)56U;
+  uint64_t t2 = x7 & (uint64_t)0xffffffffffffffU;
+  uint64_t x21 = t2;
+  uint64_t z3_ = y7 + carry3;
+  uint64_t x8 = z3_;
+  uint64_t y8 = z4;
+  uint64_t carry4 = x8 >> (uint32_t)56U;
+  uint64_t t3 = x8 & (uint64_t)0xffffffffffffffU;
+  uint64_t x31 = t3;
+  uint64_t x41 = y8 + carry4;
+  Hacl_Lib_Create64_make_h64_5(tmp, x01, x11, x21, x31, x41);
+  Hacl_Impl_BignumQ_Mul_subm_conditional(out, tmp);
+}
+
+static void Hacl_Impl_BignumQ_Mul_add_modq(uint64_t *out, uint64_t *x, uint64_t *y)
+{
+  Hacl_Impl_BignumQ_Mul_add_modq_(out, x, y);
+}
+
+static void
+Hacl_Impl_SHA512_ModQ_sha512_modq_pre_(
+  uint64_t *out,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1,
+  uint64_t *tmp
+)
+{
+  uint8_t hash1[64U] = { 0U };
+  Hacl_Impl_Sha512_sha512_pre_msg(hash1, prefix, input, len1);
+  Hacl_Impl_Load56_load_64_bytes(tmp, hash1);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction(out, tmp);
+}
+
+static void
+Hacl_Impl_SHA512_ModQ_sha512_modq_pre(
+  uint64_t *out,
+  uint8_t *prefix,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint64_t tmp[10U] = { 0U };
+  Hacl_Impl_SHA512_ModQ_sha512_modq_pre_(out, prefix, input, len1, tmp);
+}
+
+static void
+Hacl_Impl_SHA512_ModQ_sha512_modq_pre_pre2_(
+  uint64_t *out,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1,
+  uint64_t *tmp
+)
+{
+  uint8_t hash1[64U] = { 0U };
+  Hacl_Impl_Sha512_sha512_pre_pre2_msg(hash1, prefix, prefix2, input, len1);
+  Hacl_Impl_Load56_load_64_bytes(tmp, hash1);
+  Hacl_Impl_BignumQ_Mul_barrett_reduction(out, tmp);
+}
+
+static void
+Hacl_Impl_SHA512_ModQ_sha512_modq_pre_pre2(
+  uint64_t *out,
+  uint8_t *prefix,
+  uint8_t *prefix2,
+  uint8_t *input,
+  uint32_t len1
+)
+{
+  uint64_t tmp[10U] = { 0U };
+  Hacl_Impl_SHA512_ModQ_sha512_modq_pre_pre2_(out, prefix, prefix2, input, len1, tmp);
+}
+
+static bool Hacl_Impl_Ed25519_Verify_Steps_verify_step_1(uint64_t *r_, uint8_t *signature)
+{
+  uint8_t *rs = signature;
+  bool b_ = Hacl_Impl_Ed25519_PointDecompress_point_decompress(r_, rs);
+  return b_;
+}
+
+static void
+Hacl_Impl_Ed25519_Verify_Steps_verify_step_2(
+  uint8_t *r,
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *rs,
+  uint8_t *public
+)
+{
+  uint64_t r_[5U] = { 0U };
+  Hacl_Impl_SHA512_ModQ_sha512_modq_pre_pre2(r_, rs, public, msg, len1);
+  Hacl_Impl_Store56_store_56(r, r_);
+}
+
+static void Hacl_Impl_Ed25519_Verify_Steps_point_mul_g(uint64_t *result, uint8_t *scalar)
+{
+  uint64_t g1[20U] = { 0U };
+  Hacl_Impl_Ed25519_G_make_g(g1);
+  Hacl_Impl_Ed25519_Ladder_point_mul(result, scalar, g1);
+}
+
+static bool
+Hacl_Impl_Ed25519_Verify_Steps_verify_step_4(
+  uint8_t *s,
+  uint8_t *h_,
+  uint64_t *a_,
+  uint64_t *r_
+)
+{
+  uint64_t tmp[60U] = { 0U };
+  uint64_t *hA = tmp;
+  uint64_t *rhA = tmp + (uint32_t)20U;
+  uint64_t *sB = tmp + (uint32_t)40U;
+  Hacl_Impl_Ed25519_Verify_Steps_point_mul_g(sB, s);
+  Hacl_Impl_Ed25519_Ladder_point_mul(hA, h_, a_);
+  Hacl_Impl_Ed25519_PointAdd_point_add(rhA, r_, hA);
+  bool b = Hacl_Impl_Ed25519_PointEqual_point_equal(sB, rhA);
+  return b;
+}
+
+static bool
+Hacl_Impl_Ed25519_Verify_verify__(
+  uint8_t *public,
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *signature,
+  uint64_t *tmp,
+  uint8_t *tmp_
+)
+{
+  uint64_t *a_ = tmp;
+  uint64_t *r_ = tmp + (uint32_t)20U;
+  uint64_t *s = tmp + (uint32_t)40U;
+  uint8_t *h_ = tmp_;
+  bool b = Hacl_Impl_Ed25519_PointDecompress_point_decompress(a_, public);
+  if (b)
+  {
+    uint8_t *rs = signature;
+    bool b_ = Hacl_Impl_Ed25519_Verify_Steps_verify_step_1(r_, signature);
+    if (b_)
+    {
+      Hacl_Impl_Load56_load_32_bytes(s, signature + (uint32_t)32U);
+      bool b__ = Hacl_Impl_Ed25519_PointEqual_gte_q(s);
+      if (b__)
+        return false;
+      else
+      {
+        Hacl_Impl_Ed25519_Verify_Steps_verify_step_2(h_, msg, len1, rs, public);
+        bool
+        b1 = Hacl_Impl_Ed25519_Verify_Steps_verify_step_4(signature + (uint32_t)32U, h_, a_, r_);
+        return b1;
+      }
+    }
+    else
+      return false;
+  }
+  else
+    return false;
+}
+
+static bool
+Hacl_Impl_Ed25519_Verify_verify_(
+  uint8_t *public,
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *signature
+)
+{
+  uint64_t tmp[45U] = { 0U };
+  uint8_t tmp_[32U] = { 0U };
+  bool res = Hacl_Impl_Ed25519_Verify_verify__(public, msg, len1, signature, tmp, tmp_);
+  return res;
+}
+
+static bool
+Hacl_Impl_Ed25519_Verify_verify(
+  uint8_t *public,
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *signature
+)
+{
+  return Hacl_Impl_Ed25519_Verify_verify_(public, msg, len1, signature);
+}
+
+static void Hacl_Impl_Ed25519_Sign_Steps_point_mul_g(uint64_t *result, uint8_t *scalar)
+{
+  uint64_t g1[20U] = { 0U };
+  Hacl_Impl_Ed25519_G_make_g(g1);
+  Hacl_Impl_Ed25519_Ladder_point_mul(result, scalar, g1);
+}
+
+static void Hacl_Impl_Ed25519_Sign_Steps_point_mul_g_compress(uint8_t *out, uint8_t *s)
+{
+  uint64_t tmp[20U] = { 0U };
+  Hacl_Impl_Ed25519_Sign_Steps_point_mul_g(tmp, s);
+  Hacl_Impl_Ed25519_PointCompress_point_compress(out, tmp);
+}
+
+static void
+Hacl_Impl_Ed25519_Sign_Steps_copy_bytes(uint8_t *output, uint8_t *input, uint32_t len1)
+{
+  memcpy(output, input, len1 * sizeof input[0U]);
+}
+
+static void Hacl_Impl_Ed25519_Sign_Steps_sign_step_1(uint8_t *secret, uint8_t *tmp_bytes)
+{
+  uint8_t *a__ = tmp_bytes + (uint32_t)96U;
+  uint8_t *apre = tmp_bytes + (uint32_t)224U;
+  uint8_t *a = apre;
+  Hacl_Impl_Ed25519_SecretExpand_secret_expand(apre, secret);
+  Hacl_Impl_Ed25519_Sign_Steps_point_mul_g_compress(a__, a);
+}
+
+static void
+Hacl_Impl_Ed25519_Sign_Steps_sign_step_2(
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *tmp_bytes,
+  uint64_t *tmp_ints
+)
+{
+  uint64_t *r = tmp_ints + (uint32_t)20U;
+  uint8_t *apre = tmp_bytes + (uint32_t)224U;
+  uint8_t *prefix = apre + (uint32_t)32U;
+  Hacl_Impl_SHA512_ModQ_sha512_modq_pre(r, prefix, msg, len1);
+}
+
+static void
+Hacl_Impl_Ed25519_Sign_Steps_sign_step_4(
+  uint8_t *msg,
+  uint32_t len1,
+  uint8_t *tmp_bytes,
+  uint64_t *tmp_ints
+)
+{
+  uint64_t *h = tmp_ints + (uint32_t)60U;
+  uint8_t *a__ = tmp_bytes + (uint32_t)96U;
+  uint8_t *rs_ = tmp_bytes + (uint32_t)160U;
+  Hacl_Impl_SHA512_ModQ_sha512_modq_pre_pre2(h, rs_, a__, msg, len1);
+}
+
+static void Hacl_Impl_Ed25519_Sign_Steps_sign_step_5(uint8_t *tmp_bytes, uint64_t *tmp_ints)
+{
+  uint64_t *r = tmp_ints + (uint32_t)20U;
+  uint64_t *aq = tmp_ints + (uint32_t)45U;
+  uint64_t *ha = tmp_ints + (uint32_t)50U;
+  uint64_t *s = tmp_ints + (uint32_t)55U;
+  uint64_t *h = tmp_ints + (uint32_t)60U;
+  uint8_t *s_ = tmp_bytes + (uint32_t)192U;
+  uint8_t *a = tmp_bytes + (uint32_t)224U;
+  Hacl_Impl_Load56_load_32_bytes(aq, a);
+  Hacl_Impl_BignumQ_Mul_mul_modq(ha, h, aq);
+  Hacl_Impl_BignumQ_Mul_add_modq(s, r, ha);
+  Hacl_Impl_Store56_store_56(s_, s);
+}
+
+static void Hacl_Impl_Ed25519_Sign_append_to_sig(uint8_t *signature, uint8_t *a, uint8_t *b)
+{
+  Hacl_Impl_Ed25519_Sign_Steps_copy_bytes(signature, a, (uint32_t)32U);
+  Hacl_Impl_Ed25519_Sign_Steps_copy_bytes(signature + (uint32_t)32U, b, (uint32_t)32U);
+}
+
+static void
+Hacl_Impl_Ed25519_Sign_sign_(uint8_t *signature, uint8_t *secret, uint8_t *msg, uint32_t len1)
+{
+  uint8_t tmp_bytes[352U] = { 0U };
+  uint64_t tmp_ints[65U] = { 0U };
+  uint8_t *rs_ = tmp_bytes + (uint32_t)160U;
+  uint8_t *s_ = tmp_bytes + (uint32_t)192U;
+  Hacl_Impl_Ed25519_Sign_Steps_sign_step_1(secret, tmp_bytes);
+  Hacl_Impl_Ed25519_Sign_Steps_sign_step_2(msg, len1, tmp_bytes, tmp_ints);
+  uint8_t rb[32U] = { 0U };
+  uint64_t *r = tmp_ints + (uint32_t)20U;
+  uint8_t *rs_0 = tmp_bytes + (uint32_t)160U;
+  Hacl_Impl_Store56_store_56(rb, r);
+  Hacl_Impl_Ed25519_Sign_Steps_point_mul_g_compress(rs_0, rb);
+  Hacl_Impl_Ed25519_Sign_Steps_sign_step_4(msg, len1, tmp_bytes, tmp_ints);
+  Hacl_Impl_Ed25519_Sign_Steps_sign_step_5(tmp_bytes, tmp_ints);
+  Hacl_Impl_Ed25519_Sign_append_to_sig(signature, rs_, s_);
+}
+
+static void
+Hacl_Impl_Ed25519_Sign_sign(uint8_t *signature, uint8_t *secret, uint8_t *msg, uint32_t len1)
+{
+  Hacl_Impl_Ed25519_Sign_sign_(signature, secret, msg, len1);
+}
+
+void Hacl_Ed25519_sign(uint8_t *signature, uint8_t *secret, uint8_t *msg, uint32_t len1)
+{
+  Hacl_Impl_Ed25519_Sign_sign(signature, secret, msg, len1);
+}
+
+bool Hacl_Ed25519_verify(uint8_t *public, uint8_t *msg, uint32_t len1, uint8_t *signature)
+{
+  return Hacl_Impl_Ed25519_Verify_verify(public, msg, len1, signature);
+}
+
+void Hacl_Ed25519_secret_to_public(uint8_t *out, uint8_t *secret)
+{
+  Hacl_Impl_Ed25519_SecretToPublic_secret_to_public(out, secret);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.h
new file mode 100644
index 000000000..09e0d670a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Ed25519.h
@@ -0,0 +1,230 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Ed25519_H
+#define __Hacl_Ed25519_H
+
+
+
+
+
+typedef uint64_t Hacl_Bignum_Constants_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Constants_wide;
+
+typedef uint64_t Hacl_Bignum_Parameters_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Parameters_wide;
+
+typedef uint32_t Hacl_Bignum_Parameters_ctr;
+
+typedef uint64_t *Hacl_Bignum_Parameters_felem;
+
+typedef FStar_UInt128_t *Hacl_Bignum_Parameters_felem_wide;
+
+typedef void *Hacl_Bignum_Parameters_seqelem;
+
+typedef void *Hacl_Bignum_Parameters_seqelem_wide;
+
+typedef FStar_UInt128_t Hacl_Bignum_Wide_t;
+
+typedef uint64_t Hacl_Bignum_Limb_t;
+
+extern void Hacl_Bignum_lemma_diff(Prims_int x0, Prims_int x1, Prims_pos x2);
+
+typedef struct 
+{
+  void *fst;
+  void *snd;
+}
+K___FStar_Seq_Base_seq_uint64_t_FStar_Seq_Base_seq_uint64_t;
+
+typedef uint64_t *Hacl_EC_Point_point;
+
+typedef uint8_t *Hacl_EC_Format_uint8_p;
+
+typedef uint64_t Hacl_Lib_Create64_h64;
+
+typedef uint64_t Hacl_Bignum25519_limb;
+
+typedef uint64_t *Hacl_Bignum25519_felem;
+
+typedef void *Hacl_Bignum25519_seqelem;
+
+typedef uint64_t *Hacl_Impl_Ed25519_ExtPoint_point;
+
+typedef uint8_t *Hacl_Impl_Store51_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Store51_felem;
+
+typedef uint8_t *Hacl_Impl_Ed25519_PointCompress_hint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_PointCompress_hint64_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_SwapConditional_felem;
+
+typedef uint8_t *Hacl_Impl_Ed25519_Ladder_Step_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_Ladder_elemB;
+
+typedef uint8_t *Hacl_Hash_Lib_LoadStore_uint8_p;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_t;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_t;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_t;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_ht;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_ht;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_ht;
+
+typedef uint8_t *Hacl_Hash_Lib_Create_uint8_p;
+
+typedef uint32_t *Hacl_Hash_Lib_Create_uint32_p;
+
+typedef uint64_t *Hacl_Hash_Lib_Create_uint64_p;
+
+typedef uint8_t Hacl_Impl_SHA2_512_Lemmas_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_512_Lemmas_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_512_Lemmas_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_512_Lemmas_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_512_Lemmas_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_512_Lemmas_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_Impl_SHA2_512_Lemmas_uint128_ht;
+
+typedef uint64_t *Hacl_Impl_SHA2_512_Lemmas_uint64_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_512_Lemmas_uint8_p;
+
+typedef uint8_t Hacl_Impl_SHA2_512_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_512_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_512_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_512_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_512_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_512_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_Impl_SHA2_512_uint128_ht;
+
+typedef uint64_t *Hacl_Impl_SHA2_512_uint64_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_512_uint8_p;
+
+typedef uint8_t Hacl_SHA2_512_uint8_t;
+
+typedef uint32_t Hacl_SHA2_512_uint32_t;
+
+typedef uint64_t Hacl_SHA2_512_uint64_t;
+
+typedef uint8_t Hacl_SHA2_512_uint8_ht;
+
+typedef uint32_t Hacl_SHA2_512_uint32_ht;
+
+typedef uint64_t Hacl_SHA2_512_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_SHA2_512_uint128_ht;
+
+typedef uint64_t *Hacl_SHA2_512_uint64_p;
+
+typedef uint8_t *Hacl_SHA2_512_uint8_p;
+
+typedef uint8_t *Hacl_Impl_Ed25519_SecretExpand_hint8_p;
+
+typedef uint8_t *Hacl_Impl_Ed25519_SecretToPublic_hint8_p;
+
+typedef Prims_nat Hacl_Impl_Ed25519_Verify_Lemmas_u51;
+
+typedef uint8_t *Hacl_Impl_Ed25519_PointEqual_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_PointEqual_felem;
+
+typedef uint32_t Hacl_Impl_Load56_u32;
+
+typedef uint8_t Hacl_Impl_Load56_h8;
+
+typedef uint64_t Hacl_Impl_Load56_h64;
+
+typedef uint8_t *Hacl_Impl_Load56_hint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_RecoverX_elemB;
+
+typedef uint32_t Hacl_Impl_Load51_u32;
+
+typedef uint8_t Hacl_Impl_Load51_h8;
+
+typedef uint64_t Hacl_Impl_Load51_h64;
+
+typedef uint8_t *Hacl_Impl_Load51_hint8_p;
+
+typedef uint8_t *Hacl_Impl_Store56_hint8_p;
+
+typedef uint64_t *Hacl_Impl_Store56_qelem;
+
+typedef uint8_t *Hacl_Impl_SHA512_Ed25519_1_hint8_p;
+
+typedef uint8_t *Hacl_Impl_SHA512_Ed25519_hint8_p;
+
+typedef uint8_t *Hacl_Impl_Sha512_hint8_p;
+
+typedef FStar_UInt128_t Hacl_Lib_Create128_h128;
+
+typedef uint64_t *Hacl_Impl_BignumQ_Mul_qelemB;
+
+typedef uint64_t Hacl_Impl_BignumQ_Mul_h64;
+
+typedef uint8_t *Hacl_Impl_Ed25519_Verify_Steps_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_Verify_Steps_felem;
+
+typedef uint8_t *Hacl_Impl_Ed25519_Verify_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Ed25519_Verify_felem;
+
+typedef uint8_t *Hacl_Impl_Ed25519_Sign_Steps_hint8_p;
+
+typedef uint8_t *Hacl_Impl_Ed25519_Sign_hint8_p;
+
+typedef uint8_t *Hacl_Ed25519_uint8_p;
+
+typedef uint8_t *Hacl_Ed25519_hint8_p;
+
+void Hacl_Ed25519_sign(uint8_t *signature, uint8_t *secret, uint8_t *msg, uint32_t len1);
+
+bool Hacl_Ed25519_verify(uint8_t *public, uint8_t *msg, uint32_t len1, uint8_t *signature);
+
+void Hacl_Ed25519_secret_to_public(uint8_t *out, uint8_t *secret);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.c
new file mode 100644
index 000000000..9745af328
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.c
@@ -0,0 +1,377 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_HMAC_SHA2_256.h"
+
+static void
+Hacl_Hash_Lib_LoadStore_uint32s_from_be_bytes(uint32_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)4U * i;
+    uint32_t inputi = load32_be(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint32s_to_be_bytes(uint8_t *output, uint32_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint32_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)4U * i;
+    store32_be(x0, hd1);
+  }
+}
+
+static void Hacl_Impl_SHA2_256_init(uint32_t *state)
+{
+  uint32_t *n1 = state + (uint32_t)136U;
+  uint32_t *k1 = state;
+  uint32_t *h_01 = state + (uint32_t)128U;
+  uint32_t *p10 = k1;
+  uint32_t *p20 = k1 + (uint32_t)16U;
+  uint32_t *p3 = k1 + (uint32_t)32U;
+  uint32_t *p4 = k1 + (uint32_t)48U;
+  uint32_t *p11 = p10;
+  uint32_t *p21 = p10 + (uint32_t)8U;
+  uint32_t *p12 = p11;
+  uint32_t *p22 = p11 + (uint32_t)4U;
+  p12[0U] = (uint32_t)0x428a2f98U;
+  p12[1U] = (uint32_t)0x71374491U;
+  p12[2U] = (uint32_t)0xb5c0fbcfU;
+  p12[3U] = (uint32_t)0xe9b5dba5U;
+  p22[0U] = (uint32_t)0x3956c25bU;
+  p22[1U] = (uint32_t)0x59f111f1U;
+  p22[2U] = (uint32_t)0x923f82a4U;
+  p22[3U] = (uint32_t)0xab1c5ed5U;
+  uint32_t *p13 = p21;
+  uint32_t *p23 = p21 + (uint32_t)4U;
+  p13[0U] = (uint32_t)0xd807aa98U;
+  p13[1U] = (uint32_t)0x12835b01U;
+  p13[2U] = (uint32_t)0x243185beU;
+  p13[3U] = (uint32_t)0x550c7dc3U;
+  p23[0U] = (uint32_t)0x72be5d74U;
+  p23[1U] = (uint32_t)0x80deb1feU;
+  p23[2U] = (uint32_t)0x9bdc06a7U;
+  p23[3U] = (uint32_t)0xc19bf174U;
+  uint32_t *p14 = p20;
+  uint32_t *p24 = p20 + (uint32_t)8U;
+  uint32_t *p15 = p14;
+  uint32_t *p25 = p14 + (uint32_t)4U;
+  p15[0U] = (uint32_t)0xe49b69c1U;
+  p15[1U] = (uint32_t)0xefbe4786U;
+  p15[2U] = (uint32_t)0x0fc19dc6U;
+  p15[3U] = (uint32_t)0x240ca1ccU;
+  p25[0U] = (uint32_t)0x2de92c6fU;
+  p25[1U] = (uint32_t)0x4a7484aaU;
+  p25[2U] = (uint32_t)0x5cb0a9dcU;
+  p25[3U] = (uint32_t)0x76f988daU;
+  uint32_t *p16 = p24;
+  uint32_t *p26 = p24 + (uint32_t)4U;
+  p16[0U] = (uint32_t)0x983e5152U;
+  p16[1U] = (uint32_t)0xa831c66dU;
+  p16[2U] = (uint32_t)0xb00327c8U;
+  p16[3U] = (uint32_t)0xbf597fc7U;
+  p26[0U] = (uint32_t)0xc6e00bf3U;
+  p26[1U] = (uint32_t)0xd5a79147U;
+  p26[2U] = (uint32_t)0x06ca6351U;
+  p26[3U] = (uint32_t)0x14292967U;
+  uint32_t *p17 = p3;
+  uint32_t *p27 = p3 + (uint32_t)8U;
+  uint32_t *p18 = p17;
+  uint32_t *p28 = p17 + (uint32_t)4U;
+  p18[0U] = (uint32_t)0x27b70a85U;
+  p18[1U] = (uint32_t)0x2e1b2138U;
+  p18[2U] = (uint32_t)0x4d2c6dfcU;
+  p18[3U] = (uint32_t)0x53380d13U;
+  p28[0U] = (uint32_t)0x650a7354U;
+  p28[1U] = (uint32_t)0x766a0abbU;
+  p28[2U] = (uint32_t)0x81c2c92eU;
+  p28[3U] = (uint32_t)0x92722c85U;
+  uint32_t *p19 = p27;
+  uint32_t *p29 = p27 + (uint32_t)4U;
+  p19[0U] = (uint32_t)0xa2bfe8a1U;
+  p19[1U] = (uint32_t)0xa81a664bU;
+  p19[2U] = (uint32_t)0xc24b8b70U;
+  p19[3U] = (uint32_t)0xc76c51a3U;
+  p29[0U] = (uint32_t)0xd192e819U;
+  p29[1U] = (uint32_t)0xd6990624U;
+  p29[2U] = (uint32_t)0xf40e3585U;
+  p29[3U] = (uint32_t)0x106aa070U;
+  uint32_t *p110 = p4;
+  uint32_t *p210 = p4 + (uint32_t)8U;
+  uint32_t *p1 = p110;
+  uint32_t *p211 = p110 + (uint32_t)4U;
+  p1[0U] = (uint32_t)0x19a4c116U;
+  p1[1U] = (uint32_t)0x1e376c08U;
+  p1[2U] = (uint32_t)0x2748774cU;
+  p1[3U] = (uint32_t)0x34b0bcb5U;
+  p211[0U] = (uint32_t)0x391c0cb3U;
+  p211[1U] = (uint32_t)0x4ed8aa4aU;
+  p211[2U] = (uint32_t)0x5b9cca4fU;
+  p211[3U] = (uint32_t)0x682e6ff3U;
+  uint32_t *p111 = p210;
+  uint32_t *p212 = p210 + (uint32_t)4U;
+  p111[0U] = (uint32_t)0x748f82eeU;
+  p111[1U] = (uint32_t)0x78a5636fU;
+  p111[2U] = (uint32_t)0x84c87814U;
+  p111[3U] = (uint32_t)0x8cc70208U;
+  p212[0U] = (uint32_t)0x90befffaU;
+  p212[1U] = (uint32_t)0xa4506cebU;
+  p212[2U] = (uint32_t)0xbef9a3f7U;
+  p212[3U] = (uint32_t)0xc67178f2U;
+  uint32_t *p112 = h_01;
+  uint32_t *p2 = h_01 + (uint32_t)4U;
+  p112[0U] = (uint32_t)0x6a09e667U;
+  p112[1U] = (uint32_t)0xbb67ae85U;
+  p112[2U] = (uint32_t)0x3c6ef372U;
+  p112[3U] = (uint32_t)0xa54ff53aU;
+  p2[0U] = (uint32_t)0x510e527fU;
+  p2[1U] = (uint32_t)0x9b05688cU;
+  p2[2U] = (uint32_t)0x1f83d9abU;
+  p2[3U] = (uint32_t)0x5be0cd19U;
+  n1[0U] = (uint32_t)0U;
+}
+
+static void Hacl_Impl_SHA2_256_update(uint32_t *state, uint8_t *data)
+{
+  uint32_t data_w[16U] = { 0U };
+  Hacl_Hash_Lib_LoadStore_uint32s_from_be_bytes(data_w, data, (uint32_t)16U);
+  uint32_t *hash_w = state + (uint32_t)128U;
+  uint32_t *ws_w = state + (uint32_t)64U;
+  uint32_t *k_w = state;
+  uint32_t *counter_w = state + (uint32_t)136U;
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t b = data_w[i];
+    ws_w[i] = b;
+  }
+  for (uint32_t i = (uint32_t)16U; i < (uint32_t)64U; i = i + (uint32_t)1U)
+  {
+    uint32_t t16 = ws_w[i - (uint32_t)16U];
+    uint32_t t15 = ws_w[i - (uint32_t)15U];
+    uint32_t t7 = ws_w[i - (uint32_t)7U];
+    uint32_t t2 = ws_w[i - (uint32_t)2U];
+    ws_w[i] =
+      ((t2 >> (uint32_t)17U | t2 << ((uint32_t)32U - (uint32_t)17U))
+      ^ ((t2 >> (uint32_t)19U | t2 << ((uint32_t)32U - (uint32_t)19U)) ^ t2 >> (uint32_t)10U))
+      +
+        t7
+        +
+          ((t15 >> (uint32_t)7U | t15 << ((uint32_t)32U - (uint32_t)7U))
+          ^ ((t15 >> (uint32_t)18U | t15 << ((uint32_t)32U - (uint32_t)18U)) ^ t15 >> (uint32_t)3U))
+          + t16;
+  }
+  uint32_t hash_0[8U] = { 0U };
+  memcpy(hash_0, hash_w, (uint32_t)8U * sizeof hash_w[0U]);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)64U; i = i + (uint32_t)1U)
+  {
+    uint32_t a = hash_0[0U];
+    uint32_t b = hash_0[1U];
+    uint32_t c = hash_0[2U];
+    uint32_t d = hash_0[3U];
+    uint32_t e = hash_0[4U];
+    uint32_t f1 = hash_0[5U];
+    uint32_t g = hash_0[6U];
+    uint32_t h = hash_0[7U];
+    uint32_t kt = k_w[i];
+    uint32_t wst = ws_w[i];
+    uint32_t
+    t1 =
+      h
+      +
+        ((e >> (uint32_t)6U | e << ((uint32_t)32U - (uint32_t)6U))
+        ^
+          ((e >> (uint32_t)11U | e << ((uint32_t)32U - (uint32_t)11U))
+          ^ (e >> (uint32_t)25U | e << ((uint32_t)32U - (uint32_t)25U))))
+      + ((e & f1) ^ (~e & g))
+      + kt
+      + wst;
+    uint32_t
+    t2 =
+      ((a >> (uint32_t)2U | a << ((uint32_t)32U - (uint32_t)2U))
+      ^
+        ((a >> (uint32_t)13U | a << ((uint32_t)32U - (uint32_t)13U))
+        ^ (a >> (uint32_t)22U | a << ((uint32_t)32U - (uint32_t)22U))))
+      + ((a & b) ^ ((a & c) ^ (b & c)));
+    uint32_t x1 = t1 + t2;
+    uint32_t x5 = d + t1;
+    uint32_t *p1 = hash_0;
+    uint32_t *p2 = hash_0 + (uint32_t)4U;
+    p1[0U] = x1;
+    p1[1U] = a;
+    p1[2U] = b;
+    p1[3U] = c;
+    p2[0U] = x5;
+    p2[1U] = e;
+    p2[2U] = f1;
+    p2[3U] = g;
+  }
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)8U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = hash_w[i];
+    uint32_t yi = hash_0[i];
+    hash_w[i] = xi + yi;
+  }
+  uint32_t c0 = counter_w[0U];
+  uint32_t one1 = (uint32_t)1U;
+  counter_w[0U] = c0 + one1;
+}
+
+static void Hacl_Impl_SHA2_256_update_multi(uint32_t *state, uint8_t *data, uint32_t n1)
+{
+  for (uint32_t i = (uint32_t)0U; i < n1; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = data + i * (uint32_t)64U;
+    Hacl_Impl_SHA2_256_update(state, b);
+  }
+}
+
+static void Hacl_Impl_SHA2_256_update_last(uint32_t *state, uint8_t *data, uint32_t len)
+{
+  uint8_t blocks[128U] = { 0U };
+  uint32_t nb;
+  if (len < (uint32_t)56U)
+    nb = (uint32_t)1U;
+  else
+    nb = (uint32_t)2U;
+  uint8_t *final_blocks;
+  if (len < (uint32_t)56U)
+    final_blocks = blocks + (uint32_t)64U;
+  else
+    final_blocks = blocks;
+  memcpy(final_blocks, data, len * sizeof data[0U]);
+  uint32_t n1 = state[136U];
+  uint8_t *padding = final_blocks + len;
+  uint32_t
+  pad0len = ((uint32_t)64U - (len + (uint32_t)8U + (uint32_t)1U) % (uint32_t)64U) % (uint32_t)64U;
+  uint8_t *buf1 = padding;
+  uint8_t *buf2 = padding + (uint32_t)1U + pad0len;
+  uint64_t
+  encodedlen = ((uint64_t)n1 * (uint64_t)(uint32_t)64U + (uint64_t)len) * (uint64_t)(uint32_t)8U;
+  buf1[0U] = (uint8_t)0x80U;
+  store64_be(buf2, encodedlen);
+  Hacl_Impl_SHA2_256_update_multi(state, final_blocks, nb);
+}
+
+static void Hacl_Impl_SHA2_256_finish(uint32_t *state, uint8_t *hash1)
+{
+  uint32_t *hash_w = state + (uint32_t)128U;
+  Hacl_Hash_Lib_LoadStore_uint32s_to_be_bytes(hash1, hash_w, (uint32_t)8U);
+}
+
+static void Hacl_Impl_SHA2_256_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  uint32_t state[137U] = { 0U };
+  uint32_t n1 = len / (uint32_t)64U;
+  uint32_t r = len % (uint32_t)64U;
+  uint8_t *input_blocks = input;
+  uint8_t *input_last = input + n1 * (uint32_t)64U;
+  Hacl_Impl_SHA2_256_init(state);
+  Hacl_Impl_SHA2_256_update_multi(state, input_blocks, n1);
+  Hacl_Impl_SHA2_256_update_last(state, input_last, r);
+  Hacl_Impl_SHA2_256_finish(state, hash1);
+}
+
+static void Hacl_Impl_HMAC_SHA2_256_xor_bytes_inplace(uint8_t *a, uint8_t *b, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t xi = a[i];
+    uint8_t yi = b[i];
+    a[i] = xi ^ yi;
+  }
+}
+
+static void
+Hacl_Impl_HMAC_SHA2_256_hmac_core(uint8_t *mac, uint8_t *key, uint8_t *data, uint32_t len)
+{
+  uint8_t ipad[64U];
+  for (uint32_t _i = 0U; _i < (uint32_t)64U; ++_i)
+    ipad[_i] = (uint8_t)0x36U;
+  uint8_t opad[64U];
+  for (uint32_t _i = 0U; _i < (uint32_t)64U; ++_i)
+    opad[_i] = (uint8_t)0x5cU;
+  Hacl_Impl_HMAC_SHA2_256_xor_bytes_inplace(ipad, key, (uint32_t)64U);
+  uint32_t state0[137U] = { 0U };
+  uint32_t n0 = len / (uint32_t)64U;
+  uint32_t r0 = len % (uint32_t)64U;
+  uint8_t *blocks0 = data;
+  uint8_t *last0 = data + n0 * (uint32_t)64U;
+  Hacl_Impl_SHA2_256_init(state0);
+  Hacl_Impl_SHA2_256_update(state0, ipad);
+  Hacl_Impl_SHA2_256_update_multi(state0, blocks0, n0);
+  Hacl_Impl_SHA2_256_update_last(state0, last0, r0);
+  uint8_t *hash0 = ipad;
+  Hacl_Impl_SHA2_256_finish(state0, hash0);
+  uint8_t *s4 = ipad;
+  Hacl_Impl_HMAC_SHA2_256_xor_bytes_inplace(opad, key, (uint32_t)64U);
+  uint32_t state1[137U] = { 0U };
+  Hacl_Impl_SHA2_256_init(state1);
+  Hacl_Impl_SHA2_256_update(state1, opad);
+  Hacl_Impl_SHA2_256_update_last(state1, s4, (uint32_t)32U);
+  Hacl_Impl_SHA2_256_finish(state1, mac);
+}
+
+static void
+Hacl_Impl_HMAC_SHA2_256_hmac(
+  uint8_t *mac,
+  uint8_t *key,
+  uint32_t keylen,
+  uint8_t *data,
+  uint32_t datalen
+)
+{
+  uint8_t nkey[64U];
+  for (uint32_t _i = 0U; _i < (uint32_t)64U; ++_i)
+    nkey[_i] = (uint8_t)0x00U;
+  if (keylen <= (uint32_t)64U)
+    memcpy(nkey, key, keylen * sizeof key[0U]);
+  else
+  {
+    uint8_t *nkey0 = nkey;
+    Hacl_Impl_SHA2_256_hash(nkey0, key, keylen);
+  }
+  Hacl_Impl_HMAC_SHA2_256_hmac_core(mac, nkey, data, datalen);
+}
+
+void Hacl_HMAC_SHA2_256_hmac_core(uint8_t *mac, uint8_t *key, uint8_t *data, uint32_t len)
+{
+  Hacl_Impl_HMAC_SHA2_256_hmac_core(mac, key, data, len);
+}
+
+void
+Hacl_HMAC_SHA2_256_hmac(
+  uint8_t *mac,
+  uint8_t *key,
+  uint32_t keylen,
+  uint8_t *data,
+  uint32_t datalen
+)
+{
+  Hacl_Impl_HMAC_SHA2_256_hmac(mac, key, keylen, data, datalen);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.h
new file mode 100644
index 000000000..75bd6dfe8
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_HMAC_SHA2_256.h
@@ -0,0 +1,100 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_HMAC_SHA2_256_H
+#define __Hacl_HMAC_SHA2_256_H
+
+
+
+
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_t;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_t;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_t;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_ht;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_ht;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_ht;
+
+typedef uint8_t *Hacl_Hash_Lib_Create_uint8_p;
+
+typedef uint32_t *Hacl_Hash_Lib_Create_uint32_p;
+
+typedef uint64_t *Hacl_Hash_Lib_Create_uint64_p;
+
+typedef uint8_t *Hacl_Hash_Lib_LoadStore_uint8_p;
+
+typedef uint8_t Hacl_Impl_SHA2_256_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_256_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_256_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_256_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_256_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_256_uint64_ht;
+
+typedef uint32_t *Hacl_Impl_SHA2_256_uint32_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_256_uint8_p;
+
+typedef uint8_t Hacl_Impl_HMAC_SHA2_256_uint8_t;
+
+typedef uint32_t Hacl_Impl_HMAC_SHA2_256_uint32_t;
+
+typedef uint64_t Hacl_Impl_HMAC_SHA2_256_uint64_t;
+
+typedef uint8_t Hacl_Impl_HMAC_SHA2_256_uint8_ht;
+
+typedef uint32_t Hacl_Impl_HMAC_SHA2_256_uint32_ht;
+
+typedef uint64_t Hacl_Impl_HMAC_SHA2_256_uint64_ht;
+
+typedef uint32_t *Hacl_Impl_HMAC_SHA2_256_uint32_p;
+
+typedef uint8_t *Hacl_Impl_HMAC_SHA2_256_uint8_p;
+
+typedef uint8_t Hacl_HMAC_SHA2_256_uint8_ht;
+
+typedef uint32_t Hacl_HMAC_SHA2_256_uint32_t;
+
+typedef uint8_t *Hacl_HMAC_SHA2_256_uint8_p;
+
+void Hacl_HMAC_SHA2_256_hmac_core(uint8_t *mac, uint8_t *key, uint8_t *data, uint32_t len);
+
+void
+Hacl_HMAC_SHA2_256_hmac(
+  uint8_t *mac,
+  uint8_t *key,
+  uint32_t keylen,
+  uint8_t *data,
+  uint32_t datalen
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.c
new file mode 100644
index 000000000..ea176dfa6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.c
@@ -0,0 +1,66 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Policies.h"
+
+uint8_t Hacl_Policies_declassify_u8(uint8_t x)
+{
+  return x;
+}
+
+uint32_t Hacl_Policies_declassify_u32(uint32_t x)
+{
+  return x;
+}
+
+uint64_t Hacl_Policies_declassify_u64(uint64_t x)
+{
+  return x;
+}
+
+FStar_UInt128_t Hacl_Policies_declassify_u128(FStar_UInt128_t x)
+{
+  return x;
+}
+
+uint8_t Hacl_Policies_cmp_bytes_(uint8_t *b1, uint8_t *b2, uint32_t len, uint8_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t bi1 = b1[i];
+    uint8_t bi2 = b2[i];
+    uint8_t z0 = tmp[0U];
+    tmp[0U] = FStar_UInt8_eq_mask(bi1, bi2) & z0;
+  }
+  return tmp[0U];
+}
+
+uint8_t Hacl_Policies_cmp_bytes(uint8_t *b1, uint8_t *b2, uint32_t len)
+{
+  uint8_t tmp[1U];
+  tmp[0U] = (uint8_t)255U;
+  uint8_t z = Hacl_Policies_cmp_bytes_(b1, b2, len, tmp);
+  return ~z;
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.h
new file mode 100644
index 000000000..290029fb1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Policies.h
@@ -0,0 +1,43 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Policies_H
+#define __Hacl_Policies_H
+
+
+
+
+
+uint8_t Hacl_Policies_declassify_u8(uint8_t x);
+
+uint32_t Hacl_Policies_declassify_u32(uint32_t x);
+
+uint64_t Hacl_Policies_declassify_u64(uint64_t x);
+
+FStar_UInt128_t Hacl_Policies_declassify_u128(FStar_UInt128_t x);
+
+uint8_t Hacl_Policies_cmp_bytes_(uint8_t *b1, uint8_t *b2, uint32_t len, uint8_t *tmp);
+
+uint8_t Hacl_Policies_cmp_bytes(uint8_t *b1, uint8_t *b2, uint32_t len);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.c
new file mode 100644
index 000000000..c4ab05b76
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.c
@@ -0,0 +1,605 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Poly1305_32.h"
+
+inline static void Hacl_Bignum_Modulo_reduce(uint32_t *b)
+{
+  uint32_t b0 = b[0U];
+  b[0U] = (b0 << (uint32_t)2U) + b0;
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top(uint32_t *b)
+{
+  uint32_t b4 = b[4U];
+  uint32_t b0 = b[0U];
+  uint32_t b4_26 = b4 >> (uint32_t)26U;
+  b[4U] = b4 & (uint32_t)0x3ffffffU;
+  b[0U] = (b4_26 << (uint32_t)2U) + b4_26 + b0;
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top_wide(uint64_t *b)
+{
+  uint64_t b4 = b[4U];
+  uint64_t b0 = b[0U];
+  uint64_t b4_ = b4 & (uint64_t)(uint32_t)0x3ffffffU;
+  uint32_t b4_26 = (uint32_t)(b4 >> (uint32_t)26U);
+  uint64_t b0_ = b0 + (uint64_t)((b4_26 << (uint32_t)2U) + b4_26);
+  b[4U] = b4_;
+  b[0U] = b0_;
+}
+
+inline static void Hacl_Bignum_Fproduct_copy_from_wide_(uint32_t *output, uint64_t *input)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)5U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = input[i];
+    output[i] = (uint32_t)xi;
+  }
+}
+
+inline static void
+Hacl_Bignum_Fproduct_sum_scalar_multiplication_(uint64_t *output, uint32_t *input, uint32_t s)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)5U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = output[i];
+    uint32_t yi = input[i];
+    uint64_t x_wide = (uint64_t)yi;
+    uint64_t y_wide = (uint64_t)s;
+    output[i] = xi + x_wide * y_wide;
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_wide_(uint64_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)4U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    uint64_t tctr = tmp[ctr];
+    uint64_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint32_t r0 = (uint32_t)tctr & (uint32_t)0x3ffffffU;
+    uint64_t c = tctr >> (uint32_t)26U;
+    tmp[ctr] = (uint64_t)r0;
+    tmp[ctr + (uint32_t)1U] = tctrp1 + c;
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_limb_(uint32_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)4U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    uint32_t tctr = tmp[ctr];
+    uint32_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint32_t r0 = tctr & (uint32_t)0x3ffffffU;
+    uint32_t c = tctr >> (uint32_t)26U;
+    tmp[ctr] = r0;
+    tmp[ctr + (uint32_t)1U] = tctrp1 + c;
+  }
+}
+
+inline static void Hacl_Bignum_Fmul_shift_reduce(uint32_t *output)
+{
+  uint32_t tmp = output[4U];
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)4U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = (uint32_t)5U - i - (uint32_t)1U;
+    uint32_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  output[0U] = tmp;
+  Hacl_Bignum_Modulo_reduce(output);
+}
+
+static void
+Hacl_Bignum_Fmul_mul_shift_reduce_(uint64_t *output, uint32_t *input, uint32_t *input2)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)4U; i = i + (uint32_t)1U)
+  {
+    uint32_t input2i = input2[i];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  uint32_t i = (uint32_t)4U;
+  uint32_t input2i = input2[i];
+  Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+}
+
+inline static void Hacl_Bignum_Fmul_fmul(uint32_t *output, uint32_t *input, uint32_t *input2)
+{
+  uint32_t tmp[5U] = { 0U };
+  memcpy(tmp, input, (uint32_t)5U * sizeof input[0U]);
+  uint64_t t[5U] = { 0U };
+  Hacl_Bignum_Fmul_mul_shift_reduce_(t, tmp, input2);
+  Hacl_Bignum_Fproduct_carry_wide_(t);
+  Hacl_Bignum_Modulo_carry_top_wide(t);
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, t);
+  uint32_t i0 = output[0U];
+  uint32_t i1 = output[1U];
+  uint32_t i0_ = i0 & (uint32_t)0x3ffffffU;
+  uint32_t i1_ = i1 + (i0 >> (uint32_t)26U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+inline static void
+Hacl_Bignum_AddAndMultiply_add_and_multiply(uint32_t *acc, uint32_t *block, uint32_t *r)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)5U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = acc[i];
+    uint32_t yi = block[i];
+    acc[i] = xi + yi;
+  }
+  Hacl_Bignum_Fmul_fmul(acc, acc, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_32_poly1305_update(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m
+)
+{
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut0 = st;
+  uint32_t *h = scrut0.h;
+  uint32_t *acc = h;
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *r = scrut.r;
+  uint32_t *r5 = r;
+  uint32_t tmp[5U] = { 0U };
+  uint8_t *s0 = m;
+  uint8_t *s1 = m + (uint32_t)3U;
+  uint8_t *s2 = m + (uint32_t)6U;
+  uint8_t *s3 = m + (uint32_t)9U;
+  uint8_t *s4 = m + (uint32_t)12U;
+  uint32_t i0 = load32_le(s0);
+  uint32_t i1 = load32_le(s1);
+  uint32_t i2 = load32_le(s2);
+  uint32_t i3 = load32_le(s3);
+  uint32_t i4 = load32_le(s4);
+  uint32_t r0 = i0 & (uint32_t)0x3ffffffU;
+  uint32_t r1 = i1 >> (uint32_t)2U & (uint32_t)0x3ffffffU;
+  uint32_t r2 = i2 >> (uint32_t)4U & (uint32_t)0x3ffffffU;
+  uint32_t r3 = i3 >> (uint32_t)6U & (uint32_t)0x3ffffffU;
+  uint32_t r4 = i4 >> (uint32_t)8U;
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  tmp[3U] = r3;
+  tmp[4U] = r4;
+  uint32_t b4 = tmp[4U];
+  uint32_t b4_ = (uint32_t)0x1000000U | b4;
+  tmp[4U] = b4_;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(acc, tmp, r5);
+}
+
+inline static void
+Hacl_Impl_Poly1305_32_poly1305_process_last_block_(
+  uint8_t *block,
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint32_t tmp[5U] = { 0U };
+  uint8_t *s0 = block;
+  uint8_t *s1 = block + (uint32_t)3U;
+  uint8_t *s2 = block + (uint32_t)6U;
+  uint8_t *s3 = block + (uint32_t)9U;
+  uint8_t *s4 = block + (uint32_t)12U;
+  uint32_t i0 = load32_le(s0);
+  uint32_t i1 = load32_le(s1);
+  uint32_t i2 = load32_le(s2);
+  uint32_t i3 = load32_le(s3);
+  uint32_t i4 = load32_le(s4);
+  uint32_t r0 = i0 & (uint32_t)0x3ffffffU;
+  uint32_t r1 = i1 >> (uint32_t)2U & (uint32_t)0x3ffffffU;
+  uint32_t r2 = i2 >> (uint32_t)4U & (uint32_t)0x3ffffffU;
+  uint32_t r3 = i3 >> (uint32_t)6U & (uint32_t)0x3ffffffU;
+  uint32_t r4 = i4 >> (uint32_t)8U;
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  tmp[3U] = r3;
+  tmp[4U] = r4;
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut0 = st;
+  uint32_t *h = scrut0.h;
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *r = scrut.r;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(h, tmp, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_32_poly1305_process_last_block(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint8_t zero1 = (uint8_t)0U;
+  KRML_CHECK_SIZE(zero1, (uint32_t)16U);
+  uint8_t block[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    block[_i] = zero1;
+  uint32_t i0 = (uint32_t)rem_;
+  uint32_t i = (uint32_t)rem_;
+  memcpy(block, m, i * sizeof m[0U]);
+  block[i0] = (uint8_t)1U;
+  Hacl_Impl_Poly1305_32_poly1305_process_last_block_(block, st, m, rem_);
+}
+
+static void Hacl_Impl_Poly1305_32_poly1305_last_pass(uint32_t *acc)
+{
+  Hacl_Bignum_Fproduct_carry_limb_(acc);
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint32_t t0 = acc[0U];
+  uint32_t t10 = acc[1U];
+  uint32_t t20 = acc[2U];
+  uint32_t t30 = acc[3U];
+  uint32_t t40 = acc[4U];
+  uint32_t t1_ = t10 + (t0 >> (uint32_t)26U);
+  uint32_t mask_261 = (uint32_t)0x3ffffffU;
+  uint32_t t0_ = t0 & mask_261;
+  uint32_t t2_ = t20 + (t1_ >> (uint32_t)26U);
+  uint32_t t1__ = t1_ & mask_261;
+  uint32_t t3_ = t30 + (t2_ >> (uint32_t)26U);
+  uint32_t t2__ = t2_ & mask_261;
+  uint32_t t4_ = t40 + (t3_ >> (uint32_t)26U);
+  uint32_t t3__ = t3_ & mask_261;
+  acc[0U] = t0_;
+  acc[1U] = t1__;
+  acc[2U] = t2__;
+  acc[3U] = t3__;
+  acc[4U] = t4_;
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint32_t t00 = acc[0U];
+  uint32_t t1 = acc[1U];
+  uint32_t t2 = acc[2U];
+  uint32_t t3 = acc[3U];
+  uint32_t t4 = acc[4U];
+  uint32_t t1_0 = t1 + (t00 >> (uint32_t)26U);
+  uint32_t t0_0 = t00 & (uint32_t)0x3ffffffU;
+  uint32_t t2_0 = t2 + (t1_0 >> (uint32_t)26U);
+  uint32_t t1__0 = t1_0 & (uint32_t)0x3ffffffU;
+  uint32_t t3_0 = t3 + (t2_0 >> (uint32_t)26U);
+  uint32_t t2__0 = t2_0 & (uint32_t)0x3ffffffU;
+  uint32_t t4_0 = t4 + (t3_0 >> (uint32_t)26U);
+  uint32_t t3__0 = t3_0 & (uint32_t)0x3ffffffU;
+  acc[0U] = t0_0;
+  acc[1U] = t1__0;
+  acc[2U] = t2__0;
+  acc[3U] = t3__0;
+  acc[4U] = t4_0;
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint32_t i0 = acc[0U];
+  uint32_t i1 = acc[1U];
+  uint32_t i0_ = i0 & (uint32_t)0x3ffffffU;
+  uint32_t i1_ = i1 + (i0 >> (uint32_t)26U);
+  acc[0U] = i0_;
+  acc[1U] = i1_;
+  uint32_t a0 = acc[0U];
+  uint32_t a1 = acc[1U];
+  uint32_t a2 = acc[2U];
+  uint32_t a3 = acc[3U];
+  uint32_t a4 = acc[4U];
+  uint32_t mask0 = FStar_UInt32_gte_mask(a0, (uint32_t)0x3fffffbU);
+  uint32_t mask1 = FStar_UInt32_eq_mask(a1, (uint32_t)0x3ffffffU);
+  uint32_t mask2 = FStar_UInt32_eq_mask(a2, (uint32_t)0x3ffffffU);
+  uint32_t mask3 = FStar_UInt32_eq_mask(a3, (uint32_t)0x3ffffffU);
+  uint32_t mask4 = FStar_UInt32_eq_mask(a4, (uint32_t)0x3ffffffU);
+  uint32_t mask = (((mask0 & mask1) & mask2) & mask3) & mask4;
+  uint32_t a0_ = a0 - ((uint32_t)0x3fffffbU & mask);
+  uint32_t a1_ = a1 - ((uint32_t)0x3ffffffU & mask);
+  uint32_t a2_ = a2 - ((uint32_t)0x3ffffffU & mask);
+  uint32_t a3_ = a3 - ((uint32_t)0x3ffffffU & mask);
+  uint32_t a4_ = a4 - ((uint32_t)0x3ffffffU & mask);
+  acc[0U] = a0_;
+  acc[1U] = a1_;
+  acc[2U] = a2_;
+  acc[3U] = a3_;
+  acc[4U] = a4_;
+}
+
+static Hacl_Impl_Poly1305_32_State_poly1305_state
+Hacl_Impl_Poly1305_32_mk_state(uint32_t *r, uint32_t *h)
+{
+  return ((Hacl_Impl_Poly1305_32_State_poly1305_state){ .r = r, .h = h });
+}
+
+static void
+Hacl_Standalone_Poly1305_32_poly1305_blocks(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t len1
+)
+{
+  if (!(len1 == (uint64_t)0U))
+  {
+    uint8_t *block = m;
+    uint8_t *tail1 = m + (uint32_t)16U;
+    Hacl_Impl_Poly1305_32_poly1305_update(st, block);
+    uint64_t len2 = len1 - (uint64_t)1U;
+    Hacl_Standalone_Poly1305_32_poly1305_blocks(st, tail1, len2);
+  }
+}
+
+static void
+Hacl_Standalone_Poly1305_32_poly1305_partial(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *kr
+)
+{
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *r = scrut.r;
+  uint32_t *x0 = r;
+  FStar_UInt128_t k1 = load128_le(kr);
+  FStar_UInt128_t
+  k_clamped =
+    FStar_UInt128_logand(k1,
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0ffffffcU),
+          (uint32_t)64U),
+        FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0fffffffU)));
+  uint32_t r0 = (uint32_t)FStar_UInt128_uint128_to_uint64(k_clamped) & (uint32_t)0x3ffffffU;
+  uint32_t
+  r1 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)26U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r2 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)52U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r3 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)78U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r4 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)104U))
+    & (uint32_t)0x3ffffffU;
+  x0[0U] = r0;
+  x0[1U] = r1;
+  x0[2U] = r2;
+  x0[3U] = r3;
+  x0[4U] = r4;
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut0 = st;
+  uint32_t *h = scrut0.h;
+  uint32_t *x00 = h;
+  x00[0U] = (uint32_t)0U;
+  x00[1U] = (uint32_t)0U;
+  x00[2U] = (uint32_t)0U;
+  x00[3U] = (uint32_t)0U;
+  x00[4U] = (uint32_t)0U;
+  Hacl_Standalone_Poly1305_32_poly1305_blocks(st, input, len1);
+}
+
+static void
+Hacl_Standalone_Poly1305_32_poly1305_complete(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  uint8_t *kr = k1;
+  uint64_t len16 = len1 >> (uint32_t)4U;
+  uint64_t rem16 = len1 & (uint64_t)0xfU;
+  uint8_t *part_input = m;
+  uint8_t *last_block = m + (uint32_t)((uint64_t)16U * len16);
+  Hacl_Standalone_Poly1305_32_poly1305_partial(st, part_input, len16, kr);
+  if (!(rem16 == (uint64_t)0U))
+    Hacl_Impl_Poly1305_32_poly1305_process_last_block(st, last_block, rem16);
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *h = scrut.h;
+  uint32_t *acc = h;
+  Hacl_Impl_Poly1305_32_poly1305_last_pass(acc);
+}
+
+static void
+Hacl_Standalone_Poly1305_32_crypto_onetimeauth_(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  uint32_t buf[10U] = { 0U };
+  uint32_t *r = buf;
+  uint32_t *h = buf + (uint32_t)5U;
+  Hacl_Impl_Poly1305_32_State_poly1305_state st = Hacl_Impl_Poly1305_32_mk_state(r, h);
+  uint8_t *key_s = k1 + (uint32_t)16U;
+  Hacl_Standalone_Poly1305_32_poly1305_complete(st, input, len1, k1);
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *h5 = scrut.h;
+  uint32_t *acc = h5;
+  FStar_UInt128_t k_ = load128_le(key_s);
+  uint32_t h0 = acc[0U];
+  uint32_t h1 = acc[1U];
+  uint32_t h2 = acc[2U];
+  uint32_t h3 = acc[3U];
+  uint32_t h4 = acc[4U];
+  FStar_UInt128_t
+  acc_ =
+    FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h4),
+        (uint32_t)104U),
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h3),
+          (uint32_t)78U),
+        FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h2),
+            (uint32_t)52U),
+          FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h1),
+              (uint32_t)26U),
+            FStar_UInt128_uint64_to_uint128((uint64_t)h0)))));
+  FStar_UInt128_t mac_ = FStar_UInt128_add_mod(acc_, k_);
+  store128_le(output, mac_);
+}
+
+static void
+Hacl_Standalone_Poly1305_32_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  Hacl_Standalone_Poly1305_32_crypto_onetimeauth_(output, input, len1, k1);
+}
+
+void *Hacl_Poly1305_32_op_String_Access(FStar_Monotonic_HyperStack_mem h, uint8_t *b)
+{
+  return (void *)(uint8_t)0U;
+}
+
+Hacl_Impl_Poly1305_32_State_poly1305_state
+Hacl_Poly1305_32_mk_state(uint32_t *r, uint32_t *acc)
+{
+  return Hacl_Impl_Poly1305_32_mk_state(r, acc);
+}
+
+void Hacl_Poly1305_32_init(Hacl_Impl_Poly1305_32_State_poly1305_state st, uint8_t *k1)
+{
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *r = scrut.r;
+  uint32_t *x0 = r;
+  FStar_UInt128_t k10 = load128_le(k1);
+  FStar_UInt128_t
+  k_clamped =
+    FStar_UInt128_logand(k10,
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0ffffffcU),
+          (uint32_t)64U),
+        FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0fffffffU)));
+  uint32_t r0 = (uint32_t)FStar_UInt128_uint128_to_uint64(k_clamped) & (uint32_t)0x3ffffffU;
+  uint32_t
+  r1 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)26U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r2 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)52U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r3 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)78U))
+    & (uint32_t)0x3ffffffU;
+  uint32_t
+  r4 =
+    (uint32_t)FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)104U))
+    & (uint32_t)0x3ffffffU;
+  x0[0U] = r0;
+  x0[1U] = r1;
+  x0[2U] = r2;
+  x0[3U] = r3;
+  x0[4U] = r4;
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut0 = st;
+  uint32_t *h = scrut0.h;
+  uint32_t *x00 = h;
+  x00[0U] = (uint32_t)0U;
+  x00[1U] = (uint32_t)0U;
+  x00[2U] = (uint32_t)0U;
+  x00[3U] = (uint32_t)0U;
+  x00[4U] = (uint32_t)0U;
+}
+
+void *Hacl_Poly1305_32_empty_log = (void *)(uint8_t)0U;
+
+void Hacl_Poly1305_32_update_block(Hacl_Impl_Poly1305_32_State_poly1305_state st, uint8_t *m)
+{
+  Hacl_Impl_Poly1305_32_poly1305_update(st, m);
+}
+
+void
+Hacl_Poly1305_32_update(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+)
+{
+  if (!(len1 == (uint32_t)0U))
+  {
+    uint8_t *block = m;
+    uint8_t *m_ = m + (uint32_t)16U;
+    uint32_t len2 = len1 - (uint32_t)1U;
+    Hacl_Poly1305_32_update_block(st, block);
+    Hacl_Poly1305_32_update(st, m_, len2);
+  }
+}
+
+void
+Hacl_Poly1305_32_update_last(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+)
+{
+  if (!((uint64_t)len1 == (uint64_t)0U))
+    Hacl_Impl_Poly1305_32_poly1305_process_last_block(st, m, (uint64_t)len1);
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *h = scrut.h;
+  uint32_t *acc = h;
+  Hacl_Impl_Poly1305_32_poly1305_last_pass(acc);
+}
+
+void
+Hacl_Poly1305_32_finish(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *mac,
+  uint8_t *k1
+)
+{
+  Hacl_Impl_Poly1305_32_State_poly1305_state scrut = st;
+  uint32_t *h = scrut.h;
+  uint32_t *acc = h;
+  FStar_UInt128_t k_ = load128_le(k1);
+  uint32_t h0 = acc[0U];
+  uint32_t h1 = acc[1U];
+  uint32_t h2 = acc[2U];
+  uint32_t h3 = acc[3U];
+  uint32_t h4 = acc[4U];
+  FStar_UInt128_t
+  acc_ =
+    FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h4),
+        (uint32_t)104U),
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h3),
+          (uint32_t)78U),
+        FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h2),
+            (uint32_t)52U),
+          FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)h1),
+              (uint32_t)26U),
+            FStar_UInt128_uint64_to_uint128((uint64_t)h0)))));
+  FStar_UInt128_t mac_ = FStar_UInt128_add_mod(acc_, k_);
+  store128_le(mac, mac_);
+}
+
+void
+Hacl_Poly1305_32_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  Hacl_Standalone_Poly1305_32_crypto_onetimeauth(output, input, len1, k1);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.h
new file mode 100644
index 000000000..dff33a6fa
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_32.h
@@ -0,0 +1,120 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Poly1305_32_H
+#define __Hacl_Poly1305_32_H
+
+
+
+
+
+typedef uint32_t Hacl_Bignum_Constants_limb;
+
+typedef uint64_t Hacl_Bignum_Constants_wide;
+
+typedef uint64_t Hacl_Bignum_Wide_t;
+
+typedef uint32_t Hacl_Bignum_Limb_t;
+
+typedef void *Hacl_Impl_Poly1305_32_State_log_t;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_State_uint8_p;
+
+typedef uint32_t *Hacl_Impl_Poly1305_32_State_bigint;
+
+typedef void *Hacl_Impl_Poly1305_32_State_seqelem;
+
+typedef uint32_t *Hacl_Impl_Poly1305_32_State_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_State_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_State_wordB_16;
+
+typedef struct 
+{
+  uint32_t *r;
+  uint32_t *h;
+}
+Hacl_Impl_Poly1305_32_State_poly1305_state;
+
+typedef void *Hacl_Impl_Poly1305_32_log_t;
+
+typedef uint32_t *Hacl_Impl_Poly1305_32_bigint;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_uint8_p;
+
+typedef uint32_t *Hacl_Impl_Poly1305_32_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_32_wordB_16;
+
+typedef uint8_t *Hacl_Poly1305_32_uint8_p;
+
+typedef uint64_t Hacl_Poly1305_32_uint64_t;
+
+void *Hacl_Poly1305_32_op_String_Access(FStar_Monotonic_HyperStack_mem h, uint8_t *b);
+
+typedef uint8_t *Hacl_Poly1305_32_key;
+
+typedef Hacl_Impl_Poly1305_32_State_poly1305_state Hacl_Poly1305_32_state;
+
+Hacl_Impl_Poly1305_32_State_poly1305_state
+Hacl_Poly1305_32_mk_state(uint32_t *r, uint32_t *acc);
+
+void Hacl_Poly1305_32_init(Hacl_Impl_Poly1305_32_State_poly1305_state st, uint8_t *k1);
+
+extern void *Hacl_Poly1305_32_empty_log;
+
+void Hacl_Poly1305_32_update_block(Hacl_Impl_Poly1305_32_State_poly1305_state st, uint8_t *m);
+
+void
+Hacl_Poly1305_32_update(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+);
+
+void
+Hacl_Poly1305_32_update_last(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+);
+
+void
+Hacl_Poly1305_32_finish(
+  Hacl_Impl_Poly1305_32_State_poly1305_state st,
+  uint8_t *mac,
+  uint8_t *k1
+);
+
+void
+Hacl_Poly1305_32_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.c
new file mode 100644
index 000000000..3bb5ad84b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.c
@@ -0,0 +1,511 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Poly1305_64.h"
+
+inline static void Hacl_Bignum_Modulo_reduce(uint64_t *b)
+{
+  uint64_t b0 = b[0U];
+  b[0U] = (b0 << (uint32_t)4U) + (b0 << (uint32_t)2U);
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top(uint64_t *b)
+{
+  uint64_t b2 = b[2U];
+  uint64_t b0 = b[0U];
+  uint64_t b2_42 = b2 >> (uint32_t)42U;
+  b[2U] = b2 & (uint64_t)0x3ffffffffffU;
+  b[0U] = (b2_42 << (uint32_t)2U) + b2_42 + b0;
+}
+
+inline static void Hacl_Bignum_Modulo_carry_top_wide(FStar_UInt128_t *b)
+{
+  FStar_UInt128_t b2 = b[2U];
+  FStar_UInt128_t b0 = b[0U];
+  FStar_UInt128_t
+  b2_ = FStar_UInt128_logand(b2, FStar_UInt128_uint64_to_uint128((uint64_t)0x3ffffffffffU));
+  uint64_t b2_42 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(b2, (uint32_t)42U));
+  FStar_UInt128_t
+  b0_ = FStar_UInt128_add(b0, FStar_UInt128_uint64_to_uint128((b2_42 << (uint32_t)2U) + b2_42));
+  b[2U] = b2_;
+  b[0U] = b0_;
+}
+
+inline static void
+Hacl_Bignum_Fproduct_copy_from_wide_(uint64_t *output, FStar_UInt128_t *input)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    FStar_UInt128_t xi = input[i];
+    output[i] = FStar_UInt128_uint128_to_uint64(xi);
+  }
+}
+
+inline static void
+Hacl_Bignum_Fproduct_sum_scalar_multiplication_(
+  FStar_UInt128_t *output,
+  uint64_t *input,
+  uint64_t s
+)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    FStar_UInt128_t xi = output[i];
+    uint64_t yi = input[i];
+    output[i] = FStar_UInt128_add_mod(xi, FStar_UInt128_mul_wide(yi, s));
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_wide_(FStar_UInt128_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    FStar_UInt128_t tctr = tmp[ctr];
+    FStar_UInt128_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = FStar_UInt128_uint128_to_uint64(tctr) & (uint64_t)0xfffffffffffU;
+    FStar_UInt128_t c = FStar_UInt128_shift_right(tctr, (uint32_t)44U);
+    tmp[ctr] = FStar_UInt128_uint64_to_uint128(r0);
+    tmp[ctr + (uint32_t)1U] = FStar_UInt128_add(tctrp1, c);
+  }
+}
+
+inline static void Hacl_Bignum_Fproduct_carry_limb_(uint64_t *tmp)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = i;
+    uint64_t tctr = tmp[ctr];
+    uint64_t tctrp1 = tmp[ctr + (uint32_t)1U];
+    uint64_t r0 = tctr & (uint64_t)0xfffffffffffU;
+    uint64_t c = tctr >> (uint32_t)44U;
+    tmp[ctr] = r0;
+    tmp[ctr + (uint32_t)1U] = tctrp1 + c;
+  }
+}
+
+inline static void Hacl_Bignum_Fmul_shift_reduce(uint64_t *output)
+{
+  uint64_t tmp = output[2U];
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint32_t ctr = (uint32_t)3U - i - (uint32_t)1U;
+    uint64_t z = output[ctr - (uint32_t)1U];
+    output[ctr] = z;
+  }
+  output[0U] = tmp;
+  Hacl_Bignum_Modulo_reduce(output);
+}
+
+static void
+Hacl_Bignum_Fmul_mul_shift_reduce_(FStar_UInt128_t *output, uint64_t *input, uint64_t *input2)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)2U; i = i + (uint32_t)1U)
+  {
+    uint64_t input2i = input2[i];
+    Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+    Hacl_Bignum_Fmul_shift_reduce(input);
+  }
+  uint32_t i = (uint32_t)2U;
+  uint64_t input2i = input2[i];
+  Hacl_Bignum_Fproduct_sum_scalar_multiplication_(output, input, input2i);
+}
+
+inline static void Hacl_Bignum_Fmul_fmul(uint64_t *output, uint64_t *input, uint64_t *input2)
+{
+  uint64_t tmp[3U] = { 0U };
+  memcpy(tmp, input, (uint32_t)3U * sizeof input[0U]);
+  KRML_CHECK_SIZE(FStar_UInt128_uint64_to_uint128((uint64_t)0U), (uint32_t)3U);
+  FStar_UInt128_t t[3U];
+  for (uint32_t _i = 0U; _i < (uint32_t)3U; ++_i)
+    t[_i] = FStar_UInt128_uint64_to_uint128((uint64_t)0U);
+  Hacl_Bignum_Fmul_mul_shift_reduce_(t, tmp, input2);
+  Hacl_Bignum_Fproduct_carry_wide_(t);
+  Hacl_Bignum_Modulo_carry_top_wide(t);
+  Hacl_Bignum_Fproduct_copy_from_wide_(output, t);
+  uint64_t i0 = output[0U];
+  uint64_t i1 = output[1U];
+  uint64_t i0_ = i0 & (uint64_t)0xfffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)44U);
+  output[0U] = i0_;
+  output[1U] = i1_;
+}
+
+inline static void
+Hacl_Bignum_AddAndMultiply_add_and_multiply(uint64_t *acc, uint64_t *block, uint64_t *r)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)3U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = acc[i];
+    uint64_t yi = block[i];
+    acc[i] = xi + yi;
+  }
+  Hacl_Bignum_Fmul_fmul(acc, acc, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_update(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m
+)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  uint64_t *r3 = r;
+  uint64_t tmp[3U] = { 0U };
+  FStar_UInt128_t m0 = load128_le(m);
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(m0) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)88U));
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  uint64_t b2 = tmp[2U];
+  uint64_t b2_ = (uint64_t)0x10000000000U | b2;
+  tmp[2U] = b2_;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(acc, tmp, r3);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_process_last_block_(
+  uint8_t *block,
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint64_t tmp[3U] = { 0U };
+  FStar_UInt128_t m0 = load128_le(block);
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(m0) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(m0, (uint32_t)88U));
+  tmp[0U] = r0;
+  tmp[1U] = r1;
+  tmp[2U] = r2;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  Hacl_Bignum_AddAndMultiply_add_and_multiply(h, tmp, r);
+}
+
+inline static void
+Hacl_Impl_Poly1305_64_poly1305_process_last_block(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t rem_
+)
+{
+  uint8_t zero1 = (uint8_t)0U;
+  KRML_CHECK_SIZE(zero1, (uint32_t)16U);
+  uint8_t block[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    block[_i] = zero1;
+  uint32_t i0 = (uint32_t)rem_;
+  uint32_t i = (uint32_t)rem_;
+  memcpy(block, m, i * sizeof m[0U]);
+  block[i0] = (uint8_t)1U;
+  Hacl_Impl_Poly1305_64_poly1305_process_last_block_(block, st, m, rem_);
+}
+
+static void Hacl_Impl_Poly1305_64_poly1305_last_pass(uint64_t *acc)
+{
+  Hacl_Bignum_Fproduct_carry_limb_(acc);
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint64_t a0 = acc[0U];
+  uint64_t a10 = acc[1U];
+  uint64_t a20 = acc[2U];
+  uint64_t a0_ = a0 & (uint64_t)0xfffffffffffU;
+  uint64_t r0 = a0 >> (uint32_t)44U;
+  uint64_t a1_ = (a10 + r0) & (uint64_t)0xfffffffffffU;
+  uint64_t r1 = (a10 + r0) >> (uint32_t)44U;
+  uint64_t a2_ = a20 + r1;
+  acc[0U] = a0_;
+  acc[1U] = a1_;
+  acc[2U] = a2_;
+  Hacl_Bignum_Modulo_carry_top(acc);
+  uint64_t i0 = acc[0U];
+  uint64_t i1 = acc[1U];
+  uint64_t i0_ = i0 & (uint64_t)0xfffffffffffU;
+  uint64_t i1_ = i1 + (i0 >> (uint32_t)44U);
+  acc[0U] = i0_;
+  acc[1U] = i1_;
+  uint64_t a00 = acc[0U];
+  uint64_t a1 = acc[1U];
+  uint64_t a2 = acc[2U];
+  uint64_t mask0 = FStar_UInt64_gte_mask(a00, (uint64_t)0xffffffffffbU);
+  uint64_t mask1 = FStar_UInt64_eq_mask(a1, (uint64_t)0xfffffffffffU);
+  uint64_t mask2 = FStar_UInt64_eq_mask(a2, (uint64_t)0x3ffffffffffU);
+  uint64_t mask = (mask0 & mask1) & mask2;
+  uint64_t a0_0 = a00 - ((uint64_t)0xffffffffffbU & mask);
+  uint64_t a1_0 = a1 - ((uint64_t)0xfffffffffffU & mask);
+  uint64_t a2_0 = a2 - ((uint64_t)0x3ffffffffffU & mask);
+  acc[0U] = a0_0;
+  acc[1U] = a1_0;
+  acc[2U] = a2_0;
+}
+
+static Hacl_Impl_Poly1305_64_State_poly1305_state
+Hacl_Impl_Poly1305_64_mk_state(uint64_t *r, uint64_t *h)
+{
+  return ((Hacl_Impl_Poly1305_64_State_poly1305_state){ .r = r, .h = h });
+}
+
+static void
+Hacl_Standalone_Poly1305_64_poly1305_blocks(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t len1
+)
+{
+  if (!(len1 == (uint64_t)0U))
+  {
+    uint8_t *block = m;
+    uint8_t *tail1 = m + (uint32_t)16U;
+    Hacl_Impl_Poly1305_64_poly1305_update(st, block);
+    uint64_t len2 = len1 - (uint64_t)1U;
+    Hacl_Standalone_Poly1305_64_poly1305_blocks(st, tail1, len2);
+  }
+}
+
+static void
+Hacl_Standalone_Poly1305_64_poly1305_partial(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *kr
+)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  uint64_t *x0 = r;
+  FStar_UInt128_t k1 = load128_le(kr);
+  FStar_UInt128_t
+  k_clamped =
+    FStar_UInt128_logand(k1,
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0ffffffcU),
+          (uint32_t)64U),
+        FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0fffffffU)));
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(k_clamped) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)88U));
+  x0[0U] = r0;
+  x0[1U] = r1;
+  x0[2U] = r2;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  uint64_t *x00 = h;
+  x00[0U] = (uint64_t)0U;
+  x00[1U] = (uint64_t)0U;
+  x00[2U] = (uint64_t)0U;
+  Hacl_Standalone_Poly1305_64_poly1305_blocks(st, input, len1);
+}
+
+static void
+Hacl_Standalone_Poly1305_64_poly1305_complete(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  uint8_t *kr = k1;
+  uint64_t len16 = len1 >> (uint32_t)4U;
+  uint64_t rem16 = len1 & (uint64_t)0xfU;
+  uint8_t *part_input = m;
+  uint8_t *last_block = m + (uint32_t)((uint64_t)16U * len16);
+  Hacl_Standalone_Poly1305_64_poly1305_partial(st, part_input, len16, kr);
+  if (!(rem16 == (uint64_t)0U))
+    Hacl_Impl_Poly1305_64_poly1305_process_last_block(st, last_block, rem16);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h = scrut.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_poly1305_last_pass(acc);
+}
+
+static void
+Hacl_Standalone_Poly1305_64_crypto_onetimeauth_(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  uint64_t buf[6U] = { 0U };
+  uint64_t *r = buf;
+  uint64_t *h = buf + (uint32_t)3U;
+  Hacl_Impl_Poly1305_64_State_poly1305_state st = Hacl_Impl_Poly1305_64_mk_state(r, h);
+  uint8_t *key_s = k1 + (uint32_t)16U;
+  Hacl_Standalone_Poly1305_64_poly1305_complete(st, input, len1, k1);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h3 = scrut.h;
+  uint64_t *acc = h3;
+  FStar_UInt128_t k_ = load128_le(key_s);
+  uint64_t h0 = acc[0U];
+  uint64_t h1 = acc[1U];
+  uint64_t h2 = acc[2U];
+  FStar_UInt128_t
+  acc_ =
+    FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128(h2
+          << (uint32_t)24U
+          | h1 >> (uint32_t)20U),
+        (uint32_t)64U),
+      FStar_UInt128_uint64_to_uint128(h1 << (uint32_t)44U | h0));
+  FStar_UInt128_t mac_ = FStar_UInt128_add_mod(acc_, k_);
+  store128_le(output, mac_);
+}
+
+static void
+Hacl_Standalone_Poly1305_64_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  Hacl_Standalone_Poly1305_64_crypto_onetimeauth_(output, input, len1, k1);
+}
+
+Hacl_Impl_Poly1305_64_State_poly1305_state
+Hacl_Poly1305_64_mk_state(uint64_t *r, uint64_t *acc)
+{
+  return Hacl_Impl_Poly1305_64_mk_state(r, acc);
+}
+
+void Hacl_Poly1305_64_init(Hacl_Impl_Poly1305_64_State_poly1305_state st, uint8_t *k1)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *r = scrut.r;
+  uint64_t *x0 = r;
+  FStar_UInt128_t k10 = load128_le(k1);
+  FStar_UInt128_t
+  k_clamped =
+    FStar_UInt128_logand(k10,
+      FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0ffffffcU),
+          (uint32_t)64U),
+        FStar_UInt128_uint64_to_uint128((uint64_t)0x0ffffffc0fffffffU)));
+  uint64_t r0 = FStar_UInt128_uint128_to_uint64(k_clamped) & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r1 =
+    FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)44U))
+    & (uint64_t)0xfffffffffffU;
+  uint64_t
+  r2 = FStar_UInt128_uint128_to_uint64(FStar_UInt128_shift_right(k_clamped, (uint32_t)88U));
+  x0[0U] = r0;
+  x0[1U] = r1;
+  x0[2U] = r2;
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut0 = st;
+  uint64_t *h = scrut0.h;
+  uint64_t *x00 = h;
+  x00[0U] = (uint64_t)0U;
+  x00[1U] = (uint64_t)0U;
+  x00[2U] = (uint64_t)0U;
+}
+
+void Hacl_Poly1305_64_update_block(Hacl_Impl_Poly1305_64_State_poly1305_state st, uint8_t *m)
+{
+  Hacl_Impl_Poly1305_64_poly1305_update(st, m);
+}
+
+void
+Hacl_Poly1305_64_update(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t num_blocks
+)
+{
+  if (!(num_blocks == (uint32_t)0U))
+  {
+    uint8_t *block = m;
+    uint8_t *m_ = m + (uint32_t)16U;
+    uint32_t n1 = num_blocks - (uint32_t)1U;
+    Hacl_Poly1305_64_update_block(st, block);
+    Hacl_Poly1305_64_update(st, m_, n1);
+  }
+}
+
+void
+Hacl_Poly1305_64_update_last(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+)
+{
+  if (!((uint64_t)len1 == (uint64_t)0U))
+    Hacl_Impl_Poly1305_64_poly1305_process_last_block(st, m, (uint64_t)len1);
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h = scrut.h;
+  uint64_t *acc = h;
+  Hacl_Impl_Poly1305_64_poly1305_last_pass(acc);
+}
+
+void
+Hacl_Poly1305_64_finish(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *mac,
+  uint8_t *k1
+)
+{
+  Hacl_Impl_Poly1305_64_State_poly1305_state scrut = st;
+  uint64_t *h = scrut.h;
+  uint64_t *acc = h;
+  FStar_UInt128_t k_ = load128_le(k1);
+  uint64_t h0 = acc[0U];
+  uint64_t h1 = acc[1U];
+  uint64_t h2 = acc[2U];
+  FStar_UInt128_t
+  acc_ =
+    FStar_UInt128_logor(FStar_UInt128_shift_left(FStar_UInt128_uint64_to_uint128(h2
+          << (uint32_t)24U
+          | h1 >> (uint32_t)20U),
+        (uint32_t)64U),
+      FStar_UInt128_uint64_to_uint128(h1 << (uint32_t)44U | h0));
+  FStar_UInt128_t mac_ = FStar_UInt128_add_mod(acc_, k_);
+  store128_le(mac, mac_);
+}
+
+void
+Hacl_Poly1305_64_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+)
+{
+  Hacl_Standalone_Poly1305_64_crypto_onetimeauth(output, input, len1, k1);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.h
new file mode 100644
index 000000000..586d2994c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Poly1305_64.h
@@ -0,0 +1,116 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Poly1305_64_H
+#define __Hacl_Poly1305_64_H
+
+
+
+
+
+typedef uint64_t Hacl_Bignum_Constants_limb;
+
+typedef FStar_UInt128_t Hacl_Bignum_Constants_wide;
+
+typedef FStar_UInt128_t Hacl_Bignum_Wide_t;
+
+typedef uint64_t Hacl_Bignum_Limb_t;
+
+typedef void *Hacl_Impl_Poly1305_64_State_log_t;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_State_bigint;
+
+typedef void *Hacl_Impl_Poly1305_64_State_seqelem;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_State_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_State_wordB_16;
+
+typedef struct 
+{
+  uint64_t *r;
+  uint64_t *h;
+}
+Hacl_Impl_Poly1305_64_State_poly1305_state;
+
+typedef void *Hacl_Impl_Poly1305_64_log_t;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_bigint;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_uint8_p;
+
+typedef uint64_t *Hacl_Impl_Poly1305_64_elemB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_wordB;
+
+typedef uint8_t *Hacl_Impl_Poly1305_64_wordB_16;
+
+typedef uint8_t *Hacl_Poly1305_64_uint8_p;
+
+typedef uint64_t Hacl_Poly1305_64_uint64_t;
+
+typedef uint8_t *Hacl_Poly1305_64_key;
+
+typedef Hacl_Impl_Poly1305_64_State_poly1305_state Hacl_Poly1305_64_state;
+
+Hacl_Impl_Poly1305_64_State_poly1305_state
+Hacl_Poly1305_64_mk_state(uint64_t *r, uint64_t *acc);
+
+void Hacl_Poly1305_64_init(Hacl_Impl_Poly1305_64_State_poly1305_state st, uint8_t *k1);
+
+void Hacl_Poly1305_64_update_block(Hacl_Impl_Poly1305_64_State_poly1305_state st, uint8_t *m);
+
+void
+Hacl_Poly1305_64_update(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t num_blocks
+);
+
+void
+Hacl_Poly1305_64_update_last(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *m,
+  uint32_t len1
+);
+
+void
+Hacl_Poly1305_64_finish(
+  Hacl_Impl_Poly1305_64_State_poly1305_state st,
+  uint8_t *mac,
+  uint8_t *k1
+);
+
+void
+Hacl_Poly1305_64_crypto_onetimeauth(
+  uint8_t *output,
+  uint8_t *input,
+  uint64_t len1,
+  uint8_t *k1
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.c
new file mode 100644
index 000000000..434ad4e26
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.c
@@ -0,0 +1,334 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_SHA2_256.h"
+
+static void
+Hacl_Hash_Lib_LoadStore_uint32s_from_be_bytes(uint32_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)4U * i;
+    uint32_t inputi = load32_be(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint32s_to_be_bytes(uint8_t *output, uint32_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint32_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)4U * i;
+    store32_be(x0, hd1);
+  }
+}
+
+static void Hacl_Impl_SHA2_256_init(uint32_t *state)
+{
+  uint32_t *n1 = state + (uint32_t)136U;
+  uint32_t *k1 = state;
+  uint32_t *h_01 = state + (uint32_t)128U;
+  uint32_t *p10 = k1;
+  uint32_t *p20 = k1 + (uint32_t)16U;
+  uint32_t *p3 = k1 + (uint32_t)32U;
+  uint32_t *p4 = k1 + (uint32_t)48U;
+  uint32_t *p11 = p10;
+  uint32_t *p21 = p10 + (uint32_t)8U;
+  uint32_t *p12 = p11;
+  uint32_t *p22 = p11 + (uint32_t)4U;
+  p12[0U] = (uint32_t)0x428a2f98U;
+  p12[1U] = (uint32_t)0x71374491U;
+  p12[2U] = (uint32_t)0xb5c0fbcfU;
+  p12[3U] = (uint32_t)0xe9b5dba5U;
+  p22[0U] = (uint32_t)0x3956c25bU;
+  p22[1U] = (uint32_t)0x59f111f1U;
+  p22[2U] = (uint32_t)0x923f82a4U;
+  p22[3U] = (uint32_t)0xab1c5ed5U;
+  uint32_t *p13 = p21;
+  uint32_t *p23 = p21 + (uint32_t)4U;
+  p13[0U] = (uint32_t)0xd807aa98U;
+  p13[1U] = (uint32_t)0x12835b01U;
+  p13[2U] = (uint32_t)0x243185beU;
+  p13[3U] = (uint32_t)0x550c7dc3U;
+  p23[0U] = (uint32_t)0x72be5d74U;
+  p23[1U] = (uint32_t)0x80deb1feU;
+  p23[2U] = (uint32_t)0x9bdc06a7U;
+  p23[3U] = (uint32_t)0xc19bf174U;
+  uint32_t *p14 = p20;
+  uint32_t *p24 = p20 + (uint32_t)8U;
+  uint32_t *p15 = p14;
+  uint32_t *p25 = p14 + (uint32_t)4U;
+  p15[0U] = (uint32_t)0xe49b69c1U;
+  p15[1U] = (uint32_t)0xefbe4786U;
+  p15[2U] = (uint32_t)0x0fc19dc6U;
+  p15[3U] = (uint32_t)0x240ca1ccU;
+  p25[0U] = (uint32_t)0x2de92c6fU;
+  p25[1U] = (uint32_t)0x4a7484aaU;
+  p25[2U] = (uint32_t)0x5cb0a9dcU;
+  p25[3U] = (uint32_t)0x76f988daU;
+  uint32_t *p16 = p24;
+  uint32_t *p26 = p24 + (uint32_t)4U;
+  p16[0U] = (uint32_t)0x983e5152U;
+  p16[1U] = (uint32_t)0xa831c66dU;
+  p16[2U] = (uint32_t)0xb00327c8U;
+  p16[3U] = (uint32_t)0xbf597fc7U;
+  p26[0U] = (uint32_t)0xc6e00bf3U;
+  p26[1U] = (uint32_t)0xd5a79147U;
+  p26[2U] = (uint32_t)0x06ca6351U;
+  p26[3U] = (uint32_t)0x14292967U;
+  uint32_t *p17 = p3;
+  uint32_t *p27 = p3 + (uint32_t)8U;
+  uint32_t *p18 = p17;
+  uint32_t *p28 = p17 + (uint32_t)4U;
+  p18[0U] = (uint32_t)0x27b70a85U;
+  p18[1U] = (uint32_t)0x2e1b2138U;
+  p18[2U] = (uint32_t)0x4d2c6dfcU;
+  p18[3U] = (uint32_t)0x53380d13U;
+  p28[0U] = (uint32_t)0x650a7354U;
+  p28[1U] = (uint32_t)0x766a0abbU;
+  p28[2U] = (uint32_t)0x81c2c92eU;
+  p28[3U] = (uint32_t)0x92722c85U;
+  uint32_t *p19 = p27;
+  uint32_t *p29 = p27 + (uint32_t)4U;
+  p19[0U] = (uint32_t)0xa2bfe8a1U;
+  p19[1U] = (uint32_t)0xa81a664bU;
+  p19[2U] = (uint32_t)0xc24b8b70U;
+  p19[3U] = (uint32_t)0xc76c51a3U;
+  p29[0U] = (uint32_t)0xd192e819U;
+  p29[1U] = (uint32_t)0xd6990624U;
+  p29[2U] = (uint32_t)0xf40e3585U;
+  p29[3U] = (uint32_t)0x106aa070U;
+  uint32_t *p110 = p4;
+  uint32_t *p210 = p4 + (uint32_t)8U;
+  uint32_t *p1 = p110;
+  uint32_t *p211 = p110 + (uint32_t)4U;
+  p1[0U] = (uint32_t)0x19a4c116U;
+  p1[1U] = (uint32_t)0x1e376c08U;
+  p1[2U] = (uint32_t)0x2748774cU;
+  p1[3U] = (uint32_t)0x34b0bcb5U;
+  p211[0U] = (uint32_t)0x391c0cb3U;
+  p211[1U] = (uint32_t)0x4ed8aa4aU;
+  p211[2U] = (uint32_t)0x5b9cca4fU;
+  p211[3U] = (uint32_t)0x682e6ff3U;
+  uint32_t *p111 = p210;
+  uint32_t *p212 = p210 + (uint32_t)4U;
+  p111[0U] = (uint32_t)0x748f82eeU;
+  p111[1U] = (uint32_t)0x78a5636fU;
+  p111[2U] = (uint32_t)0x84c87814U;
+  p111[3U] = (uint32_t)0x8cc70208U;
+  p212[0U] = (uint32_t)0x90befffaU;
+  p212[1U] = (uint32_t)0xa4506cebU;
+  p212[2U] = (uint32_t)0xbef9a3f7U;
+  p212[3U] = (uint32_t)0xc67178f2U;
+  uint32_t *p112 = h_01;
+  uint32_t *p2 = h_01 + (uint32_t)4U;
+  p112[0U] = (uint32_t)0x6a09e667U;
+  p112[1U] = (uint32_t)0xbb67ae85U;
+  p112[2U] = (uint32_t)0x3c6ef372U;
+  p112[3U] = (uint32_t)0xa54ff53aU;
+  p2[0U] = (uint32_t)0x510e527fU;
+  p2[1U] = (uint32_t)0x9b05688cU;
+  p2[2U] = (uint32_t)0x1f83d9abU;
+  p2[3U] = (uint32_t)0x5be0cd19U;
+  n1[0U] = (uint32_t)0U;
+}
+
+static void Hacl_Impl_SHA2_256_update(uint32_t *state, uint8_t *data)
+{
+  uint32_t data_w[16U] = { 0U };
+  Hacl_Hash_Lib_LoadStore_uint32s_from_be_bytes(data_w, data, (uint32_t)16U);
+  uint32_t *hash_w = state + (uint32_t)128U;
+  uint32_t *ws_w = state + (uint32_t)64U;
+  uint32_t *k_w = state;
+  uint32_t *counter_w = state + (uint32_t)136U;
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t b = data_w[i];
+    ws_w[i] = b;
+  }
+  for (uint32_t i = (uint32_t)16U; i < (uint32_t)64U; i = i + (uint32_t)1U)
+  {
+    uint32_t t16 = ws_w[i - (uint32_t)16U];
+    uint32_t t15 = ws_w[i - (uint32_t)15U];
+    uint32_t t7 = ws_w[i - (uint32_t)7U];
+    uint32_t t2 = ws_w[i - (uint32_t)2U];
+    ws_w[i] =
+      ((t2 >> (uint32_t)17U | t2 << ((uint32_t)32U - (uint32_t)17U))
+      ^ ((t2 >> (uint32_t)19U | t2 << ((uint32_t)32U - (uint32_t)19U)) ^ t2 >> (uint32_t)10U))
+      +
+        t7
+        +
+          ((t15 >> (uint32_t)7U | t15 << ((uint32_t)32U - (uint32_t)7U))
+          ^ ((t15 >> (uint32_t)18U | t15 << ((uint32_t)32U - (uint32_t)18U)) ^ t15 >> (uint32_t)3U))
+          + t16;
+  }
+  uint32_t hash_0[8U] = { 0U };
+  memcpy(hash_0, hash_w, (uint32_t)8U * sizeof hash_w[0U]);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)64U; i = i + (uint32_t)1U)
+  {
+    uint32_t a = hash_0[0U];
+    uint32_t b = hash_0[1U];
+    uint32_t c = hash_0[2U];
+    uint32_t d = hash_0[3U];
+    uint32_t e = hash_0[4U];
+    uint32_t f1 = hash_0[5U];
+    uint32_t g = hash_0[6U];
+    uint32_t h = hash_0[7U];
+    uint32_t kt = k_w[i];
+    uint32_t wst = ws_w[i];
+    uint32_t
+    t1 =
+      h
+      +
+        ((e >> (uint32_t)6U | e << ((uint32_t)32U - (uint32_t)6U))
+        ^
+          ((e >> (uint32_t)11U | e << ((uint32_t)32U - (uint32_t)11U))
+          ^ (e >> (uint32_t)25U | e << ((uint32_t)32U - (uint32_t)25U))))
+      + ((e & f1) ^ (~e & g))
+      + kt
+      + wst;
+    uint32_t
+    t2 =
+      ((a >> (uint32_t)2U | a << ((uint32_t)32U - (uint32_t)2U))
+      ^
+        ((a >> (uint32_t)13U | a << ((uint32_t)32U - (uint32_t)13U))
+        ^ (a >> (uint32_t)22U | a << ((uint32_t)32U - (uint32_t)22U))))
+      + ((a & b) ^ ((a & c) ^ (b & c)));
+    uint32_t x1 = t1 + t2;
+    uint32_t x5 = d + t1;
+    uint32_t *p1 = hash_0;
+    uint32_t *p2 = hash_0 + (uint32_t)4U;
+    p1[0U] = x1;
+    p1[1U] = a;
+    p1[2U] = b;
+    p1[3U] = c;
+    p2[0U] = x5;
+    p2[1U] = e;
+    p2[2U] = f1;
+    p2[3U] = g;
+  }
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)8U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = hash_w[i];
+    uint32_t yi = hash_0[i];
+    hash_w[i] = xi + yi;
+  }
+  uint32_t c0 = counter_w[0U];
+  uint32_t one1 = (uint32_t)1U;
+  counter_w[0U] = c0 + one1;
+}
+
+static void Hacl_Impl_SHA2_256_update_multi(uint32_t *state, uint8_t *data, uint32_t n1)
+{
+  for (uint32_t i = (uint32_t)0U; i < n1; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = data + i * (uint32_t)64U;
+    Hacl_Impl_SHA2_256_update(state, b);
+  }
+}
+
+static void Hacl_Impl_SHA2_256_update_last(uint32_t *state, uint8_t *data, uint32_t len)
+{
+  uint8_t blocks[128U] = { 0U };
+  uint32_t nb;
+  if (len < (uint32_t)56U)
+    nb = (uint32_t)1U;
+  else
+    nb = (uint32_t)2U;
+  uint8_t *final_blocks;
+  if (len < (uint32_t)56U)
+    final_blocks = blocks + (uint32_t)64U;
+  else
+    final_blocks = blocks;
+  memcpy(final_blocks, data, len * sizeof data[0U]);
+  uint32_t n1 = state[136U];
+  uint8_t *padding = final_blocks + len;
+  uint32_t
+  pad0len = ((uint32_t)64U - (len + (uint32_t)8U + (uint32_t)1U) % (uint32_t)64U) % (uint32_t)64U;
+  uint8_t *buf1 = padding;
+  uint8_t *buf2 = padding + (uint32_t)1U + pad0len;
+  uint64_t
+  encodedlen = ((uint64_t)n1 * (uint64_t)(uint32_t)64U + (uint64_t)len) * (uint64_t)(uint32_t)8U;
+  buf1[0U] = (uint8_t)0x80U;
+  store64_be(buf2, encodedlen);
+  Hacl_Impl_SHA2_256_update_multi(state, final_blocks, nb);
+}
+
+static void Hacl_Impl_SHA2_256_finish(uint32_t *state, uint8_t *hash1)
+{
+  uint32_t *hash_w = state + (uint32_t)128U;
+  Hacl_Hash_Lib_LoadStore_uint32s_to_be_bytes(hash1, hash_w, (uint32_t)8U);
+}
+
+static void Hacl_Impl_SHA2_256_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  uint32_t state[137U] = { 0U };
+  uint32_t n1 = len / (uint32_t)64U;
+  uint32_t r = len % (uint32_t)64U;
+  uint8_t *input_blocks = input;
+  uint8_t *input_last = input + n1 * (uint32_t)64U;
+  Hacl_Impl_SHA2_256_init(state);
+  Hacl_Impl_SHA2_256_update_multi(state, input_blocks, n1);
+  Hacl_Impl_SHA2_256_update_last(state, input_last, r);
+  Hacl_Impl_SHA2_256_finish(state, hash1);
+}
+
+uint32_t Hacl_SHA2_256_size_hash = (uint32_t)32U;
+
+uint32_t Hacl_SHA2_256_size_block = (uint32_t)64U;
+
+uint32_t Hacl_SHA2_256_size_state = (uint32_t)137U;
+
+void Hacl_SHA2_256_init(uint32_t *state)
+{
+  Hacl_Impl_SHA2_256_init(state);
+}
+
+void Hacl_SHA2_256_update(uint32_t *state, uint8_t *data_8)
+{
+  Hacl_Impl_SHA2_256_update(state, data_8);
+}
+
+void Hacl_SHA2_256_update_multi(uint32_t *state, uint8_t *data, uint32_t n1)
+{
+  Hacl_Impl_SHA2_256_update_multi(state, data, n1);
+}
+
+void Hacl_SHA2_256_update_last(uint32_t *state, uint8_t *data, uint32_t len)
+{
+  Hacl_Impl_SHA2_256_update_last(state, data, len);
+}
+
+void Hacl_SHA2_256_finish(uint32_t *state, uint8_t *hash1)
+{
+  Hacl_Impl_SHA2_256_finish(state, hash1);
+}
+
+void Hacl_SHA2_256_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  Hacl_Impl_SHA2_256_hash(hash1, input, len);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.h
new file mode 100644
index 000000000..fa326849d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_256.h
@@ -0,0 +1,99 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_SHA2_256_H
+#define __Hacl_SHA2_256_H
+
+
+
+
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_t;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_t;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_t;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_ht;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_ht;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_ht;
+
+typedef uint8_t *Hacl_Hash_Lib_Create_uint8_p;
+
+typedef uint32_t *Hacl_Hash_Lib_Create_uint32_p;
+
+typedef uint64_t *Hacl_Hash_Lib_Create_uint64_p;
+
+typedef uint8_t *Hacl_Hash_Lib_LoadStore_uint8_p;
+
+typedef uint8_t Hacl_Impl_SHA2_256_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_256_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_256_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_256_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_256_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_256_uint64_ht;
+
+typedef uint32_t *Hacl_Impl_SHA2_256_uint32_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_256_uint8_p;
+
+typedef uint8_t Hacl_SHA2_256_uint8_t;
+
+typedef uint32_t Hacl_SHA2_256_uint32_t;
+
+typedef uint64_t Hacl_SHA2_256_uint64_t;
+
+typedef uint8_t Hacl_SHA2_256_uint8_ht;
+
+typedef uint32_t Hacl_SHA2_256_uint32_ht;
+
+typedef uint32_t *Hacl_SHA2_256_uint32_p;
+
+typedef uint8_t *Hacl_SHA2_256_uint8_p;
+
+extern uint32_t Hacl_SHA2_256_size_hash;
+
+extern uint32_t Hacl_SHA2_256_size_block;
+
+extern uint32_t Hacl_SHA2_256_size_state;
+
+void Hacl_SHA2_256_init(uint32_t *state);
+
+void Hacl_SHA2_256_update(uint32_t *state, uint8_t *data_8);
+
+void Hacl_SHA2_256_update_multi(uint32_t *state, uint8_t *data, uint32_t n1);
+
+void Hacl_SHA2_256_update_last(uint32_t *state, uint8_t *data, uint32_t len);
+
+void Hacl_SHA2_256_finish(uint32_t *state, uint8_t *hash1);
+
+void Hacl_SHA2_256_hash(uint8_t *hash1, uint8_t *input, uint32_t len);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.c
new file mode 100644
index 000000000..b933c2413
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.c
@@ -0,0 +1,368 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_SHA2_384.h"
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(uint64_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)8U * i;
+    uint64_t inputi = load64_be(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(uint8_t *output, uint64_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint64_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)8U * i;
+    store64_be(x0, hd1);
+  }
+}
+
+static void Hacl_Impl_SHA2_384_init(uint64_t *state)
+{
+  uint64_t *n1 = state + (uint32_t)168U;
+  uint64_t *k1 = state;
+  uint64_t *h_01 = state + (uint32_t)160U;
+  uint64_t *p10 = k1;
+  uint64_t *p20 = k1 + (uint32_t)16U;
+  uint64_t *p3 = k1 + (uint32_t)32U;
+  uint64_t *p4 = k1 + (uint32_t)48U;
+  uint64_t *p5 = k1 + (uint32_t)64U;
+  uint64_t *p11 = p10;
+  uint64_t *p21 = p10 + (uint32_t)8U;
+  uint64_t *p12 = p11;
+  uint64_t *p22 = p11 + (uint32_t)4U;
+  p12[0U] = (uint64_t)0x428a2f98d728ae22U;
+  p12[1U] = (uint64_t)0x7137449123ef65cdU;
+  p12[2U] = (uint64_t)0xb5c0fbcfec4d3b2fU;
+  p12[3U] = (uint64_t)0xe9b5dba58189dbbcU;
+  p22[0U] = (uint64_t)0x3956c25bf348b538U;
+  p22[1U] = (uint64_t)0x59f111f1b605d019U;
+  p22[2U] = (uint64_t)0x923f82a4af194f9bU;
+  p22[3U] = (uint64_t)0xab1c5ed5da6d8118U;
+  uint64_t *p13 = p21;
+  uint64_t *p23 = p21 + (uint32_t)4U;
+  p13[0U] = (uint64_t)0xd807aa98a3030242U;
+  p13[1U] = (uint64_t)0x12835b0145706fbeU;
+  p13[2U] = (uint64_t)0x243185be4ee4b28cU;
+  p13[3U] = (uint64_t)0x550c7dc3d5ffb4e2U;
+  p23[0U] = (uint64_t)0x72be5d74f27b896fU;
+  p23[1U] = (uint64_t)0x80deb1fe3b1696b1U;
+  p23[2U] = (uint64_t)0x9bdc06a725c71235U;
+  p23[3U] = (uint64_t)0xc19bf174cf692694U;
+  uint64_t *p14 = p20;
+  uint64_t *p24 = p20 + (uint32_t)8U;
+  uint64_t *p15 = p14;
+  uint64_t *p25 = p14 + (uint32_t)4U;
+  p15[0U] = (uint64_t)0xe49b69c19ef14ad2U;
+  p15[1U] = (uint64_t)0xefbe4786384f25e3U;
+  p15[2U] = (uint64_t)0x0fc19dc68b8cd5b5U;
+  p15[3U] = (uint64_t)0x240ca1cc77ac9c65U;
+  p25[0U] = (uint64_t)0x2de92c6f592b0275U;
+  p25[1U] = (uint64_t)0x4a7484aa6ea6e483U;
+  p25[2U] = (uint64_t)0x5cb0a9dcbd41fbd4U;
+  p25[3U] = (uint64_t)0x76f988da831153b5U;
+  uint64_t *p16 = p24;
+  uint64_t *p26 = p24 + (uint32_t)4U;
+  p16[0U] = (uint64_t)0x983e5152ee66dfabU;
+  p16[1U] = (uint64_t)0xa831c66d2db43210U;
+  p16[2U] = (uint64_t)0xb00327c898fb213fU;
+  p16[3U] = (uint64_t)0xbf597fc7beef0ee4U;
+  p26[0U] = (uint64_t)0xc6e00bf33da88fc2U;
+  p26[1U] = (uint64_t)0xd5a79147930aa725U;
+  p26[2U] = (uint64_t)0x06ca6351e003826fU;
+  p26[3U] = (uint64_t)0x142929670a0e6e70U;
+  uint64_t *p17 = p3;
+  uint64_t *p27 = p3 + (uint32_t)8U;
+  uint64_t *p18 = p17;
+  uint64_t *p28 = p17 + (uint32_t)4U;
+  p18[0U] = (uint64_t)0x27b70a8546d22ffcU;
+  p18[1U] = (uint64_t)0x2e1b21385c26c926U;
+  p18[2U] = (uint64_t)0x4d2c6dfc5ac42aedU;
+  p18[3U] = (uint64_t)0x53380d139d95b3dfU;
+  p28[0U] = (uint64_t)0x650a73548baf63deU;
+  p28[1U] = (uint64_t)0x766a0abb3c77b2a8U;
+  p28[2U] = (uint64_t)0x81c2c92e47edaee6U;
+  p28[3U] = (uint64_t)0x92722c851482353bU;
+  uint64_t *p19 = p27;
+  uint64_t *p29 = p27 + (uint32_t)4U;
+  p19[0U] = (uint64_t)0xa2bfe8a14cf10364U;
+  p19[1U] = (uint64_t)0xa81a664bbc423001U;
+  p19[2U] = (uint64_t)0xc24b8b70d0f89791U;
+  p19[3U] = (uint64_t)0xc76c51a30654be30U;
+  p29[0U] = (uint64_t)0xd192e819d6ef5218U;
+  p29[1U] = (uint64_t)0xd69906245565a910U;
+  p29[2U] = (uint64_t)0xf40e35855771202aU;
+  p29[3U] = (uint64_t)0x106aa07032bbd1b8U;
+  uint64_t *p110 = p4;
+  uint64_t *p210 = p4 + (uint32_t)8U;
+  uint64_t *p111 = p110;
+  uint64_t *p211 = p110 + (uint32_t)4U;
+  p111[0U] = (uint64_t)0x19a4c116b8d2d0c8U;
+  p111[1U] = (uint64_t)0x1e376c085141ab53U;
+  p111[2U] = (uint64_t)0x2748774cdf8eeb99U;
+  p111[3U] = (uint64_t)0x34b0bcb5e19b48a8U;
+  p211[0U] = (uint64_t)0x391c0cb3c5c95a63U;
+  p211[1U] = (uint64_t)0x4ed8aa4ae3418acbU;
+  p211[2U] = (uint64_t)0x5b9cca4f7763e373U;
+  p211[3U] = (uint64_t)0x682e6ff3d6b2b8a3U;
+  uint64_t *p112 = p210;
+  uint64_t *p212 = p210 + (uint32_t)4U;
+  p112[0U] = (uint64_t)0x748f82ee5defb2fcU;
+  p112[1U] = (uint64_t)0x78a5636f43172f60U;
+  p112[2U] = (uint64_t)0x84c87814a1f0ab72U;
+  p112[3U] = (uint64_t)0x8cc702081a6439ecU;
+  p212[0U] = (uint64_t)0x90befffa23631e28U;
+  p212[1U] = (uint64_t)0xa4506cebde82bde9U;
+  p212[2U] = (uint64_t)0xbef9a3f7b2c67915U;
+  p212[3U] = (uint64_t)0xc67178f2e372532bU;
+  uint64_t *p113 = p5;
+  uint64_t *p213 = p5 + (uint32_t)8U;
+  uint64_t *p1 = p113;
+  uint64_t *p214 = p113 + (uint32_t)4U;
+  p1[0U] = (uint64_t)0xca273eceea26619cU;
+  p1[1U] = (uint64_t)0xd186b8c721c0c207U;
+  p1[2U] = (uint64_t)0xeada7dd6cde0eb1eU;
+  p1[3U] = (uint64_t)0xf57d4f7fee6ed178U;
+  p214[0U] = (uint64_t)0x06f067aa72176fbaU;
+  p214[1U] = (uint64_t)0x0a637dc5a2c898a6U;
+  p214[2U] = (uint64_t)0x113f9804bef90daeU;
+  p214[3U] = (uint64_t)0x1b710b35131c471bU;
+  uint64_t *p114 = p213;
+  uint64_t *p215 = p213 + (uint32_t)4U;
+  p114[0U] = (uint64_t)0x28db77f523047d84U;
+  p114[1U] = (uint64_t)0x32caab7b40c72493U;
+  p114[2U] = (uint64_t)0x3c9ebe0a15c9bebcU;
+  p114[3U] = (uint64_t)0x431d67c49c100d4cU;
+  p215[0U] = (uint64_t)0x4cc5d4becb3e42b6U;
+  p215[1U] = (uint64_t)0x597f299cfc657e2aU;
+  p215[2U] = (uint64_t)0x5fcb6fab3ad6faecU;
+  p215[3U] = (uint64_t)0x6c44198c4a475817U;
+  uint64_t *p115 = h_01;
+  uint64_t *p2 = h_01 + (uint32_t)4U;
+  p115[0U] = (uint64_t)0xcbbb9d5dc1059ed8U;
+  p115[1U] = (uint64_t)0x629a292a367cd507U;
+  p115[2U] = (uint64_t)0x9159015a3070dd17U;
+  p115[3U] = (uint64_t)0x152fecd8f70e5939U;
+  p2[0U] = (uint64_t)0x67332667ffc00b31U;
+  p2[1U] = (uint64_t)0x8eb44a8768581511U;
+  p2[2U] = (uint64_t)0xdb0c2e0d64f98fa7U;
+  p2[3U] = (uint64_t)0x47b5481dbefa4fa4U;
+  n1[0U] = (uint64_t)0U;
+}
+
+static void Hacl_Impl_SHA2_384_update(uint64_t *state, uint8_t *data)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)16U);
+  uint64_t data_w[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    data_w[_i] = (uint64_t)(uint32_t)0U;
+  Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(data_w, data, (uint32_t)16U);
+  uint64_t *hash_w = state + (uint32_t)160U;
+  uint64_t *ws_w = state + (uint32_t)80U;
+  uint64_t *k_w = state;
+  uint64_t *counter_w = state + (uint32_t)168U;
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint64_t b = data_w[i];
+    ws_w[i] = b;
+  }
+  for (uint32_t i = (uint32_t)16U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t t16 = ws_w[i - (uint32_t)16U];
+    uint64_t t15 = ws_w[i - (uint32_t)15U];
+    uint64_t t7 = ws_w[i - (uint32_t)7U];
+    uint64_t t2 = ws_w[i - (uint32_t)2U];
+    ws_w[i] =
+      ((t2 >> (uint32_t)19U | t2 << ((uint32_t)64U - (uint32_t)19U))
+      ^ ((t2 >> (uint32_t)61U | t2 << ((uint32_t)64U - (uint32_t)61U)) ^ t2 >> (uint32_t)6U))
+      +
+        t7
+        +
+          ((t15 >> (uint32_t)1U | t15 << ((uint32_t)64U - (uint32_t)1U))
+          ^ ((t15 >> (uint32_t)8U | t15 << ((uint32_t)64U - (uint32_t)8U)) ^ t15 >> (uint32_t)7U))
+          + t16;
+  }
+  uint64_t hash_0[8U] = { 0U };
+  memcpy(hash_0, hash_w, (uint32_t)8U * sizeof hash_w[0U]);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t a = hash_0[0U];
+    uint64_t b = hash_0[1U];
+    uint64_t c = hash_0[2U];
+    uint64_t d = hash_0[3U];
+    uint64_t e = hash_0[4U];
+    uint64_t f1 = hash_0[5U];
+    uint64_t g = hash_0[6U];
+    uint64_t h = hash_0[7U];
+    uint64_t k_t = k_w[i];
+    uint64_t ws_t = ws_w[i];
+    uint64_t
+    t1 =
+      h
+      +
+        ((e >> (uint32_t)14U | e << ((uint32_t)64U - (uint32_t)14U))
+        ^
+          ((e >> (uint32_t)18U | e << ((uint32_t)64U - (uint32_t)18U))
+          ^ (e >> (uint32_t)41U | e << ((uint32_t)64U - (uint32_t)41U))))
+      + ((e & f1) ^ (~e & g))
+      + k_t
+      + ws_t;
+    uint64_t
+    t2 =
+      ((a >> (uint32_t)28U | a << ((uint32_t)64U - (uint32_t)28U))
+      ^
+        ((a >> (uint32_t)34U | a << ((uint32_t)64U - (uint32_t)34U))
+        ^ (a >> (uint32_t)39U | a << ((uint32_t)64U - (uint32_t)39U))))
+      + ((a & b) ^ ((a & c) ^ (b & c)));
+    uint64_t x1 = t1 + t2;
+    uint64_t x5 = d + t1;
+    uint64_t *p1 = hash_0;
+    uint64_t *p2 = hash_0 + (uint32_t)4U;
+    p1[0U] = x1;
+    p1[1U] = a;
+    p1[2U] = b;
+    p1[3U] = c;
+    p2[0U] = x5;
+    p2[1U] = e;
+    p2[2U] = f1;
+    p2[3U] = g;
+  }
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)8U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = hash_w[i];
+    uint64_t yi = hash_0[i];
+    hash_w[i] = xi + yi;
+  }
+  uint64_t c0 = counter_w[0U];
+  uint64_t one1 = (uint64_t)(uint32_t)1U;
+  counter_w[0U] = c0 + one1;
+}
+
+static void Hacl_Impl_SHA2_384_update_multi(uint64_t *state, uint8_t *data, uint32_t n1)
+{
+  for (uint32_t i = (uint32_t)0U; i < n1; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = data + i * (uint32_t)128U;
+    Hacl_Impl_SHA2_384_update(state, b);
+  }
+}
+
+static void Hacl_Impl_SHA2_384_update_last(uint64_t *state, uint8_t *data, uint64_t len)
+{
+  uint8_t blocks[256U] = { 0U };
+  uint32_t nb;
+  if (len < (uint64_t)112U)
+    nb = (uint32_t)1U;
+  else
+    nb = (uint32_t)2U;
+  uint8_t *final_blocks;
+  if (len < (uint64_t)112U)
+    final_blocks = blocks + (uint32_t)128U;
+  else
+    final_blocks = blocks;
+  memcpy(final_blocks, data, (uint32_t)len * sizeof data[0U]);
+  uint64_t n1 = state[168U];
+  uint8_t *padding = final_blocks + (uint32_t)len;
+  FStar_UInt128_t
+  encodedlen =
+    FStar_UInt128_shift_left(FStar_UInt128_add(FStar_UInt128_mul_wide(n1, (uint64_t)(uint32_t)128U),
+        FStar_UInt128_uint64_to_uint128(len)),
+      (uint32_t)3U);
+  uint32_t
+  pad0len =
+    ((uint32_t)128U - ((uint32_t)len + (uint32_t)16U + (uint32_t)1U) % (uint32_t)128U)
+    % (uint32_t)128U;
+  uint8_t *buf1 = padding;
+  uint8_t *buf2 = padding + (uint32_t)1U + pad0len;
+  buf1[0U] = (uint8_t)0x80U;
+  store128_be(buf2, encodedlen);
+  Hacl_Impl_SHA2_384_update_multi(state, final_blocks, nb);
+}
+
+static void Hacl_Impl_SHA2_384_finish(uint64_t *state, uint8_t *hash1)
+{
+  uint64_t *hash_w = state + (uint32_t)160U;
+  Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(hash1, hash_w, (uint32_t)6U);
+}
+
+static void Hacl_Impl_SHA2_384_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)169U);
+  uint64_t state[169U];
+  for (uint32_t _i = 0U; _i < (uint32_t)169U; ++_i)
+    state[_i] = (uint64_t)(uint32_t)0U;
+  uint32_t n1 = len / (uint32_t)128U;
+  uint32_t r = len % (uint32_t)128U;
+  uint8_t *input_blocks = input;
+  uint8_t *input_last = input + n1 * (uint32_t)128U;
+  Hacl_Impl_SHA2_384_init(state);
+  Hacl_Impl_SHA2_384_update_multi(state, input_blocks, n1);
+  Hacl_Impl_SHA2_384_update_last(state, input_last, (uint64_t)r);
+  Hacl_Impl_SHA2_384_finish(state, hash1);
+}
+
+uint32_t Hacl_SHA2_384_size_hash = (uint32_t)48U;
+
+uint32_t Hacl_SHA2_384_size_block = (uint32_t)128U;
+
+uint32_t Hacl_SHA2_384_size_state = (uint32_t)169U;
+
+void Hacl_SHA2_384_init(uint64_t *state)
+{
+  Hacl_Impl_SHA2_384_init(state);
+}
+
+void Hacl_SHA2_384_update(uint64_t *state, uint8_t *data_8)
+{
+  Hacl_Impl_SHA2_384_update(state, data_8);
+}
+
+void Hacl_SHA2_384_update_multi(uint64_t *state, uint8_t *data, uint32_t n1)
+{
+  Hacl_Impl_SHA2_384_update_multi(state, data, n1);
+}
+
+void Hacl_SHA2_384_update_last(uint64_t *state, uint8_t *data, uint64_t len)
+{
+  Hacl_Impl_SHA2_384_update_last(state, data, len);
+}
+
+void Hacl_SHA2_384_finish(uint64_t *state, uint8_t *hash1)
+{
+  Hacl_Impl_SHA2_384_finish(state, hash1);
+}
+
+void Hacl_SHA2_384_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  Hacl_Impl_SHA2_384_hash(hash1, input, len);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.h
new file mode 100644
index 000000000..2c99b5de5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_384.h
@@ -0,0 +1,101 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_SHA2_384_H
+#define __Hacl_SHA2_384_H
+
+
+
+
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_t;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_t;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_t;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_ht;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_ht;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_ht;
+
+typedef uint8_t *Hacl_Hash_Lib_Create_uint8_p;
+
+typedef uint32_t *Hacl_Hash_Lib_Create_uint32_p;
+
+typedef uint64_t *Hacl_Hash_Lib_Create_uint64_p;
+
+typedef uint8_t *Hacl_Hash_Lib_LoadStore_uint8_p;
+
+typedef uint8_t Hacl_Impl_SHA2_384_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_384_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_384_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_384_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_384_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_384_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_Impl_SHA2_384_uint128_ht;
+
+typedef uint64_t *Hacl_Impl_SHA2_384_uint64_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_384_uint8_p;
+
+typedef uint8_t Hacl_SHA2_384_uint8_t;
+
+typedef uint32_t Hacl_SHA2_384_uint32_t;
+
+typedef uint64_t Hacl_SHA2_384_uint64_t;
+
+typedef uint8_t Hacl_SHA2_384_uint8_ht;
+
+typedef uint64_t Hacl_SHA2_384_uint64_ht;
+
+typedef uint64_t *Hacl_SHA2_384_uint64_p;
+
+typedef uint8_t *Hacl_SHA2_384_uint8_p;
+
+extern uint32_t Hacl_SHA2_384_size_hash;
+
+extern uint32_t Hacl_SHA2_384_size_block;
+
+extern uint32_t Hacl_SHA2_384_size_state;
+
+void Hacl_SHA2_384_init(uint64_t *state);
+
+void Hacl_SHA2_384_update(uint64_t *state, uint8_t *data_8);
+
+void Hacl_SHA2_384_update_multi(uint64_t *state, uint8_t *data, uint32_t n1);
+
+void Hacl_SHA2_384_update_last(uint64_t *state, uint8_t *data, uint64_t len);
+
+void Hacl_SHA2_384_finish(uint64_t *state, uint8_t *hash1);
+
+void Hacl_SHA2_384_hash(uint8_t *hash1, uint8_t *input, uint32_t len);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.c
new file mode 100644
index 000000000..3535e772c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.c
@@ -0,0 +1,390 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_SHA2_512.h"
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(uint64_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)8U * i;
+    uint64_t inputi = load64_be(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(uint8_t *output, uint64_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint64_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)8U * i;
+    store64_be(x0, hd1);
+  }
+}
+
+static void Hacl_Impl_SHA2_512_init(uint64_t *state)
+{
+  uint64_t *n1 = state + (uint32_t)168U;
+  uint64_t *k1 = state;
+  uint64_t *h_01 = state + (uint32_t)160U;
+  uint64_t *p10 = k1;
+  uint64_t *p20 = k1 + (uint32_t)16U;
+  uint64_t *p3 = k1 + (uint32_t)32U;
+  uint64_t *p4 = k1 + (uint32_t)48U;
+  uint64_t *p5 = k1 + (uint32_t)64U;
+  uint64_t *p11 = p10;
+  uint64_t *p21 = p10 + (uint32_t)8U;
+  uint64_t *p12 = p11;
+  uint64_t *p22 = p11 + (uint32_t)4U;
+  p12[0U] = (uint64_t)0x428a2f98d728ae22U;
+  p12[1U] = (uint64_t)0x7137449123ef65cdU;
+  p12[2U] = (uint64_t)0xb5c0fbcfec4d3b2fU;
+  p12[3U] = (uint64_t)0xe9b5dba58189dbbcU;
+  p22[0U] = (uint64_t)0x3956c25bf348b538U;
+  p22[1U] = (uint64_t)0x59f111f1b605d019U;
+  p22[2U] = (uint64_t)0x923f82a4af194f9bU;
+  p22[3U] = (uint64_t)0xab1c5ed5da6d8118U;
+  uint64_t *p13 = p21;
+  uint64_t *p23 = p21 + (uint32_t)4U;
+  p13[0U] = (uint64_t)0xd807aa98a3030242U;
+  p13[1U] = (uint64_t)0x12835b0145706fbeU;
+  p13[2U] = (uint64_t)0x243185be4ee4b28cU;
+  p13[3U] = (uint64_t)0x550c7dc3d5ffb4e2U;
+  p23[0U] = (uint64_t)0x72be5d74f27b896fU;
+  p23[1U] = (uint64_t)0x80deb1fe3b1696b1U;
+  p23[2U] = (uint64_t)0x9bdc06a725c71235U;
+  p23[3U] = (uint64_t)0xc19bf174cf692694U;
+  uint64_t *p14 = p20;
+  uint64_t *p24 = p20 + (uint32_t)8U;
+  uint64_t *p15 = p14;
+  uint64_t *p25 = p14 + (uint32_t)4U;
+  p15[0U] = (uint64_t)0xe49b69c19ef14ad2U;
+  p15[1U] = (uint64_t)0xefbe4786384f25e3U;
+  p15[2U] = (uint64_t)0x0fc19dc68b8cd5b5U;
+  p15[3U] = (uint64_t)0x240ca1cc77ac9c65U;
+  p25[0U] = (uint64_t)0x2de92c6f592b0275U;
+  p25[1U] = (uint64_t)0x4a7484aa6ea6e483U;
+  p25[2U] = (uint64_t)0x5cb0a9dcbd41fbd4U;
+  p25[3U] = (uint64_t)0x76f988da831153b5U;
+  uint64_t *p16 = p24;
+  uint64_t *p26 = p24 + (uint32_t)4U;
+  p16[0U] = (uint64_t)0x983e5152ee66dfabU;
+  p16[1U] = (uint64_t)0xa831c66d2db43210U;
+  p16[2U] = (uint64_t)0xb00327c898fb213fU;
+  p16[3U] = (uint64_t)0xbf597fc7beef0ee4U;
+  p26[0U] = (uint64_t)0xc6e00bf33da88fc2U;
+  p26[1U] = (uint64_t)0xd5a79147930aa725U;
+  p26[2U] = (uint64_t)0x06ca6351e003826fU;
+  p26[3U] = (uint64_t)0x142929670a0e6e70U;
+  uint64_t *p17 = p3;
+  uint64_t *p27 = p3 + (uint32_t)8U;
+  uint64_t *p18 = p17;
+  uint64_t *p28 = p17 + (uint32_t)4U;
+  p18[0U] = (uint64_t)0x27b70a8546d22ffcU;
+  p18[1U] = (uint64_t)0x2e1b21385c26c926U;
+  p18[2U] = (uint64_t)0x4d2c6dfc5ac42aedU;
+  p18[3U] = (uint64_t)0x53380d139d95b3dfU;
+  p28[0U] = (uint64_t)0x650a73548baf63deU;
+  p28[1U] = (uint64_t)0x766a0abb3c77b2a8U;
+  p28[2U] = (uint64_t)0x81c2c92e47edaee6U;
+  p28[3U] = (uint64_t)0x92722c851482353bU;
+  uint64_t *p19 = p27;
+  uint64_t *p29 = p27 + (uint32_t)4U;
+  p19[0U] = (uint64_t)0xa2bfe8a14cf10364U;
+  p19[1U] = (uint64_t)0xa81a664bbc423001U;
+  p19[2U] = (uint64_t)0xc24b8b70d0f89791U;
+  p19[3U] = (uint64_t)0xc76c51a30654be30U;
+  p29[0U] = (uint64_t)0xd192e819d6ef5218U;
+  p29[1U] = (uint64_t)0xd69906245565a910U;
+  p29[2U] = (uint64_t)0xf40e35855771202aU;
+  p29[3U] = (uint64_t)0x106aa07032bbd1b8U;
+  uint64_t *p110 = p4;
+  uint64_t *p210 = p4 + (uint32_t)8U;
+  uint64_t *p111 = p110;
+  uint64_t *p211 = p110 + (uint32_t)4U;
+  p111[0U] = (uint64_t)0x19a4c116b8d2d0c8U;
+  p111[1U] = (uint64_t)0x1e376c085141ab53U;
+  p111[2U] = (uint64_t)0x2748774cdf8eeb99U;
+  p111[3U] = (uint64_t)0x34b0bcb5e19b48a8U;
+  p211[0U] = (uint64_t)0x391c0cb3c5c95a63U;
+  p211[1U] = (uint64_t)0x4ed8aa4ae3418acbU;
+  p211[2U] = (uint64_t)0x5b9cca4f7763e373U;
+  p211[3U] = (uint64_t)0x682e6ff3d6b2b8a3U;
+  uint64_t *p112 = p210;
+  uint64_t *p212 = p210 + (uint32_t)4U;
+  p112[0U] = (uint64_t)0x748f82ee5defb2fcU;
+  p112[1U] = (uint64_t)0x78a5636f43172f60U;
+  p112[2U] = (uint64_t)0x84c87814a1f0ab72U;
+  p112[3U] = (uint64_t)0x8cc702081a6439ecU;
+  p212[0U] = (uint64_t)0x90befffa23631e28U;
+  p212[1U] = (uint64_t)0xa4506cebde82bde9U;
+  p212[2U] = (uint64_t)0xbef9a3f7b2c67915U;
+  p212[3U] = (uint64_t)0xc67178f2e372532bU;
+  uint64_t *p113 = p5;
+  uint64_t *p213 = p5 + (uint32_t)8U;
+  uint64_t *p1 = p113;
+  uint64_t *p214 = p113 + (uint32_t)4U;
+  p1[0U] = (uint64_t)0xca273eceea26619cU;
+  p1[1U] = (uint64_t)0xd186b8c721c0c207U;
+  p1[2U] = (uint64_t)0xeada7dd6cde0eb1eU;
+  p1[3U] = (uint64_t)0xf57d4f7fee6ed178U;
+  p214[0U] = (uint64_t)0x06f067aa72176fbaU;
+  p214[1U] = (uint64_t)0x0a637dc5a2c898a6U;
+  p214[2U] = (uint64_t)0x113f9804bef90daeU;
+  p214[3U] = (uint64_t)0x1b710b35131c471bU;
+  uint64_t *p114 = p213;
+  uint64_t *p215 = p213 + (uint32_t)4U;
+  p114[0U] = (uint64_t)0x28db77f523047d84U;
+  p114[1U] = (uint64_t)0x32caab7b40c72493U;
+  p114[2U] = (uint64_t)0x3c9ebe0a15c9bebcU;
+  p114[3U] = (uint64_t)0x431d67c49c100d4cU;
+  p215[0U] = (uint64_t)0x4cc5d4becb3e42b6U;
+  p215[1U] = (uint64_t)0x597f299cfc657e2aU;
+  p215[2U] = (uint64_t)0x5fcb6fab3ad6faecU;
+  p215[3U] = (uint64_t)0x6c44198c4a475817U;
+  uint64_t *p115 = h_01;
+  uint64_t *p2 = h_01 + (uint32_t)4U;
+  p115[0U] = (uint64_t)0x6a09e667f3bcc908U;
+  p115[1U] = (uint64_t)0xbb67ae8584caa73bU;
+  p115[2U] = (uint64_t)0x3c6ef372fe94f82bU;
+  p115[3U] = (uint64_t)0xa54ff53a5f1d36f1U;
+  p2[0U] = (uint64_t)0x510e527fade682d1U;
+  p2[1U] = (uint64_t)0x9b05688c2b3e6c1fU;
+  p2[2U] = (uint64_t)0x1f83d9abfb41bd6bU;
+  p2[3U] = (uint64_t)0x5be0cd19137e2179U;
+  n1[0U] = (uint64_t)0U;
+}
+
+static void Hacl_Impl_SHA2_512_update(uint64_t *state, uint8_t *data)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)16U);
+  uint64_t data_w[16U];
+  for (uint32_t _i = 0U; _i < (uint32_t)16U; ++_i)
+    data_w[_i] = (uint64_t)(uint32_t)0U;
+  Hacl_Hash_Lib_LoadStore_uint64s_from_be_bytes(data_w, data, (uint32_t)16U);
+  uint64_t *hash_w = state + (uint32_t)160U;
+  uint64_t *ws_w = state + (uint32_t)80U;
+  uint64_t *k_w = state;
+  uint64_t *counter_w = state + (uint32_t)168U;
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint64_t b = data_w[i];
+    ws_w[i] = b;
+  }
+  for (uint32_t i = (uint32_t)16U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t t16 = ws_w[i - (uint32_t)16U];
+    uint64_t t15 = ws_w[i - (uint32_t)15U];
+    uint64_t t7 = ws_w[i - (uint32_t)7U];
+    uint64_t t2 = ws_w[i - (uint32_t)2U];
+    ws_w[i] =
+      ((t2 >> (uint32_t)19U | t2 << ((uint32_t)64U - (uint32_t)19U))
+      ^ ((t2 >> (uint32_t)61U | t2 << ((uint32_t)64U - (uint32_t)61U)) ^ t2 >> (uint32_t)6U))
+      +
+        t7
+        +
+          ((t15 >> (uint32_t)1U | t15 << ((uint32_t)64U - (uint32_t)1U))
+          ^ ((t15 >> (uint32_t)8U | t15 << ((uint32_t)64U - (uint32_t)8U)) ^ t15 >> (uint32_t)7U))
+          + t16;
+  }
+  uint64_t hash_0[8U] = { 0U };
+  memcpy(hash_0, hash_w, (uint32_t)8U * sizeof hash_w[0U]);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)80U; i = i + (uint32_t)1U)
+  {
+    uint64_t a = hash_0[0U];
+    uint64_t b = hash_0[1U];
+    uint64_t c = hash_0[2U];
+    uint64_t d = hash_0[3U];
+    uint64_t e = hash_0[4U];
+    uint64_t f1 = hash_0[5U];
+    uint64_t g = hash_0[6U];
+    uint64_t h = hash_0[7U];
+    uint64_t k_t = k_w[i];
+    uint64_t ws_t = ws_w[i];
+    uint64_t
+    t1 =
+      h
+      +
+        ((e >> (uint32_t)14U | e << ((uint32_t)64U - (uint32_t)14U))
+        ^
+          ((e >> (uint32_t)18U | e << ((uint32_t)64U - (uint32_t)18U))
+          ^ (e >> (uint32_t)41U | e << ((uint32_t)64U - (uint32_t)41U))))
+      + ((e & f1) ^ (~e & g))
+      + k_t
+      + ws_t;
+    uint64_t
+    t2 =
+      ((a >> (uint32_t)28U | a << ((uint32_t)64U - (uint32_t)28U))
+      ^
+        ((a >> (uint32_t)34U | a << ((uint32_t)64U - (uint32_t)34U))
+        ^ (a >> (uint32_t)39U | a << ((uint32_t)64U - (uint32_t)39U))))
+      + ((a & b) ^ ((a & c) ^ (b & c)));
+    uint64_t x1 = t1 + t2;
+    uint64_t x5 = d + t1;
+    uint64_t *p1 = hash_0;
+    uint64_t *p2 = hash_0 + (uint32_t)4U;
+    p1[0U] = x1;
+    p1[1U] = a;
+    p1[2U] = b;
+    p1[3U] = c;
+    p2[0U] = x5;
+    p2[1U] = e;
+    p2[2U] = f1;
+    p2[3U] = g;
+  }
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)8U; i = i + (uint32_t)1U)
+  {
+    uint64_t xi = hash_w[i];
+    uint64_t yi = hash_0[i];
+    hash_w[i] = xi + yi;
+  }
+  uint64_t c0 = counter_w[0U];
+  uint64_t one1 = (uint64_t)(uint32_t)1U;
+  counter_w[0U] = c0 + one1;
+}
+
+static void Hacl_Impl_SHA2_512_update_multi(uint64_t *state, uint8_t *data, uint32_t n1)
+{
+  for (uint32_t i = (uint32_t)0U; i < n1; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = data + i * (uint32_t)128U;
+    Hacl_Impl_SHA2_512_update(state, b);
+  }
+}
+
+static void Hacl_Impl_SHA2_512_update_last(uint64_t *state, uint8_t *data, uint64_t len)
+{
+  uint8_t blocks[256U] = { 0U };
+  uint32_t nb;
+  if (len < (uint64_t)112U)
+    nb = (uint32_t)1U;
+  else
+    nb = (uint32_t)2U;
+  uint8_t *final_blocks;
+  if (len < (uint64_t)112U)
+    final_blocks = blocks + (uint32_t)128U;
+  else
+    final_blocks = blocks;
+  memcpy(final_blocks, data, (uint32_t)len * sizeof data[0U]);
+  uint64_t n1 = state[168U];
+  uint8_t *padding = final_blocks + (uint32_t)len;
+  FStar_UInt128_t
+  encodedlen =
+    FStar_UInt128_shift_left(FStar_UInt128_add(FStar_UInt128_mul_wide(n1, (uint64_t)(uint32_t)128U),
+        FStar_UInt128_uint64_to_uint128(len)),
+      (uint32_t)3U);
+  uint32_t
+  pad0len = ((uint32_t)256U - ((uint32_t)len + (uint32_t)16U + (uint32_t)1U)) % (uint32_t)128U;
+  uint8_t *buf1 = padding;
+  uint8_t *buf2 = padding + (uint32_t)1U + pad0len;
+  buf1[0U] = (uint8_t)0x80U;
+  store128_be(buf2, encodedlen);
+  Hacl_Impl_SHA2_512_update_multi(state, final_blocks, nb);
+}
+
+static void Hacl_Impl_SHA2_512_finish(uint64_t *state, uint8_t *hash1)
+{
+  uint64_t *hash_w = state + (uint32_t)160U;
+  Hacl_Hash_Lib_LoadStore_uint64s_to_be_bytes(hash1, hash_w, (uint32_t)8U);
+}
+
+static void Hacl_Impl_SHA2_512_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  KRML_CHECK_SIZE((uint64_t)(uint32_t)0U, (uint32_t)169U);
+  uint64_t state[169U];
+  for (uint32_t _i = 0U; _i < (uint32_t)169U; ++_i)
+    state[_i] = (uint64_t)(uint32_t)0U;
+  uint32_t n1 = len / (uint32_t)128U;
+  uint32_t r = len % (uint32_t)128U;
+  uint8_t *input_blocks = input;
+  uint8_t *input_last = input + n1 * (uint32_t)128U;
+  Hacl_Impl_SHA2_512_init(state);
+  Hacl_Impl_SHA2_512_update_multi(state, input_blocks, n1);
+  Hacl_Impl_SHA2_512_update_last(state, input_last, (uint64_t)r);
+  Hacl_Impl_SHA2_512_finish(state, hash1);
+}
+
+uint32_t Hacl_SHA2_512_size_word = (uint32_t)8U;
+
+uint32_t Hacl_SHA2_512_size_hash_w = (uint32_t)8U;
+
+uint32_t Hacl_SHA2_512_size_block_w = (uint32_t)16U;
+
+uint32_t Hacl_SHA2_512_size_hash = (uint32_t)64U;
+
+uint32_t Hacl_SHA2_512_size_block = (uint32_t)128U;
+
+uint32_t Hacl_SHA2_512_size_k_w = (uint32_t)80U;
+
+uint32_t Hacl_SHA2_512_size_ws_w = (uint32_t)80U;
+
+uint32_t Hacl_SHA2_512_size_whash_w = (uint32_t)8U;
+
+uint32_t Hacl_SHA2_512_size_count_w = (uint32_t)1U;
+
+uint32_t Hacl_SHA2_512_size_len_8 = (uint32_t)16U;
+
+uint32_t Hacl_SHA2_512_size_state = (uint32_t)169U;
+
+uint32_t Hacl_SHA2_512_pos_k_w = (uint32_t)0U;
+
+uint32_t Hacl_SHA2_512_pos_ws_w = (uint32_t)80U;
+
+uint32_t Hacl_SHA2_512_pos_whash_w = (uint32_t)160U;
+
+uint32_t Hacl_SHA2_512_pos_count_w = (uint32_t)168U;
+
+void Hacl_SHA2_512_init(uint64_t *state)
+{
+  Hacl_Impl_SHA2_512_init(state);
+}
+
+void Hacl_SHA2_512_update(uint64_t *state, uint8_t *data)
+{
+  Hacl_Impl_SHA2_512_update(state, data);
+}
+
+void Hacl_SHA2_512_update_multi(uint64_t *state, uint8_t *data, uint32_t n1)
+{
+  Hacl_Impl_SHA2_512_update_multi(state, data, n1);
+}
+
+void Hacl_SHA2_512_update_last(uint64_t *state, uint8_t *data, uint64_t len)
+{
+  Hacl_Impl_SHA2_512_update_last(state, data, len);
+}
+
+void Hacl_SHA2_512_finish(uint64_t *state, uint8_t *hash1)
+{
+  Hacl_Impl_SHA2_512_finish(state, hash1);
+}
+
+void Hacl_SHA2_512_hash(uint8_t *hash1, uint8_t *input, uint32_t len)
+{
+  Hacl_Impl_SHA2_512_hash(hash1, input, len);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.h
new file mode 100644
index 000000000..121b8e641
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_SHA2_512.h
@@ -0,0 +1,129 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_SHA2_512_H
+#define __Hacl_SHA2_512_H
+
+
+
+
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_t;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_t;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_t;
+
+typedef uint8_t Hacl_Hash_Lib_Create_uint8_ht;
+
+typedef uint32_t Hacl_Hash_Lib_Create_uint32_ht;
+
+typedef uint64_t Hacl_Hash_Lib_Create_uint64_ht;
+
+typedef uint8_t *Hacl_Hash_Lib_Create_uint8_p;
+
+typedef uint32_t *Hacl_Hash_Lib_Create_uint32_p;
+
+typedef uint64_t *Hacl_Hash_Lib_Create_uint64_p;
+
+typedef uint8_t *Hacl_Hash_Lib_LoadStore_uint8_p;
+
+typedef uint8_t Hacl_Impl_SHA2_512_uint8_t;
+
+typedef uint32_t Hacl_Impl_SHA2_512_uint32_t;
+
+typedef uint64_t Hacl_Impl_SHA2_512_uint64_t;
+
+typedef uint8_t Hacl_Impl_SHA2_512_uint8_ht;
+
+typedef uint32_t Hacl_Impl_SHA2_512_uint32_ht;
+
+typedef uint64_t Hacl_Impl_SHA2_512_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_Impl_SHA2_512_uint128_ht;
+
+typedef uint64_t *Hacl_Impl_SHA2_512_uint64_p;
+
+typedef uint8_t *Hacl_Impl_SHA2_512_uint8_p;
+
+typedef uint8_t Hacl_SHA2_512_uint8_t;
+
+typedef uint32_t Hacl_SHA2_512_uint32_t;
+
+typedef uint64_t Hacl_SHA2_512_uint64_t;
+
+typedef uint8_t Hacl_SHA2_512_uint8_ht;
+
+typedef uint32_t Hacl_SHA2_512_uint32_ht;
+
+typedef uint64_t Hacl_SHA2_512_uint64_ht;
+
+typedef FStar_UInt128_t Hacl_SHA2_512_uint128_ht;
+
+typedef uint64_t *Hacl_SHA2_512_uint64_p;
+
+typedef uint8_t *Hacl_SHA2_512_uint8_p;
+
+extern uint32_t Hacl_SHA2_512_size_word;
+
+extern uint32_t Hacl_SHA2_512_size_hash_w;
+
+extern uint32_t Hacl_SHA2_512_size_block_w;
+
+extern uint32_t Hacl_SHA2_512_size_hash;
+
+extern uint32_t Hacl_SHA2_512_size_block;
+
+extern uint32_t Hacl_SHA2_512_size_k_w;
+
+extern uint32_t Hacl_SHA2_512_size_ws_w;
+
+extern uint32_t Hacl_SHA2_512_size_whash_w;
+
+extern uint32_t Hacl_SHA2_512_size_count_w;
+
+extern uint32_t Hacl_SHA2_512_size_len_8;
+
+extern uint32_t Hacl_SHA2_512_size_state;
+
+extern uint32_t Hacl_SHA2_512_pos_k_w;
+
+extern uint32_t Hacl_SHA2_512_pos_ws_w;
+
+extern uint32_t Hacl_SHA2_512_pos_whash_w;
+
+extern uint32_t Hacl_SHA2_512_pos_count_w;
+
+void Hacl_SHA2_512_init(uint64_t *state);
+
+void Hacl_SHA2_512_update(uint64_t *state, uint8_t *data);
+
+void Hacl_SHA2_512_update_multi(uint64_t *state, uint8_t *data, uint32_t n1);
+
+void Hacl_SHA2_512_update_last(uint64_t *state, uint8_t *data, uint64_t len);
+
+void Hacl_SHA2_512_finish(uint64_t *state, uint8_t *hash1);
+
+void Hacl_SHA2_512_hash(uint8_t *hash1, uint8_t *input, uint32_t len);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.c
new file mode 100644
index 000000000..be480be3c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.c
@@ -0,0 +1,385 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "Hacl_Salsa20.h"
+
+static void
+Hacl_Lib_Create_make_h32_4(uint32_t *b, uint32_t s0, uint32_t s1, uint32_t s2, uint32_t s3)
+{
+  b[0U] = s0;
+  b[1U] = s1;
+  b[2U] = s2;
+  b[3U] = s3;
+}
+
+static void
+Hacl_Lib_Create_make_h32_8(
+  uint32_t *b,
+  uint32_t s0,
+  uint32_t s1,
+  uint32_t s2,
+  uint32_t s3,
+  uint32_t s4,
+  uint32_t s5,
+  uint32_t s6,
+  uint32_t s7
+)
+{
+  Hacl_Lib_Create_make_h32_4(b, s0, s1, s2, s3);
+  Hacl_Lib_Create_make_h32_4(b + (uint32_t)4U, s4, s5, s6, s7);
+}
+
+static void
+Hacl_Lib_Create_make_h32_16(
+  uint32_t *b,
+  uint32_t s0,
+  uint32_t s1,
+  uint32_t s2,
+  uint32_t s3,
+  uint32_t s4,
+  uint32_t s5,
+  uint32_t s6,
+  uint32_t s7,
+  uint32_t s8,
+  uint32_t s9,
+  uint32_t s10,
+  uint32_t s11,
+  uint32_t s12,
+  uint32_t s13,
+  uint32_t s14,
+  uint32_t s15
+)
+{
+  Hacl_Lib_Create_make_h32_8(b, s0, s1, s2, s3, s4, s5, s6, s7);
+  Hacl_Lib_Create_make_h32_8(b + (uint32_t)8U, s8, s9, s10, s11, s12, s13, s14, s15);
+}
+
+static void
+Hacl_Lib_LoadStore32_uint32s_from_le_bytes(uint32_t *output, uint8_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *x0 = input + (uint32_t)4U * i;
+    uint32_t inputi = load32_le(x0);
+    output[i] = inputi;
+  }
+}
+
+static void
+Hacl_Lib_LoadStore32_uint32s_to_le_bytes(uint8_t *output, uint32_t *input, uint32_t len)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint32_t hd1 = input[i];
+    uint8_t *x0 = output + (uint32_t)4U * i;
+    store32_le(x0, hd1);
+  }
+}
+
+inline static void Hacl_Impl_Salsa20_setup(uint32_t *st, uint8_t *k, uint8_t *n1, uint64_t c)
+{
+  uint32_t tmp[10U] = { 0U };
+  uint32_t *k_ = tmp;
+  uint32_t *n_ = tmp + (uint32_t)8U;
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(k_, k, (uint32_t)8U);
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(n_, n1, (uint32_t)2U);
+  uint32_t c0 = (uint32_t)c;
+  uint32_t c1 = (uint32_t)(c >> (uint32_t)32U);
+  uint32_t k0 = k_[0U];
+  uint32_t k1 = k_[1U];
+  uint32_t k2 = k_[2U];
+  uint32_t k3 = k_[3U];
+  uint32_t k4 = k_[4U];
+  uint32_t k5 = k_[5U];
+  uint32_t k6 = k_[6U];
+  uint32_t k7 = k_[7U];
+  uint32_t n0 = n_[0U];
+  uint32_t n11 = n_[1U];
+  Hacl_Lib_Create_make_h32_16(st,
+    (uint32_t)0x61707865U,
+    k0,
+    k1,
+    k2,
+    k3,
+    (uint32_t)0x3320646eU,
+    n0,
+    n11,
+    c0,
+    c1,
+    (uint32_t)0x79622d32U,
+    k4,
+    k5,
+    k6,
+    k7,
+    (uint32_t)0x6b206574U);
+}
+
+inline static void
+Hacl_Impl_Salsa20_line(uint32_t *st, uint32_t a, uint32_t b, uint32_t d, uint32_t s)
+{
+  uint32_t sa = st[a];
+  uint32_t sb = st[b];
+  uint32_t sd = st[d];
+  uint32_t sbd = sb + sd;
+  uint32_t sbds = sbd << s | sbd >> ((uint32_t)32U - s);
+  st[a] = sa ^ sbds;
+}
+
+inline static void
+Hacl_Impl_Salsa20_quarter_round(uint32_t *st, uint32_t a, uint32_t b, uint32_t c, uint32_t d)
+{
+  Hacl_Impl_Salsa20_line(st, b, a, d, (uint32_t)7U);
+  Hacl_Impl_Salsa20_line(st, c, b, a, (uint32_t)9U);
+  Hacl_Impl_Salsa20_line(st, d, c, b, (uint32_t)13U);
+  Hacl_Impl_Salsa20_line(st, a, d, c, (uint32_t)18U);
+}
+
+inline static void Hacl_Impl_Salsa20_double_round(uint32_t *st)
+{
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)0U, (uint32_t)4U, (uint32_t)8U, (uint32_t)12U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)5U, (uint32_t)9U, (uint32_t)13U, (uint32_t)1U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)10U, (uint32_t)14U, (uint32_t)2U, (uint32_t)6U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)15U, (uint32_t)3U, (uint32_t)7U, (uint32_t)11U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)0U, (uint32_t)1U, (uint32_t)2U, (uint32_t)3U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)5U, (uint32_t)6U, (uint32_t)7U, (uint32_t)4U);
+  Hacl_Impl_Salsa20_quarter_round(st, (uint32_t)10U, (uint32_t)11U, (uint32_t)8U, (uint32_t)9U);
+  Hacl_Impl_Salsa20_quarter_round(st,
+    (uint32_t)15U,
+    (uint32_t)12U,
+    (uint32_t)13U,
+    (uint32_t)14U);
+}
+
+inline static void Hacl_Impl_Salsa20_rounds(uint32_t *st)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)10U; i = i + (uint32_t)1U)
+    Hacl_Impl_Salsa20_double_round(st);
+}
+
+inline static void Hacl_Impl_Salsa20_sum_states(uint32_t *st, uint32_t *st_)
+{
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = st[i];
+    uint32_t yi = st_[i];
+    st[i] = xi + yi;
+  }
+}
+
+inline static void Hacl_Impl_Salsa20_copy_state(uint32_t *st, uint32_t *st_)
+{
+  memcpy(st, st_, (uint32_t)16U * sizeof st_[0U]);
+}
+
+inline static void Hacl_Impl_Salsa20_salsa20_core(uint32_t *k, uint32_t *st, uint64_t ctr)
+{
+  uint32_t c0 = (uint32_t)ctr;
+  uint32_t c1 = (uint32_t)(ctr >> (uint32_t)32U);
+  st[8U] = c0;
+  st[9U] = c1;
+  Hacl_Impl_Salsa20_copy_state(k, st);
+  Hacl_Impl_Salsa20_rounds(k);
+  Hacl_Impl_Salsa20_sum_states(k, st);
+}
+
+inline static void
+Hacl_Impl_Salsa20_salsa20_block(uint8_t *stream_block, uint32_t *st, uint64_t ctr)
+{
+  uint32_t st_[16U] = { 0U };
+  Hacl_Impl_Salsa20_salsa20_core(st_, st, ctr);
+  Hacl_Lib_LoadStore32_uint32s_to_le_bytes(stream_block, st_, (uint32_t)16U);
+}
+
+inline static void Hacl_Impl_Salsa20_init(uint32_t *st, uint8_t *k, uint8_t *n1)
+{
+  Hacl_Impl_Salsa20_setup(st, k, n1, (uint64_t)0U);
+}
+
+static void
+Hacl_Impl_Salsa20_update_last(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint32_t *st,
+  uint64_t ctr
+)
+{
+  uint8_t block[64U] = { 0U };
+  Hacl_Impl_Salsa20_salsa20_block(block, st, ctr);
+  uint8_t *mask = block;
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t xi = plain[i];
+    uint8_t yi = mask[i];
+    output[i] = xi ^ yi;
+  }
+}
+
+static void
+Hacl_Impl_Salsa20_update(uint8_t *output, uint8_t *plain, uint32_t *st, uint64_t ctr)
+{
+  uint32_t b[48U] = { 0U };
+  uint32_t *k = b;
+  uint32_t *ib = b + (uint32_t)16U;
+  uint32_t *ob = b + (uint32_t)32U;
+  Hacl_Impl_Salsa20_salsa20_core(k, st, ctr);
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(ib, plain, (uint32_t)16U);
+  for (uint32_t i = (uint32_t)0U; i < (uint32_t)16U; i = i + (uint32_t)1U)
+  {
+    uint32_t xi = ib[i];
+    uint32_t yi = k[i];
+    ob[i] = xi ^ yi;
+  }
+  Hacl_Lib_LoadStore32_uint32s_to_le_bytes(output, ob, (uint32_t)16U);
+}
+
+static void
+Hacl_Impl_Salsa20_salsa20_counter_mode_blocks(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint32_t *st,
+  uint64_t ctr
+)
+{
+  for (uint32_t i = (uint32_t)0U; i < len; i = i + (uint32_t)1U)
+  {
+    uint8_t *b = plain + (uint32_t)64U * i;
+    uint8_t *o = output + (uint32_t)64U * i;
+    Hacl_Impl_Salsa20_update(o, b, st, ctr + (uint64_t)i);
+  }
+}
+
+static void
+Hacl_Impl_Salsa20_salsa20_counter_mode(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint32_t *st,
+  uint64_t ctr
+)
+{
+  uint32_t blocks_len = len >> (uint32_t)6U;
+  uint32_t part_len = len & (uint32_t)0x3fU;
+  uint8_t *output_ = output;
+  uint8_t *plain_ = plain;
+  uint8_t *output__ = output + (uint32_t)64U * blocks_len;
+  uint8_t *plain__ = plain + (uint32_t)64U * blocks_len;
+  Hacl_Impl_Salsa20_salsa20_counter_mode_blocks(output_, plain_, blocks_len, st, ctr);
+  if (part_len > (uint32_t)0U)
+    Hacl_Impl_Salsa20_update_last(output__, plain__, part_len, st, ctr + (uint64_t)blocks_len);
+}
+
+static void
+Hacl_Impl_Salsa20_salsa20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint64_t ctr
+)
+{
+  uint32_t buf[16U] = { 0U };
+  uint32_t *st = buf;
+  Hacl_Impl_Salsa20_init(st, k, n1);
+  Hacl_Impl_Salsa20_salsa20_counter_mode(output, plain, len, st, ctr);
+}
+
+inline static void Hacl_Impl_HSalsa20_setup(uint32_t *st, uint8_t *k, uint8_t *n1)
+{
+  uint32_t tmp[12U] = { 0U };
+  uint32_t *k_ = tmp;
+  uint32_t *n_ = tmp + (uint32_t)8U;
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(k_, k, (uint32_t)8U);
+  Hacl_Lib_LoadStore32_uint32s_from_le_bytes(n_, n1, (uint32_t)4U);
+  uint32_t k0 = k_[0U];
+  uint32_t k1 = k_[1U];
+  uint32_t k2 = k_[2U];
+  uint32_t k3 = k_[3U];
+  uint32_t k4 = k_[4U];
+  uint32_t k5 = k_[5U];
+  uint32_t k6 = k_[6U];
+  uint32_t k7 = k_[7U];
+  uint32_t n0 = n_[0U];
+  uint32_t n11 = n_[1U];
+  uint32_t n2 = n_[2U];
+  uint32_t n3 = n_[3U];
+  Hacl_Lib_Create_make_h32_16(st,
+    (uint32_t)0x61707865U,
+    k0,
+    k1,
+    k2,
+    k3,
+    (uint32_t)0x3320646eU,
+    n0,
+    n11,
+    n2,
+    n3,
+    (uint32_t)0x79622d32U,
+    k4,
+    k5,
+    k6,
+    k7,
+    (uint32_t)0x6b206574U);
+}
+
+static void
+Hacl_Impl_HSalsa20_crypto_core_hsalsa20(uint8_t *output, uint8_t *nonce, uint8_t *key)
+{
+  uint32_t tmp[24U] = { 0U };
+  uint32_t *st = tmp;
+  uint32_t *hs = tmp + (uint32_t)16U;
+  Hacl_Impl_HSalsa20_setup(st, key, nonce);
+  Hacl_Impl_Salsa20_rounds(st);
+  uint32_t hs0 = st[0U];
+  uint32_t hs1 = st[5U];
+  uint32_t hs2 = st[10U];
+  uint32_t hs3 = st[15U];
+  uint32_t hs4 = st[6U];
+  uint32_t hs5 = st[7U];
+  uint32_t hs6 = st[8U];
+  uint32_t hs7 = st[9U];
+  Hacl_Lib_Create_make_h32_8(hs, hs0, hs1, hs2, hs3, hs4, hs5, hs6, hs7);
+  Hacl_Lib_LoadStore32_uint32s_to_le_bytes(output, hs, (uint32_t)8U);
+}
+
+void
+Hacl_Salsa20_salsa20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint64_t ctr
+)
+{
+  Hacl_Impl_Salsa20_salsa20(output, plain, len, k, n1, ctr);
+}
+
+void Hacl_Salsa20_hsalsa20(uint8_t *output, uint8_t *key, uint8_t *nonce)
+{
+  Hacl_Impl_HSalsa20_crypto_core_hsalsa20(output, nonce, key);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.h
new file mode 100644
index 000000000..e18003f74
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Salsa20.h
@@ -0,0 +1,84 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __Hacl_Salsa20_H
+#define __Hacl_Salsa20_H
+
+
+
+
+
+typedef uint32_t Hacl_Impl_Xor_Lemmas_u32;
+
+typedef uint8_t Hacl_Impl_Xor_Lemmas_u8;
+
+typedef uint32_t Hacl_Lib_Create_h32;
+
+typedef uint8_t *Hacl_Lib_LoadStore32_uint8_p;
+
+typedef uint32_t Hacl_Impl_Salsa20_u32;
+
+typedef uint32_t Hacl_Impl_Salsa20_h32;
+
+typedef uint8_t *Hacl_Impl_Salsa20_uint8_p;
+
+typedef uint32_t *Hacl_Impl_Salsa20_state;
+
+typedef uint32_t Hacl_Impl_Salsa20_idx;
+
+typedef struct 
+{
+  void *k;
+  void *n;
+}
+Hacl_Impl_Salsa20_log_t_;
+
+typedef void *Hacl_Impl_Salsa20_log_t;
+
+typedef uint32_t Hacl_Impl_HSalsa20_h32;
+
+typedef uint32_t Hacl_Impl_HSalsa20_u32;
+
+typedef uint8_t *Hacl_Impl_HSalsa20_uint8_p;
+
+typedef uint32_t *Hacl_Impl_HSalsa20_state;
+
+typedef uint8_t *Hacl_Salsa20_uint8_p;
+
+typedef uint32_t Hacl_Salsa20_uint32_t;
+
+typedef uint32_t *Hacl_Salsa20_state;
+
+void
+Hacl_Salsa20_salsa20(
+  uint8_t *output,
+  uint8_t *plain,
+  uint32_t len,
+  uint8_t *k,
+  uint8_t *n1,
+  uint64_t ctr
+);
+
+void Hacl_Salsa20_hsalsa20(uint8_t *output, uint8_t *key, uint8_t *nonce);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.c
new file mode 100644
index 000000000..5f116b55a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.c
@@ -0,0 +1,104 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+#include "Hacl_Unverified_Random.h"
+#include <stdio.h>
+
+
+#if HACL_IS_WINDOWS
+
+#include <windows.h>
+#include <wincrypt.h>
+#include <malloc.h>
+
+bool read_random_bytes(uint64_t len, uint8_t * buf) {
+  HCRYPTPROV ctxt;
+  if (! (CryptAcquireContext(&ctxt, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT))) {
+    DWORD error = GetLastError();
+    printf("Cannot acquire crypto context: 0x%lx\n", error);
+    return false;
+  }
+  bool pass = true;
+  if (! (CryptGenRandom(ctxt, len, buf))) {
+    printf("Cannot read random bytes\n");
+    pass = false;
+  }
+  CryptReleaseContext(ctxt, 0);
+  return pass;
+}
+
+void * hacl_aligned_malloc(size_t alignment, size_t size) {
+  void * res = _aligned_malloc(size, alignment);
+  if (res == NULL) {
+    printf("Cannot allocate %" PRIu64 " bytes aligned to %" PRIu64 "\n", (uint64_t) size, (uint64_t) alignment);
+  }
+  return res;
+}
+
+void hacl_aligned_free(void * ptr) {
+  _aligned_free(ptr);
+}
+
+#else // ! HACL_IS_WINDOWS
+
+/* assume POSIX here */
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <stdlib.h>
+
+bool read_random_bytes(uint64_t len, uint8_t * buf) {
+  int fd = open("/dev/urandom", O_RDONLY);
+  if (fd == -1) {
+    printf("Cannot open /dev/urandom\n");
+    return false;
+  }
+  bool pass = true;
+  uint64_t res = read(fd, buf, len);
+  if (res != len) {
+    printf("Error on reading, expected %" PRIu64 " bytes, got %" PRIu64 " bytes\n", len, res);
+    pass = false;
+  }
+  close(fd);
+  return pass;
+}
+
+void * hacl_aligned_malloc(size_t alignment, size_t size) {
+  void * res = NULL;
+  if (posix_memalign(&res, alignment, size)) {
+    printf("Cannot allocate %" PRIu64 " bytes aligned to %" PRIu64 "\n", (uint64_t) size, (uint64_t) alignment);
+    return NULL;
+  }
+  return res;
+}
+
+void hacl_aligned_free(void * ptr) {
+  free(ptr);
+}
+
+#endif // HACL_IS_WINDOWS
+
+void randombytes(uint8_t * x,uint64_t len) {
+  if (! (read_random_bytes(len, x)))
+    exit(1);
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.h
new file mode 100644
index 000000000..4bbb9f143
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/Hacl_Unverified_Random.h
@@ -0,0 +1,43 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+#ifndef __HACL_UNVERIFIED_RANDOM
+#define __HACL_UNVERIFIED_RANDOM
+
+#include <inttypes.h>
+#include <stdbool.h>
+#include <stddef.h>
+
+#if ((defined(_WIN32) || defined(_WIN64)) && (! (defined(__CYGWIN__))))
+#define HACL_IS_WINDOWS 1
+#else
+#define HACL_IS_WINDOWS 0
+#endif
+
+bool read_random_bytes(uint64_t len, uint8_t * buf);
+void * hacl_aligned_malloc(size_t alignment, size_t size);
+void hacl_aligned_free(void * ptr);
+
+void randombytes(uint8_t * x,uint64_t len);
+
+#endif // __HACL_UNVERIFIED_RANDOM
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.c
new file mode 100644
index 000000000..a3f1f3c2f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.c
@@ -0,0 +1,463 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+
+#include "NaCl.h"
+
+static void Hacl_SecretBox_ZeroPad_set_zero_bytes(uint8_t *b)
+{
+  uint8_t zero1 = (uint8_t)0U;
+  b[0U] = zero1;
+  b[1U] = zero1;
+  b[2U] = zero1;
+  b[3U] = zero1;
+  b[4U] = zero1;
+  b[5U] = zero1;
+  b[6U] = zero1;
+  b[7U] = zero1;
+  b[8U] = zero1;
+  b[9U] = zero1;
+  b[10U] = zero1;
+  b[11U] = zero1;
+  b[12U] = zero1;
+  b[13U] = zero1;
+  b[14U] = zero1;
+  b[15U] = zero1;
+  b[16U] = zero1;
+  b[17U] = zero1;
+  b[18U] = zero1;
+  b[19U] = zero1;
+  b[20U] = zero1;
+  b[21U] = zero1;
+  b[22U] = zero1;
+  b[23U] = zero1;
+  b[24U] = zero1;
+  b[25U] = zero1;
+  b[26U] = zero1;
+  b[27U] = zero1;
+  b[28U] = zero1;
+  b[29U] = zero1;
+  b[30U] = zero1;
+  b[31U] = zero1;
+}
+
+static uint32_t
+Hacl_SecretBox_ZeroPad_crypto_secretbox_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint32_t mlen_ = (uint32_t)mlen;
+  uint8_t subkey[32U] = { 0U };
+  Hacl_Salsa20_hsalsa20(subkey, k1, n1);
+  Hacl_Salsa20_salsa20(c, m, mlen_ + (uint32_t)32U, subkey, n1 + (uint32_t)16U, (uint64_t)0U);
+  Hacl_Poly1305_64_crypto_onetimeauth(mac, c + (uint32_t)32U, mlen, c);
+  Hacl_SecretBox_ZeroPad_set_zero_bytes(c);
+  Hacl_SecretBox_ZeroPad_set_zero_bytes(subkey);
+  return (uint32_t)0U;
+}
+
+static uint32_t
+Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached_decrypt(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *subkey,
+  uint8_t verify
+)
+{
+  uint32_t clen_ = (uint32_t)clen;
+  if (verify == (uint8_t)0U)
+  {
+    Hacl_Salsa20_salsa20(m, c, clen_ + (uint32_t)32U, subkey, n1 + (uint32_t)16U, (uint64_t)0U);
+    Hacl_SecretBox_ZeroPad_set_zero_bytes(subkey);
+    Hacl_SecretBox_ZeroPad_set_zero_bytes(m);
+    return (uint32_t)0U;
+  }
+  else
+    return (uint32_t)0xffffffffU;
+}
+
+static uint32_t
+Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint8_t tmp[112U] = { 0U };
+  uint8_t *subkey = tmp;
+  uint8_t *mackey = tmp + (uint32_t)32U;
+  uint8_t *mackey_ = tmp + (uint32_t)64U;
+  uint8_t *cmac = tmp + (uint32_t)96U;
+  Hacl_Salsa20_hsalsa20(subkey, k1, n1);
+  Hacl_Salsa20_salsa20(mackey, mackey_, (uint32_t)32U, subkey, n1 + (uint32_t)16U, (uint64_t)0U);
+  Hacl_Poly1305_64_crypto_onetimeauth(cmac, c + (uint32_t)32U, clen, mackey);
+  uint8_t result = Hacl_Policies_cmp_bytes(mac, cmac, (uint32_t)16U);
+  uint8_t verify = result;
+  uint32_t
+  z =
+    Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached_decrypt(m,
+      c,
+      clen,
+      n1,
+      subkey,
+      verify);
+  return z;
+}
+
+static uint32_t
+Hacl_SecretBox_ZeroPad_crypto_secretbox_easy(
+  uint8_t *c,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint8_t cmac[16U] = { 0U };
+  uint32_t res = Hacl_SecretBox_ZeroPad_crypto_secretbox_detached(c, cmac, m, mlen, n1, k1);
+  memcpy(c + (uint32_t)16U, cmac, (uint32_t)16U * sizeof cmac[0U]);
+  return res;
+}
+
+static uint32_t
+Hacl_SecretBox_ZeroPad_crypto_secretbox_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint8_t *mac = c;
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached(m, c, mac, clen, n1, k1);
+}
+
+static uint32_t Hacl_Box_ZeroPad_crypto_box_beforenm(uint8_t *k1, uint8_t *pk, uint8_t *sk)
+{
+  uint8_t tmp[48U] = { 0U };
+  uint8_t *hsalsa_k = tmp;
+  uint8_t *hsalsa_n = tmp + (uint32_t)32U;
+  Hacl_Curve25519_crypto_scalarmult(hsalsa_k, sk, pk);
+  Hacl_Salsa20_hsalsa20(k1, hsalsa_k, hsalsa_n);
+  return (uint32_t)0U;
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_detached_afternm(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_detached(c, mac, m, mlen, n1, k1);
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  uint8_t key[80U] = { 0U };
+  uint8_t *k1 = key;
+  uint8_t *subkey = key + (uint32_t)32U;
+  uint8_t *hsalsa_n = key + (uint32_t)64U;
+  Hacl_Curve25519_crypto_scalarmult(k1, sk, pk);
+  Hacl_Salsa20_hsalsa20(subkey, k1, hsalsa_n);
+  uint32_t z = Hacl_SecretBox_ZeroPad_crypto_secretbox_detached(c, mac, m, mlen, n1, subkey);
+  return z;
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  uint8_t key[80U] = { 0U };
+  uint8_t *k1 = key;
+  uint8_t *subkey = key + (uint32_t)32U;
+  uint8_t *hsalsa_n = key + (uint32_t)64U;
+  Hacl_Curve25519_crypto_scalarmult(k1, sk, pk);
+  Hacl_Salsa20_hsalsa20(subkey, k1, hsalsa_n);
+  uint32_t
+  z = Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached(m, c, mac, mlen, n1, subkey);
+  return z;
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_easy_afternm(
+  uint8_t *c,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint8_t cmac[16U] = { 0U };
+  uint32_t z = Hacl_Box_ZeroPad_crypto_box_detached_afternm(c, cmac, m, mlen, n1, k1);
+  memcpy(c + (uint32_t)16U, cmac, (uint32_t)16U * sizeof cmac[0U]);
+  return z;
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_easy(
+  uint8_t *c,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  uint8_t cmac[16U] = { 0U };
+  uint32_t res = Hacl_Box_ZeroPad_crypto_box_detached(c, cmac, m, mlen, n1, pk, sk);
+  memcpy(c + (uint32_t)16U, cmac, (uint32_t)16U * sizeof cmac[0U]);
+  return res;
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  uint8_t *mac = c + (uint32_t)16U;
+  return Hacl_Box_ZeroPad_crypto_box_open_detached(m, c, mac, mlen, n1, pk, sk);
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_open_detached_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached(m, c, mac, mlen, n1, k1);
+}
+
+static uint32_t
+Hacl_Box_ZeroPad_crypto_box_open_easy_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  uint8_t *mac = c + (uint32_t)16U;
+  uint32_t t = Hacl_Box_ZeroPad_crypto_box_open_detached_afternm(m, c, mac, mlen, n1, k1);
+  return t;
+}
+
+Prims_int NaCl_crypto_box_NONCEBYTES = (krml_checked_int_t)24;
+
+Prims_int NaCl_crypto_box_PUBLICKEYBYTES = (krml_checked_int_t)32;
+
+Prims_int NaCl_crypto_box_SECRETKEYBYTES = (krml_checked_int_t)32;
+
+Prims_int NaCl_crypto_box_MACBYTES = (krml_checked_int_t)16;
+
+Prims_int NaCl_crypto_secretbox_NONCEBYTES = (krml_checked_int_t)24;
+
+Prims_int NaCl_crypto_secretbox_KEYBYTES = (krml_checked_int_t)32;
+
+Prims_int NaCl_crypto_secretbox_MACBYTES = (krml_checked_int_t)16;
+
+uint32_t
+NaCl_crypto_secretbox_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_detached(c, mac, m, mlen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_secretbox_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_open_detached(m, c, mac, clen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_secretbox_easy(uint8_t *c, uint8_t *m, uint64_t mlen, uint8_t *n1, uint8_t *k1)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_easy(c, m, mlen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_secretbox_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_SecretBox_ZeroPad_crypto_secretbox_open_easy(m, c, clen, n1, k1);
+}
+
+uint32_t NaCl_crypto_box_beforenm(uint8_t *k1, uint8_t *pk, uint8_t *sk)
+{
+  return Hacl_Box_ZeroPad_crypto_box_beforenm(k1, pk, sk);
+}
+
+uint32_t
+NaCl_crypto_box_detached_afternm(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_detached_afternm(c, mac, m, mlen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_box_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_detached(c, mac, m, mlen, n1, pk, sk);
+}
+
+uint32_t
+NaCl_crypto_box_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_open_detached(m, c, mac, mlen, n1, pk, sk);
+}
+
+uint32_t
+NaCl_crypto_box_easy_afternm(uint8_t *c, uint8_t *m, uint64_t mlen, uint8_t *n1, uint8_t *k1)
+{
+  return Hacl_Box_ZeroPad_crypto_box_easy_afternm(c, m, mlen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_box_easy(
+  uint8_t *c,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_easy(c, m, mlen, n1, pk, sk);
+}
+
+uint32_t
+NaCl_crypto_box_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_open_easy(m, c, mlen, n1, pk, sk);
+}
+
+uint32_t
+NaCl_crypto_box_open_detached_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_open_detached_afternm(m, c, mac, mlen, n1, k1);
+}
+
+uint32_t
+NaCl_crypto_box_open_easy_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+)
+{
+  return Hacl_Box_ZeroPad_crypto_box_open_easy_afternm(m, c, mlen, n1, k1);
+}
+
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.h
new file mode 100644
index 000000000..bdd92d496
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/NaCl.h
@@ -0,0 +1,156 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+
+#include "kremlib.h"
+#ifndef __NaCl_H
+#define __NaCl_H
+
+
+#include "Hacl_Salsa20.h"
+#include "Hacl_Curve25519.h"
+#include "Hacl_Poly1305_64.h"
+#include "Hacl_Policies.h"
+
+
+extern Prims_int NaCl_crypto_box_NONCEBYTES;
+
+extern Prims_int NaCl_crypto_box_PUBLICKEYBYTES;
+
+extern Prims_int NaCl_crypto_box_SECRETKEYBYTES;
+
+extern Prims_int NaCl_crypto_box_MACBYTES;
+
+extern Prims_int NaCl_crypto_secretbox_NONCEBYTES;
+
+extern Prims_int NaCl_crypto_secretbox_KEYBYTES;
+
+extern Prims_int NaCl_crypto_secretbox_MACBYTES;
+
+uint32_t
+NaCl_crypto_secretbox_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+
+uint32_t
+NaCl_crypto_secretbox_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+
+uint32_t
+NaCl_crypto_secretbox_easy(uint8_t *c, uint8_t *m, uint64_t mlen, uint8_t *n1, uint8_t *k1);
+
+uint32_t
+NaCl_crypto_secretbox_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t clen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+
+uint32_t NaCl_crypto_box_beforenm(uint8_t *k1, uint8_t *pk, uint8_t *sk);
+
+uint32_t
+NaCl_crypto_box_detached_afternm(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+
+uint32_t
+NaCl_crypto_box_detached(
+  uint8_t *c,
+  uint8_t *mac,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+);
+
+uint32_t
+NaCl_crypto_box_open_detached(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+);
+
+uint32_t
+NaCl_crypto_box_easy_afternm(uint8_t *c, uint8_t *m, uint64_t mlen, uint8_t *n1, uint8_t *k1);
+
+uint32_t
+NaCl_crypto_box_easy(
+  uint8_t *c,
+  uint8_t *m,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+);
+
+uint32_t
+NaCl_crypto_box_open_easy(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *pk,
+  uint8_t *sk
+);
+
+uint32_t
+NaCl_crypto_box_open_detached_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint8_t *mac,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+
+uint32_t
+NaCl_crypto_box_open_easy_afternm(
+  uint8_t *m,
+  uint8_t *c,
+  uint64_t mlen,
+  uint8_t *n1,
+  uint8_t *k1
+);
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/config/discover.ml b/vendors/tezos-modded/vendors/ocaml-hacl/src/config/discover.ml
new file mode 100644
index 000000000..61643e99a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/config/discover.ml
@@ -0,0 +1,11 @@
+let () =
+  (* inspired by https://github.com/vbmithr/ocaml-secp256k1-internal/blob/master/config/discover.ml *)
+  let ccopts = "-Ofast -mtune=generic -fwrapv -fomit-frame-pointer -funroll-loops -Wall -Werror -Wfatal-errors" in
+  (* the important bit is -DKRML_NOUINT128 which enables the verified (but slow) implementation of UInt128 in FStar.c rather than the builtin __int128 which is only available on 64-bit platforms. *)
+  let ccopts32 = "-Ofast -fwrapv -fomit-frame-pointer -funroll-loops -DKRML_NOUINT128 -Wall -Werror -Wfatal-errors" in
+
+  let oc = open_out "c_flags.sexp" in
+  let sixtyfour = Sys.word_size = 64 in
+  let flags = if sixtyfour then ccopts else ccopts32 in
+  Printf.fprintf oc "(%s)%!" flags ;
+  close_out oc
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/config/dune b/vendors/tezos-modded/vendors/ocaml-hacl/src/config/dune
new file mode 100644
index 000000000..4236bf577
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/config/dune
@@ -0,0 +1,3 @@
+(executable
+ (name discover)
+ (libraries base stdio))
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/dune b/vendors/tezos-modded/vendors/ocaml-hacl/src/dune
new file mode 100644
index 000000000..d32ccbaba
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/dune
@@ -0,0 +1,29 @@
+(library
+ (name            hacl)
+ (public_name     hacl)
+ (libraries       bigstring ocplib-endian.bigstring zarith)
+ (c_names         hacl_stubs
+                  kremlib
+                  FStar
+                  Hacl_Policies
+                  AEAD_Poly1305_64
+                  Hacl_Chacha20
+                  Hacl_Chacha20Poly1305
+                  Hacl_Curve25519
+                  Hacl_Ed25519
+                  Hacl_Poly1305_32
+                  Hacl_Poly1305_64
+                  Hacl_SHA2_256
+                  Hacl_SHA2_384
+                  Hacl_SHA2_512
+                  Hacl_HMAC_SHA2_256
+                  Hacl_Salsa20
+                  NaCl
+                  Hacl_Unverified_Random)
+ (c_flags         (:include c_flags.sexp))
+ )
+
+; sets flags for 32/64 bits architectures
+(rule
+ (targets c_flags.sexp)
+ (action  (run %{exe:config/discover.exe} -ocamlc %{ocamlc})))
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.ml b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.ml
new file mode 100644
index 000000000..f908ce296
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.ml
@@ -0,0 +1,472 @@
+(* Copyright 2018 Vincent Bernardoff, Marco Stronati.
+ *
+ * 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 EndianBigstring
+
+module Rand = struct
+  external write : Bigstring.t -> unit =
+    "ml_randombytes" [@@noalloc]
+
+  let gen len =
+    let buf = Bigstring.create len in
+    write buf ;
+    buf
+end
+
+module Hash = struct
+  module type HASH = sig
+    val init : Bigstring.t -> unit
+    val update : Bigstring.t -> Bigstring.t -> unit
+    val update_last : Bigstring.t -> Bigstring.t -> int -> unit
+    val finish : Bigstring.t -> Bigstring.t -> unit
+
+    val bytes : int
+    val blockbytes : int
+    val statebytes : int
+  end
+
+  module Make(S: HASH) = struct
+    type state = {
+      state : Bigstring.t ;
+      buf : Bigstring.t ;
+      mutable pos : int ;
+    }
+
+    let bytes = S.bytes
+    let blockbytes = S.blockbytes
+    let statebytes = S.statebytes
+
+    let init () =
+      let state = Bigstring.create S.statebytes in
+      let buf = Bigstring.create S.blockbytes in
+      S.init state ;
+      { state ; buf ; pos = 0 }
+
+    let rec update ({ state ; buf ; pos } as st) m p l =
+      if pos + l < S.blockbytes then begin
+        Bigstring.blit m p buf pos l ;
+        st.pos <- st.pos + l
+      end
+      else begin
+        let nb_consumed = S.blockbytes - pos in
+        Bigstring.blit m p buf pos nb_consumed ;
+        S.update state buf ;
+        st.pos <- 0 ;
+        update st m (p + nb_consumed) (l - nb_consumed)
+      end
+
+    let update st msg =
+      update st msg 0 (Bigstring.length msg)
+
+    let finish { state ; buf ; pos } =
+      S.update_last state buf pos ;
+      S.finish state buf ;
+      Bigstring.sub buf 0 S.bytes
+
+    let digest msg =
+      let st = init () in
+      update st msg ;
+      finish st
+  end
+
+  module type S = sig
+    type state
+
+    val bytes : int
+    val blockbytes : int
+    val statebytes : int
+
+    (** Incremental Interface *)
+
+    val init : unit -> state
+    val update : state -> Bigstring.t -> unit
+    val finish : state -> Bigstring.t
+
+    (** Direct Interface *)
+
+    val digest : Bigstring.t -> Bigstring.t
+
+    module HMAC : sig
+      val write :
+        key:Bigstring.t -> msg:Bigstring.t -> Bigstring.t -> unit
+      (** @raise [Invalid_argument] if argument is less than 32 bytes long *)
+
+      val digest :
+        key:Bigstring.t -> msg:Bigstring.t -> Bigstring.t
+    end
+  end
+
+  module SHA256 = struct
+    module H = Make(struct
+        (* state -> unit *)
+        external init : Bigstring.t -> unit =
+          "ml_Hacl_SHA2_256_init" [@@noalloc]
+
+        (* state -> data -> unit *)
+        external update : Bigstring.t -> Bigstring.t -> unit =
+          "ml_Hacl_SHA2_256_update" [@@noalloc]
+
+        (* state -> data -> datalen -> unit *)
+        external update_last : Bigstring.t -> Bigstring.t -> int -> unit =
+          "ml_Hacl_SHA2_256_update_last" [@@noalloc]
+
+        (* state -> hash *)
+        external finish : Bigstring.t -> Bigstring.t -> unit =
+          "ml_Hacl_SHA2_256_finish" [@@noalloc]
+
+        let bytes = 32
+        let blockbytes = 64
+        let statebytes = 137 * 4
+      end)
+    include H
+
+    module HMAC = struct
+      (* mac -> key -> data *)
+      external hmac :
+        Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+        "ml_Hacl_HMAC_SHA2_256_hmac" [@@noalloc]
+
+      let write ~key ~msg buf =
+        let buflen = Bigstring.length buf in
+        if buflen < 32 then
+          invalid_arg (Printf.sprintf "Hash.SHA256.HMAC.write: invalid \
+                                       len (%d), expected %d" buflen bytes) ;
+        hmac buf key msg
+
+      let digest ~key ~msg =
+        let buf = Bigstring.create 32 in
+        write ~key ~msg buf ;
+        buf
+    end
+  end
+
+  module SHA512 = struct
+    module H = Make(struct
+        (* state -> unit *)
+        external init : Bigstring.t -> unit =
+          "ml_Hacl_SHA2_512_init" [@@noalloc]
+
+        (* state -> data -> unit *)
+        external update : Bigstring.t -> Bigstring.t -> unit =
+          "ml_Hacl_SHA2_512_update" [@@noalloc]
+
+        (* state -> data -> datalen -> unit *)
+        external update_last : Bigstring.t -> Bigstring.t -> int -> unit =
+          "ml_Hacl_SHA2_512_update_last" [@@noalloc]
+
+        (* state -> hash *)
+        external finish : Bigstring.t -> Bigstring.t -> unit =
+          "ml_Hacl_SHA2_512_finish" [@@noalloc]
+
+        let bytes = 64
+        let blockbytes = 128
+        let statebytes = 169 * 8
+      end)
+    include H
+
+    module HMAC = struct
+      let derive_key k =
+        let buf = Bigstring.create blockbytes in
+        Bigstring.fill buf '\x00' ;
+        let keylen = Bigstring.length k in
+        let k, keylen =
+          if keylen > blockbytes then H.digest k, bytes else k, keylen in
+        Bigstring.blit k 0 buf 0 keylen ;
+        buf
+
+      let xor_ipad =
+        Bigstring.map ~f:(fun c -> Char.(chr ((code c) lxor 0x36)))
+      let xor_opad =
+        Bigstring.map ~f:(fun c -> Char.(chr ((code c) lxor 0x5c)))
+
+      let digest ~key ~msg =
+        let key = derive_key key in
+        let preimage =
+          Bigstring.concat "" [
+            xor_opad key ;
+            digest (Bigstring.concat "" [xor_ipad key ; msg])
+          ] in
+        digest preimage
+
+      let write ~key ~msg buf =
+        let buflen = Bigstring.length buf in
+        if buflen < bytes then
+          invalid_arg (Printf.sprintf "Hash.SHA512.HMAC.write: invalid \
+                                       len (%d), expected %d" buflen bytes) ;
+        let d = digest ~key ~msg in
+        Bigstring.blit d 0 buf 0 bytes
+    end
+  end
+end
+
+module Nonce = struct
+  type t = Bigstring.t
+  let bytes = 24
+
+  let gen () =
+    Rand.gen bytes
+
+  let rec incr_byte b step byteno =
+    let res = BigEndian.get_uint16 b byteno + step in
+    let lo = res land 0xffff in
+    let hi = res asr 16 in
+    BigEndian.set_int16 b byteno lo ;
+    if hi = 0 || byteno = 0 then ()
+    else incr_byte b hi (byteno - 2)
+
+  let increment ?(step = 1) nonce =
+    let new_nonce = Bigstring.create 24 in
+    Bigstring.blit nonce 0 new_nonce 0 24 ;
+    incr_byte new_nonce step 22 ;
+    new_nonce
+
+  let of_bytes buf =
+    if Bigstring.length buf <> bytes then None else Some buf
+
+  let of_bytes_exn buf =
+    match of_bytes buf with
+    | Some s -> s
+    | None -> invalid_arg "Hacl.Nonce.of_bytes_exn: invalid length"
+
+end
+
+module Secretbox = struct
+  type key = Bigstring.t
+
+  let keybytes = 32
+  let zerobytes = 32
+  let boxzerobytes = 16
+
+  let unsafe_of_bytes buf =
+    if Bigstring.length buf <> keybytes then
+      invalid_arg (Printf.sprintf "Secretbox.unsafe_of_bytes: buffer \
+                                   must be %d bytes long" keybytes) ;
+    buf
+
+  let blit_of_bytes buf pos =
+    if Bigstring.length buf < keybytes then
+      invalid_arg (Printf.sprintf "Secretbox.blit_of_bytes: buffer \
+                                   must be at least %d bytes long" keybytes) ;
+    let key = Bigstring.create keybytes in
+    Bigstring.blit buf pos key 0 keybytes ;
+    key
+
+  let genkey () = Rand.gen 32
+
+  (* c -> m -> n -> k -> unit *)
+  external box :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+    "ml_NaCl_crypto_secretbox_easy" [@@noalloc]
+
+  (* m -> c -> mac -> n -> k -> int *)
+  external box_open :
+    Bigstring.t -> Bigstring.t -> Bigstring.t ->
+    Bigstring.t -> Bigstring.t -> int =
+    "ml_NaCl_crypto_secretbox_open_detached" [@@noalloc]
+
+  let box ~key ~nonce ~msg ~cmsg =
+    box cmsg msg nonce key
+
+  let box_open ~key ~nonce ~cmsg ~msg =
+    let mac = Bigstring.sub cmsg boxzerobytes boxzerobytes in
+    match box_open msg cmsg mac nonce key with
+    | 0 -> true
+    | _ -> false
+end
+
+type secret
+type public
+
+module Box = struct
+  type combined
+  type _ key =
+    | Sk : Bigstring.t -> secret key
+    | Pk : Bigstring.t -> public key
+    | Ck : Bigstring.t -> combined key
+
+  let skbytes = 32
+  let pkbytes = 32
+  let ckbytes = 32
+  let zerobytes = 32
+  let boxzerobytes = 16
+
+  let unsafe_to_bytes : type a. a key -> Bigstring.t = function
+    | Pk buf -> buf
+    | Sk buf -> buf
+    | Ck buf -> buf
+
+  let blit_to_bytes :
+    type a. a key -> ?pos:int -> Bigstring.t -> unit = fun key ?(pos=0) buf ->
+    match key with
+    | Pk pk -> Bigstring.blit pk 0 buf pos pkbytes
+    | Sk sk -> Bigstring.blit sk 0 buf pos skbytes
+    | Ck ck -> Bigstring.blit ck 0 buf pos ckbytes
+
+  let equal :
+    type a. a key -> a key -> bool = fun a b -> match a, b with
+    | Pk a, Pk b -> Bigstring.equal a b
+    | Sk a, Sk b -> Bigstring.equal a b
+    | Ck a, Ck b -> Bigstring.equal a b
+
+  let unsafe_sk_of_bytes buf =
+    if Bigstring.length buf <> skbytes then
+      invalid_arg (Printf.sprintf "Box.unsafe_sk_of_bytes: buffer must \
+                                   be %d bytes long" skbytes) ;
+    Sk buf
+
+  let unsafe_pk_of_bytes buf =
+    if Bigstring.length buf <> pkbytes then
+      invalid_arg (Printf.sprintf "Box.unsafe_pk_of_bytes: buffer must \
+                                   be %d bytes long" pkbytes) ;
+    Pk buf
+
+  let unsafe_ck_of_bytes buf =
+    if Bigstring.length buf <> ckbytes then
+      invalid_arg (Printf.sprintf "Box.unsafe_ck_of_bytes: buffer must \
+                                   be %d bytes long" ckbytes) ;
+    Ck buf
+
+  let of_seed ?(pos=0) buf =
+    let buflen = Bigstring.length buf in
+    if pos < 0 || pos + skbytes > buflen then
+      invalid_arg (Printf.sprintf "Box.of_seed: invalid pos (%d) or \
+                                   buffer size (%d)" pos buflen) ;
+    let sk = Bigstring.create skbytes in
+    Bigstring.blit buf pos sk 0 skbytes ;
+    Sk sk
+
+  let basepoint =
+    Bigstring.init 32 (function 0 -> '\x09' | _ -> '\x00')
+
+  (* pk -> sk -> basepoint -> unit *)
+  external scalarmult :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+    "ml_Hacl_Curve25519_crypto_scalarmult" [@@noalloc]
+
+  let neuterize (Sk sk) =
+    let pk = Bigstring.create pkbytes in
+    scalarmult pk sk basepoint ;
+    Pk pk
+
+  let keypair () =
+    let sk = Sk (Rand.gen skbytes) in
+    neuterize sk, sk
+
+  (* ck -> pk -> sk -> unit *)
+  external box_beforenm :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+    "ml_NaCl_crypto_box_beforenm" [@@noalloc]
+
+  let dh (Pk pk) (Sk sk) =
+    let combined = Bigstring.create ckbytes in
+    box_beforenm combined pk sk ;
+    Ck combined
+
+  (* cmsg -> msg -> nonce -> k -> unit *)
+  external box_easy_afternm :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+    "ml_NaCl_crypto_box_easy_afternm" [@@noalloc]
+
+  let box ~k:(Ck k) ~nonce ~msg ~cmsg =
+    box_easy_afternm cmsg msg nonce k
+
+  (* msg -> cmsg -> n -> k -> int *)
+  external box_open_easy_afternm :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> int =
+    "ml_NaCl_crypto_box_open_easy_afternm" [@@noalloc]
+
+  let box_open ~k:(Ck k) ~nonce ~cmsg ~msg =
+    match box_open_easy_afternm msg cmsg nonce k with
+    | 0 -> true
+    | _ -> false
+end
+
+module Sign = struct
+  type _ key =
+    | Sk : Bigstring.t -> secret key
+    | Pk : Bigstring.t -> public key
+
+  let bytes = 64
+  let pkbytes = 32
+  let skbytes = 32
+
+  let unsafe_to_bytes : type a. a key -> Bigstring.t = function
+    | Pk buf -> buf
+    | Sk buf -> buf
+
+  let unsafe_sk_of_bytes seed =
+    if Bigstring.length seed <> skbytes then
+      invalid_arg (Printf.sprintf "Sign.unsafe_sk_of_bytes: sk must \
+                                   be at least %d bytes long" skbytes) ;
+    Sk seed
+
+  let unsafe_pk_of_bytes pk =
+    if Bigstring.length pk <> pkbytes then
+      invalid_arg (Printf.sprintf "Sign.unsafe_pk_of_bytes: pk must be \
+                                   at least %d bytes long" pkbytes) ;
+    Pk pk
+
+  let blit_to_bytes :
+    type a. a key -> ?pos:int -> Bigstring.t -> unit = fun key ?(pos=0) buf ->
+    match key with
+    | Pk pk -> Bigstring.blit pk 0 buf pos pkbytes
+    | Sk sk -> Bigstring.blit sk 0 buf pos skbytes
+
+  let equal :
+    type a. a key -> a key -> bool = fun a b -> match a, b with
+    | Pk a, Pk b -> Bigstring.equal a b
+    | Sk a, Sk b -> Bigstring.equal a b
+
+  (* pk -> sk -> unit *)
+  external neuterize :
+    Bigstring.t -> Bigstring.t -> unit =
+    "ml_Hacl_Ed25519_secret_to_public" [@@noalloc]
+
+  let neuterize : type a. a key -> public key = function
+    | Pk pk -> Pk pk
+    | Sk sk ->
+        let pk = Bigstring.create pkbytes in
+        neuterize pk sk ;
+        Pk pk
+
+  let keypair () =
+    let sk = Sk (Rand.gen skbytes) in
+    neuterize sk, sk
+
+  (* sig -> sk -> m -> unit *)
+  external sign :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> unit =
+    "ml_Hacl_Ed25519_sign" [@@noalloc]
+
+  let sign ~sk:(Sk sk) ~msg ~signature =
+    if Bigstring.length signature < bytes then
+      invalid_arg (Printf.sprintf "Sign.write_sign: output buffer must \
+                                   be at least %d bytes long" bytes) ;
+    sign signature sk msg
+
+  (* pk -> m -> sig -> bool *)
+  external verify :
+    Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
+    "ml_Hacl_Ed25519_verify" [@@noalloc]
+
+  let verify ~pk:(Pk pk) ~msg ~signature =
+    verify pk msg signature
+end
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.mli b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.mli
new file mode 100644
index 000000000..c95a53709
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl.mli
@@ -0,0 +1,176 @@
+(* Copyright 2018 Vincent Bernardoff, Marco Stronati.
+ *
+ * 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. *)
+
+module Rand : sig
+  val write : Bigstring.t -> unit
+  (** [write buf] writes random bytes on [buf]. *)
+
+  val gen : int -> Bigstring.t
+  (** [gen len] is a random buffer of length [len]. *)
+end
+
+module Hash : sig
+  module type S = sig
+    type state
+
+    val bytes : int
+    val blockbytes : int
+    val statebytes : int
+
+    (** Incremental Interface *)
+
+    val init : unit -> state
+    val update : state -> Bigstring.t -> unit
+    val finish : state -> Bigstring.t
+
+    (** Direct Interface *)
+
+    val digest : Bigstring.t -> Bigstring.t
+
+    module HMAC : sig
+      val write :
+        key:Bigstring.t -> msg:Bigstring.t -> Bigstring.t -> unit
+      (** @raise [Invalid_argument] if argument is less than 32 bytes long *)
+
+      val digest :
+        key:Bigstring.t -> msg:Bigstring.t -> Bigstring.t
+    end
+  end
+
+  module SHA256 : S
+  module SHA512 : S
+end
+
+module Nonce : sig
+  type t = Bigstring.t
+  val bytes : int
+  val gen : unit -> t
+  val increment : ?step:int -> t -> t
+  val of_bytes : Bigstring.t -> t option
+  val of_bytes_exn : Bigstring.t -> t
+end
+
+module Secretbox : sig
+  type key
+
+  val keybytes : int
+  val zerobytes : int
+  val boxzerobytes : int
+
+  val unsafe_of_bytes : Bigstring.t -> key
+  (** @raise Invalid_argument if argument is not [keybytes] bytes long *)
+
+  val blit_of_bytes : Bigstring.t -> int -> key
+  (** @raise Invalid_argument if argument is not [keybytes] bytes long *)
+
+  val genkey : unit -> key
+
+  val box :
+    key:key -> nonce:Bigstring.t ->
+    msg:Bigstring.t -> cmsg:Bigstring.t -> unit
+
+  val box_open :
+    key:key -> nonce:Bigstring.t ->
+    cmsg:Bigstring.t -> msg:Bigstring.t -> bool
+end
+
+type secret
+type public
+
+module Box : sig
+  type combined
+  type _ key
+
+  val skbytes : int
+  val pkbytes : int
+  val ckbytes : int
+  val zerobytes : int
+  val boxzerobytes : int
+
+  val equal : 'a key -> 'a key -> bool
+
+  val unsafe_to_bytes : _ key -> Bigstring.t
+  (** [unsafe_to_bytes k] is the internal [Bigstring.t] where the key
+      is stored. DO NOT MODIFY. *)
+
+  val blit_to_bytes : _ key -> ?pos:int -> Bigstring.t -> unit
+
+  val unsafe_sk_of_bytes : Bigstring.t -> secret key
+  (** @raise Invalid_argument if argument is not [skbytes] bytes long *)
+
+  val unsafe_pk_of_bytes : Bigstring.t -> public key
+  (** @raise Invalid_argument if argument is not [pkbytes] bytes long *)
+
+  val unsafe_ck_of_bytes : Bigstring.t -> combined key
+  (** @raise Invalid_argument if argument is not [ckbytes] bytes long *)
+
+  val of_seed : ?pos:int -> Bigstring.t -> secret key
+  (** @raise Invalid_argument if [pos] is outside the buffer or the buffer
+      is less than [skbytes] bytes long *)
+
+  val neuterize : secret key -> public key
+  val keypair : unit -> public key * secret key
+  val dh : public key -> secret key -> combined key
+
+  val box :
+    k:combined key -> nonce:Bigstring.t ->
+    msg:Bigstring.t -> cmsg:Bigstring.t -> unit
+
+  val box_open :
+    k:combined key -> nonce:Bigstring.t ->
+    cmsg:Bigstring.t -> msg:Bigstring.t -> bool
+end
+
+module Sign : sig
+  type _ key
+
+  val bytes : int
+  val pkbytes : int
+  val skbytes : int
+
+  val equal : 'a key -> 'a key -> bool
+
+  val unsafe_sk_of_bytes : Bigstring.t -> secret key
+  (** @raise Invalid_argument if argument is less than [skbytes] bytes long *)
+
+  val unsafe_pk_of_bytes : Bigstring.t -> public key
+  (** @raise Invalid_argument if argument is less than [pkbytes] bytes long *)
+
+  val unsafe_to_bytes : _ key -> Bigstring.t
+  (** [unsafe_to_bytes k] is the internal [Bigstring.t] where the key
+      is stored. DO NOT MODIFY. *)
+
+  val blit_to_bytes : _ key -> ?pos:int -> Bigstring.t -> unit
+
+  val neuterize : _ key -> public key
+  val keypair : unit -> public key * secret key
+
+  val sign :
+    sk:secret key -> msg:Bigstring.t -> signature:Bigstring.t -> unit
+  (** [sign sk msg buf] writes the signature of [msg] with [sk] at
+      [buf].
+
+      @raises Invalid_argument if [buf] is smaller than [bytes]
+      bytes long. *)
+
+  val verify :
+    pk:public key -> msg:Bigstring.t -> signature:Bigstring.t -> bool
+end
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl_stubs.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl_stubs.c
new file mode 100644
index 000000000..e1328d39e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/hacl_stubs.c
@@ -0,0 +1,165 @@
+/* Copyright 2018 Vincent Bernardoff, Marco Stronati.
+ *
+ * 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.
+ */
+
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+#include "Hacl_Unverified_Random.h"
+CAMLprim value ml_randombytes(value buf) {
+    randombytes(Caml_ba_data_val(buf),
+                Caml_ba_array_val(buf)->dim[0]);
+    return Val_unit;
+}
+
+#include "Hacl_HMAC_SHA2_256.h"
+CAMLprim value ml_Hacl_HMAC_SHA2_256_hmac(value mac, value key, value data) {
+    Hacl_HMAC_SHA2_256_hmac(Caml_ba_data_val(mac),
+                            Caml_ba_data_val(key),
+                            Caml_ba_array_val(key)->dim[0],
+                            Caml_ba_data_val(data),
+                            Caml_ba_array_val(data)->dim[0]);
+    return Val_unit;
+}
+
+#include "Hacl_SHA2_256.h"
+CAMLprim value ml_Hacl_SHA2_256_init(value state) {
+    Hacl_SHA2_256_init(Caml_ba_data_val(state));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_256_update(value state, value data) {
+    Hacl_SHA2_256_update(Caml_ba_data_val(state),
+                         Caml_ba_data_val(data));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_256_update_last(value state, value data, value datalen) {
+    Hacl_SHA2_256_update_last(Caml_ba_data_val(state),
+                              Caml_ba_data_val(data),
+                              Int_val(datalen));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_256_finish(value state, value hash) {
+    Hacl_SHA2_256_finish(Caml_ba_data_val(state),
+                         Caml_ba_data_val(hash));
+    return Val_unit;
+}
+
+#include "Hacl_SHA2_512.h"
+CAMLprim value ml_Hacl_SHA2_512_init(value state) {
+    Hacl_SHA2_512_init(Caml_ba_data_val(state));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_512_update(value state, value data) {
+    Hacl_SHA2_512_update(Caml_ba_data_val(state),
+                         Caml_ba_data_val(data));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_512_update_last(value state, value data, value datalen) {
+    Hacl_SHA2_512_update_last(Caml_ba_data_val(state),
+                              Caml_ba_data_val(data),
+                              Int_val(datalen));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_SHA2_512_finish(value state, value hash) {
+    Hacl_SHA2_512_finish(Caml_ba_data_val(state),
+                         Caml_ba_data_val(hash));
+    return Val_unit;
+}
+
+#include "Hacl_Curve25519.h"
+CAMLprim value ml_Hacl_Curve25519_crypto_scalarmult(value pk, value sk, value basepoint) {
+    Hacl_Curve25519_crypto_scalarmult(Caml_ba_data_val(pk),
+                                      Caml_ba_data_val(sk),
+                                      Caml_ba_data_val(basepoint));
+    return Val_unit;
+}
+
+#include "NaCl.h"
+CAMLprim value ml_NaCl_crypto_secretbox_easy(value c, value m, value n, value k) {
+    NaCl_crypto_secretbox_easy(Caml_ba_data_val(c),
+			       Caml_ba_data_val(m),
+			       Caml_ba_array_val(m)->dim[0] - 32,
+			       Caml_ba_data_val(n),
+			       Caml_ba_data_val(k));
+    return Val_unit;
+}
+
+CAMLprim value ml_NaCl_crypto_secretbox_open_detached(value m, value c, value mac,
+						      value n, value k) {
+    return Val_int(NaCl_crypto_secretbox_open_detached(Caml_ba_data_val(m),
+						       Caml_ba_data_val(c),
+						       Caml_ba_data_val(mac),
+						       Caml_ba_array_val(c)->dim[0] - 32,
+						       Caml_ba_data_val(n),
+						       Caml_ba_data_val(k)));
+}
+
+CAMLprim value ml_NaCl_crypto_box_beforenm(value k, value pk, value sk) {
+    NaCl_crypto_box_beforenm(Caml_ba_data_val(k),
+                             Caml_ba_data_val(pk),
+                             Caml_ba_data_val(sk));
+    return Val_unit;
+}
+
+CAMLprim value ml_NaCl_crypto_box_easy_afternm(value c, value m, value n, value k) {
+    NaCl_crypto_box_easy_afternm(Caml_ba_data_val(c),
+				 Caml_ba_data_val(m),
+				 Caml_ba_array_val(m)->dim[0] - 32,
+				 Caml_ba_data_val(n),
+				 Caml_ba_data_val(k));
+    return Val_unit;
+}
+
+CAMLprim value ml_NaCl_crypto_box_open_easy_afternm(value m, value c, value n, value k) {
+    return Val_int(NaCl_crypto_box_open_easy_afternm(Caml_ba_data_val(m),
+						     Caml_ba_data_val(c),
+						     Caml_ba_array_val(c)->dim[0] - 32,
+						     Caml_ba_data_val(n),
+						     Caml_ba_data_val(k)));
+}
+
+#include "Hacl_Ed25519.h"
+CAMLprim value ml_Hacl_Ed25519_secret_to_public(value pk, value sk) {
+    Hacl_Ed25519_secret_to_public(Caml_ba_data_val(pk),
+                                  Caml_ba_data_val(sk));
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_Ed25519_sign(value sig, value sk, value m) {
+    Hacl_Ed25519_sign(Caml_ba_data_val(sig),
+                      Caml_ba_data_val(sk),
+                      Caml_ba_data_val(m),
+                      Caml_ba_array_val(m)->dim[0]);
+    return Val_unit;
+}
+
+CAMLprim value ml_Hacl_Ed25519_verify(value pk, value m, value sig) {
+    return Val_bool(Hacl_Ed25519_verify(Caml_ba_data_val(pk),
+                                        Caml_ba_data_val(m),
+                                        Caml_ba_array_val(m)->dim[0],
+                                        Caml_ba_data_val(sig)));
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.c b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.c
new file mode 100644
index 000000000..d83d1ba2a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.c
@@ -0,0 +1,39 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+#include "kremlib.h"
+#include <stdlib.h>
+
+int exit_success = EXIT_SUCCESS;
+int exit_failure = EXIT_FAILURE;
+
+void print_string(const char *s) {
+  printf("%s", s);
+}
+
+void print_bytes(uint8_t *b, uint32_t len) {
+  uint32_t i;
+  for (i = 0; i < len; i++){
+    printf("%02x", b[i]);
+  }
+  printf("\n");
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.h
new file mode 100644
index 000000000..138846acd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib.h
@@ -0,0 +1,569 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+#ifndef __KREMLIB_H
+#define __KREMLIB_H
+
+#include "kremlib_base.h"
+
+
+/* For tests only: we might need this function to be forward-declared, because
+ * the dependency on WasmSupport appears very late, after SimplifyWasm, and
+ * sadly, after the topological order has been done. */
+void WasmSupport_check_buffer_size(uint32_t s);
+
+/******************************************************************************/
+/* Stubs to ease compilation of non-Low* code                                 */
+/******************************************************************************/
+
+/* Some types that KreMLin has no special knowledge of; many of them appear in
+ * signatures of ghost functions, meaning that it suffices to give them (any)
+ * definition. */
+typedef void *FStar_Seq_Base_seq, *Prims_prop, *FStar_HyperStack_mem,
+    *FStar_Set_set, *Prims_st_pre_h, *FStar_Heap_heap, *Prims_all_pre_h,
+    *FStar_TSet_set, *Prims_list, *FStar_Map_t, *FStar_UInt63_t_,
+    *FStar_Int63_t_, *FStar_UInt63_t, *FStar_Int63_t, *FStar_UInt_uint_t,
+    *FStar_Int_int_t, *FStar_HyperStack_stackref, *FStar_Bytes_bytes,
+    *FStar_HyperHeap_rid, *FStar_Heap_aref, *FStar_Monotonic_Heap_heap,
+    *FStar_Monotonic_Heap_aref, *FStar_Monotonic_HyperHeap_rid,
+    *FStar_Monotonic_HyperStack_mem, *FStar_Char_char_;
+
+typedef const char *Prims_string;
+
+/* For "bare" targets that do not have a C stdlib, the user might want to use
+ * [-add-include '"mydefinitions.h"'] and override these. */
+#ifndef KRML_HOST_PRINTF
+#  define KRML_HOST_PRINTF printf
+#endif
+
+#ifndef KRML_HOST_EXIT
+#  define KRML_HOST_EXIT exit
+#endif
+
+#ifndef KRML_HOST_MALLOC
+#  define KRML_HOST_MALLOC malloc
+#endif
+
+/* In statement position, exiting is easy. */
+#define KRML_EXIT                                                              \
+  do {                                                                         \
+    KRML_HOST_PRINTF("Unimplemented function at %s:%d\n", __FILE__, __LINE__); \
+    KRML_HOST_EXIT(254);                                                       \
+  } while (0)
+
+/* In expression position, use the comma-operator and a malloc to return an
+ * expression of the right size. KreMLin passes t as the parameter to the macro.
+ */
+#define KRML_EABORT(t, msg)                                                    \
+  (KRML_HOST_PRINTF("KreMLin abort at %s:%d\n%s\n", __FILE__, __LINE__, msg),  \
+   KRML_HOST_EXIT(255), *((t *)KRML_HOST_MALLOC(sizeof(t))))
+
+/* In FStar.Buffer.fst, the size of arrays is uint32_t, but it's a number of
+ * *elements*. Do an ugly, run-time check (some of which KreMLin can eliminate).
+ */
+#define KRML_CHECK_SIZE(elt, size)                                             \
+  if (((size_t)size) > SIZE_MAX / sizeof(elt)) {                               \
+    KRML_HOST_PRINTF(                                                          \
+        "Maximum allocatable size exceeded, aborting before overflow at "      \
+        "%s:%d\n",                                                             \
+        __FILE__, __LINE__);                                                   \
+    KRML_HOST_EXIT(253);                                                       \
+  }
+
+/* A series of GCC atrocities to trace function calls (kremlin's [-d c-calls]
+ * option). Useful when trying to debug, say, Wasm, to compare traces. */
+/* clang-format off */
+#ifdef __GNUC__
+#define KRML_FORMAT(X) _Generic((X),                                           \
+  uint8_t : "0x%08" PRIx8,                                                     \
+  uint16_t: "0x%08" PRIx16,                                                    \
+  uint32_t: "0x%08" PRIx32,                                                    \
+  uint64_t: "0x%08" PRIx64,                                                    \
+  int8_t  : "0x%08" PRIx8,                                                     \
+  int16_t : "0x%08" PRIx16,                                                    \
+  int32_t : "0x%08" PRIx32,                                                    \
+  int64_t : "0x%08" PRIx64,                                                    \
+  default : "%s")
+
+#define KRML_FORMAT_ARG(X) _Generic((X),                                       \
+  uint8_t : X,                                                                 \
+  uint16_t: X,                                                                 \
+  uint32_t: X,                                                                 \
+  uint64_t: X,                                                                 \
+  int8_t  : X,                                                                 \
+  int16_t : X,                                                                 \
+  int32_t : X,                                                                 \
+  int64_t : X,                                                                 \
+  default : "unknown")
+/* clang-format on */
+
+#  define KRML_DEBUG_RETURN(X)                                                 \
+    ({                                                                         \
+      __auto_type _ret = (X);                                                  \
+      KRML_HOST_PRINTF("returning: ");                                         \
+      KRML_HOST_PRINTF(KRML_FORMAT(_ret), KRML_FORMAT_ARG(_ret));              \
+      KRML_HOST_PRINTF(" \n");                                                 \
+      _ret;                                                                    \
+    })
+#endif
+
+#define FStar_Buffer_eqb(b1, b2, n)                                            \
+  (memcmp((b1), (b2), (n) * sizeof((b1)[0])) == 0)
+
+/* Stubs to make ST happy. Important note: you must generate a use of the macro
+ * argument, otherwise, you may have FStar_ST_recall(f) as the only use of f;
+ * KreMLin will think that this is a valid use, but then the C compiler, after
+ * macro expansion, will error out. */
+#define FStar_HyperHeap_root 0
+#define FStar_Pervasives_Native_fst(x) (x).fst
+#define FStar_Pervasives_Native_snd(x) (x).snd
+#define FStar_Seq_Base_createEmpty(x) 0
+#define FStar_Seq_Base_create(len, init) 0
+#define FStar_Seq_Base_upd(s, i, e) 0
+#define FStar_Seq_Base_eq(l1, l2) 0
+#define FStar_Seq_Base_length(l1) 0
+#define FStar_Seq_Base_append(x, y) 0
+#define FStar_Seq_Base_slice(x, y, z) 0
+#define FStar_Seq_Properties_snoc(x, y) 0
+#define FStar_Seq_Properties_cons(x, y) 0
+#define FStar_Seq_Base_index(x, y) 0
+#define FStar_HyperStack_is_eternal_color(x) 0
+#define FStar_Monotonic_HyperHeap_root 0
+#define FStar_Buffer_to_seq_full(x) 0
+#define FStar_Buffer_recall(x)
+#define FStar_HyperStack_ST_op_Colon_Equals(x, v) KRML_EXIT
+#define FStar_HyperStack_ST_op_Bang(x) 0
+#define FStar_HyperStack_ST_salloc(x) 0
+#define FStar_HyperStack_ST_ralloc(x, y) 0
+#define FStar_HyperStack_ST_new_region(x) (0)
+#define FStar_Monotonic_RRef_m_alloc(x)                                        \
+  { 0 }
+
+#define FStar_HyperStack_ST_recall(x)                                          \
+  do {                                                                         \
+    (void)(x);                                                                 \
+  } while (0)
+
+#define FStar_HyperStack_ST_recall_region(x)                                   \
+  do {                                                                         \
+    (void)(x);                                                                 \
+  } while (0)
+
+#define FStar_Monotonic_RRef_m_recall(x1, x2)                                  \
+  do {                                                                         \
+    (void)(x1);                                                                \
+    (void)(x2);                                                                \
+  } while (0)
+
+#define FStar_Monotonic_RRef_m_write(x1, x2, x3, x4, x5)                       \
+  do {                                                                         \
+    (void)(x1);                                                                \
+    (void)(x2);                                                                \
+    (void)(x3);                                                                \
+    (void)(x4);                                                                \
+    (void)(x5);                                                                \
+  } while (0)
+
+/******************************************************************************/
+/* Endian-ness macros that can only be implemented in C                       */
+/******************************************************************************/
+
+/* ... for Linux */
+#if defined(__linux__) || defined(__CYGWIN__)
+#  include <endian.h>
+
+/* ... for OSX */
+#elif defined(__APPLE__)
+#  include <libkern/OSByteOrder.h>
+#  define htole64(x) OSSwapHostToLittleInt64(x)
+#  define le64toh(x) OSSwapLittleToHostInt64(x)
+#  define htobe64(x) OSSwapHostToBigInt64(x)
+#  define be64toh(x) OSSwapBigToHostInt64(x)
+
+#  define htole16(x) OSSwapHostToLittleInt16(x)
+#  define le16toh(x) OSSwapLittleToHostInt16(x)
+#  define htobe16(x) OSSwapHostToBigInt16(x)
+#  define be16toh(x) OSSwapBigToHostInt16(x)
+
+#  define htole32(x) OSSwapHostToLittleInt32(x)
+#  define le32toh(x) OSSwapLittleToHostInt32(x)
+#  define htobe32(x) OSSwapHostToBigInt32(x)
+#  define be32toh(x) OSSwapBigToHostInt32(x)
+
+/* ... for Solaris */
+#elif defined(__sun__)
+#  include <sys/byteorder.h>
+#  define htole64(x) LE_64(x)
+#  define le64toh(x) LE_64(x)
+#  define htobe64(x) BE_64(x)
+#  define be64toh(x) BE_64(x)
+
+#  define htole16(x) LE_16(x)
+#  define le16toh(x) LE_16(x)
+#  define htobe16(x) BE_16(x)
+#  define be16toh(x) BE_16(x)
+
+#  define htole32(x) LE_32(x)
+#  define le32toh(x) LE_32(x)
+#  define htobe32(x) BE_32(x)
+#  define be32toh(x) BE_32(x)
+
+/* ... for the BSDs */
+#elif defined(__FreeBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
+#  include <sys/endian.h>
+#elif defined(__OpenBSD__)
+#  include <endian.h>
+
+/* ... for Windows (MSVC)... not targeting XBOX 360! */
+#elif defined(_MSC_VER)
+
+#  include <stdlib.h>
+#  define htobe16(x) _byteswap_ushort(x)
+#  define htole16(x) (x)
+#  define be16toh(x) _byteswap_ushort(x)
+#  define le16toh(x) (x)
+
+#  define htobe32(x) _byteswap_ulong(x)
+#  define htole32(x) (x)
+#  define be32toh(x) _byteswap_ulong(x)
+#  define le32toh(x) (x)
+
+#  define htobe64(x) _byteswap_uint64(x)
+#  define htole64(x) (x)
+#  define be64toh(x) _byteswap_uint64(x)
+#  define le64toh(x) (x)
+
+/* ... for Windows (GCC-like, e.g. mingw or clang) */
+#elif (defined(_WIN32) || defined(_WIN64)) &&                                  \
+    (defined(__GNUC__) || defined(__clang__))
+
+#  define htobe16(x) __builtin_bswap16(x)
+#  define htole16(x) (x)
+#  define be16toh(x) __builtin_bswap16(x)
+#  define le16toh(x) (x)
+
+#  define htobe32(x) __builtin_bswap32(x)
+#  define htole32(x) (x)
+#  define be32toh(x) __builtin_bswap32(x)
+#  define le32toh(x) (x)
+
+#  define htobe64(x) __builtin_bswap64(x)
+#  define htole64(x) (x)
+#  define be64toh(x) __builtin_bswap64(x)
+#  define le64toh(x) (x)
+
+/* ... generic big-endian fallback code */
+#elif defined(__BYTE_ORDER__) && __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
+
+/* byte swapping code inspired by:
+ * https://github.com/rweather/arduinolibs/blob/master/libraries/Crypto/utility/EndianUtil.h
+ * */
+
+#  define htobe32(x) (x)
+#  define be32toh(x) (x)
+#  define htole32(x)                                                           \
+    (__extension__({                                                           \
+      uint32_t _temp = (x);                                                    \
+      ((_temp >> 24) & 0x000000FF) | ((_temp >> 8) & 0x0000FF00) |             \
+          ((_temp << 8) & 0x00FF0000) | ((_temp << 24) & 0xFF000000);          \
+    }))
+#  define le32toh(x) (htole32((x)))
+
+#  define htobe64(x) (x)
+#  define be64toh(x) (x)
+#  define htole64(x)                                                           \
+    (__extension__({                                                           \
+      uint64_t __temp = (x);                                                   \
+      uint32_t __low = htobe32((uint32_t)__temp);                              \
+      uint32_t __high = htobe32((uint32_t)(__temp >> 32));                     \
+      (((uint64_t)__low) << 32) | __high;                                      \
+    }))
+#  define le64toh(x) (htole64((x)))
+
+/* ... generic little-endian fallback code */
+#elif defined(__BYTE_ORDER__) && __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
+
+#  define htole32(x) (x)
+#  define le32toh(x) (x)
+#  define htobe32(x)                                                           \
+    (__extension__({                                                           \
+      uint32_t _temp = (x);                                                    \
+      ((_temp >> 24) & 0x000000FF) | ((_temp >> 8) & 0x0000FF00) |             \
+          ((_temp << 8) & 0x00FF0000) | ((_temp << 24) & 0xFF000000);          \
+    }))
+#  define be32toh(x) (htobe32((x)))
+
+#  define htole64(x) (x)
+#  define le64toh(x) (x)
+#  define htobe64(x)                                                           \
+    (__extension__({                                                           \
+      uint64_t __temp = (x);                                                   \
+      uint32_t __low = htobe32((uint32_t)__temp);                              \
+      uint32_t __high = htobe32((uint32_t)(__temp >> 32));                     \
+      (((uint64_t)__low) << 32) | __high;                                      \
+    }))
+#  define be64toh(x) (htobe64((x)))
+
+/* ... couldn't determine endian-ness of the target platform */
+#else
+#  error "Please define __BYTE_ORDER__!"
+
+#endif /* defined(__linux__) || ... */
+
+/* Loads and stores. These avoid undefined behavior due to unaligned memory
+ * accesses, via memcpy. */
+
+inline static uint16_t load16(uint8_t *b) {
+  uint16_t x;
+  memcpy(&x, b, 2);
+  return x;
+}
+
+inline static uint32_t load32(uint8_t *b) {
+  uint32_t x;
+  memcpy(&x, b, 4);
+  return x;
+}
+
+inline static uint64_t load64(uint8_t *b) {
+  uint64_t x;
+  memcpy(&x, b, 8);
+  return x;
+}
+
+inline static void store16(uint8_t *b, uint16_t i) { memcpy(b, &i, 2); }
+
+inline static void store32(uint8_t *b, uint32_t i) { memcpy(b, &i, 4); }
+
+inline static void store64(uint8_t *b, uint64_t i) { memcpy(b, &i, 8); }
+
+#define load16_le(b) (le16toh(load16(b)))
+#define store16_le(b, i) (store16(b, htole16(i)))
+#define load16_be(b) (be16toh(load16(b)))
+#define store16_be(b, i) (store16(b, htobe16(i)))
+
+#define load32_le(b) (le32toh(load32(b)))
+#define store32_le(b, i) (store32(b, htole32(i)))
+#define load32_be(b) (be32toh(load32(b)))
+#define store32_be(b, i) (store32(b, htobe32(i)))
+
+#define load64_le(b) (le64toh(load64(b)))
+#define store64_le(b, i) (store64(b, htole64(i)))
+#define load64_be(b) (be64toh(load64(b)))
+#define store64_be(b, i) (store64(b, htobe64(i)))
+
+/******************************************************************************/
+/* Checked integers to ease the compilation of non-Low* code                  */
+/******************************************************************************/
+
+typedef int32_t Prims_pos, Prims_nat, Prims_nonzero, Prims_int,
+    krml_checked_int_t;
+
+inline static bool Prims_op_GreaterThanOrEqual(int32_t x, int32_t y) {
+  return x >= y;
+}
+
+inline static bool Prims_op_LessThanOrEqual(int32_t x, int32_t y) {
+  return x <= y;
+}
+
+inline static bool Prims_op_GreaterThan(int32_t x, int32_t y) { return x > y; }
+
+inline static bool Prims_op_LessThan(int32_t x, int32_t y) { return x < y; }
+
+#define RETURN_OR(x)                                                           \
+  do {                                                                         \
+    int64_t __ret = x;                                                         \
+    if (__ret < INT32_MIN || INT32_MAX < __ret) {                              \
+      KRML_HOST_PRINTF("Prims.{int,nat,pos} integer overflow at %s:%d\n",      \
+                       __FILE__, __LINE__);                                    \
+      KRML_HOST_EXIT(252);                                                     \
+    }                                                                          \
+    return (int32_t)__ret;                                                     \
+  } while (0)
+
+inline static int32_t Prims_pow2(int32_t x) {
+  RETURN_OR((int64_t)1 << (int64_t)x);
+}
+
+inline static int32_t Prims_op_Multiply(int32_t x, int32_t y) {
+  RETURN_OR((int64_t)x * (int64_t)y);
+}
+
+inline static int32_t Prims_op_Addition(int32_t x, int32_t y) {
+  RETURN_OR((int64_t)x + (int64_t)y);
+}
+
+inline static int32_t Prims_op_Subtraction(int32_t x, int32_t y) {
+  RETURN_OR((int64_t)x - (int64_t)y);
+}
+
+inline static int32_t Prims_op_Division(int32_t x, int32_t y) {
+  RETURN_OR((int64_t)x / (int64_t)y);
+}
+
+inline static int32_t Prims_op_Modulus(int32_t x, int32_t y) {
+  RETURN_OR((int64_t)x % (int64_t)y);
+}
+
+inline static int8_t FStar_UInt8_uint_to_t(int8_t x) { return x; }
+inline static int16_t FStar_UInt16_uint_to_t(int16_t x) { return x; }
+inline static int32_t FStar_UInt32_uint_to_t(int32_t x) { return x; }
+inline static int64_t FStar_UInt64_uint_to_t(int64_t x) { return x; }
+
+inline static int8_t FStar_UInt8_v(int8_t x) { return x; }
+inline static int16_t FStar_UInt16_v(int16_t x) { return x; }
+inline static int32_t FStar_UInt32_v(int32_t x) { return x; }
+inline static int64_t FStar_UInt64_v(int64_t x) { return x; }
+
+
+/* Platform-specific 128-bit arithmetic. These are static functions in a header,
+ * so that each translation unit gets its own copy and the C compiler can
+ * optimize. */
+#ifndef KRML_NOUINT128
+typedef unsigned __int128 FStar_UInt128_t, FStar_UInt128_t_, uint128_t;
+
+static inline void print128(const char *where, uint128_t n) {
+  KRML_HOST_PRINTF("%s: [%" PRIu64 ",%" PRIu64 "]\n", where,
+                   (uint64_t)(n >> 64), (uint64_t)n);
+}
+
+static inline uint128_t load128_le(uint8_t *b) {
+  uint128_t l = (uint128_t)load64_le(b);
+  uint128_t h = (uint128_t)load64_le(b + 8);
+  return (h << 64 | l);
+}
+
+static inline void store128_le(uint8_t *b, uint128_t n) {
+  store64_le(b, (uint64_t)n);
+  store64_le(b + 8, (uint64_t)(n >> 64));
+}
+
+static inline uint128_t load128_be(uint8_t *b) {
+  uint128_t h = (uint128_t)load64_be(b);
+  uint128_t l = (uint128_t)load64_be(b + 8);
+  return (h << 64 | l);
+}
+
+static inline void store128_be(uint8_t *b, uint128_t n) {
+  store64_be(b, (uint64_t)(n >> 64));
+  store64_be(b + 8, (uint64_t)n);
+}
+
+#  define FStar_UInt128_add(x, y) ((x) + (y))
+#  define FStar_UInt128_mul(x, y) ((x) * (y))
+#  define FStar_UInt128_add_mod(x, y) ((x) + (y))
+#  define FStar_UInt128_sub(x, y) ((x) - (y))
+#  define FStar_UInt128_sub_mod(x, y) ((x) - (y))
+#  define FStar_UInt128_logand(x, y) ((x) & (y))
+#  define FStar_UInt128_logor(x, y) ((x) | (y))
+#  define FStar_UInt128_logxor(x, y) ((x) ^ (y))
+#  define FStar_UInt128_lognot(x) (~(x))
+#  define FStar_UInt128_shift_left(x, y) ((x) << (y))
+#  define FStar_UInt128_shift_right(x, y) ((x) >> (y))
+#  define FStar_UInt128_uint64_to_uint128(x) ((uint128_t)(x))
+#  define FStar_UInt128_uint128_to_uint64(x) ((uint64_t)(x))
+#  define FStar_UInt128_mul_wide(x, y) ((uint128_t)(x) * (y))
+#  define FStar_UInt128_op_Hat_Hat(x, y) ((x) ^ (y))
+
+static inline uint128_t FStar_UInt128_eq_mask(uint128_t x, uint128_t y) {
+  uint64_t mask =
+      FStar_UInt64_eq_mask((uint64_t)(x >> 64), (uint64_t)(y >> 64)) &
+      FStar_UInt64_eq_mask(x, y);
+  return ((uint128_t)mask) << 64 | mask;
+}
+
+static inline uint128_t FStar_UInt128_gte_mask(uint128_t x, uint128_t y) {
+  uint64_t mask =
+      (FStar_UInt64_gte_mask(x >> 64, y >> 64) &
+       ~(FStar_UInt64_eq_mask(x >> 64, y >> 64))) |
+      (FStar_UInt64_eq_mask(x >> 64, y >> 64) & FStar_UInt64_gte_mask(x, y));
+  return ((uint128_t)mask) << 64 | mask;
+}
+
+
+
+#  else /* !defined(KRML_NOUINT128) */
+
+  /* This is a bad circular dependency... should fix it properly. */
+#    include "FStar.h"
+
+typedef FStar_UInt128_uint128 FStar_UInt128_t_, uint128_t;
+
+/* A series of definitions written using pointers. */
+static inline void print128_(const char *where, uint128_t *n) {
+  KRML_HOST_PRINTF("%s: [0x%08" PRIx64 ",0x%08" PRIx64 "]\n", where, n->high, n->low);
+}
+
+static inline void load128_le_(uint8_t *b, uint128_t *r) {
+  r->low = load64_le(b);
+  r->high = load64_le(b + 8);
+}
+
+static inline void store128_le_(uint8_t *b, uint128_t *n) {
+  store64_le(b, n->low);
+  store64_le(b + 8, n->high);
+}
+
+static inline void load128_be_(uint8_t *b, uint128_t *r) {
+  r->high = load64_be(b);
+  r->low = load64_be(b + 8);
+}
+
+static inline void store128_be_(uint8_t *b, uint128_t *n) {
+  store64_be(b, n->high);
+  store64_be(b + 8, n->low);
+}
+
+#    ifndef KRML_NOSTRUCT_PASSING
+
+static inline void print128(const char *where, uint128_t n) {
+  print128_(where, &n);
+}
+
+static inline uint128_t load128_le(uint8_t *b) {
+  uint128_t r;
+  load128_le_(b, &r);
+  return r;
+}
+
+static inline void store128_le(uint8_t *b, uint128_t n) { store128_le_(b, &n); }
+
+static inline uint128_t load128_be(uint8_t *b) {
+  uint128_t r;
+  load128_be_(b, &r);
+  return r;
+}
+
+static inline void store128_be(uint8_t *b, uint128_t n) { store128_be_(b, &n); }
+
+#    else /* !defined(KRML_STRUCT_PASSING) */
+
+#      define print128 print128_
+#      define load128_le load128_le_
+#      define store128_le store128_le_
+#      define load128_be load128_be_
+#      define store128_be store128_be_
+
+#    endif /* KRML_STRUCT_PASSING */
+#  endif   /* KRML_UINT128 */
+#endif     /* __KREMLIB_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib_base.h b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib_base.h
new file mode 100644
index 000000000..b8479efde
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/src/kremlib_base.h
@@ -0,0 +1,181 @@
+/* MIT License
+ *
+ * Copyright (c) 2016-2017 INRIA and Microsoft Corporation
+ *
+ * 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.
+ */
+#ifndef __KREMLIB_BASE_H
+#define __KREMLIB_BASE_H
+
+#include <inttypes.h>
+#include <limits.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+/******************************************************************************/
+/* Some macros to ease compatibility                                          */
+/******************************************************************************/
+
+/* Define __cdecl and friends when using GCC, so that we can safely compile code
+ * that contains __cdecl on all platforms. Note that this is in a separate
+ * header so that Dafny-generated code can include just this file. */
+#ifndef _MSC_VER
+/* Use the gcc predefined macros if on a platform/architectures that set them.
+ * Otherwise define them to be empty. */
+#ifndef __cdecl
+#define __cdecl
+#endif
+#ifndef __stdcall
+#define __stdcall
+#endif
+#ifndef __fastcall
+#define __fastcall
+#endif
+#endif
+
+#ifdef __GNUC__
+#  define inline __inline__
+#endif
+
+/* GCC-specific attribute syntax; everyone else gets the standard C inline
+ * attribute. */
+#ifdef __GNU_C__
+#  ifndef __clang__
+#    define force_inline inline __attribute__((always_inline))
+#  else
+#    define force_inline inline
+#  endif
+#else
+#  define force_inline inline
+#endif
+
+
+/******************************************************************************/
+/* Implementing C.fst                                                         */
+/******************************************************************************/
+
+/* Uppercase issue; we have to define lowercase versions of the C macros (as we
+ * have no way to refer to an uppercase *variable* in F*). */
+extern int exit_success;
+extern int exit_failure;
+
+/* This one allows the user to write C.EXIT_SUCCESS. */
+typedef int exit_code;
+
+void print_string(const char *s);
+void print_bytes(uint8_t *b, uint32_t len);
+
+/* The universal null pointer defined in C.Nullity.fst */
+#define C_Nullity_null(X) 0
+
+/* If some globals need to be initialized before the main, then kremlin will
+ * generate and try to link last a function with this type: */
+void kremlinit_globals(void);
+
+/******************************************************************************/
+/* Implementation of machine integers (possibly of 128-bit integers)          */
+/******************************************************************************/
+
+/* Integer types */
+typedef uint64_t FStar_UInt64_t, FStar_UInt64_t_;
+typedef int64_t FStar_Int64_t, FStar_Int64_t_;
+typedef uint32_t FStar_UInt32_t, FStar_UInt32_t_;
+typedef int32_t FStar_Int32_t, FStar_Int32_t_;
+typedef uint16_t FStar_UInt16_t, FStar_UInt16_t_;
+typedef int16_t FStar_Int16_t, FStar_Int16_t_;
+typedef uint8_t FStar_UInt8_t, FStar_UInt8_t_;
+typedef int8_t FStar_Int8_t, FStar_Int8_t_;
+
+static inline uint32_t rotate32_left(uint32_t x, uint32_t n) {
+  /*  assert (n<32); */
+  return (x << n) | (x >> (32 - n));
+}
+static inline uint32_t rotate32_right(uint32_t x, uint32_t n) {
+  /*  assert (n<32); */
+  return (x >> n) | (x << (32 - n));
+}
+
+/* Constant time comparisons */
+static inline uint8_t FStar_UInt8_eq_mask(uint8_t x, uint8_t y) {
+  x = ~(x ^ y);
+  x &= x << 4;
+  x &= x << 2;
+  x &= x << 1;
+  return (int8_t)x >> 7;
+}
+
+static inline uint8_t FStar_UInt8_gte_mask(uint8_t x, uint8_t y) {
+  return ~(uint8_t)(((int32_t)x - y) >> 31);
+}
+
+static inline uint16_t FStar_UInt16_eq_mask(uint16_t x, uint16_t y) {
+  x = ~(x ^ y);
+  x &= x << 8;
+  x &= x << 4;
+  x &= x << 2;
+  x &= x << 1;
+  return (int16_t)x >> 15;
+}
+
+static inline uint16_t FStar_UInt16_gte_mask(uint16_t x, uint16_t y) {
+  return ~(uint16_t)(((int32_t)x - y) >> 31);
+}
+
+static inline uint32_t FStar_UInt32_eq_mask(uint32_t x, uint32_t y) {
+  x = ~(x ^ y);
+  x &= x << 16;
+  x &= x << 8;
+  x &= x << 4;
+  x &= x << 2;
+  x &= x << 1;
+  return ((int32_t)x) >> 31;
+}
+
+static inline uint32_t FStar_UInt32_gte_mask(uint32_t x, uint32_t y) {
+  return ~((uint32_t)(((int64_t)x - y) >> 63));
+}
+
+static inline uint64_t FStar_UInt64_eq_mask(uint64_t x, uint64_t y) {
+  x = ~(x ^ y);
+  x &= x << 32;
+  x &= x << 16;
+  x &= x << 8;
+  x &= x << 4;
+  x &= x << 2;
+  x &= x << 1;
+  return ((int64_t)x) >> 63;
+}
+
+static inline uint64_t FStar_UInt64_gte_mask(uint64_t x, uint64_t y) {
+  uint64_t low63 =
+      ~((uint64_t)((int64_t)((int64_t)(x & UINT64_C(0x7fffffffffffffff)) -
+                             (int64_t)(y & UINT64_C(0x7fffffffffffffff))) >>
+                   63));
+  uint64_t high_bit =
+      ~((uint64_t)((int64_t)((int64_t)(x & UINT64_C(0x8000000000000000)) -
+                             (int64_t)(y & UINT64_C(0x8000000000000000))) >>
+                   63));
+  return low63 & high_bit;
+}
+
+
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/test/dune b/vendors/tezos-modded/vendors/ocaml-hacl/test/dune
new file mode 100644
index 000000000..bbe28525e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/test/dune
@@ -0,0 +1,11 @@
+(executable
+ (name test)
+ (libraries hex hacl alcotest))
+
+(alias
+ (name    runtest-hacl)
+ (action  (run %{exe:test.exe})))
+
+(alias
+ (name    runtest)
+ (deps    (alias runtest-hacl)))
diff --git a/vendors/tezos-modded/vendors/ocaml-hacl/test/test.ml b/vendors/tezos-modded/vendors/ocaml-hacl/test/test.ml
new file mode 100644
index 000000000..e60f860bb
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-hacl/test/test.ml
@@ -0,0 +1,195 @@
+(* Copyright 2018 Vincent Bernardoff, Marco Stronati.
+ *
+ * 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 Hacl
+
+let bigstring = Alcotest.testable
+    (fun ppf t -> Cstruct.(hexdump_pp ppf (of_bigarray t)))
+    Bigstring.equal
+
+let msg = Bigstring.of_string "Voulez-vous coucher avec moi, ce soir ?"
+let msglen = Bigstring.length msg
+
+let of_hex hex =
+  Cstruct.(to_bigarray (of_hex hex))
+
+let randmsg = of_hex "12c0c5a283401a81163dfd645e57ef6ff58b2f877c4e2d4add10345ec80bef3ffc720060c82e4288a20eccf99d64f18223edb30069fa76de9fe9ae8f875f3a3f75f91dd625652632869766839075e88afc852918da3445bca6d428a4f55d98366065fc70e0306fc6c84ec9e8d1325cc63ba09d5803383d0be40bd7ace7e7551615e4267f94630a0ad62cf798b4a7648390547a3616f42d8b8e58d7223f3c07826670209601be0ef2ea60e662c34b21113680141bead22e8b31015d7fe1a6617101036f03050d8b6854989bdfc13efaa6b2e1960c291f91da346911b1d46f20242bb1eb16f4104f9d684ed0dfca8e13e46b47ba9c39513f5e0746dd828f43da416e10341f3b169691ee823a53500f1ef00c6a52c3f4ecb42f68e1894785d4d192079cc8e53be8bb4ca1e000553504d6132e95490a4b477baaddca598f8947b20fbf732ac608830fb4b11c3cd1e19257e8cb00a22a8fc54ad6e47960086cd5ed24451c1f2ac2cda4514e6e1118ffabd74e7aae3514f3e5d40443ed94bdbbf7af5fa737d2da3b19cac58ca24539313a545164c20c4fae74d01fcb535d4414885ee50cdbb5ff1fcd465fc0c0a0c0f0ebc62687569bd5d36774a6a9c8d9e05b33ac30f13fdd7906aebd27dfd2ee19616a6f3694f2539b89b9ce6d73396816202700f50617f26a7134a6819fe808775bff75df240102fb0352f67eb97e022f66d40403"
+let randmsg_len = Bigstring.length randmsg
+
+let sha256 () =
+  let open Hash.SHA256 in
+  let resp = of_hex "bd4860cc3f39995c47f94205a86c9e22e2fc8ab91c88c5293b704d454991f757" in
+  let randresp = of_hex "9f043732d7117fa402d24e7343108976524b097390b0b160df42b0fa5bc6425c" in
+  let st = init () in
+  Printf.printf "Init done\n" ;
+  update st msg ;
+  print_endline "Update done." ;
+  let d = finish st in
+  Printf.printf "Digest size %d\n" (Bigstring.length d) ;
+  print_endline "Finish done." ;
+  Alcotest.(check bigstring "sha256" resp d) ;
+  let d = digest msg in
+  print_endline "Direct hash done." ;
+  Alcotest.(check bigstring "sha256" resp d) ;
+
+  let st = init () in
+  Printf.printf "Init done\n" ;
+  update st randmsg ;
+  print_endline "Update done." ;
+  let d = finish st in
+  Printf.printf "Digest size %d\n" (Bigstring.length d) ;
+  print_endline "Finish done." ;
+  Alcotest.(check bigstring "sha256" randresp d) ;
+  let d = digest randmsg in
+  print_endline "Direct hash done." ;
+  Alcotest.(check bigstring "sha256" randresp d)
+
+let sha256_seq () =
+  let open Hash.SHA256 in
+  let bothresp = of_hex "97e13d5a675bf308eb52ce5eb7c4926940bcf9304668e08240f7c8c73f927953" in
+  let st = init () in
+  Printf.printf "Init done\n" ;
+  update st msg ;
+  update st randmsg ;
+  print_endline "Update done." ;
+  let d = finish st in
+  Printf.printf "Digest size %d\n" (Bigstring.length d) ;
+  print_endline "Finish done." ;
+  Alcotest.(check bigstring "sha256_seq" bothresp d)
+
+let sha512 () =
+  let resp = of_hex "7941f442d956f124d77ee1d1f0ba3db100751090462cdce4aed5fcd240529097bc666bf9c424becde760910df652c7aefec50b02d7f6efe666f79e5242fb755b" in
+  let digest = Hash.SHA512.digest msg in
+  Alcotest.(check bigstring "sha512" resp digest)
+
+let hmac_sha256 () =
+  let key  = Bigstring.of_string "key" in
+  let msg = Bigstring.of_string "The quick brown fox jumps over the lazy dog" in
+  let resp = of_hex "f7bc83f430538424b13298e6aa6fb143ef4d59a14946175997479dbc2d1a3cd8" in
+  let digest = Hash.SHA256.HMAC.digest ~key ~msg in
+  Alcotest.(check bigstring "hmac_sha256" resp digest)
+
+let hmac_sha512 () =
+  let vectors = [
+    Bigstring.of_string "key",
+    Bigstring.of_string "The quick brown fox jumps over the lazy dog",
+    of_hex "b42af09057bac1e2d41708e48a902e09b5ff7f12ab428a4fe86653c73dd248fb82f948a549f7b791a5b41915ee4d1ec3935357e4e2317250d0372afa2ebeeb3a" ;
+    Bigstring.empty,
+    Bigstring.empty,
+    of_hex "b936cee86c9f87aa5d3c6f2e84cb5a4239a5fe50480a6ec66b70ab5b1f4ac6730c6c515421b327ec1d69402e53dfb49ad7381eb067b338fd7b0cb22247225d47" ;
+  ] in
+  List.iter begin fun (key, msg, resp) ->
+    let digest = Hash.SHA512.HMAC.digest ~key ~msg in
+    Alcotest.(check bigstring "hmac_sha512" resp digest)
+  end vectors
+
+let hash = [
+  "hmac_sha256", `Quick, hmac_sha256 ;
+  "hmac_sha512", `Quick, hmac_sha512 ;
+
+  "sha256", `Quick, sha256 ;
+  "sha256_seq", `Quick, sha256_seq ;
+
+  "sha512", `Quick, sha512 ;
+]
+
+let secretbox () =
+  let open Secretbox in
+  let key = genkey () in
+  let nonce = Nonce.gen () in
+  let orig_msg = Bigstring.create (msglen + zerobytes) in
+  Bigstring.fill orig_msg '\x00' ;
+  Bigstring.blit msg 0 orig_msg zerobytes msglen ;
+  let cmsg = Bigstring.create (msglen + zerobytes) in
+  box ~key ~nonce ~msg:orig_msg ~cmsg ;
+  let decrypted_msg = Bigstring.create (msglen + zerobytes) in
+  assert (box_open ~key ~nonce ~cmsg ~msg:decrypted_msg) ;
+  Alcotest.check bigstring "secretbox_decrypt" orig_msg decrypted_msg ;
+  (* in place *)
+  box ~key ~nonce ~msg:orig_msg ~cmsg:orig_msg ;
+  assert (box_open ~key ~nonce ~cmsg:orig_msg ~msg:orig_msg) ;
+  Alcotest.check bigstring "secretbox_decrypt_inplace" decrypted_msg orig_msg
+
+let secretbox = [
+  "secretbox", `Quick, secretbox ;
+]
+
+let box () =
+  let open Box in
+  let pk, sk = keypair () in
+  let k = dh pk sk in
+  let nonce = Nonce.gen () in
+  let msg_orig = Bigstring.create (msglen + zerobytes) in
+  Bigstring.fill msg_orig '\x00' ;
+  Bigstring.blit msg 0 msg_orig zerobytes msglen ;
+  let cmsg = Bigstring.create (msglen + zerobytes) in
+  Bigstring.fill cmsg '\x00' ;
+  let decrypted_msg = Bigstring.create (msglen + zerobytes) in
+  box ~k ~nonce ~msg:msg_orig ~cmsg ;
+  assert (box_open ~k ~nonce ~cmsg ~msg:decrypted_msg) ;
+  Alcotest.check bigstring "box" msg_orig decrypted_msg ;
+  (* in place *)
+  assert (box_open ~k ~nonce ~cmsg ~msg:cmsg) ;
+  Alcotest.check bigstring "box" msg_orig cmsg
+
+let box = [
+  "box", `Quick, box ;
+]
+
+let keypair () =
+  let seed = Hacl.Rand.gen 32 in
+  let sk = Sign.unsafe_sk_of_bytes seed in
+  let pk = Sign.neuterize sk in
+  let sk' = Sign.unsafe_sk_of_bytes seed in
+  let pk' = Sign.neuterize sk' in
+  Alcotest.(check bool "Sign.of_seed" true (Sign.equal pk pk')) ;
+  Alcotest.(check bool "Sign.of_seed" true (Sign.equal sk sk')) ;
+  let pk_bytes = Sign.unsafe_to_bytes pk in
+  let pk_bytes_length = Bigstring.length pk_bytes in
+  Alcotest.(check int "Sign.to_bytes" Sign.pkbytes pk_bytes_length)
+
+let sign () =
+  let pk, sk = Sign.keypair () in
+  let signature = Bigstring.create Sign.bytes in
+  Sign.sign ~sk ~msg ~signature ;
+  assert (Sign.verify ~pk ~msg ~signature)
+
+let public () =
+  let pk, sk = Sign.keypair () in
+  let pk' = Sign.unsafe_to_bytes pk in
+  let ppk = Sign.(unsafe_to_bytes (neuterize pk)) in
+  let psk = Sign.(unsafe_to_bytes (neuterize sk)) in
+  Alcotest.check bigstring "public" pk' ppk ;
+  Alcotest.check bigstring "public" pk' psk
+
+let sign = [
+  "keypair", `Quick, keypair ;
+  "sign", `Quick, sign ;
+  "public", `Quick, public ;
+]
+
+let () =
+  Alcotest.run "hacl" [
+    "hash", hash ;
+    "secretbox", secretbox ;
+    "box", box ;
+    "sign", sign ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/LICENSE.md b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/LICENSE.md
new file mode 100644
index 000000000..52b5f8cd7
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/LICENSE.md
@@ -0,0 +1,13 @@
+Copyright (c) 2017 Vincent Bernardoff
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet-tezos.opam b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet-tezos.opam
new file mode 100644
index 000000000..20cea36ea
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet-tezos.opam
@@ -0,0 +1,15 @@
+opam-version: "2.0"
+name: "ledgerwallet-tezos"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+license: "ISC"
+synopsis: "Ledger wallet library for OCaml: Tezos app"
+homepage: "https://github.com/vbmithr/ocaml-ledger-wallet"
+bug-reports: "https://github.com/vbmithr/ocaml-ledger-wallet/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-ledger-wallet"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "ledgerwallet" {= "dev"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet.opam b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet.opam
new file mode 100644
index 000000000..ac3de78ed
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/ledgerwallet.opam
@@ -0,0 +1,18 @@
+opam-version: "2.0"
+version: "dev"
+name: "ledgerwallet"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+license: "ISC"
+synopsis: "Ledger wallet library for OCaml"
+homepage: "https://github.com/vbmithr/ocaml-ledger-wallet"
+bug-reports: "https://github.com/vbmithr/ocaml-ledger-wallet/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-ledger-wallet"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "rresult" {>= "0.5.0"}
+  "cstruct" {>= "3.2.1"}
+  "hidapi" {>= "1.0"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.ml b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.ml
new file mode 100644
index 000000000..d2da32680
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.ml
@@ -0,0 +1,61 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+type cmd = Apdu_command : {
+    cmd : 'a ;
+    cla_of_cmd : 'a -> int ;
+    ins_of_cmd : 'a -> int ;
+  } -> cmd
+
+let create_cmd ~cmd ~cla_of_cmd ~ins_of_cmd =
+  Apdu_command { cmd ; cla_of_cmd ; ins_of_cmd }
+
+type t = {
+  cmd : cmd ;
+  p1 : int ;
+  p2 : int ;
+  lc : int ;
+  le : int ;
+  data : Cstruct.t ;
+}
+
+let max_data_length = 230
+
+let create ?(p1=0) ?(p2=0) ?(lc=0) ?(le=0) ?(data=Cstruct.create 0) cmd =
+  { cmd ; p1 ; p2 ; lc ; le ; data }
+
+let create_string ?(p1=0) ?(p2=0) ?(lc=0) ?(le=0) ?(data="") cmd =
+  let data = Cstruct.of_string data in
+  { cmd ; p1 ; p2 ; lc ; le ; data }
+
+let length { data ; _ } = 5 + Cstruct.len data
+
+let write cs { cmd = Apdu_command { cmd ; cla_of_cmd ; ins_of_cmd } ;
+               p1 ; p2 ; lc ; le ; data } =
+  let len = match lc, le with | 0, _ -> le | _ -> lc in
+  let datalen = Cstruct.len data in
+  Cstruct.set_uint8 cs 0 (cla_of_cmd cmd) ;
+  Cstruct.set_uint8 cs 1 (ins_of_cmd cmd) ;
+  Cstruct.set_uint8 cs 2 p1 ;
+  Cstruct.set_uint8 cs 3 p2 ;
+  Cstruct.set_uint8 cs 4 len ;
+  Cstruct.blit data 0 cs 5 datalen ;
+  Cstruct.shift cs (5 + datalen)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.mli b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.mli
new file mode 100644
index 000000000..68f6d46e2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/apdu.mli
@@ -0,0 +1,55 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+type cmd = Apdu_command : {
+    cmd : 'a ;
+    cla_of_cmd : 'a -> int ;
+    ins_of_cmd : 'a -> int ;
+  } -> cmd
+(** Arbitrary type of a command, with its converters. *)
+
+val create_cmd :
+  cmd:'a -> cla_of_cmd:('a -> int) -> ins_of_cmd:('a -> int) -> cmd
+
+type t = {
+  cmd : cmd ;
+  p1 : int ;
+  p2 : int ;
+  lc : int ;
+  le : int ;
+  data : Cstruct.t ;
+}
+(** Type of an ADPU. *)
+
+val max_data_length : int
+(** [max_data_length] is the maximum data length of an APDU. *)
+
+val create :
+  ?p1:int -> ?p2:int -> ?lc:int -> ?le:int -> ?data:Cstruct.t -> cmd -> t
+val create_string :
+  ?p1:int -> ?p2:int -> ?lc:int -> ?le:int -> ?data:string -> cmd -> t
+
+val length : t -> int
+(** [length t] is the size of [t] in bytes. *)
+
+val write : Cstruct.t -> t -> Cstruct.t
+(** [write cs t] writes t at [cs] and returns [cs] shifted by [length
+    t] bytes. *)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/dune b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/dune
new file mode 100644
index 000000000..0a5e90aa3
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/dune
@@ -0,0 +1,13 @@
+(library
+ (name        ledgerwallet)
+ (public_name ledgerwallet)
+ (modules     Apdu Transport)
+ (synopsis "Ledger wallet library for OCaml: common parts")
+ (libraries rresult cstruct hidapi))
+
+(library
+ (name        ledgerwallet_tezos)
+ (public_name ledgerwallet-tezos)
+ (modules     Ledgerwallet_tezos)
+ (synopsis "Ledger wallet library for OCaml: Tezos app")
+ (libraries ledgerwallet))
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml
new file mode 100644
index 000000000..0b55b9aec
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.ml
@@ -0,0 +1,277 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+open Ledgerwallet
+
+module Version = struct
+  type app_class = Tezos | TezBake
+  let pp_app_class ppf = function
+    | Tezos -> Format.pp_print_string ppf "Tezos Wallet"
+    | TezBake -> Format.pp_print_string ppf "Tezos Baking"
+
+  let class_of_int = function
+    | 0 -> Tezos
+    | 1 -> TezBake
+    | _ -> invalid_arg "class_of_int"
+
+  type t = {
+    app_class : app_class ;
+    major : int ;
+    minor : int ;
+    patch : int ;
+  }
+
+  let pp ppf { app_class ; major ; minor ; patch } =
+    Format.fprintf ppf "%a %d.%d.%d"
+      pp_app_class app_class major minor patch
+
+  let create ~app_class ~major ~minor ~patch = {
+    app_class ; major ; minor ; patch
+  }
+
+  type Transport.Status.t +=
+      Tezos_impossible_to_read_version
+
+  let () = Transport.Status.register_string_f begin function
+      | Tezos_impossible_to_read_version ->
+          Some "Impossible to read version"
+      | _ -> None
+    end
+
+  let read cs =
+    try
+      let app_class = class_of_int (Cstruct.get_uint8 cs 0) in
+      let major = Cstruct.get_uint8 cs 1 in
+      let minor = Cstruct.get_uint8 cs 2 in
+      let patch = Cstruct.get_uint8 cs 3 in
+      R.ok (create ~app_class ~major ~minor ~patch)
+    with _ ->
+      Transport.app_error
+        ~msg:"Version.read" (R.error Tezos_impossible_to_read_version)
+end
+
+type ins =
+  | Version
+  | Git_commit
+  | Authorize_baking
+  | Get_public_key
+  | Prompt_public_key
+  | Sign
+  | Sign_unsafe
+  | Reset_high_watermark
+  | Query_high_watermark
+  | Get_authorized_key
+  | Setup
+  | Query_all_high_watermarks
+  | Deauthorize_baking
+  | Get_authorized_path_and_curve
+
+let int_of_ins = function
+  | Version -> 0x00
+  | Authorize_baking -> 0x01
+  | Get_public_key -> 0x02
+  | Prompt_public_key -> 0x03
+  | Sign -> 0x04
+  | Sign_unsafe -> 0x05
+  | Reset_high_watermark -> 0x06
+  | Query_high_watermark -> 0x08
+  | Git_commit -> 0x09
+  | Get_authorized_key -> 0x07
+  | Setup -> 0x0A
+  | Query_all_high_watermarks -> 0x0B
+  | Deauthorize_baking -> 0x0C
+  | Get_authorized_path_and_curve -> 0x0D
+
+type curve =
+  | Ed25519
+  | Secp256k1
+  | Secp256r1
+
+let pp_curve ppf = function
+  | Ed25519 -> Format.pp_print_string ppf "ed25519"
+  | Secp256k1 -> Format.pp_print_string ppf "secp256k1"
+  | Secp256r1 -> Format.pp_print_string ppf "P-256"
+
+let pp_curve_short ppf = function
+  | Ed25519 -> Format.pp_print_string ppf "ed"
+  | Secp256k1 -> Format.pp_print_string ppf "secp"
+  | Secp256r1 -> Format.pp_print_string ppf "p2"
+
+let curve_of_string str =
+  match String.lowercase_ascii str with
+  | "ed" | "ed25519" -> Some Ed25519
+  | "secp256k1" -> Some Secp256k1
+  | "p256" | "p-256" | "secp256r1" -> Some Secp256r1
+  | _ -> None
+
+let int_of_curve = function
+  | Ed25519 -> 0x00
+  | Secp256k1 -> 0x01
+  | Secp256r1 -> 0x02
+
+let curve_of_int = function
+  | 0x00 -> Some Ed25519
+  | 0x01 -> Some Secp256k1
+  | 0x02 -> Some Secp256r1
+  | _ -> None
+
+type Transport.Status.t +=
+    Tezos_invalid_curve_code of int
+
+let () = Transport.Status.register_string_f begin function
+    | Tezos_invalid_curve_code curve_code ->
+        Some ("Unrecognized curve code: " ^ string_of_int curve_code)
+    | _ -> None
+  end
+
+let wrap_ins cmd =
+  Apdu.create_cmd ~cmd ~cla_of_cmd:(fun _ -> 0x80) ~ins_of_cmd:int_of_ins
+
+let get_version ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Version) in
+  Transport.apdu ~msg:"get_version" ?pp ?buf h apdu >>=
+  Version.read
+
+let get_git_commit ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Git_commit) in
+  Transport.apdu ~msg:"get_git_commit" ?pp ?buf h apdu >>|
+  Cstruct.to_string
+
+let read_path_with_length buf =
+  let length = Cstruct.get_uint8 buf 0 in
+  let rec go acc path =
+    if Cstruct.len path = 0 || List.length acc = length then List.rev acc
+    else
+      go (Cstruct.BE.get_uint32 path 0 :: acc)
+        (Cstruct.shift path 4) in
+  go [] (Cstruct.shift buf 1)
+
+let get_authorized_key ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Get_authorized_key) in
+  Transport.apdu ~msg:"get_authorized_key" ?pp ?buf h apdu >>| fun path ->
+  read_path_with_length path
+
+let get_authorized_path_and_curve ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Get_authorized_path_and_curve) in
+  Transport.apdu ~msg:"get_authorized_path_and_curve" ?pp ?buf h apdu >>= fun payload ->
+  let curve_code = Cstruct.get_uint8 payload 0 in
+  match curve_of_int curve_code with
+  | None ->
+      Transport.app_error ~msg:"get_authorized_path_and_curve" (R.error (Tezos_invalid_curve_code curve_code))
+  | Some curve ->
+      let path_components = read_path_with_length (Cstruct.shift payload 1) in
+      R.ok (path_components, curve)
+
+let write_path cs path =
+  ListLabels.fold_left path ~init:cs ~f:begin fun cs i ->
+    Cstruct.BE.set_uint32 cs 0 i ;
+    Cstruct.shift cs 4
+  end
+
+let get_public_key_like cmd ?pp ?buf h curve path =
+  let nb_derivations = List.length path in
+  if nb_derivations > 10 then invalid_arg "get_public_key: max 10 derivations" ;
+  let lc = 1 + 4 * nb_derivations in
+  let data_init = Cstruct.create lc in
+  Cstruct.set_uint8 data_init 0 nb_derivations ;
+  let data = Cstruct.shift data_init 1 in
+  let _data = write_path data path in
+  let msg = "get_public_key" in
+  let apdu = Apdu.create
+      ~p2:(int_of_curve curve) ~lc ~data:data_init (wrap_ins cmd) in
+  Transport.apdu ~msg ?pp ?buf h apdu >>| fun addr ->
+  let keylen = Cstruct.get_uint8 addr 0 in
+  Cstruct.sub addr 1 keylen
+
+let get_public_key ?(prompt=true) =
+  let cmd = if prompt then Prompt_public_key else Get_public_key in
+  get_public_key_like cmd
+
+let authorize_baking = get_public_key_like Authorize_baking
+
+let setup_baking ?pp ?buf h ~main_chain_id ~main_hwm ~test_hwm curve path =
+  let nb_derivations = List.length path in
+  if nb_derivations > 10 then
+    invalid_arg "Ledgerwallet_tezos.setup: max 10 derivations" ;
+  let lc =
+    (* [ chain-id | main-hwm | test-hwm | derivations-path ] *)
+    (* derivations-path = [ length | paths ] *)
+    (3 * 4) + 1 + (4 * nb_derivations) in
+  let data_init = Cstruct.create lc in
+  (* If the size of chain-ids changes, then all assumptions of this
+     binary format are broken (the ledger expects a uint32). *)
+  assert (String.length main_chain_id = 4) ;
+  for ith = 0 to 3 do
+    Cstruct.set_uint8 data_init ith (int_of_char main_chain_id.[ith]) ;
+  done ;
+  Cstruct.BE.set_uint32 data_init 4 main_hwm ;
+  Cstruct.BE.set_uint32 data_init 8 test_hwm ;
+  Cstruct.set_uint8 data_init 12 nb_derivations ;
+  let (_ : Cstruct.t) =
+    let data = Cstruct.shift data_init (12 + 1) in
+    write_path data path in
+  let msg = "setup" in
+  let apdu =
+    Apdu.create
+      ~p2:(int_of_curve curve) ~lc ~data:data_init (wrap_ins Setup) in
+  Transport.apdu ~msg ?pp ?buf h apdu >>| fun addr ->
+  let keylen = Cstruct.get_uint8 addr 0 in
+  Cstruct.sub addr 1 keylen
+
+let deauthorize_baking ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Deauthorize_baking) in
+  Transport.apdu ~msg:"deauthorize_baking" ?pp ?buf h apdu >>| fun _ ->
+  ()
+
+let get_high_watermark ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Query_high_watermark) in
+  Transport.apdu ~msg:"get_high_watermark" ?pp ?buf h apdu >>| fun hwm ->
+  Cstruct.BE.get_uint32 hwm 0
+
+let get_all_high_watermarks ?pp ?buf h =
+  let apdu = Apdu.create (wrap_ins Query_all_high_watermarks) in
+  Transport.apdu ~msg:"get_high_watermark" ?pp ?buf h apdu >>| fun tuple ->
+  let main_hwm = Cstruct.BE.get_uint32 tuple 0 in
+  let test_hwm = Cstruct.BE.get_uint32 tuple 4 in
+  let chain_id = Cstruct.copy tuple 8 4 in
+  (`Main_hwm main_hwm, `Test_hwm test_hwm, `Chain_id chain_id)
+
+let set_high_watermark ?pp ?buf h hwm =
+  let data = Cstruct.create 4 in
+  Cstruct.BE.set_uint32 data 0 hwm ;
+  let apdu = Apdu.create ~lc:4 ~data (wrap_ins Reset_high_watermark) in
+  Transport.apdu ~msg:"set_high_watermark" ?pp ?buf h apdu >>|
+  ignore
+
+let sign ?pp ?buf ?(hash_on_ledger=true) h curve path payload =
+  let nb_derivations = List.length path in
+  if nb_derivations > 10 then invalid_arg "get_public_key: max 10 derivations" ;
+  let lc = 1 + 4 * nb_derivations in
+  let data_init = Cstruct.create lc in
+  Cstruct.set_uint8 data_init 0 nb_derivations ;
+  let data = Cstruct.shift data_init 1 in
+  let _data = write_path data path in
+  let cmd = wrap_ins (if hash_on_ledger then Sign else Sign_unsafe) in
+  let msg = "sign" in
+  let apdu = Apdu.create ~p2:(int_of_curve curve) ~lc ~data:data_init cmd in
+  let _addr = Transport.apdu ~msg ?pp ?buf h apdu in
+  Transport.write_payload ~mark_last:true ?pp ?buf ~msg ~cmd h ~p1:0x01 payload
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli
new file mode 100644
index 000000000..a4537eb90
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/ledgerwallet_tezos.mli
@@ -0,0 +1,146 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Ledgerwallet
+
+module Version : sig
+  type app_class = Tezos | TezBake
+  val pp_app_class : Format.formatter -> app_class -> unit
+
+  type Transport.Status.t +=
+      Tezos_impossible_to_read_version
+
+  type t = {
+    app_class : app_class ;
+    major : int ;
+    minor : int ;
+    patch : int ;
+  }
+  val pp : Format.formatter -> t -> unit
+end
+
+type curve =
+  | Ed25519
+  | Secp256k1
+  | Secp256r1
+
+val curve_of_string : string -> curve option
+val pp_curve : Format.formatter -> curve -> unit
+val pp_curve_short : Format.formatter -> curve -> unit
+
+val get_version :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (Version.t, Transport.error) result
+(** [get_version ?pp ?buf ledger] is the version information of the
+    Ledger app running at [ledger]. *)
+
+val get_git_commit :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (string, Transport.error) result
+(** [get_git_commit ?pp ?buf ledger] is the git commit information of
+    the Ledger app running at [ledger]. *)
+
+val get_authorized_key :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (int32 list, Transport.error) result
+(** [get_authorized_key ?pp ?buf ledger] is the BIP32 path of the key
+    authorized to bake on the Ledger app running at [ledger]. *)
+
+val get_authorized_path_and_curve :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (int32 list * curve, Transport.error) result
+(** [get_authorized_path_and_curve ?pp ?buf ledger] is the BIP32 path
+    and the curve code of the key authorized to bake on the Ledger app
+    running at [ledger]. *)
+
+
+val get_public_key :
+  ?prompt:bool ->
+  ?pp:Format.formatter ->
+  ?buf:Cstruct.t ->
+  Hidapi.t -> curve -> int32 list -> (Cstruct.t, Transport.error) result
+(** [get_public_key ?pp ?buf ?prompt ledger curve path] is [0x02 ||
+    pk] from [ledger] at [path] for curve [curve]. If [prompt] is
+    [true] (the default), then a prompt on Ledger screen will ask user
+    confirmation. *)
+
+val authorize_baking :
+  ?pp:Format.formatter ->
+  ?buf:Cstruct.t ->
+  Hidapi.t -> curve -> int32 list -> (Cstruct.t, Transport.error) result
+(** [authorize_baking ?pp ?buf ?prompt ledger curve path] is like
+    [get_public_key] with [prompt = true], but only works with the
+    baking Ledger application and serves to indicate that the key from
+    [curve] at [path] is allowed to bake.
+
+    This is deprecated as it ignores test-chains, see {!setup_baking}. *)
+
+val setup_baking :
+  ?pp:Format.formatter -> ?buf:Cstruct.t -> Hidapi.t ->
+  main_chain_id: string -> main_hwm:int32 -> test_hwm:int32 ->
+  curve -> int32 list -> (Cstruct.t, Transport.error) result
+(** [setup_baking ?pp ?buf ?prompt ledger ~main_chain_id ~main_hwm ~test_hwm curve path]
+    sets up the Ledger's Baking application: it informs
+    the device of the ID of the main chain (should be of length [4]),
+    sets the high watermarks for the main and test chains, {i and}
+    indicates that the key at the given [curve/path] is authorized for
+    baking. *)
+
+val deauthorize_baking :
+  ?pp:Format.formatter -> ?buf:Cstruct.t -> Hidapi.t -> (unit, Transport.error) result
+(** [deauthorize_baking ?pp ?buf ledger]
+    deauthorizes the Ledger's Baking application from baking for any address. *)
+
+val get_high_watermark :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (int32, Transport.error) result
+(** [get_high_watermark ?pp ?buf ledger] is the current value of the
+    high water mark for the main-chain on [ledger]. This works with
+    the baking app only. See {!get_all_high_watermarks} for a more
+    complete query. *)
+
+val get_all_high_watermarks :
+  ?pp:Format.formatter ->
+  ?buf:Cstruct.t ->
+  Hidapi.t ->
+  ([ `Main_hwm of int32 ] * [ `Test_hwm of int32 ] * [ `Chain_id of string ],
+   Transport.error) result
+(** Query the high water marks for the main and test chains, as well as the ID
+    of the main-chain (string of length 4) recorded by the Ledger Baking app. *)
+
+val set_high_watermark :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> int32 -> (unit, Transport.error) result
+(** [set_high_watermark ?pp ?buf ledger hwm] reset the high water
+    mark on [ledger] to [hwm] for the main-chain.
+    This works with the baking app only. Use {!setup_baking} to be able to also
+    reset all the test-chain water mark. *)
+
+val sign :
+  ?pp:Format.formatter ->
+  ?buf:Cstruct.t ->
+  ?hash_on_ledger:bool ->
+  Hidapi.t -> curve -> int32 list ->
+  Cstruct.t -> (Cstruct.t, Transport.error) result
+(** [sign ?pp ?buf ?hash_on_ledger h curve path payload] is the
+    signature of [payload] (or its hash if [hash_on_ledger] is [true],
+    the default), signed on [ledger] with key from curve [curve] at
+    [path]. *)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.ml b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.ml
new file mode 100644
index 000000000..1206c779f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.ml
@@ -0,0 +1,360 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+let packet_length = 64
+let channel = 0x0101
+let apdu = 0x05
+let ping = 0x02
+
+let check_buflen cs =
+  let cslen = Cstruct.len cs in
+  if cslen < packet_length then invalid_arg
+      ("HID packets must be 64 bytes long, got " ^ string_of_int cslen)
+
+module Status = struct
+  type t = ..
+  type t +=
+    | Invalid_pin of int
+    | Incorrect_length
+    | Incorrect_length_for_ins
+    | Incompatible_file_structure
+    | Security_status_unsatisfied
+    | Hid_required
+    | Conditions_of_use_not_satisfied
+    | Incorrect_data
+    | File_not_found
+    | Parse_error
+    | Incorrect_params
+    | Incorrect_class
+    | Ins_not_supported
+    | Memory_error
+    | Referenced_data_not_found
+    | Technical_problem of int
+    | Ok
+    | Unknown of int
+
+  let of_int = function
+    | 0x6700 -> Incorrect_length
+    | 0x6981 -> Incompatible_file_structure
+    | 0x6982 -> Security_status_unsatisfied
+    | 0x6983 -> Hid_required
+    | 0x6985 -> Conditions_of_use_not_satisfied
+    | 0x6a80 -> Incorrect_data
+    | 0x9404 -> File_not_found
+    | 0x9405 -> Parse_error
+    | 0x6b00 -> Incorrect_params
+    | 0x6c00 -> Incorrect_length
+    | 0x6d00 -> Ins_not_supported
+    | 0x6e00 -> Incorrect_class
+    | 0x9000 -> Ok
+    | 0x917e -> Incorrect_length_for_ins
+    | 0x9200 -> Memory_error
+    | 0x6a88 -> Referenced_data_not_found
+    | v when v >= 0x63c0 && v <= 0x63cf -> Invalid_pin (v land 0x0f)
+    | v when v >= 0x6f00 && v <= 0x6fff -> Technical_problem (v land 0xff)
+    | v -> Unknown v
+
+  let string_fs = ref []
+  let register_string_f f =
+    string_fs := f :: !string_fs
+
+  let to_string = function
+    | Invalid_pin i -> "Invalid pin " ^  string_of_int i
+    | Incorrect_length -> "Incorrect length"
+    | Incompatible_file_structure -> "Incompatible file structure"
+    | Security_status_unsatisfied -> "Security status unsatisfied"
+    | Conditions_of_use_not_satisfied -> "Conditions of use not satisfied"
+    | Incorrect_data -> "Incorrect data"
+    | File_not_found -> "File not found"
+    | Incorrect_params -> "Incorrect params"
+    | Ins_not_supported -> "Instruction not supported"
+    | Technical_problem i -> "Technical problem " ^ string_of_int i
+    | Referenced_data_not_found -> "Referenced data not found"
+    | Ok -> "Ok"
+    | Unknown i -> Printf.sprintf "Unknown status code 0x%x" i
+    | t ->
+        try
+          List.fold_left begin fun a f ->
+            match f t with Some s -> failwith s | None -> a
+          end "Unregistered status message" !string_fs
+        with Failure s -> s
+
+  let show t = to_string t
+
+  let pp ppf t =
+    Format.pp_print_string ppf (to_string t)
+end
+
+module Header = struct
+
+  type t = {
+    cmd : cmd ;
+    seq : int ;
+  }
+  and cmd = Ping | Apdu
+
+  let cmd_of_int = function
+    | 0x05 -> Some Apdu
+    | 0x02 -> Some Ping
+    | _ -> None
+
+  module Error = struct
+    type t =
+      | Header_too_short of int
+      | Invalid_channel of int
+      | Invalid_command_tag of int
+      | Unexpected_sequence_number of { expected : int ;
+                                        actual : int }
+
+    let pp ppf = function
+      | Header_too_short i ->
+          Format.fprintf ppf "Header too short (got %d bytes)" i
+      | Invalid_channel i ->
+          Format.fprintf ppf "Invalid channel (%d)" i
+      | Invalid_command_tag i ->
+          Format.fprintf ppf "Invalid command tag (%d)" i
+      | Unexpected_sequence_number { expected ; actual } ->
+          Format.fprintf ppf "Unexpected sequence number (expected %d, got %d)"
+            expected actual
+  end
+
+  let fail_header_too_short i = R.error (Error.Header_too_short i)
+  let fail_invalid_chan i = R.error (Error.Invalid_channel i)
+  let fail_invalid_cmd i = R.error (Error.Invalid_command_tag i)
+  let fail_unexpected_seqnum ~expected ~actual =
+    R.error (Error.Unexpected_sequence_number { expected ; actual })
+
+  let read cs =
+    let cslen = Cstruct.len cs in
+    begin if cslen < 5 then
+        fail_header_too_short cslen
+      else R.ok ()
+    end >>= fun () ->
+    let channel_id = Cstruct.BE.get_uint16 cs 0 in
+    let cmd = Cstruct.get_uint8 cs 2 in
+    let seq = Cstruct.BE.get_uint16 cs 3 in
+    begin
+      if channel_id <> channel then
+        fail_invalid_chan channel_id
+      else R.ok ()
+    end >>= fun () ->
+    begin match cmd_of_int cmd with
+      | Some cmd -> R.ok cmd
+      | None -> fail_invalid_cmd cmd
+    end >>= fun cmd ->
+    R.ok ({ cmd ; seq }, Cstruct.shift cs 5)
+
+  let check_seqnum t expected_seq =
+    if expected_seq <> t.seq then
+      fail_unexpected_seqnum ~actual:t.seq ~expected:expected_seq
+    else R.ok ()
+end
+
+type transport_error =
+  | Hidapi of string
+  | Incomplete_write of int
+  | Incomplete_read of int
+
+let pp_transport_error ppf = function
+  | Hidapi s -> Format.pp_print_string ppf s
+  | Incomplete_write i ->
+      Format.fprintf ppf "wrote %d bytes, expected to write 64 \
+                          bytes" i
+  | Incomplete_read i ->
+      Format.fprintf ppf "read %d bytes, expected to read 64 \
+                          bytes" i
+
+type error =
+  | AppError of { status : Status.t ; msg : string }
+  | ApduError of Header.Error.t
+  | TransportError of transport_error
+
+let app_error ~msg r =
+  R.reword_error (fun status -> AppError { status ; msg }) r
+let apdu_error r =
+  R.reword_error (fun e -> ApduError e) r
+
+let pp_error ppf = function
+  | AppError { status ; msg } ->
+      Format.fprintf ppf "Application level error (%s): %a"
+        msg Status.pp status
+  | ApduError e ->
+      Format.fprintf ppf "APDU level error: %a" Header.Error.pp e
+  | TransportError e ->
+      Format.fprintf ppf "Transport level error: %a" pp_transport_error e
+
+let check_nbwritten = function
+  | n when n = packet_length -> R.ok ()
+  | n -> R.error (TransportError (Incomplete_write n))
+let check_nbread = function
+  | n when n = packet_length -> R.ok ()
+  | n -> R.error (TransportError (Incomplete_read n))
+
+let write_hidapi h ?len buf =
+  R.reword_error (fun s -> TransportError (Hidapi s))
+    (Hidapi.write h ?len Cstruct.(to_bigarray (sub buf 0 packet_length))) >>=
+  check_nbwritten
+
+let read_hidapi ?timeout h buf =
+  R.reword_error (fun s -> TransportError (Hidapi s))
+    (Hidapi.read ?timeout h buf packet_length) >>=
+  check_nbread
+
+let write_ping ?(buf=Cstruct.create packet_length) h =
+  check_buflen buf ;
+  let open Cstruct in
+  BE.set_uint16 buf 0 channel ;
+  set_uint8 buf 2 ping ;
+  BE.set_uint16 buf 3 0 ;
+  memset (sub buf 5 59) 0 ;
+  write_hidapi h buf
+
+let write_apdu
+    ?pp
+    ?(buf=Cstruct.create packet_length)
+    h p =
+  check_buflen buf ;
+  let apdu_len = Apdu.length p in
+  let apdu_buf = Cstruct.create apdu_len in
+  let _nb_written = Apdu.write apdu_buf p in
+  begin match pp with
+    | None -> ()
+    | Some pp ->
+        Format.fprintf pp "-> REQ %a@." Cstruct.hexdump_pp apdu_buf ;
+        Format.pp_print_flush pp ()
+  end ;
+  let apdu_p = ref 0 in (* pos in the apdu buf *)
+  let i = ref 0 in (* packet id *)
+  let open Cstruct in
+
+  (* write first packet *)
+  BE.set_uint16 buf 0 channel ;
+  set_uint8 buf 2 apdu ;
+  BE.set_uint16 buf 3 !i ;
+  BE.set_uint16 buf 5 apdu_len ;
+  let nb_to_write = (min apdu_len (packet_length - 7)) in
+  blit apdu_buf 0 buf 7 nb_to_write ;
+  write_hidapi h buf >>= fun () ->
+  apdu_p := !apdu_p + nb_to_write ;
+  incr i ;
+
+  (* write following packets *)
+  let rec inner apdu_p =
+    if apdu_p >= apdu_len then R.ok ()
+    else begin
+      memset buf 0 ;
+      BE.set_uint16 buf 0 channel ;
+      set_uint8 buf 2 apdu ;
+      BE.set_uint16 buf 3 !i ;
+      let nb_to_write = (min (apdu_len - apdu_p) (packet_length - 5)) in
+      blit apdu_buf apdu_p buf 5 nb_to_write ;
+      write_hidapi h buf >>= fun () ->
+      incr i ;
+      inner (apdu_p + nb_to_write)
+    end
+  in
+  inner !apdu_p
+
+let read ?pp ?(buf=Cstruct.create packet_length) h =
+  check_buflen buf ;
+  let expected_seq = ref 0 in
+  let full_payload = ref (Cstruct.create 0) in
+  let payload = ref (Cstruct.create 0) in
+  (* let pos = ref 0 in *)
+  let rec inner () =
+    read_hidapi ~timeout:600_000 h (Cstruct.to_bigarray buf) >>= fun () ->
+    begin match pp with
+      | None -> ()
+      | Some pp ->
+          Format.fprintf pp "<- RAW PKT %a@."
+            Cstruct.hexdump_pp (Cstruct.sub buf 0 packet_length) ;
+          Format.pp_print_flush pp ()
+    end ;
+    apdu_error (Header.read buf) >>= fun (hdr, buf) ->
+    apdu_error (Header.check_seqnum hdr !expected_seq) >>= fun () ->
+    if hdr.seq = 0 then begin (* first frame *)
+      let len = Cstruct.BE.get_uint16 buf 0 in
+      let cs = Cstruct.shift buf 2 in
+      payload := Cstruct.create len ;
+      full_payload := !payload ;
+      let nb_to_read = min len (packet_length - 7) in
+      Cstruct.blit cs 0 !payload 0 nb_to_read ;
+      payload := Cstruct.shift !payload nb_to_read ;
+      (* pos := !pos + nb_to_read ; *)
+      expected_seq := !expected_seq + 1 ;
+    end else begin (* next frames *)
+      (* let rem = Bytes.length !payload - !pos in *)
+      let nb_to_read = min (Cstruct.len !payload) (packet_length - 5) in
+      Cstruct.blit buf 0 !payload 0 nb_to_read ;
+      payload := Cstruct.shift !payload nb_to_read ;
+      (* pos := !pos + nb_to_read ; *)
+      expected_seq := !expected_seq + 1
+    end ;
+    match Cstruct.len !payload, hdr.cmd with
+    | 0, Ping -> R.ok (Status.Ok, Cstruct.create 0)
+    | 0, Apdu ->
+        (* let sw_pos = Bytes.length !payload - 2 in *)
+        let payload_len = Cstruct.len !full_payload in
+        let sw = Cstruct.BE.get_uint16 !full_payload (payload_len - 2) in
+        R.ok
+          (Status.of_int sw,
+           Cstruct.sub !full_payload 0 (payload_len - 2))
+    | _ -> inner ()
+  in
+  inner ()
+
+let ping ?pp ?buf h =
+  write_ping ?buf h >>= fun () ->
+  read ?pp ?buf h >>|
+  ignore
+
+let apdu ?pp ?(msg="") ?buf h apdu =
+  write_apdu ?pp ?buf h apdu >>= fun () ->
+  read ?pp ?buf h >>= fun (status, payload) ->
+  begin match pp with
+    | None -> ()
+    | Some pp ->
+        Format.fprintf pp "<- RESP [%a] %a@."
+          Status.pp status Cstruct.hexdump_pp payload ;
+        Format.pp_print_flush pp ()
+  end ;
+  match status with
+  | Status.Ok -> R.ok payload
+  | status -> app_error ~msg (R.error status)
+
+let write_payload
+    ?pp ?(msg="write_payload") ?buf ?(mark_last=false) ~cmd ?p1 ?p2 h cs =
+  let rec inner cs =
+    let cs_len = Cstruct.len cs in
+    let lc = min Apdu.max_data_length cs_len in
+    let last = lc = cs_len in
+    let p1 = match last, mark_last, p1 with
+      | true, true, None -> Some 0x80
+      | true, true, Some p1 -> Some (0x80 lor p1)
+      | _ -> p1 in
+    apdu ?pp ~msg ?buf h
+      Apdu.(create ?p1 ?p2 ~lc
+              ~data:(Cstruct.sub cs 0 lc) cmd) >>= fun response ->
+    if last then R.ok response
+    else inner (Cstruct.shift cs lc) in
+  if Cstruct.len cs = 0 then R.ok cs else inner cs
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.mli b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.mli
new file mode 100644
index 000000000..e505a3c4b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/src/transport.mli
@@ -0,0 +1,104 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+module Status : sig
+  type t = ..
+  type t +=
+    | Invalid_pin of int
+    | Incorrect_length
+    | Incorrect_length_for_ins
+    | Incompatible_file_structure
+    | Security_status_unsatisfied
+    | Hid_required
+    | Conditions_of_use_not_satisfied
+    | Incorrect_data
+    | File_not_found
+    | Parse_error
+    | Incorrect_params
+    | Incorrect_class
+    | Ins_not_supported
+    | Memory_error
+    | Referenced_data_not_found
+    | Technical_problem of int
+    | Ok
+
+  val register_string_f : (t -> string option) -> unit
+
+  val to_string : t -> string
+  val show : t -> string
+  val pp : Format.formatter -> t -> unit
+end
+
+module Header : sig
+  module Error : sig
+    type t =
+      | Header_too_short of int
+      | Invalid_channel of int
+      | Invalid_command_tag of int
+      | Unexpected_sequence_number of { expected : int ;
+                                        actual : int }
+  end
+end
+
+type transport_error =
+  | Hidapi of string
+  | Incomplete_write of int
+  | Incomplete_read of int
+
+type error =
+  | AppError of { status : Status.t ; msg : string }
+  | ApduError of Header.Error.t
+  | TransportError of transport_error
+
+val app_error :
+  msg:string -> ('a, Status.t) result -> ('a, error) result
+
+val pp_error : Format.formatter -> error -> unit
+
+val write_apdu :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> Apdu.t -> (unit, error) result
+(** [write_apdu ?pp ?buf ledger apdu] writes [apdu] to [ledger]. *)
+
+val read :
+  ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (Status.t * Cstruct.t, error) result
+(** [read ?pp ?buf ledger] reads from [ledger] a status response and a
+    payload. *)
+
+val ping : ?pp:Format.formatter -> ?buf:Cstruct.t ->
+  Hidapi.t -> (unit, error) result
+(** [ping ?pp ?buf ledger] writes a ping packet to [ledger],
+    optionally containing [buf]. *)
+
+val apdu :
+  ?pp:Format.formatter -> ?msg:string -> ?buf:Cstruct.t ->
+  Hidapi.t -> Apdu.t -> (Cstruct.t, error) result
+(** [apdu ?pp ?msg ?buf ledger apdu] writes [apdu] to [ledger] and
+    returns the response. *)
+
+val write_payload :
+  ?pp:Format.formatter -> ?msg:string -> ?buf:Cstruct.t ->
+  ?mark_last:bool -> cmd:Apdu.cmd -> ?p1:int -> ?p2:int ->
+  Hidapi.t -> Cstruct.t -> (Cstruct.t, error) result
+(** [write_payload ?pp ?msg ?buf ?mark_last ~cmd ?p1 ?p2 ledger
+    payload] writes the [payload] of [cmd] into [ledger] and returns
+    the response. *)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/dune b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/dune
new file mode 100644
index 000000000..8d4be1bd1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/dune
@@ -0,0 +1,8 @@
+(executable
+ (name test_tezos)
+ (modules Test_tezos)
+ (libraries hex alcotest ledgerwallet-tezos tweetnacl uecc))
+
+(alias
+ (name    runtest-ledgerwallet-tezos)
+ (action  (run %{exe:test_tezos.exe})))
diff --git a/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/test_tezos.ml b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/test_tezos.ml
new file mode 100644
index 000000000..42d3b3abc
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-ledger-wallet/test/test_tezos.ml
@@ -0,0 +1,79 @@
+open Ledgerwallet_tezos
+
+let vendor_id = 0x2C97
+let product_id = 0x0001
+
+let test_open_close () =
+  let h = Hidapi.open_id_exn ~vendor_id ~product_id in
+  Hidapi.close h
+
+let test_ping () =
+  let h = Hidapi.open_id_exn ~vendor_id ~product_id in
+  Ledgerwallet.Transport.ping h ;
+  Hidapi.close h
+
+let hard x =
+  Int32.logor x 0x8000_0000l
+
+let path = [
+  hard 44l ; hard 1729l
+]
+
+let curves = [Ed25519; Secp256k1; Secp256r1]
+
+let msg = Cstruct.of_string "Voulez-vous coucher avec moi, ce soir ?"
+let msg_ba = Cstruct.to_bigarray msg
+
+let test_getpk h curve =
+  let pk = get_public_key h curve path in
+  Alcotest.(check int "pklen"
+              (if curve = Ed25519 then 33 else 65) (Cstruct.len pk))
+
+let test_getpk () =
+  let h = Hidapi.open_id_exn ~vendor_id ~product_id in
+  List.iter (test_getpk h) curves ;
+  Hidapi.close h
+
+let test_sign h curve =
+  let open Alcotest in
+  let pk = get_public_key h curve path in
+  let signature = sign h curve path msg in
+  match curve with
+  | Ed25519 ->
+      let pk = Tweetnacl.Sign.(pk_of_cstruct_exn (Cstruct.sub pk 1 pkbytes)) in
+      check bool "sign Ed25519" true
+        (Tweetnacl.Sign.verify_detached ~key:pk ~signature msg)
+  | Secp256k1 -> begin
+      let pk = Cstruct.to_bigarray pk in
+      let signature = Cstruct.to_bigarray signature in
+      match Uecc.(pk_of_bytes secp256k1 pk) with
+      | None -> assert false
+      | Some pk ->
+          check bool "sign Secp256k1" true (Uecc.verify pk ~msg:msg_ba ~signature)
+    end
+  | Secp256r1 -> begin
+      let pk = Cstruct.to_bigarray pk in
+      let signature = Cstruct.to_bigarray signature in
+      match Uecc.(pk_of_bytes secp256r1 pk) with
+      | None -> assert false
+      | Some pk ->
+          check bool "sign Secp256r1" true (Uecc.verify pk ~msg:msg_ba ~signature)
+    end
+
+let test_sign () =
+  let h = Hidapi.open_id_exn ~vendor_id ~product_id in
+  (* List.iter (test_sign h) curves ; *)
+  (* List.iter (test_sign h) [Secp256k1] ; *)
+  Hidapi.close h
+
+let basic = [
+  "open_close", `Quick, test_open_close ;
+  "ping", `Quick, test_ping ;
+  "get_public_key", `Quick, test_getpk ;
+  "sign", `Quick, test_sign ;
+]
+
+let () =
+  Alcotest.run "ledgerwallet.tezos" [
+    "basic", basic ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/LICENSE b/vendors/tezos-modded/vendors/ocaml-lmdb/LICENSE
new file mode 100644
index 000000000..05ad7571e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/LICENSE
@@ -0,0 +1,47 @@
+The OpenLDAP Public License
+  Version 2.8, 17 August 2003
+
+Redistribution and use of this software and associated documentation
+("Software"), with or without modification, are permitted provided
+that the following conditions are met:
+
+1. Redistributions in source form must retain copyright statements
+   and notices,
+
+2. Redistributions in binary form must reproduce applicable copyright
+   statements and notices, this list of conditions, and the following
+   disclaimer in the documentation and/or other materials provided
+   with the distribution, and
+
+3. Redistributions must contain a verbatim copy of this document.
+
+The OpenLDAP Foundation may revise this license from time to time.
+Each revision is distinguished by a version number.  You may use
+this Software under terms of this license revision or under the
+terms of any subsequent revision of the license.
+
+THIS SOFTWARE IS PROVIDED BY THE OPENLDAP FOUNDATION AND ITS
+CONTRIBUTORS ``AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT
+SHALL THE OPENLDAP FOUNDATION, ITS CONTRIBUTORS, OR THE AUTHOR(S)
+OR OWNER(S) OF THE SOFTWARE BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+The names of the authors and copyright holders must not be used in
+advertising or otherwise to promote the sale, use or other dealing
+in this Software without specific, written prior permission.  Title
+to copyright in this Software shall at all times remain with copyright
+holders.
+
+OpenLDAP is a registered trademark of the OpenLDAP Foundation.
+
+Copyright 1999-2003 The OpenLDAP Foundation, Redwood City,
+California, USA.  All Rights Reserved.  Permission to copy and
+distribute verbatim copies of this document is granted.
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/config/discover.ml b/vendors/tezos-modded/vendors/ocaml-lmdb/config/discover.ml
new file mode 100644
index 000000000..1b0496ec9
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/config/discover.ml
@@ -0,0 +1,8 @@
+let () =
+  let oc = open_out "c_flags.sexp" in
+  let w = "-W -Wall -Wno-unused-parameter -Wbad-function-cast -Wuninitialized" in
+  let thread = "-pthread" in
+  let opt = "-O2 -g" in
+  Printf.fprintf oc "(%s %s %s %s)" w thread opt
+    (if Sys.word_size = 32 then "-DMDB_VL32" else "") ;
+  close_out oc
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/config/dune b/vendors/tezos-modded/vendors/ocaml-lmdb/config/dune
new file mode 100644
index 000000000..9d7ae4886
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/config/dune
@@ -0,0 +1,2 @@
+(executable
+ (name discover))
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/lmdb.opam b/vendors/tezos-modded/vendors/ocaml-lmdb/lmdb.opam
new file mode 100644
index 000000000..e41112f60
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/lmdb.opam
@@ -0,0 +1,17 @@
+opam-version: "2.0"
+name: "lmdb"
+version: "0.1"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+license: "ISC"
+synopsis: "Simple OCaml binding to Lightning Memory-Mapped Database from Symas"
+homepage: "https://github.com/vbmithr/ocaml-lmdb"
+bug-reports: "https://github.com/vbmithr/ocaml-lmdb/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-lmdb"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "rresult" {>= "0.5.0"}
+  "cstruct" {with-test & >= "3.2.1"}
+  "alcotest" {with-test & >= "0.8.1"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/dune b/vendors/tezos-modded/vendors/ocaml-lmdb/src/dune
new file mode 100644
index 000000000..9011f0558
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/dune
@@ -0,0 +1,11 @@
+(library
+ (name            lmdb)
+ (public_name     lmdb)
+ (libraries       rresult)
+ (c_names         mdb midl lmdb_stubs)
+ (c_flags         (:include c_flags.sexp))
+ (c_library_flags (-lpthread)))
+
+(rule
+ (targets c_flags.sexp)
+ (action  (run %{exe:../config/discover.exe} -ocamlc %{ocamlc})))
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.h b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.h
new file mode 100644
index 000000000..16c574a4d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.h
@@ -0,0 +1,1647 @@
+/** @file lmdb.h
+ *	@brief Lightning memory-mapped database library
+ *
+ *	@mainpage	Lightning Memory-Mapped Database Manager (LMDB)
+ *
+ *	@section intro_sec Introduction
+ *	LMDB is a Btree-based database management library modeled loosely on the
+ *	BerkeleyDB API, but much simplified. The entire database is exposed
+ *	in a memory map, and all data fetches return data directly
+ *	from the mapped memory, so no malloc's or memcpy's occur during
+ *	data fetches. As such, the library is extremely simple because it
+ *	requires no page caching layer of its own, and it is extremely high
+ *	performance and memory-efficient. It is also fully transactional with
+ *	full ACID semantics, and when the memory map is read-only, the
+ *	database integrity cannot be corrupted by stray pointer writes from
+ *	application code.
+ *
+ *	The library is fully thread-aware and supports concurrent read/write
+ *	access from multiple processes and threads. Data pages use a copy-on-
+ *	write strategy so no active data pages are ever overwritten, which
+ *	also provides resistance to corruption and eliminates the need of any
+ *	special recovery procedures after a system crash. Writes are fully
+ *	serialized; only one write transaction may be active at a time, which
+ *	guarantees that writers can never deadlock. The database structure is
+ *	multi-versioned so readers run with no locks; writers cannot block
+ *	readers, and readers don't block writers.
+ *
+ *	Unlike other well-known database mechanisms which use either write-ahead
+ *	transaction logs or append-only data writes, LMDB requires no maintenance
+ *	during operation. Both write-ahead loggers and append-only databases
+ *	require periodic checkpointing and/or compaction of their log or database
+ *	files otherwise they grow without bound. LMDB tracks free pages within
+ *	the database and re-uses them for new write operations, so the database
+ *	size does not grow without bound in normal use.
+ *
+ *	The memory map can be used as a read-only or read-write map. It is
+ *	read-only by default as this provides total immunity to corruption.
+ *	Using read-write mode offers much higher write performance, but adds
+ *	the possibility for stray application writes thru pointers to silently
+ *	corrupt the database. Of course if your application code is known to
+ *	be bug-free (...) then this is not an issue.
+ *
+ *	If this is your first time using a transactional embedded key/value
+ *	store, you may find the \ref starting page to be helpful.
+ *
+ *	@section caveats_sec Caveats
+ *	Troubleshooting the lock file, plus semaphores on BSD systems:
+ *
+ *	- A broken lockfile can cause sync issues.
+ *	  Stale reader transactions left behind by an aborted program
+ *	  cause further writes to grow the database quickly, and
+ *	  stale locks can block further operation.
+ *
+ *	  Fix: Check for stale readers periodically, using the
+ *	  #mdb_reader_check function or the \ref mdb_stat_1 "mdb_stat" tool.
+ *	  Stale writers will be cleared automatically on most systems:
+ *	  - Windows - automatic
+ *	  - BSD, systems using SysV semaphores - automatic
+ *	  - Linux, systems using POSIX mutexes with Robust option - automatic
+ *	  Otherwise just make all programs using the database close it;
+ *	  the lockfile is always reset on first open of the environment.
+ *
+ *	- On BSD systems or others configured with MDB_USE_SYSV_SEM or
+ *	  MDB_USE_POSIX_SEM,
+ *	  startup can fail due to semaphores owned by another userid.
+ *
+ *	  Fix: Open and close the database as the user which owns the
+ *	  semaphores (likely last user) or as root, while no other
+ *	  process is using the database.
+ *
+ *	Restrictions/caveats (in addition to those listed for some functions):
+ *
+ *	- Only the database owner should normally use the database on
+ *	  BSD systems or when otherwise configured with MDB_USE_POSIX_SEM.
+ *	  Multiple users can cause startup to fail later, as noted above.
+ *
+ *	- There is normally no pure read-only mode, since readers need write
+ *	  access to locks and lock file. Exceptions: On read-only filesystems
+ *	  or with the #MDB_NOLOCK flag described under #mdb_env_open().
+ *
+ *	- An LMDB configuration will often reserve considerable \b unused
+ *	  memory address space and maybe file size for future growth.
+ *	  This does not use actual memory or disk space, but users may need
+ *	  to understand the difference so they won't be scared off.
+ *
+ *	- By default, in versions before 0.9.10, unused portions of the data
+ *	  file might receive garbage data from memory freed by other code.
+ *	  (This does not happen when using the #MDB_WRITEMAP flag.) As of
+ *	  0.9.10 the default behavior is to initialize such memory before
+ *	  writing to the data file. Since there may be a slight performance
+ *	  cost due to this initialization, applications may disable it using
+ *	  the #MDB_NOMEMINIT flag. Applications handling sensitive data
+ *	  which must not be written should not use this flag. This flag is
+ *	  irrelevant when using #MDB_WRITEMAP.
+ *
+ *	- A thread can only use one transaction at a time, plus any child
+ *	  transactions.  Each transaction belongs to one thread.  See below.
+ *	  The #MDB_NOTLS flag changes this for read-only transactions.
+ *
+ *	- Use an MDB_env* in the process which opened it, not after fork().
+ *
+ *	- Do not have open an LMDB database twice in the same process at
+ *	  the same time.  Not even from a plain open() call - close()ing it
+ *	  breaks fcntl() advisory locking.  (It is OK to reopen it after
+ *	  fork() - exec*(), since the lockfile has FD_CLOEXEC set.)
+ *
+ *	- Avoid long-lived transactions.  Read transactions prevent
+ *	  reuse of pages freed by newer write transactions, thus the
+ *	  database can grow quickly.  Write transactions prevent
+ *	  other write transactions, since writes are serialized.
+ *
+ *	- Avoid suspending a process with active transactions.  These
+ *	  would then be "long-lived" as above.  Also read transactions
+ *	  suspended when writers commit could sometimes see wrong data.
+ *
+ *	...when several processes can use a database concurrently:
+ *
+ *	- Avoid aborting a process with an active transaction.
+ *	  The transaction becomes "long-lived" as above until a check
+ *	  for stale readers is performed or the lockfile is reset,
+ *	  since the process may not remove it from the lockfile.
+ *
+ *	  This does not apply to write transactions if the system clears
+ *	  stale writers, see above.
+ *
+ *	- If you do that anyway, do a periodic check for stale readers. Or
+ *	  close the environment once in a while, so the lockfile can get reset.
+ *
+ *	- Do not use LMDB databases on remote filesystems, even between
+ *	  processes on the same host.  This breaks flock() on some OSes,
+ *	  possibly memory map sync, and certainly sync between programs
+ *	  on different hosts.
+ *
+ *	- Opening a database can fail if another process is opening or
+ *	  closing it at exactly the same time.
+ *
+ *	@author	Howard Chu, Symas Corporation.
+ *
+ *	@copyright Copyright 2011-2018 Howard Chu, Symas Corp. All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted only as authorized by the OpenLDAP
+ * Public License.
+ *
+ * A copy of this license is available in the file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ *
+ *	@par Derived From:
+ * This code is derived from btree.c written by Martin Hedenfalk.
+ *
+ * Copyright (c) 2009, 2010 Martin Hedenfalk <martin@bzero.se>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+#ifndef _LMDB_H_
+#define _LMDB_H_
+
+#include <sys/types.h>
+#include <inttypes.h>
+#include <limits.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/** Unix permissions for creating files, or dummy definition for Windows */
+#ifdef _MSC_VER
+typedef	int	mdb_mode_t;
+#else
+typedef	mode_t	mdb_mode_t;
+#endif
+
+#ifdef _WIN32
+# define MDB_FMT_Z	"I"
+#else
+# define MDB_FMT_Z	"z"			/**< printf/scanf format modifier for size_t */
+#endif
+
+#ifndef MDB_VL32
+/** Unsigned type used for mapsize, entry counts and page/transaction IDs.
+ *
+ *	It is normally size_t, hence the name. Defining MDB_VL32 makes it
+ *	uint64_t, but do not try this unless you know what you are doing.
+ */
+typedef size_t	mdb_size_t;
+# define MDB_SIZE_MAX	SIZE_MAX	/**< max #mdb_size_t */
+/** #mdb_size_t printf formats, \b t = one of [diouxX] without quotes */
+# define MDB_PRIy(t)	MDB_FMT_Z #t
+/** #mdb_size_t scanf formats, \b t = one of [dioux] without quotes */
+# define MDB_SCNy(t)	MDB_FMT_Z #t
+#else
+typedef uint64_t	mdb_size_t;
+# define MDB_SIZE_MAX	UINT64_MAX
+# define MDB_PRIy(t)	PRI##t##64
+# define MDB_SCNy(t)	SCN##t##64
+# define mdb_env_create	mdb_env_create_vl32	/**< Prevent mixing with non-VL32 builds */
+#endif
+
+/** An abstraction for a file handle.
+ *	On POSIX systems file handles are small integers. On Windows
+ *	they're opaque pointers.
+ */
+#ifdef _WIN32
+typedef	void *mdb_filehandle_t;
+#else
+typedef int mdb_filehandle_t;
+#endif
+
+/** @defgroup mdb LMDB API
+ *	@{
+ *	@brief OpenLDAP Lightning Memory-Mapped Database Manager
+ */
+/** @defgroup Version Version Macros
+ *	@{
+ */
+/** Library major version */
+#define MDB_VERSION_MAJOR	0
+/** Library minor version */
+#define MDB_VERSION_MINOR	9
+/** Library patch version */
+#define MDB_VERSION_PATCH	70
+
+/** Combine args a,b,c into a single integer for easy version comparisons */
+#define MDB_VERINT(a,b,c)	(((a) << 24) | ((b) << 16) | (c))
+
+/** The full library version as a single integer */
+#define MDB_VERSION_FULL	\
+	MDB_VERINT(MDB_VERSION_MAJOR,MDB_VERSION_MINOR,MDB_VERSION_PATCH)
+
+/** The release date of this library version */
+#define MDB_VERSION_DATE	"December 19, 2015"
+
+/** A stringifier for the version info */
+#define MDB_VERSTR(a,b,c,d)	"LMDB " #a "." #b "." #c ": (" d ")"
+
+/** A helper for the stringifier macro */
+#define MDB_VERFOO(a,b,c,d)	MDB_VERSTR(a,b,c,d)
+
+/** The full library version as a C string */
+#define	MDB_VERSION_STRING	\
+	MDB_VERFOO(MDB_VERSION_MAJOR,MDB_VERSION_MINOR,MDB_VERSION_PATCH,MDB_VERSION_DATE)
+/**	@} */
+
+/** @brief Opaque structure for a database environment.
+ *
+ * A DB environment supports multiple databases, all residing in the same
+ * shared-memory map.
+ */
+typedef struct MDB_env MDB_env;
+
+/** @brief Opaque structure for a transaction handle.
+ *
+ * All database operations require a transaction handle. Transactions may be
+ * read-only or read-write.
+ */
+typedef struct MDB_txn MDB_txn;
+
+/** @brief A handle for an individual database in the DB environment. */
+typedef unsigned int	MDB_dbi;
+
+/** @brief Opaque structure for navigating through a database */
+typedef struct MDB_cursor MDB_cursor;
+
+/** @brief Generic structure used for passing keys and data in and out
+ * of the database.
+ *
+ * Values returned from the database are valid only until a subsequent
+ * update operation, or the end of the transaction. Do not modify or
+ * free them, they commonly point into the database itself.
+ *
+ * Key sizes must be between 1 and #mdb_env_get_maxkeysize() inclusive.
+ * The same applies to data sizes in databases with the #MDB_DUPSORT flag.
+ * Other data items can in theory be from 0 to 0xffffffff bytes long.
+ */
+typedef struct MDB_val {
+	size_t		 mv_size;	/**< size of the data item */
+	void		*mv_data;	/**< address of the data item */
+} MDB_val;
+
+/** @brief A callback function used to compare two keys in a database */
+typedef int  (MDB_cmp_func)(const MDB_val *a, const MDB_val *b);
+
+/** @brief A callback function used to relocate a position-dependent data item
+ * in a fixed-address database.
+ *
+ * The \b newptr gives the item's desired address in
+ * the memory map, and \b oldptr gives its previous address. The item's actual
+ * data resides at the address in \b item.  This callback is expected to walk
+ * through the fields of the record in \b item and modify any
+ * values based at the \b oldptr address to be relative to the \b newptr address.
+ * @param[in,out] item The item that is to be relocated.
+ * @param[in] oldptr The previous address.
+ * @param[in] newptr The new address to relocate to.
+ * @param[in] relctx An application-provided context, set by #mdb_set_relctx().
+ * @todo This feature is currently unimplemented.
+ */
+typedef void (MDB_rel_func)(MDB_val *item, void *oldptr, void *newptr, void *relctx);
+
+/** @defgroup	mdb_env	Environment Flags
+ *	@{
+ */
+	/** mmap at a fixed address (experimental) */
+#define MDB_FIXEDMAP	0x01
+	/** no environment directory */
+#define MDB_NOSUBDIR	0x4000
+	/** don't fsync after commit */
+#define MDB_NOSYNC		0x10000
+	/** read only */
+#define MDB_RDONLY		0x20000
+	/** don't fsync metapage after commit */
+#define MDB_NOMETASYNC		0x40000
+	/** use writable mmap */
+#define MDB_WRITEMAP		0x80000
+	/** use asynchronous msync when #MDB_WRITEMAP is used */
+#define MDB_MAPASYNC		0x100000
+	/** tie reader locktable slots to #MDB_txn objects instead of to threads */
+#define MDB_NOTLS		0x200000
+	/** don't do any locking, caller must manage their own locks */
+#define MDB_NOLOCK		0x400000
+	/** don't do readahead (no effect on Windows) */
+#define MDB_NORDAHEAD	0x800000
+	/** don't initialize malloc'd memory before writing to datafile */
+#define MDB_NOMEMINIT	0x1000000
+	/** use the previous meta page rather than the latest one */
+#define MDB_PREVMETA	0x2000000
+/** @} */
+
+/**	@defgroup	mdb_dbi_open	Database Flags
+ *	@{
+ */
+	/** use reverse string keys */
+#define MDB_REVERSEKEY	0x02
+	/** use sorted duplicates */
+#define MDB_DUPSORT		0x04
+	/** numeric keys in native byte order, either unsigned int or #mdb_size_t.
+	 *	(lmdb expects 32-bit int <= size_t <= 32/64-bit mdb_size_t.)
+	 *  The keys must all be of the same size. */
+#define MDB_INTEGERKEY	0x08
+	/** with #MDB_DUPSORT, sorted dup items have fixed size */
+#define MDB_DUPFIXED	0x10
+	/** with #MDB_DUPSORT, dups are #MDB_INTEGERKEY-style integers */
+#define MDB_INTEGERDUP	0x20
+	/** with #MDB_DUPSORT, use reverse string dups */
+#define MDB_REVERSEDUP	0x40
+	/** create DB if not already existing */
+#define MDB_CREATE		0x40000
+/** @} */
+
+/**	@defgroup mdb_put	Write Flags
+ *	@{
+ */
+/** For put: Don't write if the key already exists. */
+#define MDB_NOOVERWRITE	0x10
+/** Only for #MDB_DUPSORT<br>
+ * For put: don't write if the key and data pair already exist.<br>
+ * For mdb_cursor_del: remove all duplicate data items.
+ */
+#define MDB_NODUPDATA	0x20
+/** For mdb_cursor_put: overwrite the current key/data pair */
+#define MDB_CURRENT	0x40
+/** For put: Just reserve space for data, don't copy it. Return a
+ * pointer to the reserved space.
+ */
+#define MDB_RESERVE	0x10000
+/** Data is being appended, don't split full pages. */
+#define MDB_APPEND	0x20000
+/** Duplicate data is being appended, don't split full pages. */
+#define MDB_APPENDDUP	0x40000
+/** Store multiple data items in one call. Only for #MDB_DUPFIXED. */
+#define MDB_MULTIPLE	0x80000
+/*	@} */
+
+/**	@defgroup mdb_copy	Copy Flags
+ *	@{
+ */
+/** Compacting copy: Omit free space from copy, and renumber all
+ * pages sequentially.
+ */
+#define MDB_CP_COMPACT	0x01
+/*	@} */
+
+/** @brief Cursor Get operations.
+ *
+ *	This is the set of all operations for retrieving data
+ *	using a cursor.
+ */
+typedef enum MDB_cursor_op {
+	MDB_FIRST,				/**< Position at first key/data item */
+	MDB_FIRST_DUP,			/**< Position at first data item of current key.
+								Only for #MDB_DUPSORT */
+	MDB_GET_BOTH,			/**< Position at key/data pair. Only for #MDB_DUPSORT */
+	MDB_GET_BOTH_RANGE,		/**< position at key, nearest data. Only for #MDB_DUPSORT */
+	MDB_GET_CURRENT,		/**< Return key/data at current cursor position */
+	MDB_GET_MULTIPLE,		/**< Return key and up to a page of duplicate data items
+								from current cursor position. Move cursor to prepare
+								for #MDB_NEXT_MULTIPLE. Only for #MDB_DUPFIXED */
+	MDB_LAST,				/**< Position at last key/data item */
+	MDB_LAST_DUP,			/**< Position at last data item of current key.
+								Only for #MDB_DUPSORT */
+	MDB_NEXT,				/**< Position at next data item */
+	MDB_NEXT_DUP,			/**< Position at next data item of current key.
+								Only for #MDB_DUPSORT */
+	MDB_NEXT_MULTIPLE,		/**< Return key and up to a page of duplicate data items
+								from next cursor position. Move cursor to prepare
+								for #MDB_NEXT_MULTIPLE. Only for #MDB_DUPFIXED */
+	MDB_NEXT_NODUP,			/**< Position at first data item of next key */
+	MDB_PREV,				/**< Position at previous data item */
+	MDB_PREV_DUP,			/**< Position at previous data item of current key.
+								Only for #MDB_DUPSORT */
+	MDB_PREV_NODUP,			/**< Position at last data item of previous key */
+	MDB_SET,				/**< Position at specified key */
+	MDB_SET_KEY,			/**< Position at specified key, return key + data */
+	MDB_SET_RANGE,			/**< Position at first key greater than or equal to specified key. */
+	MDB_PREV_MULTIPLE		/**< Position at previous page and return key and up to
+								a page of duplicate data items. Only for #MDB_DUPFIXED */
+} MDB_cursor_op;
+
+/** @defgroup  errors	Return Codes
+ *
+ *	BerkeleyDB uses -30800 to -30999, we'll go under them
+ *	@{
+ */
+	/**	Successful result */
+#define MDB_SUCCESS	 0
+	/** key/data pair already exists */
+#define MDB_KEYEXIST	(-30799)
+	/** key/data pair not found (EOF) */
+#define MDB_NOTFOUND	(-30798)
+	/** Requested page not found - this usually indicates corruption */
+#define MDB_PAGE_NOTFOUND	(-30797)
+	/** Located page was wrong type */
+#define MDB_CORRUPTED	(-30796)
+	/** Update of meta page failed or environment had fatal error */
+#define MDB_PANIC		(-30795)
+	/** Environment version mismatch */
+#define MDB_VERSION_MISMATCH	(-30794)
+	/** File is not a valid LMDB file */
+#define MDB_INVALID	(-30793)
+	/** Environment mapsize reached */
+#define MDB_MAP_FULL	(-30792)
+	/** Environment maxdbs reached */
+#define MDB_DBS_FULL	(-30791)
+	/** Environment maxreaders reached */
+#define MDB_READERS_FULL	(-30790)
+	/** Too many TLS keys in use - Windows only */
+#define MDB_TLS_FULL	(-30789)
+	/** Txn has too many dirty pages */
+#define MDB_TXN_FULL	(-30788)
+	/** Cursor stack too deep - internal error */
+#define MDB_CURSOR_FULL	(-30787)
+	/** Page has not enough space - internal error */
+#define MDB_PAGE_FULL	(-30786)
+	/** Database contents grew beyond environment mapsize */
+#define MDB_MAP_RESIZED	(-30785)
+	/** Operation and DB incompatible, or DB type changed. This can mean:
+	 *	<ul>
+	 *	<li>The operation expects an #MDB_DUPSORT / #MDB_DUPFIXED database.
+	 *	<li>Opening a named DB when the unnamed DB has #MDB_DUPSORT / #MDB_INTEGERKEY.
+	 *	<li>Accessing a data record as a database, or vice versa.
+	 *	<li>The database was dropped and recreated with different flags.
+	 *	</ul>
+	 */
+#define MDB_INCOMPATIBLE	(-30784)
+	/** Invalid reuse of reader locktable slot */
+#define MDB_BAD_RSLOT		(-30783)
+	/** Transaction must abort, has a child, or is invalid */
+#define MDB_BAD_TXN			(-30782)
+	/** Unsupported size of key/DB name/data, or wrong DUPFIXED size */
+#define MDB_BAD_VALSIZE		(-30781)
+	/** The specified DBI was changed unexpectedly */
+#define MDB_BAD_DBI		(-30780)
+	/** Unexpected problem - txn should abort */
+#define MDB_PROBLEM		(-30779)
+	/** The last defined error code */
+#define MDB_LAST_ERRCODE	MDB_PROBLEM
+/** @} */
+
+/** @brief Statistics for a database in the environment */
+typedef struct MDB_stat {
+	unsigned int	ms_psize;			/**< Size of a database page.
+											This is currently the same for all databases. */
+	unsigned int	ms_depth;			/**< Depth (height) of the B-tree */
+	mdb_size_t		ms_branch_pages;	/**< Number of internal (non-leaf) pages */
+	mdb_size_t		ms_leaf_pages;		/**< Number of leaf pages */
+	mdb_size_t		ms_overflow_pages;	/**< Number of overflow pages */
+	mdb_size_t		ms_entries;			/**< Number of data items */
+} MDB_stat;
+
+/** @brief Information about the environment */
+typedef struct MDB_envinfo {
+	void	*me_mapaddr;			/**< Address of map, if fixed */
+	mdb_size_t	me_mapsize;				/**< Size of the data memory map */
+	mdb_size_t	me_last_pgno;			/**< ID of the last used page */
+	mdb_size_t	me_last_txnid;			/**< ID of the last committed transaction */
+	unsigned int me_maxreaders;		/**< max reader slots in the environment */
+	unsigned int me_numreaders;		/**< max reader slots used in the environment */
+} MDB_envinfo;
+
+	/** @brief Return the LMDB library version information.
+	 *
+	 * @param[out] major if non-NULL, the library major version number is copied here
+	 * @param[out] minor if non-NULL, the library minor version number is copied here
+	 * @param[out] patch if non-NULL, the library patch version number is copied here
+	 * @retval "version string" The library version as a string
+	 */
+char *mdb_version(int *major, int *minor, int *patch);
+
+	/** @brief Return a string describing a given error code.
+	 *
+	 * This function is a superset of the ANSI C X3.159-1989 (ANSI C) strerror(3)
+	 * function. If the error code is greater than or equal to 0, then the string
+	 * returned by the system function strerror(3) is returned. If the error code
+	 * is less than 0, an error string corresponding to the LMDB library error is
+	 * returned. See @ref errors for a list of LMDB-specific error codes.
+	 * @param[in] err The error code
+	 * @retval "error message" The description of the error
+	 */
+char *mdb_strerror(int err);
+
+	/** @brief Create an LMDB environment handle.
+	 *
+	 * This function allocates memory for a #MDB_env structure. To release
+	 * the allocated memory and discard the handle, call #mdb_env_close().
+	 * Before the handle may be used, it must be opened using #mdb_env_open().
+	 * Various other options may also need to be set before opening the handle,
+	 * e.g. #mdb_env_set_mapsize(), #mdb_env_set_maxreaders(), #mdb_env_set_maxdbs(),
+	 * depending on usage requirements.
+	 * @param[out] env The address where the new handle will be stored
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_create(MDB_env **env);
+
+	/** @brief Open an environment handle.
+	 *
+	 * If this function fails, #mdb_env_close() must be called to discard the #MDB_env handle.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] path The directory in which the database files reside. This
+	 * directory must already exist and be writable.
+	 * @param[in] flags Special options for this environment. This parameter
+	 * must be set to 0 or by bitwise OR'ing together one or more of the
+	 * values described here.
+	 * Flags set by mdb_env_set_flags() are also used.
+	 * <ul>
+	 *	<li>#MDB_FIXEDMAP
+	 *      use a fixed address for the mmap region. This flag must be specified
+	 *      when creating the environment, and is stored persistently in the environment.
+	 *		If successful, the memory map will always reside at the same virtual address
+	 *		and pointers used to reference data items in the database will be constant
+	 *		across multiple invocations. This option may not always work, depending on
+	 *		how the operating system has allocated memory to shared libraries and other uses.
+	 *		The feature is highly experimental.
+	 *	<li>#MDB_NOSUBDIR
+	 *		By default, LMDB creates its environment in a directory whose
+	 *		pathname is given in \b path, and creates its data and lock files
+	 *		under that directory. With this option, \b path is used as-is for
+	 *		the database main data file. The database lock file is the \b path
+	 *		with "-lock" appended.
+	 *	<li>#MDB_RDONLY
+	 *		Open the environment in read-only mode. No write operations will be
+	 *		allowed. LMDB will still modify the lock file - except on read-only
+	 *		filesystems, where LMDB does not use locks.
+	 *	<li>#MDB_WRITEMAP
+	 *		Use a writeable memory map unless MDB_RDONLY is set. This uses
+	 *		fewer mallocs but loses protection from application bugs
+	 *		like wild pointer writes and other bad updates into the database.
+	 *		This may be slightly faster for DBs that fit entirely in RAM, but
+	 *		is slower for DBs larger than RAM.
+	 *		Incompatible with nested transactions.
+	 *		Do not mix processes with and without MDB_WRITEMAP on the same
+	 *		environment.  This can defeat durability (#mdb_env_sync etc).
+	 *	<li>#MDB_NOMETASYNC
+	 *		Flush system buffers to disk only once per transaction, omit the
+	 *		metadata flush. Defer that until the system flushes files to disk,
+	 *		or next non-MDB_RDONLY commit or #mdb_env_sync(). This optimization
+	 *		maintains database integrity, but a system crash may undo the last
+	 *		committed transaction. I.e. it preserves the ACI (atomicity,
+	 *		consistency, isolation) but not D (durability) database property.
+	 *		This flag may be changed at any time using #mdb_env_set_flags().
+	 *	<li>#MDB_NOSYNC
+	 *		Don't flush system buffers to disk when committing a transaction.
+	 *		This optimization means a system crash can corrupt the database or
+	 *		lose the last transactions if buffers are not yet flushed to disk.
+	 *		The risk is governed by how often the system flushes dirty buffers
+	 *		to disk and how often #mdb_env_sync() is called.  However, if the
+	 *		filesystem preserves write order and the #MDB_WRITEMAP flag is not
+	 *		used, transactions exhibit ACI (atomicity, consistency, isolation)
+	 *		properties and only lose D (durability).  I.e. database integrity
+	 *		is maintained, but a system crash may undo the final transactions.
+	 *		Note that (#MDB_NOSYNC | #MDB_WRITEMAP) leaves the system with no
+	 *		hint for when to write transactions to disk, unless #mdb_env_sync()
+	 *		is called. (#MDB_MAPASYNC | #MDB_WRITEMAP) may be preferable.
+	 *		This flag may be changed at any time using #mdb_env_set_flags().
+	 *	<li>#MDB_MAPASYNC
+	 *		When using #MDB_WRITEMAP, use asynchronous flushes to disk.
+	 *		As with #MDB_NOSYNC, a system crash can then corrupt the
+	 *		database or lose the last transactions. Calling #mdb_env_sync()
+	 *		ensures on-disk database integrity until next commit.
+	 *		This flag may be changed at any time using #mdb_env_set_flags().
+	 *	<li>#MDB_NOTLS
+	 *		Don't use Thread-Local Storage. Tie reader locktable slots to
+	 *		#MDB_txn objects instead of to threads. I.e. #mdb_txn_reset() keeps
+	 *		the slot reseved for the #MDB_txn object. A thread may use parallel
+	 *		read-only transactions. A read-only transaction may span threads if
+	 *		the user synchronizes its use. Applications that multiplex many
+	 *		user threads over individual OS threads need this option. Such an
+	 *		application must also serialize the write transactions in an OS
+	 *		thread, since LMDB's write locking is unaware of the user threads.
+	 *	<li>#MDB_NOLOCK
+	 *		Don't do any locking. If concurrent access is anticipated, the
+	 *		caller must manage all concurrency itself. For proper operation
+	 *		the caller must enforce single-writer semantics, and must ensure
+	 *		that no readers are using old transactions while a writer is
+	 *		active. The simplest approach is to use an exclusive lock so that
+	 *		no readers may be active at all when a writer begins.
+	 *	<li>#MDB_NORDAHEAD
+	 *		Turn off readahead. Most operating systems perform readahead on
+	 *		read requests by default. This option turns it off if the OS
+	 *		supports it. Turning it off may help random read performance
+	 *		when the DB is larger than RAM and system RAM is full.
+	 *		The option is not implemented on Windows.
+	 *	<li>#MDB_NOMEMINIT
+	 *		Don't initialize malloc'd memory before writing to unused spaces
+	 *		in the data file. By default, memory for pages written to the data
+	 *		file is obtained using malloc. While these pages may be reused in
+	 *		subsequent transactions, freshly malloc'd pages will be initialized
+	 *		to zeroes before use. This avoids persisting leftover data from other
+	 *		code (that used the heap and subsequently freed the memory) into the
+	 *		data file. Note that many other system libraries may allocate
+	 *		and free memory from the heap for arbitrary uses. E.g., stdio may
+	 *		use the heap for file I/O buffers. This initialization step has a
+	 *		modest performance cost so some applications may want to disable
+	 *		it using this flag. This option can be a problem for applications
+	 *		which handle sensitive data like passwords, and it makes memory
+	 *		checkers like Valgrind noisy. This flag is not needed with #MDB_WRITEMAP,
+	 *		which writes directly to the mmap instead of using malloc for pages. The
+	 *		initialization is also skipped if #MDB_RESERVE is used; the
+	 *		caller is expected to overwrite all of the memory that was
+	 *		reserved in that case.
+	 *		This flag may be changed at any time using #mdb_env_set_flags().
+	 *	<li>#MDB_PREVMETA
+	 *		Open the environment with the previous meta page rather than the latest
+	 *		one. This loses the latest transaction, but may help work around some
+	 *		types of corruption.
+	 * </ul>
+	 * @param[in] mode The UNIX permissions to set on created files and semaphores.
+	 * This parameter is ignored on Windows.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_VERSION_MISMATCH - the version of the LMDB library doesn't match the
+	 *	version that created the database environment.
+	 *	<li>#MDB_INVALID - the environment file headers are corrupted.
+	 *	<li>ENOENT - the directory specified by the path parameter doesn't exist.
+	 *	<li>EACCES - the user didn't have permission to access the environment files.
+	 *	<li>EAGAIN - the environment was locked by another process.
+	 * </ul>
+	 */
+int  mdb_env_open(MDB_env *env, const char *path, unsigned int flags, mdb_mode_t mode);
+
+	/** @brief Copy an LMDB environment to the specified path.
+	 *
+	 * This function may be used to make a backup of an existing environment.
+	 * No lockfile is created, since it gets recreated at need.
+	 * @note This call can trigger significant file size growth if run in
+	 * parallel with write transactions, because it employs a read-only
+	 * transaction. See long-lived transactions under @ref caveats_sec.
+	 * @param[in] env An environment handle returned by #mdb_env_create(). It
+	 * must have already been opened successfully.
+	 * @param[in] path The directory in which the copy will reside. This
+	 * directory must already exist and be writable but must otherwise be
+	 * empty.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_copy(MDB_env *env, const char *path);
+
+	/** @brief Copy an LMDB environment to the specified file descriptor.
+	 *
+	 * This function may be used to make a backup of an existing environment.
+	 * No lockfile is created, since it gets recreated at need.
+	 * @note This call can trigger significant file size growth if run in
+	 * parallel with write transactions, because it employs a read-only
+	 * transaction. See long-lived transactions under @ref caveats_sec.
+	 * @param[in] env An environment handle returned by #mdb_env_create(). It
+	 * must have already been opened successfully.
+	 * @param[in] fd The filedescriptor to write the copy to. It must
+	 * have already been opened for Write access.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_copyfd(MDB_env *env, mdb_filehandle_t fd);
+
+	/** @brief Copy an LMDB environment to the specified path, with options.
+	 *
+	 * This function may be used to make a backup of an existing environment.
+	 * No lockfile is created, since it gets recreated at need.
+	 * @note This call can trigger significant file size growth if run in
+	 * parallel with write transactions, because it employs a read-only
+	 * transaction. See long-lived transactions under @ref caveats_sec.
+	 * @param[in] env An environment handle returned by #mdb_env_create(). It
+	 * must have already been opened successfully.
+	 * @param[in] path The directory in which the copy will reside. This
+	 * directory must already exist and be writable but must otherwise be
+	 * empty.
+	 * @param[in] flags Special options for this operation. This parameter
+	 * must be set to 0 or by bitwise OR'ing together one or more of the
+	 * values described here.
+	 * <ul>
+	 *	<li>#MDB_CP_COMPACT - Perform compaction while copying: omit free
+	 *		pages and sequentially renumber all pages in output. This option
+	 *		consumes more CPU and runs more slowly than the default.
+	 *		Currently it fails if the environment has suffered a page leak.
+	 * </ul>
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_copy2(MDB_env *env, const char *path, unsigned int flags);
+
+	/** @brief Copy an LMDB environment to the specified file descriptor,
+	 *	with options.
+	 *
+	 * This function may be used to make a backup of an existing environment.
+	 * No lockfile is created, since it gets recreated at need. See
+	 * #mdb_env_copy2() for further details.
+	 * @note This call can trigger significant file size growth if run in
+	 * parallel with write transactions, because it employs a read-only
+	 * transaction. See long-lived transactions under @ref caveats_sec.
+	 * @param[in] env An environment handle returned by #mdb_env_create(). It
+	 * must have already been opened successfully.
+	 * @param[in] fd The filedescriptor to write the copy to. It must
+	 * have already been opened for Write access.
+	 * @param[in] flags Special options for this operation.
+	 * See #mdb_env_copy2() for options.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_copyfd2(MDB_env *env, mdb_filehandle_t fd, unsigned int flags);
+
+	/** @brief Return statistics about the LMDB environment.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] stat The address of an #MDB_stat structure
+	 * 	where the statistics will be copied
+	 */
+int  mdb_env_stat(MDB_env *env, MDB_stat *stat);
+
+	/** @brief Return information about the LMDB environment.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] stat The address of an #MDB_envinfo structure
+	 * 	where the information will be copied
+	 */
+int  mdb_env_info(MDB_env *env, MDB_envinfo *stat);
+
+	/** @brief Flush the data buffers to disk.
+	 *
+	 * Data is always written to disk when #mdb_txn_commit() is called,
+	 * but the operating system may keep it buffered. LMDB always flushes
+	 * the OS buffers upon commit as well, unless the environment was
+	 * opened with #MDB_NOSYNC or in part #MDB_NOMETASYNC. This call is
+	 * not valid if the environment was opened with #MDB_RDONLY.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] force If non-zero, force a synchronous flush.  Otherwise
+	 *  if the environment has the #MDB_NOSYNC flag set the flushes
+	 *	will be omitted, and with #MDB_MAPASYNC they will be asynchronous.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EACCES - the environment is read-only.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 *	<li>EIO - an error occurred during synchronization.
+	 * </ul>
+	 */
+int  mdb_env_sync(MDB_env *env, int force);
+
+	/** @brief Close the environment and release the memory map.
+	 *
+	 * Only a single thread may call this function. All transactions, databases,
+	 * and cursors must already be closed before calling this function. Attempts to
+	 * use any such handles after calling this function will cause a SIGSEGV.
+	 * The environment handle will be freed and must not be used again after this call.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 */
+void mdb_env_close(MDB_env *env);
+
+	/** @brief Set environment flags.
+	 *
+	 * This may be used to set some flags in addition to those from
+	 * #mdb_env_open(), or to unset these flags.  If several threads
+	 * change the flags at the same time, the result is undefined.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] flags The flags to change, bitwise OR'ed together
+	 * @param[in] onoff A non-zero value sets the flags, zero clears them.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_env_set_flags(MDB_env *env, unsigned int flags, int onoff);
+
+	/** @brief Get environment flags.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] flags The address of an integer to store the flags
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_env_get_flags(MDB_env *env, unsigned int *flags);
+
+	/** @brief Return the path that was used in #mdb_env_open().
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] path Address of a string pointer to contain the path. This
+	 * is the actual string in the environment, not a copy. It should not be
+	 * altered in any way.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_env_get_path(MDB_env *env, const char **path);
+
+	/** @brief Return the filedescriptor for the given environment.
+	 *
+	 * This function may be called after fork(), so the descriptor can be
+	 * closed before exec*().  Other LMDB file descriptors have FD_CLOEXEC.
+	 * (Until LMDB 0.9.18, only the lockfile had that.)
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] fd Address of a mdb_filehandle_t to contain the descriptor.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_env_get_fd(MDB_env *env, mdb_filehandle_t *fd);
+
+	/** @brief Set the size of the memory map to use for this environment.
+	 *
+	 * The size should be a multiple of the OS page size. The default is
+	 * 10485760 bytes. The size of the memory map is also the maximum size
+	 * of the database. The value should be chosen as large as possible,
+	 * to accommodate future growth of the database.
+	 * This function should be called after #mdb_env_create() and before #mdb_env_open().
+	 * It may be called at later times if no transactions are active in
+	 * this process. Note that the library does not check for this condition,
+	 * the caller must ensure it explicitly.
+	 *
+	 * The new size takes effect immediately for the current process but
+	 * will not be persisted to any others until a write transaction has been
+	 * committed by the current process. Also, only mapsize increases are
+	 * persisted into the environment.
+	 *
+	 * If the mapsize is increased by another process, and data has grown
+	 * beyond the range of the current mapsize, #mdb_txn_begin() will
+	 * return #MDB_MAP_RESIZED. This function may be called with a size
+	 * of zero to adopt the new size.
+	 *
+	 * Any attempt to set a size smaller than the space already consumed
+	 * by the environment will be silently changed to the current size of the used space.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] size The size in bytes
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified, or the environment has
+	 *   	an active write transaction.
+	 * </ul>
+	 */
+int  mdb_env_set_mapsize(MDB_env *env, mdb_size_t size);
+
+	/** @brief Set the maximum number of threads/reader slots for the environment.
+	 *
+	 * This defines the number of slots in the lock table that is used to track readers in the
+	 * the environment. The default is 126.
+	 * Starting a read-only transaction normally ties a lock table slot to the
+	 * current thread until the environment closes or the thread exits. If
+	 * MDB_NOTLS is in use, #mdb_txn_begin() instead ties the slot to the
+	 * MDB_txn object until it or the #MDB_env object is destroyed.
+	 * This function may only be called after #mdb_env_create() and before #mdb_env_open().
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] readers The maximum number of reader lock table slots
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified, or the environment is already open.
+	 * </ul>
+	 */
+int  mdb_env_set_maxreaders(MDB_env *env, unsigned int readers);
+
+	/** @brief Get the maximum number of threads/reader slots for the environment.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] readers Address of an integer to store the number of readers
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_env_get_maxreaders(MDB_env *env, unsigned int *readers);
+
+	/** @brief Set the maximum number of named databases for the environment.
+	 *
+	 * This function is only needed if multiple databases will be used in the
+	 * environment. Simpler applications that use the environment as a single
+	 * unnamed database can ignore this option.
+	 * This function may only be called after #mdb_env_create() and before #mdb_env_open().
+	 *
+	 * Currently a moderate number of slots are cheap but a huge number gets
+	 * expensive: 7-120 words per transaction, and every #mdb_dbi_open()
+	 * does a linear search of the opened slots.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] dbs The maximum number of databases
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified, or the environment is already open.
+	 * </ul>
+	 */
+int  mdb_env_set_maxdbs(MDB_env *env, MDB_dbi dbs);
+
+	/** @brief Get the maximum size of keys and #MDB_DUPSORT data we can write.
+	 *
+	 * Depends on the compile-time constant #MDB_MAXKEYSIZE. Default 511.
+	 * See @ref MDB_val.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @return The maximum size of a key we can write
+	 */
+int  mdb_env_get_maxkeysize(MDB_env *env);
+
+	/** @brief Set application information associated with the #MDB_env.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] ctx An arbitrary pointer for whatever the application needs.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_set_userctx(MDB_env *env, void *ctx);
+
+	/** @brief Get the application information associated with the #MDB_env.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @return The pointer set by #mdb_env_set_userctx().
+	 */
+void *mdb_env_get_userctx(MDB_env *env);
+
+	/** @brief A callback function for most LMDB assert() failures,
+	 * called before printing the message and aborting.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create().
+	 * @param[in] msg The assertion message, not including newline.
+	 */
+typedef void MDB_assert_func(MDB_env *env, const char *msg);
+
+	/** Set or reset the assert() callback of the environment.
+	 * Disabled if liblmdb is buillt with NDEBUG.
+	 * @note This hack should become obsolete as lmdb's error handling matures.
+	 * @param[in] env An environment handle returned by #mdb_env_create().
+	 * @param[in] func An #MDB_assert_func function, or 0.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_env_set_assert(MDB_env *env, MDB_assert_func *func);
+
+	/** @brief Create a transaction for use with the environment.
+	 *
+	 * The transaction handle may be discarded using #mdb_txn_abort() or #mdb_txn_commit().
+	 * @note A transaction and its cursors must only be used by a single
+	 * thread, and a thread may only have a single transaction at a time.
+	 * If #MDB_NOTLS is in use, this does not apply to read-only transactions.
+	 * @note Cursors may not span transactions.
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] parent If this parameter is non-NULL, the new transaction
+	 * will be a nested transaction, with the transaction indicated by \b parent
+	 * as its parent. Transactions may be nested to any level. A parent
+	 * transaction and its cursors may not issue any other operations than
+	 * mdb_txn_commit and mdb_txn_abort while it has active child transactions.
+	 * @param[in] flags Special options for this transaction. This parameter
+	 * must be set to 0 or by bitwise OR'ing together one or more of the
+	 * values described here.
+	 * <ul>
+	 *	<li>#MDB_RDONLY
+	 *		This transaction will not perform any write operations.
+	 *	<li>#MDB_NOSYNC
+	 *		Don't flush system buffers to disk when committing this transaction.
+	 *	<li>#MDB_NOMETASYNC
+	 *		Flush system buffers but omit metadata flush when committing this transaction.
+	 * </ul>
+	 * @param[out] txn Address where the new #MDB_txn handle will be stored
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_PANIC - a fatal error occurred earlier and the environment
+	 *		must be shut down.
+	 *	<li>#MDB_MAP_RESIZED - another process wrote data beyond this MDB_env's
+	 *		mapsize and this environment's map must be resized as well.
+	 *		See #mdb_env_set_mapsize().
+	 *	<li>#MDB_READERS_FULL - a read-only transaction was requested and
+	 *		the reader lock table is full. See #mdb_env_set_maxreaders().
+	 *	<li>ENOMEM - out of memory.
+	 * </ul>
+	 */
+int  mdb_txn_begin(MDB_env *env, MDB_txn *parent, unsigned int flags, MDB_txn **txn);
+
+	/** @brief Returns the transaction's #MDB_env
+	 *
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 */
+MDB_env *mdb_txn_env(MDB_txn *txn);
+
+	/** @brief Return the transaction's ID.
+	 *
+	 * This returns the identifier associated with this transaction. For a
+	 * read-only transaction, this corresponds to the snapshot being read;
+	 * concurrent readers will frequently have the same transaction ID.
+	 *
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @return A transaction ID, valid if input is an active transaction.
+	 */
+mdb_size_t mdb_txn_id(MDB_txn *txn);
+
+	/** @brief Commit all the operations of a transaction into the database.
+	 *
+	 * The transaction handle is freed. It and its cursors must not be used
+	 * again after this call, except with #mdb_cursor_renew().
+	 * @note Earlier documentation incorrectly said all cursors would be freed.
+	 * Only write-transactions free cursors.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 *	<li>ENOSPC - no more disk space.
+	 *	<li>EIO - a low-level I/O error occurred while writing.
+	 *	<li>ENOMEM - out of memory.
+	 * </ul>
+	 */
+int  mdb_txn_commit(MDB_txn *txn);
+
+	/** @brief Abandon all the operations of the transaction instead of saving them.
+	 *
+	 * The transaction handle is freed. It and its cursors must not be used
+	 * again after this call, except with #mdb_cursor_renew().
+	 * @note Earlier documentation incorrectly said all cursors would be freed.
+	 * Only write-transactions free cursors.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 */
+void mdb_txn_abort(MDB_txn *txn);
+
+	/** @brief Reset a read-only transaction.
+	 *
+	 * Abort the transaction like #mdb_txn_abort(), but keep the transaction
+	 * handle. #mdb_txn_renew() may reuse the handle. This saves allocation
+	 * overhead if the process will start a new read-only transaction soon,
+	 * and also locking overhead if #MDB_NOTLS is in use. The reader table
+	 * lock is released, but the table slot stays tied to its thread or
+	 * #MDB_txn. Use mdb_txn_abort() to discard a reset handle, and to free
+	 * its lock table slot if MDB_NOTLS is in use.
+	 * Cursors opened within the transaction must not be used
+	 * again after this call, except with #mdb_cursor_renew().
+	 * Reader locks generally don't interfere with writers, but they keep old
+	 * versions of database pages allocated. Thus they prevent the old pages
+	 * from being reused when writers commit new data, and so under heavy load
+	 * the database size may grow much more rapidly than otherwise.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 */
+void mdb_txn_reset(MDB_txn *txn);
+
+	/** @brief Renew a read-only transaction.
+	 *
+	 * This acquires a new reader lock for a transaction handle that had been
+	 * released by #mdb_txn_reset(). It must be called before a reset transaction
+	 * may be used again.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_PANIC - a fatal error occurred earlier and the environment
+	 *		must be shut down.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_txn_renew(MDB_txn *txn);
+
+/** Compat with version <= 0.9.4, avoid clash with libmdb from MDB Tools project */
+#define mdb_open(txn,name,flags,dbi)	mdb_dbi_open(txn,name,flags,dbi)
+/** Compat with version <= 0.9.4, avoid clash with libmdb from MDB Tools project */
+#define mdb_close(env,dbi)				mdb_dbi_close(env,dbi)
+
+	/** @brief Open a database in the environment.
+	 *
+	 * A database handle denotes the name and parameters of a database,
+	 * independently of whether such a database exists.
+	 * The database handle may be discarded by calling #mdb_dbi_close().
+	 * The old database handle is returned if the database was already open.
+	 * The handle may only be closed once.
+	 *
+	 * The database handle will be private to the current transaction until
+	 * the transaction is successfully committed. If the transaction is
+	 * aborted the handle will be closed automatically.
+	 * After a successful commit the handle will reside in the shared
+	 * environment, and may be used by other transactions.
+	 *
+	 * This function must not be called from multiple concurrent
+	 * transactions in the same process. A transaction that uses
+	 * this function must finish (either commit or abort) before
+	 * any other transaction in the process may use this function.
+	 *
+	 * To use named databases (with name != NULL), #mdb_env_set_maxdbs()
+	 * must be called before opening the environment.  Database names are
+	 * keys in the unnamed database, and may be read but not written.
+	 *
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] name The name of the database to open. If only a single
+	 * 	database is needed in the environment, this value may be NULL.
+	 * @param[in] flags Special options for this database. This parameter
+	 * must be set to 0 or by bitwise OR'ing together one or more of the
+	 * values described here.
+	 * <ul>
+	 *	<li>#MDB_REVERSEKEY
+	 *		Keys are strings to be compared in reverse order, from the end
+	 *		of the strings to the beginning. By default, Keys are treated as strings and
+	 *		compared from beginning to end.
+	 *	<li>#MDB_DUPSORT
+	 *		Duplicate keys may be used in the database. (Or, from another perspective,
+	 *		keys may have multiple data items, stored in sorted order.) By default
+	 *		keys must be unique and may have only a single data item.
+	 *	<li>#MDB_INTEGERKEY
+	 *		Keys are binary integers in native byte order, either unsigned int
+	 *		or #mdb_size_t, and will be sorted as such.
+	 *		(lmdb expects 32-bit int <= size_t <= 32/64-bit mdb_size_t.)
+	 *		The keys must all be of the same size.
+	 *	<li>#MDB_DUPFIXED
+	 *		This flag may only be used in combination with #MDB_DUPSORT. This option
+	 *		tells the library that the data items for this database are all the same
+	 *		size, which allows further optimizations in storage and retrieval. When
+	 *		all data items are the same size, the #MDB_GET_MULTIPLE, #MDB_NEXT_MULTIPLE
+	 *		and #MDB_PREV_MULTIPLE cursor operations may be used to retrieve multiple
+	 *		items at once.
+	 *	<li>#MDB_INTEGERDUP
+	 *		This option specifies that duplicate data items are binary integers,
+	 *		similar to #MDB_INTEGERKEY keys.
+	 *	<li>#MDB_REVERSEDUP
+	 *		This option specifies that duplicate data items should be compared as
+	 *		strings in reverse order.
+	 *	<li>#MDB_CREATE
+	 *		Create the named database if it doesn't exist. This option is not
+	 *		allowed in a read-only transaction or a read-only environment.
+	 * </ul>
+	 * @param[out] dbi Address where the new #MDB_dbi handle will be stored
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_NOTFOUND - the specified database doesn't exist in the environment
+	 *		and #MDB_CREATE was not specified.
+	 *	<li>#MDB_DBS_FULL - too many databases have been opened. See #mdb_env_set_maxdbs().
+	 * </ul>
+	 */
+int  mdb_dbi_open(MDB_txn *txn, const char *name, unsigned int flags, MDB_dbi *dbi);
+
+	/** @brief Retrieve statistics for a database.
+	 *
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[out] stat The address of an #MDB_stat structure
+	 * 	where the statistics will be copied
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_stat(MDB_txn *txn, MDB_dbi dbi, MDB_stat *stat);
+
+	/** @brief Retrieve the DB flags for a database handle.
+	 *
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[out] flags Address where the flags will be returned.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int mdb_dbi_flags(MDB_txn *txn, MDB_dbi dbi, unsigned int *flags);
+
+	/** @brief Close a database handle. Normally unnecessary. Use with care:
+	 *
+	 * This call is not mutex protected. Handles should only be closed by
+	 * a single thread, and only if no other threads are going to reference
+	 * the database handle or one of its cursors any further. Do not close
+	 * a handle if an existing transaction has modified its database.
+	 * Doing so can cause misbehavior from database corruption to errors
+	 * like MDB_BAD_VALSIZE (since the DB name is gone).
+	 *
+	 * Closing a database handle is not necessary, but lets #mdb_dbi_open()
+	 * reuse the handle value.  Usually it's better to set a bigger
+	 * #mdb_env_set_maxdbs(), unless that value would be large.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 */
+void mdb_dbi_close(MDB_env *env, MDB_dbi dbi);
+
+	/** @brief Empty or delete+close a database.
+	 *
+	 * See #mdb_dbi_close() for restrictions about closing the DB handle.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] del 0 to empty the DB, 1 to delete it from the
+	 * environment and close the DB handle.
+	 * @return A non-zero error value on failure and 0 on success.
+	 */
+int  mdb_drop(MDB_txn *txn, MDB_dbi dbi, int del);
+
+	/** @brief Set a custom key comparison function for a database.
+	 *
+	 * The comparison function is called whenever it is necessary to compare a
+	 * key specified by the application with a key currently stored in the database.
+	 * If no comparison function is specified, and no special key flags were specified
+	 * with #mdb_dbi_open(), the keys are compared lexically, with shorter keys collating
+	 * before longer keys.
+	 * @warning This function must be called before any data access functions are used,
+	 * otherwise data corruption may occur. The same comparison function must be used by every
+	 * program accessing the database, every time the database is used.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] cmp A #MDB_cmp_func function
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_set_compare(MDB_txn *txn, MDB_dbi dbi, MDB_cmp_func *cmp);
+
+	/** @brief Set a custom data comparison function for a #MDB_DUPSORT database.
+	 *
+	 * This comparison function is called whenever it is necessary to compare a data
+	 * item specified by the application with a data item currently stored in the database.
+	 * This function only takes effect if the database was opened with the #MDB_DUPSORT
+	 * flag.
+	 * If no comparison function is specified, and no special key flags were specified
+	 * with #mdb_dbi_open(), the data items are compared lexically, with shorter items collating
+	 * before longer items.
+	 * @warning This function must be called before any data access functions are used,
+	 * otherwise data corruption may occur. The same comparison function must be used by every
+	 * program accessing the database, every time the database is used.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] cmp A #MDB_cmp_func function
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_set_dupsort(MDB_txn *txn, MDB_dbi dbi, MDB_cmp_func *cmp);
+
+	/** @brief Set a relocation function for a #MDB_FIXEDMAP database.
+	 *
+	 * @todo The relocation function is called whenever it is necessary to move the data
+	 * of an item to a different position in the database (e.g. through tree
+	 * balancing operations, shifts as a result of adds or deletes, etc.). It is
+	 * intended to allow address/position-dependent data items to be stored in
+	 * a database in an environment opened with the #MDB_FIXEDMAP option.
+	 * Currently the relocation feature is unimplemented and setting
+	 * this function has no effect.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] rel A #MDB_rel_func function
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_set_relfunc(MDB_txn *txn, MDB_dbi dbi, MDB_rel_func *rel);
+
+	/** @brief Set a context pointer for a #MDB_FIXEDMAP database's relocation function.
+	 *
+	 * See #mdb_set_relfunc and #MDB_rel_func for more details.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] ctx An arbitrary pointer for whatever the application needs.
+	 * It will be passed to the callback function set by #mdb_set_relfunc
+	 * as its \b relctx parameter whenever the callback is invoked.
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_set_relctx(MDB_txn *txn, MDB_dbi dbi, void *ctx);
+
+	/** @brief Get items from a database.
+	 *
+	 * This function retrieves key/data pairs from the database. The address
+	 * and length of the data associated with the specified \b key are returned
+	 * in the structure to which \b data refers.
+	 * If the database supports duplicate keys (#MDB_DUPSORT) then the
+	 * first data item for the key will be returned. Retrieval of other
+	 * items requires the use of #mdb_cursor_get().
+	 *
+	 * @note The memory pointed to by the returned values is owned by the
+	 * database. The caller need not dispose of the memory, and may not
+	 * modify it in any way. For values returned in a read-only transaction
+	 * any modification attempts will cause a SIGSEGV.
+	 * @note Values returned from the database are valid only until a
+	 * subsequent update operation, or the end of the transaction.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] key The key to search for in the database
+	 * @param[out] data The data corresponding to the key
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_NOTFOUND - the key was not in the database.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_get(MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data);
+
+	/** @brief Store items into a database.
+	 *
+	 * This function stores key/data pairs in the database. The default behavior
+	 * is to enter the new key/data pair, replacing any previously existing key
+	 * if duplicates are disallowed, or adding a duplicate data item if
+	 * duplicates are allowed (#MDB_DUPSORT).
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] key The key to store in the database
+	 * @param[in,out] data The data to store
+	 * @param[in] flags Special options for this operation. This parameter
+	 * must be set to 0 or by bitwise OR'ing together one or more of the
+	 * values described here.
+	 * <ul>
+	 *	<li>#MDB_NODUPDATA - enter the new key/data pair only if it does not
+	 *		already appear in the database. This flag may only be specified
+	 *		if the database was opened with #MDB_DUPSORT. The function will
+	 *		return #MDB_KEYEXIST if the key/data pair already appears in the
+	 *		database.
+	 *	<li>#MDB_NOOVERWRITE - enter the new key/data pair only if the key
+	 *		does not already appear in the database. The function will return
+	 *		#MDB_KEYEXIST if the key already appears in the database, even if
+	 *		the database supports duplicates (#MDB_DUPSORT). The \b data
+	 *		parameter will be set to point to the existing item.
+	 *	<li>#MDB_RESERVE - reserve space for data of the given size, but
+	 *		don't copy the given data. Instead, return a pointer to the
+	 *		reserved space, which the caller can fill in later - before
+	 *		the next update operation or the transaction ends. This saves
+	 *		an extra memcpy if the data is being generated later.
+	 *		LMDB does nothing else with this memory, the caller is expected
+	 *		to modify all of the space requested. This flag must not be
+	 *		specified if the database was opened with #MDB_DUPSORT.
+	 *	<li>#MDB_APPEND - append the given key/data pair to the end of the
+	 *		database. This option allows fast bulk loading when keys are
+	 *		already known to be in the correct order. Loading unsorted keys
+	 *		with this flag will cause a #MDB_KEYEXIST error.
+	 *	<li>#MDB_APPENDDUP - as above, but for sorted dup data.
+	 * </ul>
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_MAP_FULL - the database is full, see #mdb_env_set_mapsize().
+	 *	<li>#MDB_TXN_FULL - the transaction has too many dirty pages.
+	 *	<li>EACCES - an attempt was made to write in a read-only transaction.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_put(MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data,
+			    unsigned int flags);
+
+	/** @brief Delete items from a database.
+	 *
+	 * This function removes key/data pairs from the database.
+	 * If the database does not support sorted duplicate data items
+	 * (#MDB_DUPSORT) the data parameter is ignored.
+	 * If the database supports sorted duplicates and the data parameter
+	 * is NULL, all of the duplicate data items for the key will be
+	 * deleted. Otherwise, if the data parameter is non-NULL
+	 * only the matching data item will be deleted.
+	 * This function will return #MDB_NOTFOUND if the specified key/data
+	 * pair is not in the database.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] key The key to delete from the database
+	 * @param[in] data The data to delete
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EACCES - an attempt was made to write in a read-only transaction.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_del(MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data);
+
+	/** @brief Create a cursor handle.
+	 *
+	 * A cursor is associated with a specific transaction and database.
+	 * A cursor cannot be used when its database handle is closed.  Nor
+	 * when its transaction has ended, except with #mdb_cursor_renew().
+	 * It can be discarded with #mdb_cursor_close().
+	 * A cursor in a write-transaction can be closed before its transaction
+	 * ends, and will otherwise be closed when its transaction ends.
+	 * A cursor in a read-only transaction must be closed explicitly, before
+	 * or after its transaction ends. It can be reused with
+	 * #mdb_cursor_renew() before finally closing it.
+	 * @note Earlier documentation said that cursors in every transaction
+	 * were closed when the transaction committed or aborted.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[out] cursor Address where the new #MDB_cursor handle will be stored
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_open(MDB_txn *txn, MDB_dbi dbi, MDB_cursor **cursor);
+
+	/** @brief Close a cursor handle.
+	 *
+	 * The cursor handle will be freed and must not be used again after this call.
+	 * Its transaction must still be live if it is a write-transaction.
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 */
+void mdb_cursor_close(MDB_cursor *cursor);
+
+	/** @brief Renew a cursor handle.
+	 *
+	 * A cursor is associated with a specific transaction and database.
+	 * Cursors that are only used in read-only
+	 * transactions may be re-used, to avoid unnecessary malloc/free overhead.
+	 * The cursor may be associated with a new read-only transaction, and
+	 * referencing the same database handle as it was created with.
+	 * This may be done whether the previous transaction is live or dead.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_renew(MDB_txn *txn, MDB_cursor *cursor);
+
+	/** @brief Return the cursor's transaction handle.
+	 *
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 */
+MDB_txn *mdb_cursor_txn(MDB_cursor *cursor);
+
+	/** @brief Return the cursor's database handle.
+	 *
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 */
+MDB_dbi mdb_cursor_dbi(MDB_cursor *cursor);
+
+	/** @brief Retrieve by cursor.
+	 *
+	 * This function retrieves key/data pairs from the database. The address and length
+	 * of the key are returned in the object to which \b key refers (except for the
+	 * case of the #MDB_SET option, in which the \b key object is unchanged), and
+	 * the address and length of the data are returned in the object to which \b data
+	 * refers.
+	 * See #mdb_get() for restrictions on using the output values.
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 * @param[in,out] key The key for a retrieved item
+	 * @param[in,out] data The data of a retrieved item
+	 * @param[in] op A cursor operation #MDB_cursor_op
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_NOTFOUND - no matching key found.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_get(MDB_cursor *cursor, MDB_val *key, MDB_val *data,
+			    MDB_cursor_op op);
+
+	/** @brief Store by cursor.
+	 *
+	 * This function stores key/data pairs into the database.
+	 * The cursor is positioned at the new item, or on failure usually near it.
+	 * @note Earlier documentation incorrectly said errors would leave the
+	 * state of the cursor unchanged.
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 * @param[in] key The key operated on.
+	 * @param[in] data The data operated on.
+	 * @param[in] flags Options for this operation. This parameter
+	 * must be set to 0 or one of the values described here.
+	 * <ul>
+	 *	<li>#MDB_CURRENT - replace the item at the current cursor position.
+	 *		The \b key parameter must still be provided, and must match it.
+	 *		If using sorted duplicates (#MDB_DUPSORT) the data item must still
+	 *		sort into the same place. This is intended to be used when the
+	 *		new data is the same size as the old. Otherwise it will simply
+	 *		perform a delete of the old record followed by an insert.
+	 *	<li>#MDB_NODUPDATA - enter the new key/data pair only if it does not
+	 *		already appear in the database. This flag may only be specified
+	 *		if the database was opened with #MDB_DUPSORT. The function will
+	 *		return #MDB_KEYEXIST if the key/data pair already appears in the
+	 *		database.
+	 *	<li>#MDB_NOOVERWRITE - enter the new key/data pair only if the key
+	 *		does not already appear in the database. The function will return
+	 *		#MDB_KEYEXIST if the key already appears in the database, even if
+	 *		the database supports duplicates (#MDB_DUPSORT).
+	 *	<li>#MDB_RESERVE - reserve space for data of the given size, but
+	 *		don't copy the given data. Instead, return a pointer to the
+	 *		reserved space, which the caller can fill in later - before
+	 *		the next update operation or the transaction ends. This saves
+	 *		an extra memcpy if the data is being generated later. This flag
+	 *		must not be specified if the database was opened with #MDB_DUPSORT.
+	 *	<li>#MDB_APPEND - append the given key/data pair to the end of the
+	 *		database. No key comparisons are performed. This option allows
+	 *		fast bulk loading when keys are already known to be in the
+	 *		correct order. Loading unsorted keys with this flag will cause
+	 *		a #MDB_KEYEXIST error.
+	 *	<li>#MDB_APPENDDUP - as above, but for sorted dup data.
+	 *	<li>#MDB_MULTIPLE - store multiple contiguous data elements in a
+	 *		single request. This flag may only be specified if the database
+	 *		was opened with #MDB_DUPFIXED. The \b data argument must be an
+	 *		array of two MDB_vals. The mv_size of the first MDB_val must be
+	 *		the size of a single data element. The mv_data of the first MDB_val
+	 *		must point to the beginning of the array of contiguous data elements.
+	 *		The mv_size of the second MDB_val must be the count of the number
+	 *		of data elements to store. On return this field will be set to
+	 *		the count of the number of elements actually written. The mv_data
+	 *		of the second MDB_val is unused.
+	 * </ul>
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>#MDB_MAP_FULL - the database is full, see #mdb_env_set_mapsize().
+	 *	<li>#MDB_TXN_FULL - the transaction has too many dirty pages.
+	 *	<li>EACCES - an attempt was made to write in a read-only transaction.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_put(MDB_cursor *cursor, MDB_val *key, MDB_val *data,
+				unsigned int flags);
+
+	/** @brief Delete current key/data pair
+	 *
+	 * This function deletes the key/data pair to which the cursor refers.
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 * @param[in] flags Options for this operation. This parameter
+	 * must be set to 0 or one of the values described here.
+	 * <ul>
+	 *	<li>#MDB_NODUPDATA - delete all of the data items for the current key.
+	 *		This flag may only be specified if the database was opened with #MDB_DUPSORT.
+	 * </ul>
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EACCES - an attempt was made to write in a read-only transaction.
+	 *	<li>EINVAL - an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_del(MDB_cursor *cursor, unsigned int flags);
+
+	/** @brief Return count of duplicates for current key.
+	 *
+	 * This call is only valid on databases that support sorted duplicate
+	 * data items #MDB_DUPSORT.
+	 * @param[in] cursor A cursor handle returned by #mdb_cursor_open()
+	 * @param[out] countp Address where the count will be stored
+	 * @return A non-zero error value on failure and 0 on success. Some possible
+	 * errors are:
+	 * <ul>
+	 *	<li>EINVAL - cursor is not initialized, or an invalid parameter was specified.
+	 * </ul>
+	 */
+int  mdb_cursor_count(MDB_cursor *cursor, mdb_size_t *countp);
+
+	/** @brief Compare two data items according to a particular database.
+	 *
+	 * This returns a comparison as if the two data items were keys in the
+	 * specified database.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] a The first item to compare
+	 * @param[in] b The second item to compare
+	 * @return < 0 if a < b, 0 if a == b, > 0 if a > b
+	 */
+int  mdb_cmp(MDB_txn *txn, MDB_dbi dbi, const MDB_val *a, const MDB_val *b);
+
+	/** @brief Compare two data items according to a particular database.
+	 *
+	 * This returns a comparison as if the two items were data items of
+	 * the specified database. The database must have the #MDB_DUPSORT flag.
+	 * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+	 * @param[in] dbi A database handle returned by #mdb_dbi_open()
+	 * @param[in] a The first item to compare
+	 * @param[in] b The second item to compare
+	 * @return < 0 if a < b, 0 if a == b, > 0 if a > b
+	 */
+int  mdb_dcmp(MDB_txn *txn, MDB_dbi dbi, const MDB_val *a, const MDB_val *b);
+
+	/** @brief A callback function used to print a message from the library.
+	 *
+	 * @param[in] msg The string to be printed.
+	 * @param[in] ctx An arbitrary context pointer for the callback.
+	 * @return < 0 on failure, >= 0 on success.
+	 */
+typedef int (MDB_msg_func)(const char *msg, void *ctx);
+
+	/** @brief Dump the entries in the reader lock table.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[in] func A #MDB_msg_func function
+	 * @param[in] ctx Anything the message function needs
+	 * @return < 0 on failure, >= 0 on success.
+	 */
+int	mdb_reader_list(MDB_env *env, MDB_msg_func *func, void *ctx);
+
+	/** @brief Check for stale entries in the reader lock table.
+	 *
+	 * @param[in] env An environment handle returned by #mdb_env_create()
+	 * @param[out] dead Number of stale slots that were cleared
+	 * @return 0 on success, non-zero on failure.
+	 */
+int	mdb_reader_check(MDB_env *env, int *dead);
+/**	@} */
+
+#ifdef __cplusplus
+}
+#endif
+/** @page tools LMDB Command Line Tools
+	The following describes the command line tools that are available for LMDB.
+	\li \ref mdb_copy_1
+	\li \ref mdb_dump_1
+	\li \ref mdb_load_1
+	\li \ref mdb_stat_1
+*/
+
+#endif /* _LMDB_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.ml b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.ml
new file mode 100644
index 000000000..9cbca4f39
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.ml
@@ -0,0 +1,648 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+module Option = struct
+  let map ~f = function
+    | None -> None
+    | Some v -> Some (f v)
+end
+
+let finalize ~final ~f =
+  try
+    let res = f () in
+    final () ;
+    res
+  with exn ->
+    final () ;
+    raise exn
+
+open Rresult
+
+type error =
+  | NoSuchFileOrDir
+  | IOError
+  | EnvironmentLocked
+  | OutOfMemory
+  | PermissionDenied
+  | InvalidArgument
+  | NoSpaceLeftOnDevice
+  | KeyExist
+  | KeyNotFound
+  | PageNotFound
+  | Corrupted
+  | Panic
+  | VersionMismatch
+  | InvalidFile
+  | MapFull
+  | DbsFull
+  | ReadersFull
+  | TLSFull
+  | TxnFull
+  | CursorFull
+  | PageFull
+  | MapResized
+  | Incompatible
+  | BadRslot
+  | BadTxn
+  | BadValSize
+  | BadDbi
+  | TxnProblem
+
+let int_of_error = function
+  | NoSuchFileOrDir -> 2
+  | IOError -> 5
+  | EnvironmentLocked -> 11
+  | OutOfMemory -> 12
+  | PermissionDenied -> 13
+  | InvalidArgument -> 22
+  | NoSpaceLeftOnDevice -> 28
+  | KeyExist -> -30799
+  | KeyNotFound -> -30798
+  | PageNotFound -> -30797
+  | Corrupted -> -30796
+  | Panic -> -30795
+  | VersionMismatch -> -30794
+  | InvalidFile -> -30793
+  | MapFull -> -30792
+  | DbsFull -> -30791
+  | ReadersFull -> -30790
+  | TLSFull -> -30789
+  | TxnFull -> -30788
+  | CursorFull -> -30787
+  | PageFull -> -30786
+  | MapResized -> -30785
+  | Incompatible -> -30784
+  | BadRslot -> -30783
+  | BadTxn -> -30782
+  | BadValSize -> -30781
+  | BadDbi -> -30780
+  | TxnProblem -> -30779
+
+let error_of_int = function
+  | 2      -> NoSuchFileOrDir
+  | 5      -> IOError
+  | 11     -> EnvironmentLocked
+  | 12     -> OutOfMemory
+  | 13     -> PermissionDenied
+  | 22     -> InvalidArgument
+  | 28     -> NoSpaceLeftOnDevice
+  | -30799 -> KeyExist
+  | -30798 -> KeyNotFound
+  | -30797 -> PageNotFound
+  | -30796 -> Corrupted
+  | -30795 -> Panic
+  | -30794 -> VersionMismatch
+  | -30793 -> InvalidFile
+  | -30792 -> MapFull
+  | -30791 -> DbsFull
+  | -30790 -> ReadersFull
+  | -30789 -> TLSFull
+  | -30788 -> TxnFull
+  | -30787 -> CursorFull
+  | -30786 -> PageFull
+  | -30785 -> MapResized
+  | -30784 -> Incompatible
+  | -30783 -> BadRslot
+  | -30782 -> BadTxn
+  | -30781 -> BadValSize
+  | -30780 -> BadDbi
+  | -30779 -> TxnProblem
+  | i -> invalid_arg (Printf.sprintf "error_of_int: %d" i)
+
+type version = {
+  major : int ;
+  minor : int ;
+  patch : int ;
+}
+
+external version : unit -> version = "stub_mdb_version"
+external strerror : int -> string = "stub_mdb_strerror"
+
+let string_of_error error =
+  strerror (int_of_error error)
+
+let pp_error ppf err =
+  Format.fprintf ppf "%s" (string_of_error err)
+
+let to_msg t = R.error_to_msg ~pp_error t
+
+type t
+external create : unit -> (t, int) result = "stub_mdb_env_create"
+
+type flag_env =
+  | FixedMap
+  | NoSubdir
+  | NoSync
+  | RdOnly
+  | NoMetaSync
+  | WriteMap
+  | MapAsync
+  | NoTLS
+  | NoLock
+  | NoRdAhead
+  | NoMemInit
+  | PrevMeta
+
+let int_of_flag_env = function
+  | FixedMap -> 0x01
+  | NoSubdir -> 0x4000
+  | NoSync -> 0x10_000
+  | RdOnly -> 0x20_000
+  | NoMetaSync -> 0x40_000
+  | WriteMap -> 0x80_000
+  | MapAsync -> 0x100_000
+  | NoTLS -> 0x200_000
+  | NoLock -> 0x400_000
+  | NoRdAhead -> 0x800_000
+  | NoMemInit -> 0x1_000_000
+  | PrevMeta -> 0x2_000_000
+
+let flags_env_of_int v =
+  List.fold_left begin fun acc flag ->
+    if v land (int_of_flag_env flag) <> 0 then flag :: acc else acc
+  end []
+    [ FixedMap ; NoSubdir ; NoSync ; RdOnly ; NoMetaSync ;
+      WriteMap ; MapAsync ; NoTLS ; NoLock ; NoRdAhead ;
+      NoMemInit ; PrevMeta ]
+
+type flag_open =
+  | ReverseKey
+  | DupSort
+  | IntegerKey
+  | DupFixed
+  | IntegerDup
+  | ReverseDup
+  | Create
+
+let int_of_flag_open = function
+  | ReverseKey -> 0x02
+  | DupSort -> 0x04
+  | IntegerKey -> 0x08
+  | DupFixed -> 0x10
+  | IntegerDup -> 0x20
+  | ReverseDup -> 0x40
+  | Create -> 0x40_000
+
+let flags_open_of_int v =
+  List.fold_left begin fun acc flag ->
+    if v land (int_of_flag_open flag) <> 0 then flag :: acc else acc
+  end []
+    [ ReverseKey ; DupSort ; IntegerKey ; DupFixed ; IntegerDup ;
+      ReverseDup ; Create ]
+
+type flag_put =
+  | NoOverwrite
+  | NoDupData
+  | Current
+  | Reserve
+  | Append
+  | AppendDup
+  | Multiple
+
+let int_of_flag_put = function
+  | NoOverwrite -> 0x10
+  | NoDupData -> 0x20
+  | Current -> 0x40
+  | Reserve -> 0x10_000
+  | Append -> 0x20_000
+  | AppendDup -> 0x40_000
+  | Multiple -> 0x80_000
+
+let fold_flags int_of_flag flags =
+  List.fold_left (fun a flag -> a lor (int_of_flag flag)) 0 flags
+
+let int_of_flags_env = fold_flags int_of_flag_env
+let int_of_flags_open = fold_flags int_of_flag_open
+let int_of_flags_put = fold_flags int_of_flag_put
+
+let return ?(on_error = fun () -> ()) ret v =
+  if ret = 0 then
+    Ok v
+  else begin
+    on_error () ;
+    Error (error_of_int ret)
+  end
+
+external set_maxreaders : t -> int -> int = "stub_mdb_env_set_maxreaders" [@@noalloc]
+
+let set_maxreaders t readers =
+  let ret = set_maxreaders t readers in
+  return ret ()
+
+external set_maxdbs : t -> int -> int = "stub_mdb_env_set_maxdbs" [@@noalloc]
+
+let set_maxdbs t dbs =
+  let ret = set_maxdbs t dbs in
+  return ret ()
+
+external set_mapsize : t -> int64 -> int = "stub_mdb_env_set_mapsize" [@@noalloc]
+
+let set_mapsize t size =
+  let ret = set_mapsize t size in
+  return ret ()
+
+external opendir :
+  t -> string -> int -> Unix.file_perm -> int = "stub_mdb_env_open" [@@noalloc]
+
+external closedir :
+  t -> unit = "stub_mdb_env_close" [@@noalloc]
+
+let opendir ?maxreaders ?maxdbs ?mapsize ?(flags=[]) path mode =
+  match create () with
+  | Error v -> Error (error_of_int v)
+  | Ok t ->
+      begin match maxreaders with
+        | None -> Ok ()
+        | Some readers -> set_maxreaders t readers
+      end >>= fun () ->
+      begin match maxdbs with
+        | None -> Ok ()
+        | Some dbs -> set_maxdbs t dbs
+      end >>= fun () ->
+      begin match mapsize with
+        | None -> Ok ()
+        | Some size -> set_mapsize t size
+      end >>= fun () ->
+      let ret = opendir t path (int_of_flags_env flags) mode in
+      return ret t ~on_error:(fun () -> closedir t)
+
+external copy :
+  t -> string -> int -> int = "stub_mdb_env_copy2" [@@noalloc]
+
+let copy ?(compact=false) t path =
+  let ret = copy t path (if compact then 0x01 else 0x00) in
+  return ret ()
+
+external copyfd :
+  t -> Unix.file_descr -> int -> int = "stub_mdb_env_copyfd2" [@@noalloc]
+
+let copyfd ?(compact=false) t fd =
+  let ret = copyfd t fd (if compact then 0x01 else 0x00) in
+  return ret ()
+
+type stat = {
+  psize : int ;
+  depth : int ;
+  branch_pages : int ;
+  leaf_pages : int ;
+  overflow_pages : int ;
+  entries : int ;
+}
+
+external stat : t -> stat = "stub_mdb_env_stat"
+
+type envinfo = {
+  mapsize : int ;
+  last_pgno : int ;
+  last_txnid : int ;
+  maxreaders : int ;
+  numreaders : int ;
+}
+
+external envinfo : t -> envinfo = "stub_mdb_env_info"
+
+external sync : t -> bool -> int = "stub_mdb_env_sync" [@@noalloc]
+
+let sync ?(force=false) t =
+  let ret = sync t force in
+  return ret ()
+
+external setclear_flags :
+  t -> int -> bool -> int = "stub_mdb_env_set_flags" [@@noalloc]
+
+let set_flags t flags =
+  let ret = setclear_flags t (int_of_flags_env flags) true in
+  return ret ()
+
+let clear_flags t flags =
+  let ret = setclear_flags t (int_of_flags_env flags) false in
+  return ret ()
+
+external get_flags : t -> int = "stub_mdb_env_get_flags" [@@noalloc]
+
+let get_flags t =
+  flags_env_of_int (get_flags t)
+
+external get_path : t -> string = "stub_mdb_env_get_path"
+external get_fd : t -> Unix.file_descr = "stub_mdb_env_get_fd" [@@noalloc]
+external get_maxreaders : t -> int = "stub_mdb_env_get_maxreaders" [@@noalloc]
+external get_maxkeysize : t -> int = "stub_mdb_env_get_maxkeysize" [@@noalloc]
+
+type rawtxn
+type ro
+type rw
+type _ txn =
+  | Txn_ro : rawtxn -> ro txn
+  | Txn_rw : rawtxn -> rw txn
+
+let rawtxn_of_txn : type a. a txn -> rawtxn = function
+  | Txn_ro rawtxn -> rawtxn
+  | Txn_rw rawtxn -> rawtxn
+
+external txn_begin :
+  t -> int -> rawtxn option -> (rawtxn, int) result = "stub_mdb_txn_begin"
+
+let create_rw_txn ?(nosync=false) ?(nometasync=false) ?parent t =
+  let flags = match nosync, nometasync with
+    | true, true -> int_of_flags_env [NoSync; NoMetaSync]
+    | true, false -> int_of_flag_env NoSync
+    | false, true -> int_of_flag_env NoMetaSync
+    | _ -> 0 in
+  match txn_begin t flags (Option.map ~f:rawtxn_of_txn parent) with
+  | Error i -> Error (error_of_int i)
+  | Ok tx -> Ok (Txn_rw tx)
+
+let create_ro_txn ?(nosync=false) ?(nometasync=false) ?parent t =
+  let flags = match nosync, nometasync with
+    | true, true -> int_of_flags_env [RdOnly; NoSync; NoMetaSync]
+    | true, false -> int_of_flags_env [RdOnly; NoSync]
+    | false, true -> int_of_flags_env [RdOnly; NoMetaSync]
+    | _ -> int_of_flag_env RdOnly in
+  match txn_begin t flags (Option.map ~f:rawtxn_of_txn parent) with
+  | Error i -> Error (error_of_int i)
+  | Ok tx -> Ok (Txn_ro tx)
+
+external get_txn_id : rawtxn -> int = "stub_mdb_txn_id" [@@noalloc]
+external get_txn_env : rawtxn -> t = "stub_mdb_txn_env"
+
+let get_txn_id txn =
+  get_txn_id (rawtxn_of_txn txn)
+
+let get_txn_env txn =
+  get_txn_env (rawtxn_of_txn txn)
+
+external commit_txn : rawtxn -> int = "stub_mdb_txn_commit" [@@noalloc]
+external abort_txn : rawtxn -> unit = "stub_mdb_txn_abort" [@@noalloc]
+
+let commit_txn txn =
+  return (commit_txn (rawtxn_of_txn txn)) ()
+
+let abort_txn txn =
+  abort_txn (rawtxn_of_txn txn)
+
+external reset_ro_txn : rawtxn -> unit = "stub_mdb_txn_reset" [@@noalloc]
+external renew_ro_txn : rawtxn -> int = "stub_mdb_txn_renew" [@@noalloc]
+
+let reset_ro_txn (Txn_ro rawtxn) =
+  reset_ro_txn rawtxn
+
+let renew_ro_txn (Txn_ro rawtxn) =
+  return (renew_ro_txn rawtxn) ()
+
+type db = nativeint
+
+external opendb :
+  rawtxn -> string option -> int -> (db, int) result = "stub_mdb_dbi_open"
+
+let opendb ?(flags=[]) ?name txn =
+  R.reword_error error_of_int
+    (opendb (rawtxn_of_txn txn) name (int_of_flags_open flags))
+
+external db_stat :
+  rawtxn -> db -> (stat, int) result = "stub_mdb_stat"
+
+let db_stat txn dbi =
+  R.reword_error error_of_int (db_stat (rawtxn_of_txn txn) dbi)
+
+external db_flags :
+  rawtxn -> db -> (int, int) result = "stub_mdb_dbi_flags"
+
+let db_flags txn dbi =
+  match db_flags (rawtxn_of_txn txn) dbi with
+  | Error i -> Error (error_of_int i)
+  | Ok v -> Ok (flags_open_of_int v)
+
+external db_drop :
+  rawtxn -> db -> bool -> int = "stub_mdb_drop" [@@noalloc]
+
+let db_drop txn dbi =
+  return (db_drop (rawtxn_of_txn txn) dbi false) ()
+
+let with_ro_db ?nosync ?nometasync ?parent ?flags ?name t ~f =
+  create_ro_txn ?nosync ?nometasync ?parent t >>= fun txn ->
+  opendb ?flags ?name txn >>= fun db ->
+  match f txn db with
+  | exception exn ->
+      abort_txn txn ;
+      raise exn
+  | Ok res ->
+      commit_txn txn >>= fun () ->
+      Ok res
+  | Error err ->
+      abort_txn txn ;
+      Error err
+
+let with_rw_db ?nosync ?nometasync ?parent ?flags ?name t ~f =
+  create_rw_txn ?nosync ?nometasync ?parent t >>= fun txn ->
+  opendb ?flags ?name txn >>= fun db ->
+  match f txn db with
+  | exception exn ->
+      abort_txn txn ;
+      raise exn
+  | Ok res ->
+      commit_txn txn >>= fun () ->
+      Ok res
+  | Error err ->
+      abort_txn txn ;
+      Error err
+
+type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+external get :
+  rawtxn -> db -> string -> (buffer, int) result = "stub_mdb_get"
+
+let get txn dbi k =
+  R.reword_error error_of_int (get (rawtxn_of_txn txn) dbi k)
+
+let mem txn dbi k =
+  match get txn dbi k with
+  | Ok _ -> Ok true
+  | Error KeyNotFound -> Ok false
+  | Error err -> Error err
+
+external put :
+  rawtxn -> db -> string -> buffer -> int -> int = "stub_mdb_put" [@@noalloc]
+external put_string :
+  rawtxn -> db -> string -> string -> int -> int = "stub_mdb_put_string" [@@noalloc]
+
+let put ?(flags=[]) txn dbi k v =
+  let flags = int_of_flags_put flags in
+  return (put (rawtxn_of_txn txn) dbi k v flags) ()
+
+let put_string ?(flags=[]) txn dbi k v =
+  let flags = int_of_flags_put flags in
+  return (put_string (rawtxn_of_txn txn) dbi k v flags) ()
+
+external del :
+  rawtxn -> db -> string -> buffer option -> int = "stub_mdb_del" [@@noalloc]
+external del_string :
+  rawtxn -> db -> string -> string option -> int = "stub_mdb_del_string" [@@noalloc]
+
+let del ?data txn dbi k =
+  return (del (rawtxn_of_txn txn) dbi k data) ()
+
+let del_string ?data txn dbi k =
+  return (del_string (rawtxn_of_txn txn) dbi k data) ()
+
+type rawcursor
+type _ cursor =
+  | Cursor_ro : rawcursor -> ro cursor
+  | Cursor_rw : rawcursor -> rw cursor
+
+let rawcursor_of_cursor : type a. a cursor -> rawcursor = function
+  | Cursor_ro rawcursor -> rawcursor
+  | Cursor_rw rawcursor -> rawcursor
+
+let cursor_ro rawcursor = Cursor_ro rawcursor
+let cursor_rw rawcursor = Cursor_rw rawcursor
+
+external opencursor :
+  rawtxn -> db -> (rawcursor, int) result = "stub_mdb_cursor_open"
+
+let opencursor :
+  type a. a txn -> db -> (a cursor, error) result = fun txn dbi ->
+  match txn with
+  | Txn_ro rawtxn ->
+      R.reword_error error_of_int (opencursor rawtxn dbi) |>
+      R.map cursor_ro
+  | Txn_rw rawtxn ->
+      R.reword_error error_of_int (opencursor rawtxn dbi) |>
+      R.map cursor_rw
+
+external cursor_close :
+  rawcursor -> unit = "stub_mdb_cursor_close" [@@noalloc]
+
+external cursor_renew :
+  rawtxn -> rawcursor -> int = "stub_mdb_cursor_renew" [@@noalloc]
+
+let cursor_close cursor =
+  cursor_close (rawcursor_of_cursor cursor)
+
+let cursor_renew (Txn_ro rawtxn) (Cursor_ro rawcursor) =
+  return (cursor_renew rawtxn rawcursor) ()
+
+external cursor_txn :
+  rawcursor -> rawtxn = "stub_mdb_cursor_txn"
+
+let cursor_txn : type a. a cursor -> a txn = function
+  | Cursor_ro rawcursor -> Txn_ro (cursor_txn rawcursor)
+  | Cursor_rw rawcursor -> Txn_rw (cursor_txn rawcursor)
+
+external cursor_db :
+  rawcursor -> db = "stub_mdb_cursor_dbi" [@@noalloc]
+
+let cursor_db cursor =
+  cursor_db (rawcursor_of_cursor cursor)
+
+type cursor_op =
+  | First
+  | First_dup
+  | Get_both
+  | Get_both_range
+  | Get_current
+  | Get_multiple
+  | Last
+  | Last_dup
+  | Next
+  | Next_dup
+  | Next_multiple
+  | Next_nodup
+  | Prev
+  | Prev_dup
+  | Prev_nodup
+  | Set
+  | Set_key
+  | Set_range
+  | Prev_multiple
+
+external cursor_get_op :
+  rawcursor -> string option -> buffer option -> cursor_op ->
+  (buffer * buffer, int) result = "stub_mdb_cursor_get"
+
+let cursor_get_op ?key ?data cursor op =
+  R.reword_error error_of_int
+    (cursor_get_op (rawcursor_of_cursor cursor) key data op)
+
+let cursor_first cursor =
+  R.map ignore (cursor_get_op cursor First)
+let cursor_last cursor =
+  R.map ignore (cursor_get_op cursor Last)
+let cursor_next cursor =
+  R.map ignore (cursor_get_op cursor Next)
+let cursor_prev cursor =
+  R.map ignore (cursor_get_op cursor Prev)
+let cursor_at cursor = function
+  | "" -> cursor_first cursor
+  | key -> R.map ignore (cursor_get_op ~key cursor Set_range)
+
+let cursor_get cursor =
+  cursor_get_op cursor Get_current
+
+let cursor_fold_left ~f ~init cursor =
+  let rec inner a =
+    match cursor_get cursor with
+    | Error KeyNotFound -> Ok a
+    | Error err -> Error err
+    | Ok kv ->
+        f a kv >>= fun a ->
+        match cursor_next cursor with
+        | Error KeyNotFound -> Ok a
+        | Error err -> Error err
+        | Ok () -> inner a
+  in
+  inner init
+
+let cursor_iter ~f cursor =
+  cursor_fold_left ~init:() ~f:(fun () kv -> f kv) cursor
+
+external cursor_put :
+  rawcursor -> string -> buffer -> int -> int = "stub_mdb_cursor_put" [@@noalloc]
+external cursor_put_string :
+  rawcursor -> string -> string -> int -> int = "stub_mdb_cursor_put_string" [@@noalloc]
+external cursor_del :
+  rawcursor -> int -> int = "stub_mdb_cursor_del" [@@noalloc]
+external cursor_count :
+  rawcursor -> (int, int) result = "stub_mdb_cursor_count"
+
+let cursor_put ?(flags=[]) cursor k v =
+  return
+    (cursor_put (rawcursor_of_cursor cursor) k v (int_of_flags_put flags))
+    ()
+
+let cursor_put_string ?(flags=[]) cursor k v =
+  return
+    (cursor_put_string (rawcursor_of_cursor cursor) k v (int_of_flags_put flags))
+    ()
+
+let cursor_del ?(flags=[]) cursor =
+  return
+    (cursor_del (rawcursor_of_cursor cursor) (int_of_flags_put flags))
+    ()
+
+let cursor_count cursor =
+  R.reword_error error_of_int
+    (cursor_count (rawcursor_of_cursor cursor))
+
+let with_cursor txn db ~f =
+  opencursor txn db >>= fun cursor ->
+  finalize
+    ~final:(fun () -> cursor_close cursor)
+    ~f:(fun () -> f cursor)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.mli b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.mli
new file mode 100644
index 000000000..92e74fb81
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb.mli
@@ -0,0 +1,255 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+open Rresult
+
+type error =
+  | NoSuchFileOrDir
+  | IOError
+  | EnvironmentLocked
+  | OutOfMemory
+  | PermissionDenied
+  | InvalidArgument
+  | NoSpaceLeftOnDevice
+  | KeyExist
+  | KeyNotFound
+  | PageNotFound
+  | Corrupted
+  | Panic
+  | VersionMismatch
+  | InvalidFile
+  | MapFull
+  | DbsFull
+  | ReadersFull
+  | TLSFull
+  | TxnFull
+  | CursorFull
+  | PageFull
+  | MapResized
+  | Incompatible
+  | BadRslot
+  | BadTxn
+  | BadValSize
+  | BadDbi
+  | TxnProblem
+
+val string_of_error : error -> string
+val pp_error : Format.formatter -> error -> unit
+val to_msg : ('a, error) result -> ('a, [> R.msg]) result
+
+type version = {
+  major : int ;
+  minor : int ;
+  patch : int ;
+}
+
+val version : unit -> version
+
+type ro
+type rw
+type t
+
+type flag_env =
+  | FixedMap
+  | NoSubdir
+  | NoSync
+  | RdOnly
+  | NoMetaSync
+  | WriteMap
+  | MapAsync
+  | NoTLS
+  | NoLock
+  | NoRdAhead
+  | NoMemInit
+  | PrevMeta
+
+val opendir :
+  ?maxreaders:int -> ?maxdbs:int -> ?mapsize:int64 -> ?flags:flag_env list ->
+  string -> Unix.file_perm -> (t, error) result
+
+val closedir : t -> unit
+
+val copy : ?compact:bool -> t -> string -> (unit, error) result
+val copyfd : ?compact:bool -> t -> Unix.file_descr -> (unit, error) result
+
+type stat = {
+  psize : int ;
+  depth : int ;
+  branch_pages : int ;
+  leaf_pages : int ;
+  overflow_pages : int ;
+  entries : int ;
+}
+
+val stat : t -> stat
+
+type envinfo = {
+  mapsize : int ;
+  last_pgno : int ;
+  last_txnid : int ;
+  maxreaders : int ;
+  numreaders : int ;
+}
+
+val envinfo : t -> envinfo
+
+val sync : ?force:bool -> t -> (unit, error) result
+
+val get_flags : t -> flag_env list
+val set_flags : t -> flag_env list -> (unit, error) result
+val clear_flags : t -> flag_env list -> (unit, error) result
+
+val get_path : t -> string
+val get_fd : t -> Unix.file_descr
+
+val get_maxreaders : t -> int
+val get_maxkeysize : t -> int
+
+val set_mapsize : t -> int64 -> (unit, error) result
+
+type _ txn
+
+val create_rw_txn :
+  ?nosync:bool -> ?nometasync:bool ->
+  ?parent:rw txn -> t -> (rw txn, error) result
+
+val create_ro_txn :
+  ?nosync:bool -> ?nometasync:bool ->
+  ?parent:_ txn -> t -> (ro txn, error) result
+
+val get_txn_id : _ txn -> int
+val get_txn_env : _ txn -> t
+
+val commit_txn : _ txn -> (unit, error) result
+val abort_txn : _ txn -> unit
+
+val reset_ro_txn : ro txn -> unit
+val renew_ro_txn : ro txn -> (unit, error) result
+
+type flag_open =
+  | ReverseKey
+  | DupSort
+  | IntegerKey
+  | DupFixed
+  | IntegerDup
+  | ReverseDup
+  | Create
+
+type db
+
+val opendb :
+  ?flags:flag_open list -> ?name:string -> _ txn -> (db, error) result
+
+val db_stat : _ txn -> db -> (stat, error) result
+val db_flags : _ txn -> db -> (flag_open list, error) result
+val db_drop : _ txn -> db -> (unit, error) result
+
+val with_ro_db :
+  ?nosync:bool -> ?nometasync:bool ->
+  ?parent:_ txn -> ?flags:flag_open list ->
+  ?name:string -> t -> f:(ro txn -> db -> ('a, error) result) ->
+  ('a, error) result
+
+val with_rw_db :
+  ?nosync:bool -> ?nometasync:bool ->
+  ?parent:rw txn -> ?flags:flag_open list ->
+  ?name:string -> t -> f:(rw txn -> db -> ('a, error) result) ->
+  ('a, error) result
+
+type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+val get : _ txn -> db -> string -> (buffer, error) result
+val mem : _ txn -> db -> string -> (bool, error) result
+
+type flag_put =
+  | NoOverwrite
+  | NoDupData
+  | Current
+  | Reserve
+  | Append
+  | AppendDup
+  | Multiple
+
+val put : ?flags:flag_put list ->
+  rw txn -> db -> string -> buffer -> (unit, error) result
+val put_string : ?flags:flag_put list ->
+  rw txn -> db -> string -> string -> (unit, error) result
+
+val del : ?data:buffer ->
+  rw txn -> db -> string -> (unit, error) result
+val del_string : ?data:string ->
+  rw txn -> db -> string -> (unit, error) result
+
+type _ cursor
+
+val opencursor : 'a txn -> db -> ('a cursor, error) result
+val cursor_close : _ cursor -> unit
+val cursor_renew : ro txn -> ro cursor -> (unit, error) result
+
+val cursor_txn : 'a cursor -> 'a txn
+val cursor_db : _ cursor -> db
+
+val cursor_first : _ cursor -> (unit, error) result
+val cursor_last : _ cursor -> (unit, error) result
+val cursor_prev : _ cursor -> (unit, error) result
+val cursor_next : _ cursor -> (unit, error) result
+val cursor_at : _ cursor -> string -> (unit, error) result
+
+val cursor_get : _ cursor -> (buffer * buffer, error) result
+
+val cursor_fold_left :
+  f:('a -> (buffer * buffer) -> ('a, error) result) ->
+  init:'a -> _ cursor -> ('a, error) result
+
+val cursor_iter :
+  f:(buffer * buffer -> (unit, error) result) -> _ cursor -> (unit, error) result
+
+val with_cursor :
+  'a txn -> db -> f:('a cursor -> ('b, error) result) ->
+  ('b, error) result
+
+type cursor_op =
+  | First
+  | First_dup
+  | Get_both
+  | Get_both_range
+  | Get_current
+  | Get_multiple
+  | Last
+  | Last_dup
+  | Next
+  | Next_dup
+  | Next_multiple
+  | Next_nodup
+  | Prev
+  | Prev_dup
+  | Prev_nodup
+  | Set
+  | Set_key
+  | Set_range
+  | Prev_multiple
+
+val cursor_put : ?flags:flag_put list ->
+  rw cursor -> string -> buffer -> (unit, error) result
+val cursor_put_string : ?flags:flag_put list ->
+  rw cursor -> string -> string -> (unit, error) result
+val cursor_del : ?flags:flag_put list -> rw cursor -> (unit, error) result
+val cursor_count : _ cursor -> (int, error) result
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb_stubs.c b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb_stubs.c
new file mode 100644
index 000000000..9461b2a7b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/lmdb_stubs.c
@@ -0,0 +1,569 @@
+/* --------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  --------------------------------------------------------------------------- */
+
+#include <string.h>
+
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/custom.h>
+#include <caml/bigarray.h>
+
+#include "lmdb.h"
+
+CAMLprim value stub_mdb_version(value unit) {
+    CAMLparam1(unit);
+    CAMLlocal1(result);
+
+    int major, minor, patch;
+    mdb_version(&major, &minor, &patch);
+    result = caml_alloc_tuple(3);
+    Store_field(result, 0, Val_int(major));
+    Store_field(result, 1, Val_int(minor));
+    Store_field(result, 2, Val_int(patch));
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_strerror(value errno) {
+    CAMLparam1(errno);
+    CAMLlocal1(result);
+
+    char *errstr;
+    errstr = mdb_strerror(Int_val(errno));
+    result = caml_copy_string(errstr);
+
+    CAMLreturn(result);
+}
+
+#define Env_val(v) (*((MDB_env **) Data_custom_val(v)))
+#define Txn_val(v) (*((MDB_txn **) Data_custom_val(v)))
+#define Cursor_val(v) (*((MDB_cursor **) Data_custom_val(v)))
+
+#define Gen_custom_block(SNAME, CNAME, MNAME)                           \
+    static int compare_##SNAME(value a, value b) {                      \
+        CNAME *aa = MNAME(a), *bb = MNAME(b);                           \
+        return (aa == bb ? 0 : (aa < bb ? -1 : 1));                     \
+    }                                                                   \
+                                                                        \
+    static struct custom_operations lmdb_##SNAME##_ops = {              \
+        .identifier = "lmdb_" #SNAME,                                   \
+        .finalize = custom_finalize_default,                            \
+        .compare = compare_##SNAME,                                     \
+        .compare_ext = custom_compare_ext_default,                      \
+        .hash = custom_hash_default,                                    \
+        .serialize = custom_serialize_default,                          \
+        .deserialize = custom_deserialize_default                       \
+    };                                                                  \
+                                                                        \
+    static value alloc_##SNAME (CNAME *a) {                             \
+        value custom = alloc_custom(&lmdb_##SNAME##_ops, sizeof(CNAME *), 0, 1); \
+        MNAME(custom) = a;                                              \
+        return custom;                                                  \
+    }
+
+Gen_custom_block(env, MDB_env, Env_val)
+Gen_custom_block(txn, MDB_txn, Txn_val)
+Gen_custom_block(cursor, MDB_cursor, Cursor_val)
+
+CAMLprim value stub_mdb_env_create(value unit) {
+    CAMLparam1(unit);
+    CAMLlocal2(result, ml_env);
+
+    int ret;
+    MDB_env *env;
+
+    ret = mdb_env_create(&env);
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        ml_env = alloc_env(env);
+        Store_field(result, 0, ml_env);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_env_open(value env, value path, value flags, value mode) {
+    return Val_int(mdb_env_open(Env_val(env), String_val(path), Int_val(flags), Int_val(mode)));
+}
+
+CAMLprim value stub_mdb_env_close(value env) {
+    mdb_env_close(Env_val(env));
+    return Val_unit;
+}
+
+CAMLprim value stub_mdb_env_copy2(value env, value path, value flags) {
+    return Val_int(mdb_env_copy2(Env_val(env), String_val(path), Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_env_copyfd2(value env, value fd, value flags) {
+    return Val_int(mdb_env_copyfd2(Env_val(env), Int_val(fd), Int_val(flags)));
+}
+
+static void caml_mdb_stat(value result, const MDB_stat *stat) {
+    Store_field(result, 0, Val_int(stat->ms_psize));
+    Store_field(result, 1, Val_int(stat->ms_depth));
+    Store_field(result, 2, Val_long(stat->ms_branch_pages));
+    Store_field(result, 3, Val_long(stat->ms_leaf_pages));
+    Store_field(result, 4, Val_long(stat->ms_overflow_pages));
+    Store_field(result, 5, Val_long(stat->ms_entries));
+}
+
+CAMLprim value stub_mdb_env_stat(value env) {
+    CAMLparam1(env);
+    CAMLlocal1(result);
+
+    MDB_stat stat;
+    mdb_env_stat(Env_val(env), &stat);
+    result = caml_alloc_tuple(6);
+    caml_mdb_stat(result, &stat);
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_env_info(value env) {
+    CAMLparam1(env);
+    CAMLlocal1(result);
+
+    MDB_envinfo info;
+    mdb_env_info(Env_val(env), &info);
+    result = caml_alloc_tuple(5);
+
+    Store_field(result, 0, Val_long(info.me_mapsize));
+    Store_field(result, 1, Val_long(info.me_last_pgno));
+    Store_field(result, 2, Val_long(info.me_last_txnid));
+    Store_field(result, 3, Val_int(info.me_maxreaders));
+    Store_field(result, 4, Val_int(info.me_numreaders));
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_env_sync(value env, value force) {
+    return Val_int(mdb_env_sync(Env_val(env), Bool_val(force)));
+}
+
+CAMLprim value stub_mdb_env_set_flags(value env, value flags, value onoff) {
+    return Val_int(mdb_env_set_flags(Env_val(env), Int_val(flags), Bool_val(onoff)));
+}
+
+CAMLprim value stub_mdb_env_get_flags(value env) {
+    unsigned int flags;
+    mdb_env_get_flags(Env_val(env), &flags);
+    return Val_int(flags);
+}
+
+CAMLprim value stub_mdb_env_get_path(value env) {
+    CAMLparam1(env);
+    CAMLlocal1(result);
+
+    const char *path;
+    mdb_env_get_path(Env_val(env), &path);
+    result = caml_copy_string(path);
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_env_get_fd(value env) {
+    mdb_filehandle_t fd;
+    mdb_env_get_fd(Env_val(env), &fd);
+    return Val_int(fd);
+}
+
+CAMLprim value stub_mdb_env_set_mapsize(value env, value size) {
+    return Val_int(mdb_env_set_mapsize(Env_val(env), Int64_val(size)));
+}
+
+CAMLprim value stub_mdb_env_set_maxreaders(value env, value readers) {
+    return Val_int(mdb_env_set_maxreaders(Env_val(env), Int_val(readers)));
+}
+
+CAMLprim value stub_mdb_env_get_maxreaders(value env) {
+    unsigned int readers;
+    mdb_env_get_maxreaders(Env_val(env), &readers);
+    return Val_int(readers);
+}
+
+CAMLprim value stub_mdb_env_set_maxdbs(value env, value dbs) {
+    return Val_int(mdb_env_set_maxdbs(Env_val(env), Int_val(dbs)));
+}
+
+CAMLprim value stub_mdb_env_get_maxkeysize(value env) {
+    return Val_int(mdb_env_get_maxkeysize(Env_val(env)));
+}
+
+CAMLprim value stub_mdb_txn_begin(value env, value flags, value parent) {
+    CAMLparam3(env, flags, parent);
+    CAMLlocal2(result, ml_txn);
+
+    int ret;
+    MDB_txn *parent_txn = Is_block(parent) ? Txn_val(Field(parent, 0)) : NULL;
+    MDB_txn *new_txn;
+
+    ret = mdb_txn_begin(Env_val(env), parent_txn, Int_val(flags), &new_txn);
+
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        ml_txn = alloc_txn(new_txn);
+        Store_field(result, 0, ml_txn);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_txn_env(value txn) {
+    CAMLparam1(txn);
+    CAMLlocal1(result);
+    MDB_env *env = mdb_txn_env(Txn_val(txn));
+    result = alloc_env(env);
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_txn_id(value txn) {
+    return Val_long(mdb_txn_id(Txn_val(txn)));
+}
+
+CAMLprim value stub_mdb_txn_commit(value txn) {
+    return Val_int(mdb_txn_commit(Txn_val(txn)));
+}
+
+CAMLprim value stub_mdb_txn_abort(value txn) {
+    mdb_txn_abort(Txn_val(txn));
+    return Val_unit;
+}
+
+CAMLprim value stub_mdb_txn_reset(value txn) {
+    mdb_txn_reset(Txn_val(txn));
+    return Val_unit;
+}
+
+CAMLprim value stub_mdb_txn_renew(value txn) {
+    return Val_int(mdb_txn_renew(Txn_val(txn)));
+}
+
+CAMLprim value stub_mdb_dbi_open(value txn, value name, value flags) {
+    CAMLparam3(txn, name, flags);
+    CAMLlocal2(result, ml_dbi);
+
+    MDB_dbi dbi;
+    int ret;
+    const char* db_name = NULL;
+
+    if (Is_block(name)) db_name = String_val(Field(name, 0));
+
+    ret = mdb_dbi_open(Txn_val(txn), db_name, Int_val(flags), &dbi);
+
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        ml_dbi = caml_copy_nativeint(dbi);
+        Store_field(result, 0, ml_dbi);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_stat(value txn, value dbi) {
+    CAMLparam2(txn, dbi);
+    CAMLlocal2(result, tuple);
+
+    MDB_stat stat;
+    int ret;
+    ret = mdb_stat(Txn_val(txn), Nativeint_val(dbi), &stat);
+
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        tuple = caml_alloc_tuple(6);
+        caml_mdb_stat(tuple, &stat);
+        Store_field(result, 0, tuple);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_dbi_flags(value txn, value dbi) {
+    CAMLparam2(txn, dbi);
+    CAMLlocal1(result);
+
+    unsigned int flags;
+    int ret;
+    ret = mdb_dbi_flags(Txn_val(txn), Nativeint_val(dbi), &flags);
+
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        Store_field(result, 0, Val_int(flags));
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_dbi_close(value env, value dbi) {
+    mdb_dbi_close(Env_val(env), Nativeint_val(dbi));
+    return Val_unit;
+}
+
+CAMLprim value stub_mdb_drop(value txn, value dbi, value del) {
+    return Val_int(mdb_drop(Txn_val(txn), Nativeint_val(dbi), Bool_val(del)));
+}
+
+static inline value alloc_mdb_val_ba (MDB_val *v) {
+    return
+        (v ?
+         caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, v->mv_data, v->mv_size) :
+         caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, NULL, 0));
+}
+
+CAMLprim value stub_mdb_get(value txn, value dbi, value key) {
+    CAMLparam3(txn, dbi, key);
+    CAMLlocal1(result);
+
+    MDB_val k, v;
+    int ret;
+
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+
+    ret = mdb_get(Txn_val(txn), Nativeint_val(dbi), &k, &v);
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        Store_field(result, 0, alloc_mdb_val_ba(&v));
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_put(value txn, value dbi,
+                            value key, value data, value flags) {
+    MDB_val k, v;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+    v.mv_size = Caml_ba_array_val(data)->dim[0];
+    v.mv_data = Caml_ba_data_val(data);
+    return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_put_string(value txn, value dbi,
+                                   value key, value data, value flags) {
+    MDB_val k, v;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+    v.mv_size = caml_string_length(data);
+    v.mv_data = String_val(data);
+    return Val_int(mdb_put(Txn_val(txn), Nativeint_val(dbi), &k, &v, Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_del(value txn, value dbi, value key, value data) {
+    MDB_val k, v, *vp = NULL;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+
+    if (Is_block(data)) {
+        v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
+        v.mv_data = Caml_ba_data_val(Field(data, 0));
+        vp = &v;
+    }
+
+    return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
+}
+
+CAMLprim value stub_mdb_del_string(value txn, value dbi, value key, value data) {
+    MDB_val k, v, *vp = NULL;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+
+    if (Is_block(data)) {
+        v.mv_size = caml_string_length(Field(data, 0));
+        v.mv_data = String_val(Field(data, 0));
+        vp = &v;
+    }
+
+    return Val_int(mdb_del(Txn_val(txn), Nativeint_val(dbi), &k, vp));
+}
+
+CAMLprim value stub_mdb_cursor_open(value txn, value dbi) {
+    CAMLparam2(txn, dbi);
+    CAMLlocal2(result, ml_cursor);
+
+    MDB_cursor *cursor;
+    int ret;
+    ret = mdb_cursor_open(Txn_val(txn), Nativeint_val(dbi), &cursor);
+
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        ml_cursor = alloc_cursor(cursor);
+        Store_field(result, 0, ml_cursor);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_cursor_close(value cursor) {
+    mdb_cursor_close(Cursor_val(cursor));
+    return Val_unit;
+}
+
+CAMLprim value stub_mdb_cursor_renew(value txn, value cursor) {
+    return Val_int(mdb_cursor_renew(Txn_val(txn), Cursor_val(cursor)));
+}
+
+CAMLprim value stub_mdb_cursor_txn(value cursor) {
+    CAMLparam1(cursor);
+    CAMLlocal1(txn);
+    txn = alloc_txn(mdb_cursor_txn(Cursor_val(cursor)));
+    CAMLreturn(txn);
+}
+
+CAMLprim value stub_mdb_cursor_dbi(value cursor) {
+    return Val_int(mdb_cursor_dbi(Cursor_val(cursor)));
+}
+
+CAMLprim value stub_mdb_cursor_get(value cursor, value key, value data, value op) {
+    CAMLparam4(cursor, key, data, op);
+    CAMLlocal2(result, tuple);
+
+    MDB_val k, v;
+    int ret;
+
+    if (Is_block(key)) {
+        k.mv_size = caml_string_length(Field(key, 0));
+        k.mv_data = String_val(Field(key, 0));
+    }
+
+    if (Is_block(data)) {
+        v.mv_size = Caml_ba_array_val(Field(data, 0))->dim[0];
+        v.mv_data = Caml_ba_data_val(Field(data, 0));
+    }
+
+    ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        tuple = caml_alloc_tuple(2);
+        Store_field(tuple, 0, alloc_mdb_val_ba(&k));
+        Store_field(tuple, 1, alloc_mdb_val_ba(&v));
+        Store_field(result, 0, tuple);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_cursor_get_string(value cursor, value key, value data, value op) {
+    CAMLparam4(cursor, key, data, op);
+    CAMLlocal2(result, tuple);
+
+    MDB_val k, v;
+    int ret;
+
+    if (Is_block(key)) {
+        k.mv_size = caml_string_length(Field(key, 0));
+        k.mv_data = String_val(Field(key, 0));
+    }
+
+    if (Is_block(data)) {
+        v.mv_size = caml_string_length(Field(data, 0));
+        v.mv_data = String_val(Field(data, 0));
+    }
+
+    ret = mdb_cursor_get(Cursor_val(cursor), &k, &v, Int_val(op));
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        tuple = caml_alloc_tuple(2);
+        Store_field(tuple, 0, alloc_mdb_val_ba(&k));
+        Store_field(tuple, 1, alloc_mdb_val_ba(&v));
+        Store_field(result, 0, tuple);
+    }
+
+    CAMLreturn(result);
+}
+
+CAMLprim value stub_mdb_cursor_put(value cursor, value key, value data, value flags) {
+    MDB_val k, v;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+    v.mv_size = Caml_ba_array_val(data)->dim[0];
+    v.mv_data = Caml_ba_data_val(data);
+    return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_cursor_put_string(value cursor, value key, value data, value flags) {
+    MDB_val k, v;
+    k.mv_size = caml_string_length(key);
+    k.mv_data = String_val(key);
+    v.mv_size = caml_string_length(data);
+    v.mv_data = String_val(data);
+    return Val_int(mdb_cursor_put(Cursor_val(cursor), &k, &v, Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_cursor_del(value cursor, value flags) {
+    return Val_int(mdb_cursor_del(Cursor_val(cursor), Int_val(flags)));
+}
+
+CAMLprim value stub_mdb_cursor_count(value cursor) {
+    CAMLparam1(cursor);
+    CAMLlocal1(result);
+
+    mdb_size_t count;
+    int ret;
+
+    ret = mdb_cursor_count(Cursor_val(cursor), &count);
+    if (ret) {
+        result = caml_alloc(1, 1);
+        Store_field(result, 0, Val_int(ret));
+    }
+    else {
+        result = caml_alloc(1, 0);
+        Store_field(result, 0, Val_long(count));
+    }
+
+    CAMLreturn(result);
+}
+
+/* --------------------------------------------------------------------------
+   Copyright (c) 2018 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  --------------------------------------------------------------------------- */
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/mdb.c b/vendors/tezos-modded/vendors/ocaml-lmdb/src/mdb.c
new file mode 100644
index 000000000..85f5bc3fb
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/mdb.c
@@ -0,0 +1,11153 @@
+/** @file mdb.c
+ *	@brief Lightning memory-mapped database library
+ *
+ *	A Btree-based database management library modeled loosely on the
+ *	BerkeleyDB API, but much simplified.
+ */
+/*
+ * Copyright 2011-2018 Howard Chu, Symas Corp.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted only as authorized by the OpenLDAP
+ * Public License.
+ *
+ * A copy of this license is available in the file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ *
+ * This code is derived from btree.c written by Martin Hedenfalk.
+ *
+ * Copyright (c) 2009, 2010 Martin Hedenfalk <martin@bzero.se>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE 1
+#endif
+#if defined(MDB_VL32) || defined(__WIN64__)
+#define _FILE_OFFSET_BITS	64
+#endif
+#ifdef _WIN32
+#include <malloc.h>
+#include <windows.h>
+#include <wchar.h>				/* get wcscpy() */
+
+/* We use native NT APIs to setup the memory map, so that we can
+ * let the DB file grow incrementally instead of always preallocating
+ * the full size. These APIs are defined in <wdm.h> and <ntifs.h>
+ * but those headers are meant for driver-level development and
+ * conflict with the regular user-level headers, so we explicitly
+ * declare them here. We get pointers to these functions from
+ * NTDLL.DLL at runtime, to avoid buildtime dependencies on any
+ * NTDLL import libraries.
+ */
+typedef NTSTATUS WINAPI (NtCreateSectionFunc)
+  (OUT PHANDLE sh, IN ACCESS_MASK acc,
+  IN void * oa OPTIONAL,
+  IN PLARGE_INTEGER ms OPTIONAL,
+  IN ULONG pp, IN ULONG aa, IN HANDLE fh OPTIONAL);
+
+static NtCreateSectionFunc *NtCreateSection;
+
+typedef enum _SECTION_INHERIT {
+	ViewShare = 1,
+	ViewUnmap = 2
+} SECTION_INHERIT;
+
+typedef NTSTATUS WINAPI (NtMapViewOfSectionFunc)
+  (IN PHANDLE sh, IN HANDLE ph,
+  IN OUT PVOID *addr, IN ULONG_PTR zbits,
+  IN SIZE_T cs, IN OUT PLARGE_INTEGER off OPTIONAL,
+  IN OUT PSIZE_T vs, IN SECTION_INHERIT ih,
+  IN ULONG at, IN ULONG pp);
+
+static NtMapViewOfSectionFunc *NtMapViewOfSection;
+
+typedef NTSTATUS WINAPI (NtCloseFunc)(HANDLE h);
+
+static NtCloseFunc *NtClose;
+
+/** getpid() returns int; MinGW defines pid_t but MinGW64 typedefs it
+ *  as int64 which is wrong. MSVC doesn't define it at all, so just
+ *  don't use it.
+ */
+#define MDB_PID_T	int
+#define MDB_THR_T	DWORD
+#include <sys/types.h>
+#include <sys/stat.h>
+#ifdef __GNUC__
+# include <sys/param.h>
+#else
+# define LITTLE_ENDIAN	1234
+# define BIG_ENDIAN	4321
+# define BYTE_ORDER	LITTLE_ENDIAN
+# ifndef SSIZE_MAX
+#  define SSIZE_MAX	INT_MAX
+# endif
+#endif
+#else
+#include <sys/types.h>
+#include <sys/stat.h>
+#define MDB_PID_T	pid_t
+#define MDB_THR_T	pthread_t
+#include <sys/param.h>
+#include <sys/uio.h>
+#include <sys/mman.h>
+#ifdef HAVE_SYS_FILE_H
+#include <sys/file.h>
+#endif
+#include <fcntl.h>
+#endif
+
+#if defined(__mips) && defined(__linux)
+/* MIPS has cache coherency issues, requires explicit cache control */
+#include <asm/cachectl.h>
+extern int cacheflush(char *addr, int nbytes, int cache);
+#define CACHEFLUSH(addr, bytes, cache)	cacheflush(addr, bytes, cache)
+#else
+#define CACHEFLUSH(addr, bytes, cache)
+#endif
+
+#if defined(__linux) && !defined(MDB_FDATASYNC_WORKS)
+/** fdatasync is broken on ext3/ext4fs on older kernels, see
+ *	description in #mdb_env_open2 comments. You can safely
+ *	define MDB_FDATASYNC_WORKS if this code will only be run
+ *	on kernels 3.6 and newer.
+ */
+#define	BROKEN_FDATASYNC
+#endif
+
+#include <errno.h>
+#include <limits.h>
+#include <stddef.h>
+#include <inttypes.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#ifdef _MSC_VER
+#include <io.h>
+typedef SSIZE_T	ssize_t;
+#else
+#include <unistd.h>
+#endif
+
+#if defined(__sun) || defined(ANDROID)
+/* Most platforms have posix_memalign, older may only have memalign */
+#define HAVE_MEMALIGN	1
+#include <malloc.h>
+/* On Solaris, we need the POSIX sigwait function */
+#if defined (__sun)
+# define _POSIX_PTHREAD_SEMANTICS	1
+#endif
+#endif
+
+#if !(defined(BYTE_ORDER) || defined(__BYTE_ORDER))
+#include <netinet/in.h>
+#include <resolv.h>	/* defines BYTE_ORDER on HPUX and Solaris */
+#endif
+
+#if defined(__APPLE__) || defined (BSD) || defined(__FreeBSD_kernel__)
+# if !(defined(MDB_USE_POSIX_MUTEX) || defined(MDB_USE_POSIX_SEM))
+# define MDB_USE_SYSV_SEM	1
+# endif
+# define MDB_FDATASYNC		fsync
+#elif defined(ANDROID)
+# define MDB_FDATASYNC		fsync
+#endif
+
+#ifndef _WIN32
+#include <pthread.h>
+#include <signal.h>
+#ifdef MDB_USE_POSIX_SEM
+# define MDB_USE_HASH		1
+#include <semaphore.h>
+#elif defined(MDB_USE_SYSV_SEM)
+#include <sys/ipc.h>
+#include <sys/sem.h>
+#ifdef _SEM_SEMUN_UNDEFINED
+union semun {
+	int val;
+	struct semid_ds *buf;
+	unsigned short *array;
+};
+#endif /* _SEM_SEMUN_UNDEFINED */
+#else
+#define MDB_USE_POSIX_MUTEX	1
+#endif /* MDB_USE_POSIX_SEM */
+#endif /* !_WIN32 */
+
+#if defined(_WIN32) + defined(MDB_USE_POSIX_SEM) + defined(MDB_USE_SYSV_SEM) \
+	+ defined(MDB_USE_POSIX_MUTEX) != 1
+# error "Ambiguous shared-lock implementation"
+#endif
+
+#ifdef USE_VALGRIND
+#include <valgrind/memcheck.h>
+#define VGMEMP_CREATE(h,r,z)    VALGRIND_CREATE_MEMPOOL(h,r,z)
+#define VGMEMP_ALLOC(h,a,s) VALGRIND_MEMPOOL_ALLOC(h,a,s)
+#define VGMEMP_FREE(h,a) VALGRIND_MEMPOOL_FREE(h,a)
+#define VGMEMP_DESTROY(h)	VALGRIND_DESTROY_MEMPOOL(h)
+#define VGMEMP_DEFINED(a,s)	VALGRIND_MAKE_MEM_DEFINED(a,s)
+#else
+#define VGMEMP_CREATE(h,r,z)
+#define VGMEMP_ALLOC(h,a,s)
+#define VGMEMP_FREE(h,a)
+#define VGMEMP_DESTROY(h)
+#define VGMEMP_DEFINED(a,s)
+#endif
+
+#ifndef BYTE_ORDER
+# if (defined(_LITTLE_ENDIAN) || defined(_BIG_ENDIAN)) && !(defined(_LITTLE_ENDIAN) && defined(_BIG_ENDIAN))
+/* Solaris just defines one or the other */
+#  define LITTLE_ENDIAN	1234
+#  define BIG_ENDIAN	4321
+#  ifdef _LITTLE_ENDIAN
+#   define BYTE_ORDER  LITTLE_ENDIAN
+#  else
+#   define BYTE_ORDER  BIG_ENDIAN
+#  endif
+# else
+#  define BYTE_ORDER   __BYTE_ORDER
+# endif
+#endif
+
+#ifndef LITTLE_ENDIAN
+#define LITTLE_ENDIAN	__LITTLE_ENDIAN
+#endif
+#ifndef BIG_ENDIAN
+#define BIG_ENDIAN	__BIG_ENDIAN
+#endif
+
+#if defined(__i386) || defined(__x86_64) || defined(_M_IX86)
+#define MISALIGNED_OK	1
+#endif
+
+#include "lmdb.h"
+#include "midl.h"
+
+#if (BYTE_ORDER == LITTLE_ENDIAN) == (BYTE_ORDER == BIG_ENDIAN)
+# error "Unknown or unsupported endianness (BYTE_ORDER)"
+#elif (-6 & 5) || CHAR_BIT!=8 || UINT_MAX!=0xffffffff || MDB_SIZE_MAX%UINT_MAX
+# error "Two's complement, reasonably sized integer types, please"
+#endif
+
+#ifdef __GNUC__
+/** Put infrequently used env functions in separate section */
+# ifdef __APPLE__
+#  define	ESECT	__attribute__ ((section("__TEXT,text_env")))
+# else
+#  define	ESECT	__attribute__ ((section("text_env")))
+# endif
+#else
+#define ESECT
+#endif
+
+#ifdef _WIN32
+#define CALL_CONV WINAPI
+#else
+#define CALL_CONV
+#endif
+
+/** @defgroup internal	LMDB Internals
+ *	@{
+ */
+/** @defgroup compat	Compatibility Macros
+ *	A bunch of macros to minimize the amount of platform-specific ifdefs
+ *	needed throughout the rest of the code. When the features this library
+ *	needs are similar enough to POSIX to be hidden in a one-or-two line
+ *	replacement, this macro approach is used.
+ *	@{
+ */
+
+	/** Features under development */
+#ifndef MDB_DEVEL
+#define MDB_DEVEL 0
+#endif
+
+	/** Wrapper around __func__, which is a C99 feature */
+#if __STDC_VERSION__ >= 199901L
+# define mdb_func_	__func__
+#elif __GNUC__ >= 2 || _MSC_VER >= 1300
+# define mdb_func_	__FUNCTION__
+#else
+/* If a debug message says <mdb_unknown>(), update the #if statements above */
+# define mdb_func_	"<mdb_unknown>"
+#endif
+
+/* Internal error codes, not exposed outside liblmdb */
+#define	MDB_NO_ROOT		(MDB_LAST_ERRCODE + 10)
+#ifdef _WIN32
+#define MDB_OWNERDEAD	((int) WAIT_ABANDONED)
+#elif defined MDB_USE_SYSV_SEM
+#define MDB_OWNERDEAD	(MDB_LAST_ERRCODE + 11)
+#elif defined(MDB_USE_POSIX_MUTEX) && defined(EOWNERDEAD)
+#define MDB_OWNERDEAD	EOWNERDEAD	/**< #LOCK_MUTEX0() result if dead owner */
+#endif
+
+#ifdef __GLIBC__
+#define	GLIBC_VER	((__GLIBC__ << 16 )| __GLIBC_MINOR__)
+#endif
+/** Some platforms define the EOWNERDEAD error code
+ * even though they don't support Robust Mutexes.
+ * Compile with -DMDB_USE_ROBUST=0, or use some other
+ * mechanism like -DMDB_USE_SYSV_SEM instead of
+ * -DMDB_USE_POSIX_MUTEX. (SysV semaphores are
+ * also Robust, but some systems don't support them
+ * either.)
+ */
+#ifndef MDB_USE_ROBUST
+/* Android currently lacks Robust Mutex support. So does glibc < 2.4. */
+# if defined(MDB_USE_POSIX_MUTEX) && (defined(ANDROID) || \
+	(defined(__GLIBC__) && GLIBC_VER < 0x020004))
+#  define MDB_USE_ROBUST	0
+# else
+#  define MDB_USE_ROBUST	1
+# endif
+#endif /* !MDB_USE_ROBUST */
+
+#if defined(MDB_USE_POSIX_MUTEX) && (MDB_USE_ROBUST)
+/* glibc < 2.12 only provided _np API */
+#  if (defined(__GLIBC__) && GLIBC_VER < 0x02000c) || \
+	(defined(PTHREAD_MUTEX_ROBUST_NP) && !defined(PTHREAD_MUTEX_ROBUST))
+#   define PTHREAD_MUTEX_ROBUST	PTHREAD_MUTEX_ROBUST_NP
+#   define pthread_mutexattr_setrobust(attr, flag)	pthread_mutexattr_setrobust_np(attr, flag)
+#   define pthread_mutex_consistent(mutex)	pthread_mutex_consistent_np(mutex)
+#  endif
+#endif /* MDB_USE_POSIX_MUTEX && MDB_USE_ROBUST */
+
+#if defined(MDB_OWNERDEAD) && (MDB_USE_ROBUST)
+#define MDB_ROBUST_SUPPORTED	1
+#endif
+
+#ifdef _WIN32
+#define MDB_USE_HASH	1
+#define MDB_PIDLOCK	0
+#define THREAD_RET	DWORD
+#define pthread_t	HANDLE
+#define pthread_mutex_t	HANDLE
+#define pthread_cond_t	HANDLE
+typedef HANDLE mdb_mutex_t, mdb_mutexref_t;
+#define pthread_key_t	DWORD
+#define pthread_self()	GetCurrentThreadId()
+#define pthread_key_create(x,y)	\
+	((*(x) = TlsAlloc()) == TLS_OUT_OF_INDEXES ? ErrCode() : 0)
+#define pthread_key_delete(x)	TlsFree(x)
+#define pthread_getspecific(x)	TlsGetValue(x)
+#define pthread_setspecific(x,y)	(TlsSetValue(x,y) ? 0 : ErrCode())
+#define pthread_mutex_unlock(x)	ReleaseMutex(*x)
+#define pthread_mutex_lock(x)	WaitForSingleObject(*x, INFINITE)
+#define pthread_cond_signal(x)	SetEvent(*x)
+#define pthread_cond_wait(cond,mutex)	do{SignalObjectAndWait(*mutex, *cond, INFINITE, FALSE); WaitForSingleObject(*mutex, INFINITE);}while(0)
+#define THREAD_CREATE(thr,start,arg) \
+	(((thr) = CreateThread(NULL, 0, start, arg, 0, NULL)) ? 0 : ErrCode())
+#define THREAD_FINISH(thr) \
+	(WaitForSingleObject(thr, INFINITE) ? ErrCode() : 0)
+#define LOCK_MUTEX0(mutex)		WaitForSingleObject(mutex, INFINITE)
+#define UNLOCK_MUTEX(mutex)		ReleaseMutex(mutex)
+#define mdb_mutex_consistent(mutex)	0
+#define getpid()	GetCurrentProcessId()
+#define	MDB_FDATASYNC(fd)	(!FlushFileBuffers(fd))
+#define	MDB_MSYNC(addr,len,flags)	(!FlushViewOfFile(addr,len))
+#define	ErrCode()	GetLastError()
+#define GET_PAGESIZE(x) {SYSTEM_INFO si; GetSystemInfo(&si); (x) = si.dwPageSize;}
+#define	close(fd)	(CloseHandle(fd) ? 0 : -1)
+#define	munmap(ptr,len)	UnmapViewOfFile(ptr)
+#ifdef PROCESS_QUERY_LIMITED_INFORMATION
+#define MDB_PROCESS_QUERY_LIMITED_INFORMATION PROCESS_QUERY_LIMITED_INFORMATION
+#else
+#define MDB_PROCESS_QUERY_LIMITED_INFORMATION 0x1000
+#endif
+#else
+#define THREAD_RET	void *
+#define THREAD_CREATE(thr,start,arg)	pthread_create(&thr,NULL,start,arg)
+#define THREAD_FINISH(thr)	pthread_join(thr,NULL)
+
+	/** For MDB_LOCK_FORMAT: True if readers take a pid lock in the lockfile */
+#define MDB_PIDLOCK			1
+
+#ifdef MDB_USE_POSIX_SEM
+
+typedef sem_t *mdb_mutex_t, *mdb_mutexref_t;
+#define LOCK_MUTEX0(mutex)		mdb_sem_wait(mutex)
+#define UNLOCK_MUTEX(mutex)		sem_post(mutex)
+
+static int
+mdb_sem_wait(sem_t *sem)
+{
+   int rc;
+   while ((rc = sem_wait(sem)) && (rc = errno) == EINTR) ;
+   return rc;
+}
+
+#elif defined MDB_USE_SYSV_SEM
+
+typedef struct mdb_mutex {
+	int semid;
+	int semnum;
+	int *locked;
+} mdb_mutex_t[1], *mdb_mutexref_t;
+
+#define LOCK_MUTEX0(mutex)		mdb_sem_wait(mutex)
+#define UNLOCK_MUTEX(mutex)		do { \
+	struct sembuf sb = { 0, 1, SEM_UNDO }; \
+	sb.sem_num = (mutex)->semnum; \
+	*(mutex)->locked = 0; \
+	semop((mutex)->semid, &sb, 1); \
+} while(0)
+
+static int
+mdb_sem_wait(mdb_mutexref_t sem)
+{
+	int rc, *locked = sem->locked;
+	struct sembuf sb = { 0, -1, SEM_UNDO };
+	sb.sem_num = sem->semnum;
+	do {
+		if (!semop(sem->semid, &sb, 1)) {
+			rc = *locked ? MDB_OWNERDEAD : MDB_SUCCESS;
+			*locked = 1;
+			break;
+		}
+	} while ((rc = errno) == EINTR);
+	return rc;
+}
+
+#define mdb_mutex_consistent(mutex)	0
+
+#else	/* MDB_USE_POSIX_MUTEX: */
+	/** Shared mutex/semaphore as the original is stored.
+	 *
+	 *	Not for copies.  Instead it can be assigned to an #mdb_mutexref_t.
+	 *	When mdb_mutexref_t is a pointer and mdb_mutex_t is not, then it
+	 *	is array[size 1] so it can be assigned to the pointer.
+	 */
+typedef pthread_mutex_t mdb_mutex_t[1];
+	/** Reference to an #mdb_mutex_t */
+typedef pthread_mutex_t *mdb_mutexref_t;
+	/** Lock the reader or writer mutex.
+	 *	Returns 0 or a code to give #mdb_mutex_failed(), as in #LOCK_MUTEX().
+	 */
+#define LOCK_MUTEX0(mutex)	pthread_mutex_lock(mutex)
+	/** Unlock the reader or writer mutex.
+	 */
+#define UNLOCK_MUTEX(mutex)	pthread_mutex_unlock(mutex)
+	/** Mark mutex-protected data as repaired, after death of previous owner.
+	 */
+#define mdb_mutex_consistent(mutex)	pthread_mutex_consistent(mutex)
+#endif	/* MDB_USE_POSIX_SEM || MDB_USE_SYSV_SEM */
+
+	/** Get the error code for the last failed system function.
+	 */
+#define	ErrCode()	errno
+
+	/** An abstraction for a file handle.
+	 *	On POSIX systems file handles are small integers. On Windows
+	 *	they're opaque pointers.
+	 */
+#define	HANDLE	int
+
+	/**	A value for an invalid file handle.
+	 *	Mainly used to initialize file variables and signify that they are
+	 *	unused.
+	 */
+#define INVALID_HANDLE_VALUE	(-1)
+
+	/** Get the size of a memory page for the system.
+	 *	This is the basic size that the platform's memory manager uses, and is
+	 *	fundamental to the use of memory-mapped files.
+	 */
+#define	GET_PAGESIZE(x)	((x) = sysconf(_SC_PAGE_SIZE))
+#endif
+
+#define	Z	MDB_FMT_Z	/**< printf/scanf format modifier for size_t */
+#define	Yu	MDB_PRIy(u)	/**< printf format for #mdb_size_t */
+#define	Yd	MDB_PRIy(d)	/**< printf format for 'signed #mdb_size_t' */
+
+#ifdef MDB_USE_SYSV_SEM
+#define MNAME_LEN	(sizeof(int))
+#else
+#define MNAME_LEN	(sizeof(pthread_mutex_t))
+#endif
+
+/** Initial part of #MDB_env.me_mutexname[].
+ *	Changes to this code must be reflected in #MDB_LOCK_FORMAT.
+ */
+#ifdef _WIN32
+#define MUTEXNAME_PREFIX		"Global\\MDB"
+#elif defined MDB_USE_POSIX_SEM
+#define MUTEXNAME_PREFIX		"/MDB"
+#endif
+
+/** @} */
+
+#ifdef MDB_ROBUST_SUPPORTED
+	/** Lock mutex, handle any error, set rc = result.
+	 *	Return 0 on success, nonzero (not rc) on error.
+	 */
+#define LOCK_MUTEX(rc, env, mutex) \
+	(((rc) = LOCK_MUTEX0(mutex)) && \
+	 ((rc) = mdb_mutex_failed(env, mutex, rc)))
+static int mdb_mutex_failed(MDB_env *env, mdb_mutexref_t mutex, int rc);
+#else
+#define LOCK_MUTEX(rc, env, mutex) ((rc) = LOCK_MUTEX0(mutex))
+#define mdb_mutex_failed(env, mutex, rc) (rc)
+#endif
+
+#ifndef _WIN32
+/**	A flag for opening a file and requesting synchronous data writes.
+ *	This is only used when writing a meta page. It's not strictly needed;
+ *	we could just do a normal write and then immediately perform a flush.
+ *	But if this flag is available it saves us an extra system call.
+ *
+ *	@note If O_DSYNC is undefined but exists in /usr/include,
+ * preferably set some compiler flag to get the definition.
+ */
+#ifndef MDB_DSYNC
+# ifdef O_DSYNC
+# define MDB_DSYNC	O_DSYNC
+# else
+# define MDB_DSYNC	O_SYNC
+# endif
+#endif
+#endif
+
+/** Function for flushing the data of a file. Define this to fsync
+ *	if fdatasync() is not supported.
+ */
+#ifndef MDB_FDATASYNC
+# define MDB_FDATASYNC	fdatasync
+#endif
+
+#ifndef MDB_MSYNC
+# define MDB_MSYNC(addr,len,flags)	msync(addr,len,flags)
+#endif
+
+#ifndef MS_SYNC
+#define	MS_SYNC	1
+#endif
+
+#ifndef MS_ASYNC
+#define	MS_ASYNC	0
+#endif
+
+	/** A page number in the database.
+	 *	Note that 64 bit page numbers are overkill, since pages themselves
+	 *	already represent 12-13 bits of addressable memory, and the OS will
+	 *	always limit applications to a maximum of 63 bits of address space.
+	 *
+	 *	@note In the #MDB_node structure, we only store 48 bits of this value,
+	 *	which thus limits us to only 60 bits of addressable data.
+	 */
+typedef MDB_ID	pgno_t;
+
+	/** A transaction ID.
+	 *	See struct MDB_txn.mt_txnid for details.
+	 */
+typedef MDB_ID	txnid_t;
+
+/** @defgroup debug	Debug Macros
+ *	@{
+ */
+#ifndef MDB_DEBUG
+	/**	Enable debug output.  Needs variable argument macros (a C99 feature).
+	 *	Set this to 1 for copious tracing. Set to 2 to add dumps of all IDLs
+	 *	read from and written to the database (used for free space management).
+	 */
+#define MDB_DEBUG 0
+#endif
+
+#if MDB_DEBUG
+static int mdb_debug;
+static txnid_t mdb_debug_start;
+
+	/**	Print a debug message with printf formatting.
+	 *	Requires double parenthesis around 2 or more args.
+	 */
+# define DPRINTF(args) ((void) ((mdb_debug) && DPRINTF0 args))
+# define DPRINTF0(fmt, ...) \
+	fprintf(stderr, "%s:%d " fmt "\n", mdb_func_, __LINE__, __VA_ARGS__)
+#else
+# define DPRINTF(args)	((void) 0)
+#endif
+	/**	Print a debug string.
+	 *	The string is printed literally, with no format processing.
+	 */
+#define DPUTS(arg)	DPRINTF(("%s", arg))
+	/** Debuging output value of a cursor DBI: Negative in a sub-cursor. */
+#define DDBI(mc) \
+	(((mc)->mc_flags & C_SUB) ? -(int)(mc)->mc_dbi : (int)(mc)->mc_dbi)
+/** @} */
+
+	/**	@brief The maximum size of a database page.
+	 *
+	 *	It is 32k or 64k, since value-PAGEBASE must fit in
+	 *	#MDB_page.%mp_upper.
+	 *
+	 *	LMDB will use database pages < OS pages if needed.
+	 *	That causes more I/O in write transactions: The OS must
+	 *	know (read) the whole page before writing a partial page.
+	 *
+	 *	Note that we don't currently support Huge pages. On Linux,
+	 *	regular data files cannot use Huge pages, and in general
+	 *	Huge pages aren't actually pageable. We rely on the OS
+	 *	demand-pager to read our data and page it out when memory
+	 *	pressure from other processes is high. So until OSs have
+	 *	actual paging support for Huge pages, they're not viable.
+	 */
+#define MAX_PAGESIZE	 (PAGEBASE ? 0x10000 : 0x8000)
+
+	/** The minimum number of keys required in a database page.
+	 *	Setting this to a larger value will place a smaller bound on the
+	 *	maximum size of a data item. Data items larger than this size will
+	 *	be pushed into overflow pages instead of being stored directly in
+	 *	the B-tree node. This value used to default to 4. With a page size
+	 *	of 4096 bytes that meant that any item larger than 1024 bytes would
+	 *	go into an overflow page. That also meant that on average 2-3KB of
+	 *	each overflow page was wasted space. The value cannot be lower than
+	 *	2 because then there would no longer be a tree structure. With this
+	 *	value, items larger than 2KB will go into overflow pages, and on
+	 *	average only 1KB will be wasted.
+	 */
+#define MDB_MINKEYS	 2
+
+	/**	A stamp that identifies a file as an LMDB file.
+	 *	There's nothing special about this value other than that it is easily
+	 *	recognizable, and it will reflect any byte order mismatches.
+	 */
+#define MDB_MAGIC	 0xBEEFC0DE
+
+	/**	The version number for a database's datafile format. */
+#define MDB_DATA_VERSION	 ((MDB_DEVEL) ? 999 : 1)
+	/**	The version number for a database's lockfile format. */
+#define MDB_LOCK_VERSION	 ((MDB_DEVEL) ? 999 : 2)
+	/** Number of bits representing #MDB_LOCK_VERSION in #MDB_LOCK_FORMAT.
+	 *	The remaining bits must leave room for #MDB_lock_desc.
+	 */
+#define MDB_LOCK_VERSION_BITS 12
+
+	/**	@brief The max size of a key we can write, or 0 for computed max.
+	 *
+	 *	This macro should normally be left alone or set to 0.
+	 *	Note that a database with big keys or dupsort data cannot be
+	 *	reliably modified by a liblmdb which uses a smaller max.
+	 *	The default is 511 for backwards compat, or 0 when #MDB_DEVEL.
+	 *
+	 *	Other values are allowed, for backwards compat.  However:
+	 *	A value bigger than the computed max can break if you do not
+	 *	know what you are doing, and liblmdb <= 0.9.10 can break when
+	 *	modifying a DB with keys/dupsort data bigger than its max.
+	 *
+	 *	Data items in an #MDB_DUPSORT database are also limited to
+	 *	this size, since they're actually keys of a sub-DB.  Keys and
+	 *	#MDB_DUPSORT data items must fit on a node in a regular page.
+	 */
+#ifndef MDB_MAXKEYSIZE
+#define MDB_MAXKEYSIZE	 ((MDB_DEVEL) ? 0 : 511)
+#endif
+
+	/**	The maximum size of a key we can write to the environment. */
+#if MDB_MAXKEYSIZE
+#define ENV_MAXKEY(env)	(MDB_MAXKEYSIZE)
+#else
+#define ENV_MAXKEY(env)	((env)->me_maxkey)
+#endif
+
+	/**	@brief The maximum size of a data item.
+	 *
+	 *	We only store a 32 bit value for node sizes.
+	 */
+#define MAXDATASIZE	0xffffffffUL
+
+#if MDB_DEBUG
+	/**	Key size which fits in a #DKBUF.
+	 *	@ingroup debug
+	 */
+#define DKBUF_MAXKEYSIZE ((MDB_MAXKEYSIZE) > 0 ? (MDB_MAXKEYSIZE) : 511)
+	/**	A key buffer.
+	 *	@ingroup debug
+	 *	This is used for printing a hex dump of a key's contents.
+	 */
+#define DKBUF	char kbuf[DKBUF_MAXKEYSIZE*2+1]
+	/**	Display a key in hex.
+	 *	@ingroup debug
+	 *	Invoke a function to display a key in hex.
+	 */
+#define	DKEY(x)	mdb_dkey(x, kbuf)
+#else
+#define	DKBUF
+#define DKEY(x)	0
+#endif
+
+	/** An invalid page number.
+	 *	Mainly used to denote an empty tree.
+	 */
+#define P_INVALID	 (~(pgno_t)0)
+
+	/** Test if the flags \b f are set in a flag word \b w. */
+#define F_ISSET(w, f)	 (((w) & (f)) == (f))
+
+	/** Round \b n up to an even number. */
+#define EVEN(n)		(((n) + 1U) & -2) /* sign-extending -2 to match n+1U */
+
+	/** Least significant 1-bit of \b n.  n must be of an unsigned type. */
+#define LOW_BIT(n)		((n) & (-(n)))
+
+	/** (log2(\b p2) % \b n), for p2 = power of 2 and 0 < n < 8. */
+#define LOG2_MOD(p2, n)	(7 - 86 / ((p2) % ((1U<<(n))-1) + 11))
+	/* Explanation: Let p2 = 2**(n*y + x), x<n and M = (1U<<n)-1. Now p2 =
+	 * (M+1)**y * 2**x = 2**x (mod M). Finally "/" "happens" to return 7-x.
+	 */
+
+	/** Should be alignment of \b type. Ensure it is a power of 2. */
+#define ALIGNOF2(type) \
+	LOW_BIT(offsetof(struct { char ch_; type align_; }, align_))
+
+	/**	Used for offsets within a single page.
+	 *	Since memory pages are typically 4 or 8KB in size, 12-13 bits,
+	 *	this is plenty.
+	 */
+typedef uint16_t	 indx_t;
+
+typedef unsigned long long	mdb_hash_t;
+
+	/**	Default size of memory map.
+	 *	This is certainly too small for any actual applications. Apps should always set
+	 *	the size explicitly using #mdb_env_set_mapsize().
+	 */
+#define DEFAULT_MAPSIZE	1048576
+
+/**	@defgroup readers	Reader Lock Table
+ *	Readers don't acquire any locks for their data access. Instead, they
+ *	simply record their transaction ID in the reader table. The reader
+ *	mutex is needed just to find an empty slot in the reader table. The
+ *	slot's address is saved in thread-specific data so that subsequent read
+ *	transactions started by the same thread need no further locking to proceed.
+ *
+ *	If #MDB_NOTLS is set, the slot address is not saved in thread-specific data.
+ *
+ *	No reader table is used if the database is on a read-only filesystem, or
+ *	if #MDB_NOLOCK is set.
+ *
+ *	Since the database uses multi-version concurrency control, readers don't
+ *	actually need any locking. This table is used to keep track of which
+ *	readers are using data from which old transactions, so that we'll know
+ *	when a particular old transaction is no longer in use. Old transactions
+ *	that have discarded any data pages can then have those pages reclaimed
+ *	for use by a later write transaction.
+ *
+ *	The lock table is constructed such that reader slots are aligned with the
+ *	processor's cache line size. Any slot is only ever used by one thread.
+ *	This alignment guarantees that there will be no contention or cache
+ *	thrashing as threads update their own slot info, and also eliminates
+ *	any need for locking when accessing a slot.
+ *
+ *	A writer thread will scan every slot in the table to determine the oldest
+ *	outstanding reader transaction. Any freed pages older than this will be
+ *	reclaimed by the writer. The writer doesn't use any locks when scanning
+ *	this table. This means that there's no guarantee that the writer will
+ *	see the most up-to-date reader info, but that's not required for correct
+ *	operation - all we need is to know the upper bound on the oldest reader,
+ *	we don't care at all about the newest reader. So the only consequence of
+ *	reading stale information here is that old pages might hang around a
+ *	while longer before being reclaimed. That's actually good anyway, because
+ *	the longer we delay reclaiming old pages, the more likely it is that a
+ *	string of contiguous pages can be found after coalescing old pages from
+ *	many old transactions together.
+ *	@{
+ */
+	/**	Number of slots in the reader table.
+	 *	This value was chosen somewhat arbitrarily. 126 readers plus a
+	 *	couple mutexes fit exactly into 8KB on my development machine.
+	 *	Applications should set the table size using #mdb_env_set_maxreaders().
+	 */
+#define DEFAULT_READERS	126
+
+	/**	The size of a CPU cache line in bytes. We want our lock structures
+	 *	aligned to this size to avoid false cache line sharing in the
+	 *	lock table.
+	 *	This value works for most CPUs. For Itanium this should be 128.
+	 */
+#ifndef CACHELINE
+#define CACHELINE	64
+#endif
+
+	/**	The information we store in a single slot of the reader table.
+	 *	In addition to a transaction ID, we also record the process and
+	 *	thread ID that owns a slot, so that we can detect stale information,
+	 *	e.g. threads or processes that went away without cleaning up.
+	 *	@note We currently don't check for stale records. We simply re-init
+	 *	the table when we know that we're the only process opening the
+	 *	lock file.
+	 */
+typedef struct MDB_rxbody {
+	/**	Current Transaction ID when this transaction began, or (txnid_t)-1.
+	 *	Multiple readers that start at the same time will probably have the
+	 *	same ID here. Again, it's not important to exclude them from
+	 *	anything; all we need to know is which version of the DB they
+	 *	started from so we can avoid overwriting any data used in that
+	 *	particular version.
+	 */
+	volatile txnid_t		mrb_txnid;
+	/** The process ID of the process owning this reader txn. */
+	volatile MDB_PID_T	mrb_pid;
+	/** The thread ID of the thread owning this txn. */
+	volatile MDB_THR_T	mrb_tid;
+} MDB_rxbody;
+
+	/** The actual reader record, with cacheline padding. */
+typedef struct MDB_reader {
+	union {
+		MDB_rxbody mrx;
+		/** shorthand for mrb_txnid */
+#define	mr_txnid	mru.mrx.mrb_txnid
+#define	mr_pid	mru.mrx.mrb_pid
+#define	mr_tid	mru.mrx.mrb_tid
+		/** cache line alignment */
+		char pad[(sizeof(MDB_rxbody)+CACHELINE-1) & ~(CACHELINE-1)];
+	} mru;
+} MDB_reader;
+
+	/** The header for the reader table.
+	 *	The table resides in a memory-mapped file. (This is a different file
+	 *	than is used for the main database.)
+	 *
+	 *	For POSIX the actual mutexes reside in the shared memory of this
+	 *	mapped file. On Windows, mutexes are named objects allocated by the
+	 *	kernel; we store the mutex names in this mapped file so that other
+	 *	processes can grab them. This same approach is also used on
+	 *	MacOSX/Darwin (using named semaphores) since MacOSX doesn't support
+	 *	process-shared POSIX mutexes. For these cases where a named object
+	 *	is used, the object name is derived from a 64 bit FNV hash of the
+	 *	environment pathname. As such, naming collisions are extremely
+	 *	unlikely. If a collision occurs, the results are unpredictable.
+	 */
+typedef struct MDB_txbody {
+		/** Stamp identifying this as an LMDB file. It must be set
+		 *	to #MDB_MAGIC. */
+	uint32_t	mtb_magic;
+		/** Format of this lock file. Must be set to #MDB_LOCK_FORMAT. */
+	uint32_t	mtb_format;
+		/**	The ID of the last transaction committed to the database.
+		 *	This is recorded here only for convenience; the value can always
+		 *	be determined by reading the main database meta pages.
+		 */
+	volatile txnid_t		mtb_txnid;
+		/** The number of slots that have been used in the reader table.
+		 *	This always records the maximum count, it is not decremented
+		 *	when readers release their slots.
+		 */
+	volatile unsigned	mtb_numreaders;
+#if defined(_WIN32) || defined(MDB_USE_POSIX_SEM)
+		/** Binary form of names of the reader/writer locks */
+	mdb_hash_t			mtb_mutexid;
+#elif defined(MDB_USE_SYSV_SEM)
+	int 	mtb_semid;
+	int		mtb_rlocked;
+#else
+		/** Mutex protecting access to this table.
+		 *	This is the reader table lock used with LOCK_MUTEX().
+		 */
+	mdb_mutex_t	mtb_rmutex;
+#endif
+} MDB_txbody;
+
+	/** The actual reader table definition. */
+typedef struct MDB_txninfo {
+	union {
+		MDB_txbody mtb;
+#define mti_magic	mt1.mtb.mtb_magic
+#define mti_format	mt1.mtb.mtb_format
+#define mti_rmutex	mt1.mtb.mtb_rmutex
+#define mti_txnid	mt1.mtb.mtb_txnid
+#define mti_numreaders	mt1.mtb.mtb_numreaders
+#define mti_mutexid	mt1.mtb.mtb_mutexid
+#ifdef MDB_USE_SYSV_SEM
+#define	mti_semid	mt1.mtb.mtb_semid
+#define	mti_rlocked	mt1.mtb.mtb_rlocked
+#endif
+		char pad[(sizeof(MDB_txbody)+CACHELINE-1) & ~(CACHELINE-1)];
+	} mt1;
+#if !(defined(_WIN32) || defined(MDB_USE_POSIX_SEM))
+	union {
+#ifdef MDB_USE_SYSV_SEM
+		int mt2_wlocked;
+#define mti_wlocked	mt2.mt2_wlocked
+#else
+		mdb_mutex_t	mt2_wmutex;
+#define mti_wmutex	mt2.mt2_wmutex
+#endif
+		char pad[(MNAME_LEN+CACHELINE-1) & ~(CACHELINE-1)];
+	} mt2;
+#endif
+	MDB_reader	mti_readers[1];
+} MDB_txninfo;
+
+	/** Lockfile format signature: version, features and field layout */
+#define MDB_LOCK_FORMAT \
+	((uint32_t)         \
+	 (((MDB_LOCK_VERSION) % (1U << MDB_LOCK_VERSION_BITS)) \
+	  + MDB_lock_desc     * (1U << MDB_LOCK_VERSION_BITS)))
+
+	/** Lock type and layout. Values 0-119. _WIN32 implies #MDB_PIDLOCK.
+	 *	Some low values are reserved for future tweaks.
+	 */
+#ifdef _WIN32
+# define MDB_LOCK_TYPE	(0 + ALIGNOF2(mdb_hash_t)/8 % 2)
+#elif defined MDB_USE_POSIX_SEM
+# define MDB_LOCK_TYPE	(4 + ALIGNOF2(mdb_hash_t)/8 % 2)
+#elif defined MDB_USE_SYSV_SEM
+# define MDB_LOCK_TYPE	(8)
+#elif defined MDB_USE_POSIX_MUTEX
+/* We do not know the inside of a POSIX mutex and how to check if mutexes
+ * used by two executables are compatible. Just check alignment and size.
+ */
+# define MDB_LOCK_TYPE	(10 + \
+		LOG2_MOD(ALIGNOF2(pthread_mutex_t), 5) + \
+		sizeof(pthread_mutex_t) / 4U % 22 * 5)
+#endif
+
+enum {
+	/** Magic number for lockfile layout and features.
+	 *
+	 *  This *attempts* to stop liblmdb variants compiled with conflicting
+	 *	options from using the lockfile at the same time and thus breaking
+	 *	it.  It describes locking types, and sizes and sometimes alignment
+	 *	of the various lockfile items.
+	 *
+	 *	The detected ranges are mostly guesswork, or based simply on how
+	 *	big they could be without using more bits.  So we can tweak them
+	 *	in good conscience when updating #MDB_LOCK_VERSION.
+	 */
+	MDB_lock_desc =
+	/* Default CACHELINE=64 vs. other values (have seen mention of 32-256) */
+	(CACHELINE==64 ? 0 : 1 + LOG2_MOD(CACHELINE >> (CACHELINE>64), 5))
+	+ 6  * (sizeof(MDB_PID_T)/4 % 3)    /* legacy(2) to word(4/8)? */
+	+ 18 * (sizeof(pthread_t)/4 % 5)    /* can be struct{id, active data} */
+	+ 90 * (sizeof(MDB_txbody) / CACHELINE % 3)
+	+ 270 * (MDB_LOCK_TYPE % 120)
+	/* The above is < 270*120 < 2**15 */
+	+ ((sizeof(txnid_t) == 8) << 15)    /* 32bit/64bit */
+	+ ((sizeof(MDB_reader) > CACHELINE) << 16)
+	/* Not really needed - implied by MDB_LOCK_TYPE != (_WIN32 locking) */
+	+ (((MDB_PIDLOCK) != 0)   << 17)
+	/* 18 bits total: Must be <= (32 - MDB_LOCK_VERSION_BITS). */
+};
+/** @} */
+
+/** Common header for all page types. The page type depends on #mp_flags.
+ *
+ * #P_BRANCH and #P_LEAF pages have unsorted '#MDB_node's at the end, with
+ * sorted #mp_ptrs[] entries referring to them. Exception: #P_LEAF2 pages
+ * omit mp_ptrs and pack sorted #MDB_DUPFIXED values after the page header.
+ *
+ * #P_OVERFLOW records occupy one or more contiguous pages where only the
+ * first has a page header. They hold the real data of #F_BIGDATA nodes.
+ *
+ * #P_SUBP sub-pages are small leaf "pages" with duplicate data.
+ * A node with flag #F_DUPDATA but not #F_SUBDATA contains a sub-page.
+ * (Duplicate data can also go in sub-databases, which use normal pages.)
+ *
+ * #P_META pages contain #MDB_meta, the start point of an LMDB snapshot.
+ *
+ * Each non-metapage up to #MDB_meta.%mm_last_pg is reachable exactly once
+ * in the snapshot: Either used by a database or listed in a freeDB record.
+ */
+typedef struct MDB_page {
+#define	mp_pgno	mp_p.p_pgno
+#define	mp_next	mp_p.p_next
+	union {
+		pgno_t		p_pgno;	/**< page number */
+		struct MDB_page *p_next; /**< for in-memory list of freed pages */
+	} mp_p;
+	uint16_t	mp_pad;			/**< key size if this is a LEAF2 page */
+/**	@defgroup mdb_page	Page Flags
+ *	@ingroup internal
+ *	Flags for the page headers.
+ *	@{
+ */
+#define	P_BRANCH	 0x01		/**< branch page */
+#define	P_LEAF		 0x02		/**< leaf page */
+#define	P_OVERFLOW	 0x04		/**< overflow page */
+#define	P_META		 0x08		/**< meta page */
+#define	P_DIRTY		 0x10		/**< dirty page, also set for #P_SUBP pages */
+#define	P_LEAF2		 0x20		/**< for #MDB_DUPFIXED records */
+#define	P_SUBP		 0x40		/**< for #MDB_DUPSORT sub-pages */
+#define	P_LOOSE		 0x4000		/**< page was dirtied then freed, can be reused */
+#define	P_KEEP		 0x8000		/**< leave this page alone during spill */
+/** @} */
+	uint16_t	mp_flags;		/**< @ref mdb_page */
+#define mp_lower	mp_pb.pb.pb_lower
+#define mp_upper	mp_pb.pb.pb_upper
+#define mp_pages	mp_pb.pb_pages
+	union {
+		struct {
+			indx_t		pb_lower;		/**< lower bound of free space */
+			indx_t		pb_upper;		/**< upper bound of free space */
+		} pb;
+		uint32_t	pb_pages;	/**< number of overflow pages */
+	} mp_pb;
+	indx_t		mp_ptrs[1];		/**< dynamic size */
+} MDB_page;
+
+	/** Size of the page header, excluding dynamic data at the end */
+#define PAGEHDRSZ	 ((unsigned) offsetof(MDB_page, mp_ptrs))
+
+	/** Address of first usable data byte in a page, after the header */
+#define METADATA(p)	 ((void *)((char *)(p) + PAGEHDRSZ))
+
+	/** ITS#7713, change PAGEBASE to handle 65536 byte pages */
+#define	PAGEBASE	((MDB_DEVEL) ? PAGEHDRSZ : 0)
+
+	/** Number of nodes on a page */
+#define NUMKEYS(p)	 (((p)->mp_lower - (PAGEHDRSZ-PAGEBASE)) >> 1)
+
+	/** The amount of space remaining in the page */
+#define SIZELEFT(p)	 (indx_t)((p)->mp_upper - (p)->mp_lower)
+
+	/** The percentage of space used in the page, in tenths of a percent. */
+#define PAGEFILL(env, p) (1000L * ((env)->me_psize - PAGEHDRSZ - SIZELEFT(p)) / \
+				((env)->me_psize - PAGEHDRSZ))
+	/** The minimum page fill factor, in tenths of a percent.
+	 *	Pages emptier than this are candidates for merging.
+	 */
+#define FILL_THRESHOLD	 250
+
+	/** Test if a page is a leaf page */
+#define IS_LEAF(p)	 F_ISSET((p)->mp_flags, P_LEAF)
+	/** Test if a page is a LEAF2 page */
+#define IS_LEAF2(p)	 F_ISSET((p)->mp_flags, P_LEAF2)
+	/** Test if a page is a branch page */
+#define IS_BRANCH(p)	 F_ISSET((p)->mp_flags, P_BRANCH)
+	/** Test if a page is an overflow page */
+#define IS_OVERFLOW(p)	 F_ISSET((p)->mp_flags, P_OVERFLOW)
+	/** Test if a page is a sub page */
+#define IS_SUBP(p)	 F_ISSET((p)->mp_flags, P_SUBP)
+
+	/** The number of overflow pages needed to store the given size. */
+#define OVPAGES(size, psize)	((PAGEHDRSZ-1 + (size)) / (psize) + 1)
+
+	/** Link in #MDB_txn.%mt_loose_pgs list.
+	 *  Kept outside the page header, which is needed when reusing the page.
+	 */
+#define NEXT_LOOSE_PAGE(p)		(*(MDB_page **)((p) + 2))
+
+	/** Header for a single key/data pair within a page.
+	 * Used in pages of type #P_BRANCH and #P_LEAF without #P_LEAF2.
+	 * We guarantee 2-byte alignment for 'MDB_node's.
+	 *
+	 * #mn_lo and #mn_hi are used for data size on leaf nodes, and for child
+	 * pgno on branch nodes.  On 64 bit platforms, #mn_flags is also used
+	 * for pgno.  (Branch nodes have no flags).  Lo and hi are in host byte
+	 * order in case some accesses can be optimized to 32-bit word access.
+	 *
+	 * Leaf node flags describe node contents.  #F_BIGDATA says the node's
+	 * data part is the page number of an overflow page with actual data.
+	 * #F_DUPDATA and #F_SUBDATA can be combined giving duplicate data in
+	 * a sub-page/sub-database, and named databases (just #F_SUBDATA).
+	 */
+typedef struct MDB_node {
+	/** part of data size or pgno
+	 *	@{ */
+#if BYTE_ORDER == LITTLE_ENDIAN
+	unsigned short	mn_lo, mn_hi;
+#else
+	unsigned short	mn_hi, mn_lo;
+#endif
+	/** @} */
+/** @defgroup mdb_node Node Flags
+ *	@ingroup internal
+ *	Flags for node headers.
+ *	@{
+ */
+#define F_BIGDATA	 0x01			/**< data put on overflow page */
+#define F_SUBDATA	 0x02			/**< data is a sub-database */
+#define F_DUPDATA	 0x04			/**< data has duplicates */
+
+/** valid flags for #mdb_node_add() */
+#define	NODE_ADD_FLAGS	(F_DUPDATA|F_SUBDATA|MDB_RESERVE|MDB_APPEND)
+
+/** @} */
+	unsigned short	mn_flags;		/**< @ref mdb_node */
+	unsigned short	mn_ksize;		/**< key size */
+	char		mn_data[1];			/**< key and data are appended here */
+} MDB_node;
+
+	/** Size of the node header, excluding dynamic data at the end */
+#define NODESIZE	 offsetof(MDB_node, mn_data)
+
+	/** Bit position of top word in page number, for shifting mn_flags */
+#define PGNO_TOPWORD ((pgno_t)-1 > 0xffffffffu ? 32 : 0)
+
+	/** Size of a node in a branch page with a given key.
+	 *	This is just the node header plus the key, there is no data.
+	 */
+#define INDXSIZE(k)	 (NODESIZE + ((k) == NULL ? 0 : (k)->mv_size))
+
+	/** Size of a node in a leaf page with a given key and data.
+	 *	This is node header plus key plus data size.
+	 */
+#define LEAFSIZE(k, d)	 (NODESIZE + (k)->mv_size + (d)->mv_size)
+
+	/** Address of node \b i in page \b p */
+#define NODEPTR(p, i)	 ((MDB_node *)((char *)(p) + (p)->mp_ptrs[i] + PAGEBASE))
+
+	/** Address of the key for the node */
+#define NODEKEY(node)	 (void *)((node)->mn_data)
+
+	/** Address of the data for a node */
+#define NODEDATA(node)	 (void *)((char *)(node)->mn_data + (node)->mn_ksize)
+
+	/** Get the page number pointed to by a branch node */
+#define NODEPGNO(node) \
+	((node)->mn_lo | ((pgno_t) (node)->mn_hi << 16) | \
+	 (PGNO_TOPWORD ? ((pgno_t) (node)->mn_flags << PGNO_TOPWORD) : 0))
+	/** Set the page number in a branch node */
+#define SETPGNO(node,pgno)	do { \
+	(node)->mn_lo = (pgno) & 0xffff; (node)->mn_hi = (pgno) >> 16; \
+	if (PGNO_TOPWORD) (node)->mn_flags = (pgno) >> PGNO_TOPWORD; } while(0)
+
+	/** Get the size of the data in a leaf node */
+#define NODEDSZ(node)	 ((node)->mn_lo | ((unsigned)(node)->mn_hi << 16))
+	/** Set the size of the data for a leaf node */
+#define SETDSZ(node,size)	do { \
+	(node)->mn_lo = (size) & 0xffff; (node)->mn_hi = (size) >> 16;} while(0)
+	/** The size of a key in a node */
+#define NODEKSZ(node)	 ((node)->mn_ksize)
+
+	/** Copy a page number from src to dst */
+#ifdef MISALIGNED_OK
+#define COPY_PGNO(dst,src)	dst = src
+#else
+#if MDB_SIZE_MAX > 0xffffffffU
+#define COPY_PGNO(dst,src)	do { \
+	unsigned short *s, *d;	\
+	s = (unsigned short *)&(src);	\
+	d = (unsigned short *)&(dst);	\
+	*d++ = *s++;	\
+	*d++ = *s++;	\
+	*d++ = *s++;	\
+	*d = *s;	\
+} while (0)
+#else
+#define COPY_PGNO(dst,src)	do { \
+	unsigned short *s, *d;	\
+	s = (unsigned short *)&(src);	\
+	d = (unsigned short *)&(dst);	\
+	*d++ = *s++;	\
+	*d = *s;	\
+} while (0)
+#endif
+#endif
+	/** The address of a key in a LEAF2 page.
+	 *	LEAF2 pages are used for #MDB_DUPFIXED sorted-duplicate sub-DBs.
+	 *	There are no node headers, keys are stored contiguously.
+	 */
+#define LEAF2KEY(p, i, ks)	((char *)(p) + PAGEHDRSZ + ((i)*(ks)))
+
+	/** Set the \b node's key into \b keyptr, if requested. */
+#define MDB_GET_KEY(node, keyptr)	{ if ((keyptr) != NULL) { \
+	(keyptr)->mv_size = NODEKSZ(node); (keyptr)->mv_data = NODEKEY(node); } }
+
+	/** Set the \b node's key into \b key. */
+#define MDB_GET_KEY2(node, key)	{ key.mv_size = NODEKSZ(node); key.mv_data = NODEKEY(node); }
+
+	/** Information about a single database in the environment. */
+typedef struct MDB_db {
+	uint32_t	md_pad;		/**< also ksize for LEAF2 pages */
+	uint16_t	md_flags;	/**< @ref mdb_dbi_open */
+	uint16_t	md_depth;	/**< depth of this tree */
+	pgno_t		md_branch_pages;	/**< number of internal pages */
+	pgno_t		md_leaf_pages;		/**< number of leaf pages */
+	pgno_t		md_overflow_pages;	/**< number of overflow pages */
+	mdb_size_t	md_entries;		/**< number of data items */
+	pgno_t		md_root;		/**< the root page of this tree */
+} MDB_db;
+
+#define MDB_VALID	0x8000		/**< DB handle is valid, for me_dbflags */
+#define PERSISTENT_FLAGS	(0xffff & ~(MDB_VALID))
+	/** #mdb_dbi_open() flags */
+#define VALID_FLAGS	(MDB_REVERSEKEY|MDB_DUPSORT|MDB_INTEGERKEY|MDB_DUPFIXED|\
+	MDB_INTEGERDUP|MDB_REVERSEDUP|MDB_CREATE)
+
+	/** Handle for the DB used to track free pages. */
+#define	FREE_DBI	0
+	/** Handle for the default DB. */
+#define	MAIN_DBI	1
+	/** Number of DBs in metapage (free and main) - also hardcoded elsewhere */
+#define CORE_DBS	2
+
+	/** Number of meta pages - also hardcoded elsewhere */
+#define NUM_METAS	2
+
+	/** Meta page content.
+	 *	A meta page is the start point for accessing a database snapshot.
+	 *	Pages 0-1 are meta pages. Transaction N writes meta page #(N % 2).
+	 */
+typedef struct MDB_meta {
+		/** Stamp identifying this as an LMDB file. It must be set
+		 *	to #MDB_MAGIC. */
+	uint32_t	mm_magic;
+		/** Version number of this file. Must be set to #MDB_DATA_VERSION. */
+	uint32_t	mm_version;
+#ifdef MDB_VL32
+	union {		/* always zero since we don't support fixed mapping in MDB_VL32 */
+		MDB_ID	mmun_ull;
+		void *mmun_address;
+	} mm_un;
+#define	mm_address mm_un.mmun_address
+#else
+	void		*mm_address;		/**< address for fixed mapping */
+#endif
+	mdb_size_t	mm_mapsize;			/**< size of mmap region */
+	MDB_db		mm_dbs[CORE_DBS];	/**< first is free space, 2nd is main db */
+	/** The size of pages used in this DB */
+#define	mm_psize	mm_dbs[FREE_DBI].md_pad
+	/** Any persistent environment flags. @ref mdb_env */
+#define	mm_flags	mm_dbs[FREE_DBI].md_flags
+	/** Last used page in the datafile.
+	 *	Actually the file may be shorter if the freeDB lists the final pages.
+	 */
+	pgno_t		mm_last_pg;
+	volatile txnid_t	mm_txnid;	/**< txnid that committed this page */
+} MDB_meta;
+
+	/** Buffer for a stack-allocated meta page.
+	 *	The members define size and alignment, and silence type
+	 *	aliasing warnings.  They are not used directly; that could
+	 *	mean incorrectly using several union members in parallel.
+	 */
+typedef union MDB_metabuf {
+	MDB_page	mb_page;
+	struct {
+		char		mm_pad[PAGEHDRSZ];
+		MDB_meta	mm_meta;
+	} mb_metabuf;
+} MDB_metabuf;
+
+	/** Auxiliary DB info.
+	 *	The information here is mostly static/read-only. There is
+	 *	only a single copy of this record in the environment.
+	 */
+typedef struct MDB_dbx {
+	MDB_val		md_name;		/**< name of the database */
+	MDB_cmp_func	*md_cmp;	/**< function for comparing keys */
+	MDB_cmp_func	*md_dcmp;	/**< function for comparing data items */
+	MDB_rel_func	*md_rel;	/**< user relocate function */
+	void		*md_relctx;		/**< user-provided context for md_rel */
+} MDB_dbx;
+
+	/** A database transaction.
+	 *	Every operation requires a transaction handle.
+	 */
+struct MDB_txn {
+	MDB_txn		*mt_parent;		/**< parent of a nested txn */
+	/** Nested txn under this txn, set together with flag #MDB_TXN_HAS_CHILD */
+	MDB_txn		*mt_child;
+	pgno_t		mt_next_pgno;	/**< next unallocated page */
+#ifdef MDB_VL32
+	pgno_t		mt_last_pgno;	/**< last written page */
+#endif
+	/** The ID of this transaction. IDs are integers incrementing from 1.
+	 *	Only committed write transactions increment the ID. If a transaction
+	 *	aborts, the ID may be re-used by the next writer.
+	 */
+	txnid_t		mt_txnid;
+	MDB_env		*mt_env;		/**< the DB environment */
+	/** The list of pages that became unused during this transaction.
+	 */
+	MDB_IDL		mt_free_pgs;
+	/** The list of loose pages that became unused and may be reused
+	 *	in this transaction, linked through #NEXT_LOOSE_PAGE(page).
+	 */
+	MDB_page	*mt_loose_pgs;
+	/** Number of loose pages (#mt_loose_pgs) */
+	int			mt_loose_count;
+	/** The sorted list of dirty pages we temporarily wrote to disk
+	 *	because the dirty list was full. page numbers in here are
+	 *	shifted left by 1, deleted slots have the LSB set.
+	 */
+	MDB_IDL		mt_spill_pgs;
+	union {
+		/** For write txns: Modified pages. Sorted when not MDB_WRITEMAP. */
+		MDB_ID2L	dirty_list;
+		/** For read txns: This thread/txn's reader table slot, or NULL. */
+		MDB_reader	*reader;
+	} mt_u;
+	/** Array of records for each DB known in the environment. */
+	MDB_dbx		*mt_dbxs;
+	/** Array of MDB_db records for each known DB */
+	MDB_db		*mt_dbs;
+	/** Array of sequence numbers for each DB handle */
+	unsigned int	*mt_dbiseqs;
+/** @defgroup mt_dbflag	Transaction DB Flags
+ *	@ingroup internal
+ * @{
+ */
+#define DB_DIRTY	0x01		/**< DB was written in this txn */
+#define DB_STALE	0x02		/**< Named-DB record is older than txnID */
+#define DB_NEW		0x04		/**< Named-DB handle opened in this txn */
+#define DB_VALID	0x08		/**< DB handle is valid, see also #MDB_VALID */
+#define DB_USRVALID	0x10		/**< As #DB_VALID, but not set for #FREE_DBI */
+#define DB_DUPDATA	0x20		/**< DB is #MDB_DUPSORT data */
+/** @} */
+	/** In write txns, array of cursors for each DB */
+	MDB_cursor	**mt_cursors;
+	/** Array of flags for each DB */
+	unsigned char	*mt_dbflags;
+#ifdef MDB_VL32
+	/** List of read-only pages (actually chunks) */
+	MDB_ID3L	mt_rpages;
+	/** We map chunks of 16 pages. Even though Windows uses 4KB pages, all
+	 * mappings must begin on 64KB boundaries. So we round off all pgnos to
+	 * a chunk boundary. We do the same on Linux for symmetry, and also to
+	 * reduce the frequency of mmap/munmap calls.
+	 */
+#define MDB_RPAGE_CHUNK	16
+#define MDB_TRPAGE_SIZE	4096	/**< size of #mt_rpages array of chunks */
+#define MDB_TRPAGE_MAX	(MDB_TRPAGE_SIZE-1)	/**< maximum chunk index */
+	unsigned int mt_rpcheck;	/**< threshold for reclaiming unref'd chunks */
+#endif
+	/**	Number of DB records in use, or 0 when the txn is finished.
+	 *	This number only ever increments until the txn finishes; we
+	 *	don't decrement it when individual DB handles are closed.
+	 */
+	MDB_dbi		mt_numdbs;
+
+/** @defgroup mdb_txn	Transaction Flags
+ *	@ingroup internal
+ *	@{
+ */
+	/** #mdb_txn_begin() flags */
+#define MDB_TXN_BEGIN_FLAGS	(MDB_NOMETASYNC|MDB_NOSYNC|MDB_RDONLY)
+#define MDB_TXN_NOMETASYNC	MDB_NOMETASYNC	/**< don't sync meta for this txn on commit */
+#define MDB_TXN_NOSYNC		MDB_NOSYNC	/**< don't sync this txn on commit */
+#define MDB_TXN_RDONLY		MDB_RDONLY	/**< read-only transaction */
+	/* internal txn flags */
+#define MDB_TXN_WRITEMAP	MDB_WRITEMAP	/**< copy of #MDB_env flag in writers */
+#define MDB_TXN_FINISHED	0x01		/**< txn is finished or never began */
+#define MDB_TXN_ERROR		0x02		/**< txn is unusable after an error */
+#define MDB_TXN_DIRTY		0x04		/**< must write, even if dirty list is empty */
+#define MDB_TXN_SPILLS		0x08		/**< txn or a parent has spilled pages */
+#define MDB_TXN_HAS_CHILD	0x10		/**< txn has an #MDB_txn.%mt_child */
+	/** most operations on the txn are currently illegal */
+#define MDB_TXN_BLOCKED		(MDB_TXN_FINISHED|MDB_TXN_ERROR|MDB_TXN_HAS_CHILD)
+/** @} */
+	unsigned int	mt_flags;		/**< @ref mdb_txn */
+	/** #dirty_list room: Array size - \#dirty pages visible to this txn.
+	 *	Includes ancestor txns' dirty pages not hidden by other txns'
+	 *	dirty/spilled pages. Thus commit(nested txn) has room to merge
+	 *	dirty_list into mt_parent after freeing hidden mt_parent pages.
+	 */
+	unsigned int	mt_dirty_room;
+};
+
+/** Enough space for 2^32 nodes with minimum of 2 keys per node. I.e., plenty.
+ * At 4 keys per node, enough for 2^64 nodes, so there's probably no need to
+ * raise this on a 64 bit machine.
+ */
+#define CURSOR_STACK		 32
+
+struct MDB_xcursor;
+
+	/** Cursors are used for all DB operations.
+	 *	A cursor holds a path of (page pointer, key index) from the DB
+	 *	root to a position in the DB, plus other state. #MDB_DUPSORT
+	 *	cursors include an xcursor to the current data item. Write txns
+	 *	track their cursors and keep them up to date when data moves.
+	 *	Exception: An xcursor's pointer to a #P_SUBP page can be stale.
+	 *	(A node with #F_DUPDATA but no #F_SUBDATA contains a subpage).
+	 */
+struct MDB_cursor {
+	/** Next cursor on this DB in this txn */
+	MDB_cursor	*mc_next;
+	/** Backup of the original cursor if this cursor is a shadow */
+	MDB_cursor	*mc_backup;
+	/** Context used for databases with #MDB_DUPSORT, otherwise NULL */
+	struct MDB_xcursor	*mc_xcursor;
+	/** The transaction that owns this cursor */
+	MDB_txn		*mc_txn;
+	/** The database handle this cursor operates on */
+	MDB_dbi		mc_dbi;
+	/** The database record for this cursor */
+	MDB_db		*mc_db;
+	/** The database auxiliary record for this cursor */
+	MDB_dbx		*mc_dbx;
+	/** The @ref mt_dbflag for this database */
+	unsigned char	*mc_dbflag;
+	unsigned short 	mc_snum;	/**< number of pushed pages */
+	unsigned short	mc_top;		/**< index of top page, normally mc_snum-1 */
+/** @defgroup mdb_cursor	Cursor Flags
+ *	@ingroup internal
+ *	Cursor state flags.
+ *	@{
+ */
+#define C_INITIALIZED	0x01	/**< cursor has been initialized and is valid */
+#define C_EOF	0x02			/**< No more data */
+#define C_SUB	0x04			/**< Cursor is a sub-cursor */
+#define C_DEL	0x08			/**< last op was a cursor_del */
+#define C_UNTRACK	0x40		/**< Un-track cursor when closing */
+#define C_WRITEMAP	MDB_TXN_WRITEMAP /**< Copy of txn flag */
+/** Read-only cursor into the txn's original snapshot in the map.
+ *	Set for read-only txns, and in #mdb_page_alloc() for #FREE_DBI when
+ *	#MDB_DEVEL & 2. Only implements code which is necessary for this.
+ */
+#define C_ORIG_RDONLY	MDB_TXN_RDONLY
+/** @} */
+	unsigned int	mc_flags;	/**< @ref mdb_cursor */
+	MDB_page	*mc_pg[CURSOR_STACK];	/**< stack of pushed pages */
+	indx_t		mc_ki[CURSOR_STACK];	/**< stack of page indices */
+#ifdef MDB_VL32
+	MDB_page	*mc_ovpg;		/**< a referenced overflow page */
+#	define MC_OVPG(mc)			((mc)->mc_ovpg)
+#	define MC_SET_OVPG(mc, pg)	((mc)->mc_ovpg = (pg))
+#else
+#	define MC_OVPG(mc)			((MDB_page *)0)
+#	define MC_SET_OVPG(mc, pg)	((void)0)
+#endif
+};
+
+	/** Context for sorted-dup records.
+	 *	We could have gone to a fully recursive design, with arbitrarily
+	 *	deep nesting of sub-databases. But for now we only handle these
+	 *	levels - main DB, optional sub-DB, sorted-duplicate DB.
+	 */
+typedef struct MDB_xcursor {
+	/** A sub-cursor for traversing the Dup DB */
+	MDB_cursor mx_cursor;
+	/** The database record for this Dup DB */
+	MDB_db	mx_db;
+	/**	The auxiliary DB record for this Dup DB */
+	MDB_dbx	mx_dbx;
+	/** The @ref mt_dbflag for this Dup DB */
+	unsigned char mx_dbflag;
+} MDB_xcursor;
+
+	/** Check if there is an inited xcursor */
+#define XCURSOR_INITED(mc) \
+	((mc)->mc_xcursor && ((mc)->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED))
+
+	/** Update the xcursor's sub-page pointer, if any, in \b mc.  Needed
+	 *	when the node which contains the sub-page may have moved.  Called
+	 *	with leaf page \b mp = mc->mc_pg[\b top].
+	 */
+#define XCURSOR_REFRESH(mc, top, mp) do { \
+	MDB_page *xr_pg = (mp); \
+	MDB_node *xr_node; \
+	if (!XCURSOR_INITED(mc) || (mc)->mc_ki[top] >= NUMKEYS(xr_pg)) break; \
+	xr_node = NODEPTR(xr_pg, (mc)->mc_ki[top]); \
+	if ((xr_node->mn_flags & (F_DUPDATA|F_SUBDATA)) == F_DUPDATA) \
+		(mc)->mc_xcursor->mx_cursor.mc_pg[0] = NODEDATA(xr_node); \
+} while (0)
+
+	/** State of FreeDB old pages, stored in the MDB_env */
+typedef struct MDB_pgstate {
+	pgno_t		*mf_pghead;	/**< Reclaimed freeDB pages, or NULL before use */
+	txnid_t		mf_pglast;	/**< ID of last used record, or 0 if !mf_pghead */
+} MDB_pgstate;
+
+	/** The database environment. */
+struct MDB_env {
+	HANDLE		me_fd;		/**< The main data file */
+	HANDLE		me_lfd;		/**< The lock file */
+	HANDLE		me_mfd;		/**< For writing and syncing the meta pages */
+#if defined(MDB_VL32) && defined(_WIN32)
+	HANDLE		me_fmh;		/**< File Mapping handle */
+#endif
+	/** Failed to update the meta page. Probably an I/O error. */
+#define	MDB_FATAL_ERROR	0x80000000U
+	/** Some fields are initialized. */
+#define	MDB_ENV_ACTIVE	0x20000000U
+	/** me_txkey is set */
+#define	MDB_ENV_TXKEY	0x10000000U
+	/** fdatasync is unreliable */
+#define	MDB_FSYNCONLY	0x08000000U
+	uint32_t 	me_flags;		/**< @ref mdb_env */
+	unsigned int	me_psize;	/**< DB page size, inited from me_os_psize */
+	unsigned int	me_os_psize;	/**< OS page size, from #GET_PAGESIZE */
+	unsigned int	me_maxreaders;	/**< size of the reader table */
+	/** Max #MDB_txninfo.%mti_numreaders of interest to #mdb_env_close() */
+	volatile int	me_close_readers;
+	MDB_dbi		me_numdbs;		/**< number of DBs opened */
+	MDB_dbi		me_maxdbs;		/**< size of the DB table */
+	MDB_PID_T	me_pid;		/**< process ID of this env */
+	char		*me_path;		/**< path to the DB files */
+	char		*me_map;		/**< the memory map of the data file */
+	MDB_txninfo	*me_txns;		/**< the memory map of the lock file or NULL */
+	MDB_meta	*me_metas[NUM_METAS];	/**< pointers to the two meta pages */
+	void		*me_pbuf;		/**< scratch area for DUPSORT put() */
+	MDB_txn		*me_txn;		/**< current write transaction */
+	MDB_txn		*me_txn0;		/**< prealloc'd write transaction */
+	mdb_size_t	me_mapsize;		/**< size of the data memory map */
+	off_t		me_size;		/**< current file size */
+	pgno_t		me_maxpg;		/**< me_mapsize / me_psize */
+	MDB_dbx		*me_dbxs;		/**< array of static DB info */
+	uint16_t	*me_dbflags;	/**< array of flags from MDB_db.md_flags */
+	unsigned int	*me_dbiseqs;	/**< array of dbi sequence numbers */
+	pthread_key_t	me_txkey;	/**< thread-key for readers */
+	txnid_t		me_pgoldest;	/**< ID of oldest reader last time we looked */
+	MDB_pgstate	me_pgstate;		/**< state of old pages from freeDB */
+#	define		me_pglast	me_pgstate.mf_pglast
+#	define		me_pghead	me_pgstate.mf_pghead
+	MDB_page	*me_dpages;		/**< list of malloc'd blocks for re-use */
+	/** IDL of pages that became unused in a write txn */
+	MDB_IDL		me_free_pgs;
+	/** ID2L of pages written during a write txn. Length MDB_IDL_UM_SIZE. */
+	MDB_ID2L	me_dirty_list;
+	/** Max number of freelist items that can fit in a single overflow page */
+	int			me_maxfree_1pg;
+	/** Max size of a node on a page */
+	unsigned int	me_nodemax;
+#if !(MDB_MAXKEYSIZE)
+	unsigned int	me_maxkey;	/**< max size of a key */
+#endif
+	int		me_live_reader;		/**< have liveness lock in reader table */
+#ifdef _WIN32
+	int		me_pidquery;		/**< Used in OpenProcess */
+#endif
+#ifdef MDB_USE_POSIX_MUTEX	/* Posix mutexes reside in shared mem */
+#	define		me_rmutex	me_txns->mti_rmutex /**< Shared reader lock */
+#	define		me_wmutex	me_txns->mti_wmutex /**< Shared writer lock */
+#else
+	mdb_mutex_t	me_rmutex;
+	mdb_mutex_t	me_wmutex;
+# if defined(_WIN32) || defined(MDB_USE_POSIX_SEM)
+	/** Half-initialized name of mutexes, to be completed by #MUTEXNAME() */
+	char		me_mutexname[sizeof(MUTEXNAME_PREFIX) + 11];
+# endif
+#endif
+#ifdef MDB_VL32
+	MDB_ID3L	me_rpages;	/**< like #mt_rpages, but global to env */
+	pthread_mutex_t	me_rpmutex;	/**< control access to #me_rpages */
+#define MDB_ERPAGE_SIZE	16384
+#define MDB_ERPAGE_MAX	(MDB_ERPAGE_SIZE-1)
+	unsigned int me_rpcheck;
+#endif
+	void		*me_userctx;	 /**< User-settable context */
+	MDB_assert_func *me_assert_func; /**< Callback for assertion failures */
+};
+
+	/** Nested transaction */
+typedef struct MDB_ntxn {
+	MDB_txn		mnt_txn;		/**< the transaction */
+	MDB_pgstate	mnt_pgstate;	/**< parent transaction's saved freestate */
+} MDB_ntxn;
+
+	/** max number of pages to commit in one writev() call */
+#define MDB_COMMIT_PAGES	 64
+#if defined(IOV_MAX) && IOV_MAX < MDB_COMMIT_PAGES
+#undef MDB_COMMIT_PAGES
+#define MDB_COMMIT_PAGES	IOV_MAX
+#endif
+
+	/** max bytes to write in one call */
+#define MAX_WRITE		(0x40000000U >> (sizeof(ssize_t) == 4))
+
+	/** Check \b txn and \b dbi arguments to a function */
+#define TXN_DBI_EXIST(txn, dbi, validity) \
+	((txn) && (dbi)<(txn)->mt_numdbs && ((txn)->mt_dbflags[dbi] & (validity)))
+
+	/** Check for misused \b dbi handles */
+#define TXN_DBI_CHANGED(txn, dbi) \
+	((txn)->mt_dbiseqs[dbi] != (txn)->mt_env->me_dbiseqs[dbi])
+
+static int  mdb_page_alloc(MDB_cursor *mc, int num, MDB_page **mp);
+static int  mdb_page_new(MDB_cursor *mc, uint32_t flags, int num, MDB_page **mp);
+static int  mdb_page_touch(MDB_cursor *mc);
+
+#define MDB_END_NAMES {"committed", "empty-commit", "abort", "reset", \
+	"reset-tmp", "fail-begin", "fail-beginchild"}
+enum {
+	/* mdb_txn_end operation number, for logging */
+	MDB_END_COMMITTED, MDB_END_EMPTY_COMMIT, MDB_END_ABORT, MDB_END_RESET,
+	MDB_END_RESET_TMP, MDB_END_FAIL_BEGIN, MDB_END_FAIL_BEGINCHILD
+};
+#define MDB_END_OPMASK	0x0F	/**< mask for #mdb_txn_end() operation number */
+#define MDB_END_UPDATE	0x10	/**< update env state (DBIs) */
+#define MDB_END_FREE	0x20	/**< free txn unless it is #MDB_env.%me_txn0 */
+#define MDB_END_SLOT MDB_NOTLS	/**< release any reader slot if #MDB_NOTLS */
+static void mdb_txn_end(MDB_txn *txn, unsigned mode);
+
+static int  mdb_page_get(MDB_cursor *mc, pgno_t pgno, MDB_page **mp, int *lvl);
+static int  mdb_page_search_root(MDB_cursor *mc,
+			    MDB_val *key, int modify);
+#define MDB_PS_MODIFY	1
+#define MDB_PS_ROOTONLY	2
+#define MDB_PS_FIRST	4
+#define MDB_PS_LAST		8
+static int  mdb_page_search(MDB_cursor *mc,
+			    MDB_val *key, int flags);
+static int	mdb_page_merge(MDB_cursor *csrc, MDB_cursor *cdst);
+
+#define MDB_SPLIT_REPLACE	MDB_APPENDDUP	/**< newkey is not new */
+static int	mdb_page_split(MDB_cursor *mc, MDB_val *newkey, MDB_val *newdata,
+				pgno_t newpgno, unsigned int nflags);
+
+static int  mdb_env_read_header(MDB_env *env, int prev, MDB_meta *meta);
+static MDB_meta *mdb_env_pick_meta(const MDB_env *env);
+static int  mdb_env_write_meta(MDB_txn *txn);
+#ifdef MDB_USE_POSIX_MUTEX /* Drop unused excl arg */
+# define mdb_env_close0(env, excl) mdb_env_close1(env)
+#endif
+static void mdb_env_close0(MDB_env *env, int excl);
+
+static MDB_node *mdb_node_search(MDB_cursor *mc, MDB_val *key, int *exactp);
+static int  mdb_node_add(MDB_cursor *mc, indx_t indx,
+			    MDB_val *key, MDB_val *data, pgno_t pgno, unsigned int flags);
+static void mdb_node_del(MDB_cursor *mc, int ksize);
+static void mdb_node_shrink(MDB_page *mp, indx_t indx);
+static int	mdb_node_move(MDB_cursor *csrc, MDB_cursor *cdst, int fromleft);
+static int  mdb_node_read(MDB_cursor *mc, MDB_node *leaf, MDB_val *data);
+static size_t	mdb_leaf_size(MDB_env *env, MDB_val *key, MDB_val *data);
+static size_t	mdb_branch_size(MDB_env *env, MDB_val *key);
+
+static int	mdb_rebalance(MDB_cursor *mc);
+static int	mdb_update_key(MDB_cursor *mc, MDB_val *key);
+
+static void	mdb_cursor_pop(MDB_cursor *mc);
+static int	mdb_cursor_push(MDB_cursor *mc, MDB_page *mp);
+
+static int	mdb_cursor_del0(MDB_cursor *mc);
+static int	mdb_del0(MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data, unsigned flags);
+static int	mdb_cursor_sibling(MDB_cursor *mc, int move_right);
+static int	mdb_cursor_next(MDB_cursor *mc, MDB_val *key, MDB_val *data, MDB_cursor_op op);
+static int	mdb_cursor_prev(MDB_cursor *mc, MDB_val *key, MDB_val *data, MDB_cursor_op op);
+static int	mdb_cursor_set(MDB_cursor *mc, MDB_val *key, MDB_val *data, MDB_cursor_op op,
+				int *exactp);
+static int	mdb_cursor_first(MDB_cursor *mc, MDB_val *key, MDB_val *data);
+static int	mdb_cursor_last(MDB_cursor *mc, MDB_val *key, MDB_val *data);
+
+static void	mdb_cursor_init(MDB_cursor *mc, MDB_txn *txn, MDB_dbi dbi, MDB_xcursor *mx);
+static void	mdb_xcursor_init0(MDB_cursor *mc);
+static void	mdb_xcursor_init1(MDB_cursor *mc, MDB_node *node);
+static void	mdb_xcursor_init2(MDB_cursor *mc, MDB_xcursor *src_mx, int force);
+
+static int	mdb_drop0(MDB_cursor *mc, int subs);
+static void mdb_default_cmp(MDB_txn *txn, MDB_dbi dbi);
+static int mdb_reader_check0(MDB_env *env, int rlocked, int *dead);
+
+/** @cond */
+static MDB_cmp_func	mdb_cmp_memn, mdb_cmp_memnr, mdb_cmp_int, mdb_cmp_cint, mdb_cmp_long;
+/** @endcond */
+
+/** Compare two items pointing at '#mdb_size_t's of unknown alignment. */
+#ifdef MISALIGNED_OK
+# define mdb_cmp_clong mdb_cmp_long
+#else
+# define mdb_cmp_clong mdb_cmp_cint
+#endif
+
+/** True if we need #mdb_cmp_clong() instead of \b cmp for #MDB_INTEGERDUP */
+#define NEED_CMP_CLONG(cmp, ksize) \
+	(UINT_MAX < MDB_SIZE_MAX && \
+	 (cmp) == mdb_cmp_int && (ksize) == sizeof(mdb_size_t))
+
+#ifdef _WIN32
+static SECURITY_DESCRIPTOR mdb_null_sd;
+static SECURITY_ATTRIBUTES mdb_all_sa;
+static int mdb_sec_inited;
+
+struct MDB_name;
+static int utf8_to_utf16(const char *src, struct MDB_name *dst, int xtra);
+#endif
+
+/** Return the library version info. */
+char * ESECT
+mdb_version(int *major, int *minor, int *patch)
+{
+	if (major) *major = MDB_VERSION_MAJOR;
+	if (minor) *minor = MDB_VERSION_MINOR;
+	if (patch) *patch = MDB_VERSION_PATCH;
+	return MDB_VERSION_STRING;
+}
+
+/** Table of descriptions for LMDB @ref errors */
+static char *const mdb_errstr[] = {
+	"MDB_KEYEXIST: Key/data pair already exists",
+	"MDB_NOTFOUND: No matching key/data pair found",
+	"MDB_PAGE_NOTFOUND: Requested page not found",
+	"MDB_CORRUPTED: Located page was wrong type",
+	"MDB_PANIC: Update of meta page failed or environment had fatal error",
+	"MDB_VERSION_MISMATCH: Database environment version mismatch",
+	"MDB_INVALID: File is not an LMDB file",
+	"MDB_MAP_FULL: Environment mapsize limit reached",
+	"MDB_DBS_FULL: Environment maxdbs limit reached",
+	"MDB_READERS_FULL: Environment maxreaders limit reached",
+	"MDB_TLS_FULL: Thread-local storage keys full - too many environments open",
+	"MDB_TXN_FULL: Transaction has too many dirty pages - transaction too big",
+	"MDB_CURSOR_FULL: Internal error - cursor stack limit reached",
+	"MDB_PAGE_FULL: Internal error - page has no more space",
+	"MDB_MAP_RESIZED: Database contents grew beyond environment mapsize",
+	"MDB_INCOMPATIBLE: Operation and DB incompatible, or DB flags changed",
+	"MDB_BAD_RSLOT: Invalid reuse of reader locktable slot",
+	"MDB_BAD_TXN: Transaction must abort, has a child, or is invalid",
+	"MDB_BAD_VALSIZE: Unsupported size of key/DB name/data, or wrong DUPFIXED size",
+	"MDB_BAD_DBI: The specified DBI handle was closed/changed unexpectedly",
+	"MDB_PROBLEM: Unexpected problem - txn should abort",
+};
+
+char *
+mdb_strerror(int err)
+{
+#ifdef _WIN32
+	/** HACK: pad 4KB on stack over the buf. Return system msgs in buf.
+	 *	This works as long as no function between the call to mdb_strerror
+	 *	and the actual use of the message uses more than 4K of stack.
+	 */
+#define MSGSIZE	1024
+#define PADSIZE	4096
+	char buf[MSGSIZE+PADSIZE], *ptr = buf;
+#endif
+	int i;
+	if (!err)
+		return ("Successful return: 0");
+
+	if (err >= MDB_KEYEXIST && err <= MDB_LAST_ERRCODE) {
+		i = err - MDB_KEYEXIST;
+		return mdb_errstr[i];
+	}
+
+#ifdef _WIN32
+	/* These are the C-runtime error codes we use. The comment indicates
+	 * their numeric value, and the Win32 error they would correspond to
+	 * if the error actually came from a Win32 API. A major mess, we should
+	 * have used LMDB-specific error codes for everything.
+	 */
+	switch(err) {
+	case ENOENT:	/* 2, FILE_NOT_FOUND */
+	case EIO:		/* 5, ACCESS_DENIED */
+	case ENOMEM:	/* 12, INVALID_ACCESS */
+	case EACCES:	/* 13, INVALID_DATA */
+	case EBUSY:		/* 16, CURRENT_DIRECTORY */
+	case EINVAL:	/* 22, BAD_COMMAND */
+	case ENOSPC:	/* 28, OUT_OF_PAPER */
+		return strerror(err);
+	default:
+		;
+	}
+	buf[0] = 0;
+	FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM |
+		FORMAT_MESSAGE_IGNORE_INSERTS,
+		NULL, err, 0, ptr, MSGSIZE, (va_list *)buf+MSGSIZE);
+	return ptr;
+#else
+	return strerror(err);
+#endif
+}
+
+/** assert(3) variant in cursor context */
+#define mdb_cassert(mc, expr)	mdb_assert0((mc)->mc_txn->mt_env, expr, #expr)
+/** assert(3) variant in transaction context */
+#define mdb_tassert(txn, expr)	mdb_assert0((txn)->mt_env, expr, #expr)
+/** assert(3) variant in environment context */
+#define mdb_eassert(env, expr)	mdb_assert0(env, expr, #expr)
+
+#ifndef NDEBUG
+# define mdb_assert0(env, expr, expr_txt) ((expr) ? (void)0 : \
+		mdb_assert_fail(env, expr_txt, mdb_func_, __FILE__, __LINE__))
+
+static void ESECT
+mdb_assert_fail(MDB_env *env, const char *expr_txt,
+	const char *func, const char *file, int line)
+{
+	char buf[400];
+	sprintf(buf, "%.100s:%d: Assertion '%.200s' failed in %.40s()",
+		file, line, expr_txt, func);
+	if (env->me_assert_func)
+		env->me_assert_func(env, buf);
+	fprintf(stderr, "%s\n", buf);
+	abort();
+}
+#else
+# define mdb_assert0(env, expr, expr_txt) ((void) 0)
+#endif /* NDEBUG */
+
+#if MDB_DEBUG
+/** Return the page number of \b mp which may be sub-page, for debug output */
+static pgno_t
+mdb_dbg_pgno(MDB_page *mp)
+{
+	pgno_t ret;
+	COPY_PGNO(ret, mp->mp_pgno);
+	return ret;
+}
+
+/** Display a key in hexadecimal and return the address of the result.
+ * @param[in] key the key to display
+ * @param[in] buf the buffer to write into. Should always be #DKBUF.
+ * @return The key in hexadecimal form.
+ */
+char *
+mdb_dkey(MDB_val *key, char *buf)
+{
+	char *ptr = buf;
+	unsigned char *c = key->mv_data;
+	unsigned int i;
+
+	if (!key)
+		return "";
+
+	if (key->mv_size > DKBUF_MAXKEYSIZE)
+		return "MDB_MAXKEYSIZE";
+	/* may want to make this a dynamic check: if the key is mostly
+	 * printable characters, print it as-is instead of converting to hex.
+	 */
+#if 1
+	buf[0] = '\0';
+	for (i=0; i<key->mv_size; i++)
+		ptr += sprintf(ptr, "%02x", *c++);
+#else
+	sprintf(buf, "%.*s", key->mv_size, key->mv_data);
+#endif
+	return buf;
+}
+
+static const char *
+mdb_leafnode_type(MDB_node *n)
+{
+	static char *const tp[2][2] = {{"", ": DB"}, {": sub-page", ": sub-DB"}};
+	return F_ISSET(n->mn_flags, F_BIGDATA) ? ": overflow page" :
+		tp[F_ISSET(n->mn_flags, F_DUPDATA)][F_ISSET(n->mn_flags, F_SUBDATA)];
+}
+
+/** Display all the keys in the page. */
+void
+mdb_page_list(MDB_page *mp)
+{
+	pgno_t pgno = mdb_dbg_pgno(mp);
+	const char *type, *state = (mp->mp_flags & P_DIRTY) ? ", dirty" : "";
+	MDB_node *node;
+	unsigned int i, nkeys, nsize, total = 0;
+	MDB_val key;
+	DKBUF;
+
+	switch (mp->mp_flags & (P_BRANCH|P_LEAF|P_LEAF2|P_META|P_OVERFLOW|P_SUBP)) {
+	case P_BRANCH:              type = "Branch page";		break;
+	case P_LEAF:                type = "Leaf page";			break;
+	case P_LEAF|P_SUBP:         type = "Sub-page";			break;
+	case P_LEAF|P_LEAF2:        type = "LEAF2 page";		break;
+	case P_LEAF|P_LEAF2|P_SUBP: type = "LEAF2 sub-page";	break;
+	case P_OVERFLOW:
+		fprintf(stderr, "Overflow page %"Yu" pages %u%s\n",
+			pgno, mp->mp_pages, state);
+		return;
+	case P_META:
+		fprintf(stderr, "Meta-page %"Yu" txnid %"Yu"\n",
+			pgno, ((MDB_meta *)METADATA(mp))->mm_txnid);
+		return;
+	default:
+		fprintf(stderr, "Bad page %"Yu" flags 0x%X\n", pgno, mp->mp_flags);
+		return;
+	}
+
+	nkeys = NUMKEYS(mp);
+	fprintf(stderr, "%s %"Yu" numkeys %d%s\n", type, pgno, nkeys, state);
+
+	for (i=0; i<nkeys; i++) {
+		if (IS_LEAF2(mp)) {	/* LEAF2 pages have no mp_ptrs[] or node headers */
+			key.mv_size = nsize = mp->mp_pad;
+			key.mv_data = LEAF2KEY(mp, i, nsize);
+			total += nsize;
+			fprintf(stderr, "key %d: nsize %d, %s\n", i, nsize, DKEY(&key));
+			continue;
+		}
+		node = NODEPTR(mp, i);
+		key.mv_size = node->mn_ksize;
+		key.mv_data = node->mn_data;
+		nsize = NODESIZE + key.mv_size;
+		if (IS_BRANCH(mp)) {
+			fprintf(stderr, "key %d: page %"Yu", %s\n", i, NODEPGNO(node),
+				DKEY(&key));
+			total += nsize;
+		} else {
+			if (F_ISSET(node->mn_flags, F_BIGDATA))
+				nsize += sizeof(pgno_t);
+			else
+				nsize += NODEDSZ(node);
+			total += nsize;
+			nsize += sizeof(indx_t);
+			fprintf(stderr, "key %d: nsize %d, %s%s\n",
+				i, nsize, DKEY(&key), mdb_leafnode_type(node));
+		}
+		total = EVEN(total);
+	}
+	fprintf(stderr, "Total: header %d + contents %d + unused %d\n",
+		IS_LEAF2(mp) ? PAGEHDRSZ : PAGEBASE + mp->mp_lower, total, SIZELEFT(mp));
+}
+
+void
+mdb_cursor_chk(MDB_cursor *mc)
+{
+	unsigned int i;
+	MDB_node *node;
+	MDB_page *mp;
+
+	if (!mc->mc_snum || !(mc->mc_flags & C_INITIALIZED)) return;
+	for (i=0; i<mc->mc_top; i++) {
+		mp = mc->mc_pg[i];
+		node = NODEPTR(mp, mc->mc_ki[i]);
+		if (NODEPGNO(node) != mc->mc_pg[i+1]->mp_pgno)
+			printf("oops!\n");
+	}
+	if (mc->mc_ki[i] >= NUMKEYS(mc->mc_pg[i]))
+		printf("ack!\n");
+	if (XCURSOR_INITED(mc)) {
+		node = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+		if (((node->mn_flags & (F_DUPDATA|F_SUBDATA)) == F_DUPDATA) &&
+			mc->mc_xcursor->mx_cursor.mc_pg[0] != NODEDATA(node)) {
+			printf("blah!\n");
+		}
+	}
+}
+#endif
+
+#if (MDB_DEBUG) > 2
+/** Count all the pages in each DB and in the freelist
+ *  and make sure it matches the actual number of pages
+ *  being used.
+ *  All named DBs must be open for a correct count.
+ */
+static void mdb_audit(MDB_txn *txn)
+{
+	MDB_cursor mc;
+	MDB_val key, data;
+	MDB_ID freecount, count;
+	MDB_dbi i;
+	int rc;
+
+	freecount = 0;
+	mdb_cursor_init(&mc, txn, FREE_DBI, NULL);
+	while ((rc = mdb_cursor_get(&mc, &key, &data, MDB_NEXT)) == 0)
+		freecount += *(MDB_ID *)data.mv_data;
+	mdb_tassert(txn, rc == MDB_NOTFOUND);
+
+	count = 0;
+	for (i = 0; i<txn->mt_numdbs; i++) {
+		MDB_xcursor mx;
+		if (!(txn->mt_dbflags[i] & DB_VALID))
+			continue;
+		mdb_cursor_init(&mc, txn, i, &mx);
+		if (txn->mt_dbs[i].md_root == P_INVALID)
+			continue;
+		count += txn->mt_dbs[i].md_branch_pages +
+			txn->mt_dbs[i].md_leaf_pages +
+			txn->mt_dbs[i].md_overflow_pages;
+		if (txn->mt_dbs[i].md_flags & MDB_DUPSORT) {
+			rc = mdb_page_search(&mc, NULL, MDB_PS_FIRST);
+			for (; rc == MDB_SUCCESS; rc = mdb_cursor_sibling(&mc, 1)) {
+				unsigned j;
+				MDB_page *mp;
+				mp = mc.mc_pg[mc.mc_top];
+				for (j=0; j<NUMKEYS(mp); j++) {
+					MDB_node *leaf = NODEPTR(mp, j);
+					if (leaf->mn_flags & F_SUBDATA) {
+						MDB_db db;
+						memcpy(&db, NODEDATA(leaf), sizeof(db));
+						count += db.md_branch_pages + db.md_leaf_pages +
+							db.md_overflow_pages;
+					}
+				}
+			}
+			mdb_tassert(txn, rc == MDB_NOTFOUND);
+		}
+	}
+	if (freecount + count + NUM_METAS != txn->mt_next_pgno) {
+		fprintf(stderr, "audit: %"Yu" freecount: %"Yu" count: %"Yu" total: %"Yu" next_pgno: %"Yu"\n",
+			txn->mt_txnid, freecount, count+NUM_METAS,
+			freecount+count+NUM_METAS, txn->mt_next_pgno);
+	}
+}
+#endif
+
+int
+mdb_cmp(MDB_txn *txn, MDB_dbi dbi, const MDB_val *a, const MDB_val *b)
+{
+	return txn->mt_dbxs[dbi].md_cmp(a, b);
+}
+
+int
+mdb_dcmp(MDB_txn *txn, MDB_dbi dbi, const MDB_val *a, const MDB_val *b)
+{
+	MDB_cmp_func *dcmp = txn->mt_dbxs[dbi].md_dcmp;
+	if (NEED_CMP_CLONG(dcmp, a->mv_size))
+		dcmp = mdb_cmp_clong;
+	return dcmp(a, b);
+}
+
+/** Allocate memory for a page.
+ * Re-use old malloc'd pages first for singletons, otherwise just malloc.
+ * Set #MDB_TXN_ERROR on failure.
+ */
+static MDB_page *
+mdb_page_malloc(MDB_txn *txn, unsigned num)
+{
+	MDB_env *env = txn->mt_env;
+	MDB_page *ret = env->me_dpages;
+	size_t psize = env->me_psize, sz = psize, off;
+	/* For ! #MDB_NOMEMINIT, psize counts how much to init.
+	 * For a single page alloc, we init everything after the page header.
+	 * For multi-page, we init the final page; if the caller needed that
+	 * many pages they will be filling in at least up to the last page.
+	 */
+	if (num == 1) {
+		if (ret) {
+			VGMEMP_ALLOC(env, ret, sz);
+			VGMEMP_DEFINED(ret, sizeof(ret->mp_next));
+			env->me_dpages = ret->mp_next;
+			return ret;
+		}
+		psize -= off = PAGEHDRSZ;
+	} else {
+		sz *= num;
+		off = sz - psize;
+	}
+	if ((ret = malloc(sz)) != NULL) {
+		VGMEMP_ALLOC(env, ret, sz);
+		if (!(env->me_flags & MDB_NOMEMINIT)) {
+			memset((char *)ret + off, 0, psize);
+			ret->mp_pad = 0;
+		}
+	} else {
+		txn->mt_flags |= MDB_TXN_ERROR;
+	}
+	return ret;
+}
+/** Free a single page.
+ * Saves single pages to a list, for future reuse.
+ * (This is not used for multi-page overflow pages.)
+ */
+static void
+mdb_page_free(MDB_env *env, MDB_page *mp)
+{
+	mp->mp_next = env->me_dpages;
+	VGMEMP_FREE(env, mp);
+	env->me_dpages = mp;
+}
+
+/** Free a dirty page */
+static void
+mdb_dpage_free(MDB_env *env, MDB_page *dp)
+{
+	if (!IS_OVERFLOW(dp) || dp->mp_pages == 1) {
+		mdb_page_free(env, dp);
+	} else {
+		/* large pages just get freed directly */
+		VGMEMP_FREE(env, dp);
+		free(dp);
+	}
+}
+
+/**	Return all dirty pages to dpage list */
+static void
+mdb_dlist_free(MDB_txn *txn)
+{
+	MDB_env *env = txn->mt_env;
+	MDB_ID2L dl = txn->mt_u.dirty_list;
+	unsigned i, n = dl[0].mid;
+
+	for (i = 1; i <= n; i++) {
+		mdb_dpage_free(env, dl[i].mptr);
+	}
+	dl[0].mid = 0;
+}
+
+#ifdef MDB_VL32
+static void
+mdb_page_unref(MDB_txn *txn, MDB_page *mp)
+{
+	pgno_t pgno;
+	MDB_ID3L tl = txn->mt_rpages;
+	unsigned x, rem;
+	if (mp->mp_flags & (P_SUBP|P_DIRTY))
+		return;
+	rem = mp->mp_pgno & (MDB_RPAGE_CHUNK-1);
+	pgno = mp->mp_pgno ^ rem;
+	x = mdb_mid3l_search(tl, pgno);
+	if (x != tl[0].mid && tl[x+1].mid == mp->mp_pgno)
+		x++;
+	if (tl[x].mref)
+		tl[x].mref--;
+}
+#define MDB_PAGE_UNREF(txn, mp)	mdb_page_unref(txn, mp)
+
+static void
+mdb_cursor_unref(MDB_cursor *mc)
+{
+	int i;
+	if (mc->mc_txn->mt_rpages[0].mid) {
+		if (!mc->mc_snum || !mc->mc_pg[0] || IS_SUBP(mc->mc_pg[0]))
+			return;
+		for (i=0; i<mc->mc_snum; i++)
+			mdb_page_unref(mc->mc_txn, mc->mc_pg[i]);
+		if (mc->mc_ovpg) {
+			mdb_page_unref(mc->mc_txn, mc->mc_ovpg);
+			mc->mc_ovpg = 0;
+		}
+	}
+	mc->mc_snum = mc->mc_top = 0;
+	mc->mc_pg[0] = NULL;
+	mc->mc_flags &= ~C_INITIALIZED;
+}
+#define MDB_CURSOR_UNREF(mc, force) \
+	(((force) || ((mc)->mc_flags & C_INITIALIZED)) \
+	 ? mdb_cursor_unref(mc) \
+	 : (void)0)
+
+#else
+#define MDB_PAGE_UNREF(txn, mp)
+#define MDB_CURSOR_UNREF(mc, force) ((void)0)
+#endif /* MDB_VL32 */
+
+/** Loosen or free a single page.
+ * Saves single pages to a list for future reuse
+ * in this same txn. It has been pulled from the freeDB
+ * and already resides on the dirty list, but has been
+ * deleted. Use these pages first before pulling again
+ * from the freeDB.
+ *
+ * If the page wasn't dirtied in this txn, just add it
+ * to this txn's free list.
+ */
+static int
+mdb_page_loose(MDB_cursor *mc, MDB_page *mp)
+{
+	int loose = 0;
+	pgno_t pgno = mp->mp_pgno;
+	MDB_txn *txn = mc->mc_txn;
+
+	if ((mp->mp_flags & P_DIRTY) && mc->mc_dbi != FREE_DBI) {
+		if (txn->mt_parent) {
+			MDB_ID2 *dl = txn->mt_u.dirty_list;
+			/* If txn has a parent, make sure the page is in our
+			 * dirty list.
+			 */
+			if (dl[0].mid) {
+				unsigned x = mdb_mid2l_search(dl, pgno);
+				if (x <= dl[0].mid && dl[x].mid == pgno) {
+					if (mp != dl[x].mptr) { /* bad cursor? */
+						mc->mc_flags &= ~(C_INITIALIZED|C_EOF);
+						txn->mt_flags |= MDB_TXN_ERROR;
+						return MDB_PROBLEM;
+					}
+					/* ok, it's ours */
+					loose = 1;
+				}
+			}
+		} else {
+			/* no parent txn, so it's just ours */
+			loose = 1;
+		}
+	}
+	if (loose) {
+		DPRINTF(("loosen db %d page %"Yu, DDBI(mc), mp->mp_pgno));
+		NEXT_LOOSE_PAGE(mp) = txn->mt_loose_pgs;
+		txn->mt_loose_pgs = mp;
+		txn->mt_loose_count++;
+		mp->mp_flags |= P_LOOSE;
+	} else {
+		int rc = mdb_midl_append(&txn->mt_free_pgs, pgno);
+		if (rc)
+			return rc;
+	}
+
+	return MDB_SUCCESS;
+}
+
+/** Set or clear P_KEEP in dirty, non-overflow, non-sub pages watched by txn.
+ * @param[in] mc A cursor handle for the current operation.
+ * @param[in] pflags Flags of the pages to update:
+ * P_DIRTY to set P_KEEP, P_DIRTY|P_KEEP to clear it.
+ * @param[in] all No shortcuts. Needed except after a full #mdb_page_flush().
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_pages_xkeep(MDB_cursor *mc, unsigned pflags, int all)
+{
+	enum { Mask = P_SUBP|P_DIRTY|P_LOOSE|P_KEEP };
+	MDB_txn *txn = mc->mc_txn;
+	MDB_cursor *m3, *m0 = mc;
+	MDB_xcursor *mx;
+	MDB_page *dp, *mp;
+	MDB_node *leaf;
+	unsigned i, j;
+	int rc = MDB_SUCCESS, level;
+
+	/* Mark pages seen by cursors: First m0, then tracked cursors */
+	for (i = txn->mt_numdbs;; ) {
+		if (mc->mc_flags & C_INITIALIZED) {
+			for (m3 = mc;; m3 = &mx->mx_cursor) {
+				mp = NULL;
+				for (j=0; j<m3->mc_snum; j++) {
+					mp = m3->mc_pg[j];
+					if ((mp->mp_flags & Mask) == pflags)
+						mp->mp_flags ^= P_KEEP;
+				}
+				mx = m3->mc_xcursor;
+				/* Proceed to mx if it is at a sub-database */
+				if (! (mx && (mx->mx_cursor.mc_flags & C_INITIALIZED)))
+					break;
+				if (! (mp && (mp->mp_flags & P_LEAF)))
+					break;
+				leaf = NODEPTR(mp, m3->mc_ki[j-1]);
+				if (!(leaf->mn_flags & F_SUBDATA))
+					break;
+			}
+		}
+		mc = mc->mc_next;
+		for (; !mc || mc == m0; mc = txn->mt_cursors[--i])
+			if (i == 0)
+				goto mark_done;
+	}
+
+mark_done:
+	if (all) {
+		/* Mark dirty root pages */
+		for (i=0; i<txn->mt_numdbs; i++) {
+			if (txn->mt_dbflags[i] & DB_DIRTY) {
+				pgno_t pgno = txn->mt_dbs[i].md_root;
+				if (pgno == P_INVALID)
+					continue;
+				if ((rc = mdb_page_get(m0, pgno, &dp, &level)) != MDB_SUCCESS)
+					break;
+				if ((dp->mp_flags & Mask) == pflags && level <= 1)
+					dp->mp_flags ^= P_KEEP;
+			}
+		}
+	}
+
+	return rc;
+}
+
+static int mdb_page_flush(MDB_txn *txn, int keep);
+
+/**	Spill pages from the dirty list back to disk.
+ * This is intended to prevent running into #MDB_TXN_FULL situations,
+ * but note that they may still occur in a few cases:
+ *	1) our estimate of the txn size could be too small. Currently this
+ *	 seems unlikely, except with a large number of #MDB_MULTIPLE items.
+ *	2) child txns may run out of space if their parents dirtied a
+ *	 lot of pages and never spilled them. TODO: we probably should do
+ *	 a preemptive spill during #mdb_txn_begin() of a child txn, if
+ *	 the parent's dirty_room is below a given threshold.
+ *
+ * Otherwise, if not using nested txns, it is expected that apps will
+ * not run into #MDB_TXN_FULL any more. The pages are flushed to disk
+ * the same way as for a txn commit, e.g. their P_DIRTY flag is cleared.
+ * If the txn never references them again, they can be left alone.
+ * If the txn only reads them, they can be used without any fuss.
+ * If the txn writes them again, they can be dirtied immediately without
+ * going thru all of the work of #mdb_page_touch(). Such references are
+ * handled by #mdb_page_unspill().
+ *
+ * Also note, we never spill DB root pages, nor pages of active cursors,
+ * because we'll need these back again soon anyway. And in nested txns,
+ * we can't spill a page in a child txn if it was already spilled in a
+ * parent txn. That would alter the parent txns' data even though
+ * the child hasn't committed yet, and we'd have no way to undo it if
+ * the child aborted.
+ *
+ * @param[in] m0 cursor A cursor handle identifying the transaction and
+ *	database for which we are checking space.
+ * @param[in] key For a put operation, the key being stored.
+ * @param[in] data For a put operation, the data being stored.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_spill(MDB_cursor *m0, MDB_val *key, MDB_val *data)
+{
+	MDB_txn *txn = m0->mc_txn;
+	MDB_page *dp;
+	MDB_ID2L dl = txn->mt_u.dirty_list;
+	unsigned int i, j, need;
+	int rc;
+
+	if (m0->mc_flags & C_SUB)
+		return MDB_SUCCESS;
+
+	/* Estimate how much space this op will take */
+	i = m0->mc_db->md_depth;
+	/* Named DBs also dirty the main DB */
+	if (m0->mc_dbi >= CORE_DBS)
+		i += txn->mt_dbs[MAIN_DBI].md_depth;
+	/* For puts, roughly factor in the key+data size */
+	if (key)
+		i += (LEAFSIZE(key, data) + txn->mt_env->me_psize) / txn->mt_env->me_psize;
+	i += i;	/* double it for good measure */
+	need = i;
+
+	if (txn->mt_dirty_room > i)
+		return MDB_SUCCESS;
+
+	if (!txn->mt_spill_pgs) {
+		txn->mt_spill_pgs = mdb_midl_alloc(MDB_IDL_UM_MAX);
+		if (!txn->mt_spill_pgs)
+			return ENOMEM;
+	} else {
+		/* purge deleted slots */
+		MDB_IDL sl = txn->mt_spill_pgs;
+		unsigned int num = sl[0];
+		j=0;
+		for (i=1; i<=num; i++) {
+			if (!(sl[i] & 1))
+				sl[++j] = sl[i];
+		}
+		sl[0] = j;
+	}
+
+	/* Preserve pages which may soon be dirtied again */
+	if ((rc = mdb_pages_xkeep(m0, P_DIRTY, 1)) != MDB_SUCCESS)
+		goto done;
+
+	/* Less aggressive spill - we originally spilled the entire dirty list,
+	 * with a few exceptions for cursor pages and DB root pages. But this
+	 * turns out to be a lot of wasted effort because in a large txn many
+	 * of those pages will need to be used again. So now we spill only 1/8th
+	 * of the dirty pages. Testing revealed this to be a good tradeoff,
+	 * better than 1/2, 1/4, or 1/10.
+	 */
+	if (need < MDB_IDL_UM_MAX / 8)
+		need = MDB_IDL_UM_MAX / 8;
+
+	/* Save the page IDs of all the pages we're flushing */
+	/* flush from the tail forward, this saves a lot of shifting later on. */
+	for (i=dl[0].mid; i && need; i--) {
+		MDB_ID pn = dl[i].mid << 1;
+		dp = dl[i].mptr;
+		if (dp->mp_flags & (P_LOOSE|P_KEEP))
+			continue;
+		/* Can't spill twice, make sure it's not already in a parent's
+		 * spill list.
+		 */
+		if (txn->mt_parent) {
+			MDB_txn *tx2;
+			for (tx2 = txn->mt_parent; tx2; tx2 = tx2->mt_parent) {
+				if (tx2->mt_spill_pgs) {
+					j = mdb_midl_search(tx2->mt_spill_pgs, pn);
+					if (j <= tx2->mt_spill_pgs[0] && tx2->mt_spill_pgs[j] == pn) {
+						dp->mp_flags |= P_KEEP;
+						break;
+					}
+				}
+			}
+			if (tx2)
+				continue;
+		}
+		if ((rc = mdb_midl_append(&txn->mt_spill_pgs, pn)))
+			goto done;
+		need--;
+	}
+	mdb_midl_sort(txn->mt_spill_pgs);
+
+	/* Flush the spilled part of dirty list */
+	if ((rc = mdb_page_flush(txn, i)) != MDB_SUCCESS)
+		goto done;
+
+	/* Reset any dirty pages we kept that page_flush didn't see */
+	rc = mdb_pages_xkeep(m0, P_DIRTY|P_KEEP, i);
+
+done:
+	txn->mt_flags |= rc ? MDB_TXN_ERROR : MDB_TXN_SPILLS;
+	return rc;
+}
+
+/** Find oldest txnid still referenced. Expects txn->mt_txnid > 0. */
+static txnid_t
+mdb_find_oldest(MDB_txn *txn)
+{
+	int i;
+	txnid_t mr, oldest = txn->mt_txnid - 1;
+	if (txn->mt_env->me_txns) {
+		MDB_reader *r = txn->mt_env->me_txns->mti_readers;
+		for (i = txn->mt_env->me_txns->mti_numreaders; --i >= 0; ) {
+			if (r[i].mr_pid) {
+				mr = r[i].mr_txnid;
+				if (oldest > mr)
+					oldest = mr;
+			}
+		}
+	}
+	return oldest;
+}
+
+/** Add a page to the txn's dirty list */
+static void
+mdb_page_dirty(MDB_txn *txn, MDB_page *mp)
+{
+	MDB_ID2 mid;
+	int rc, (*insert)(MDB_ID2L, MDB_ID2 *);
+
+	if (txn->mt_flags & MDB_TXN_WRITEMAP) {
+		insert = mdb_mid2l_append;
+	} else {
+		insert = mdb_mid2l_insert;
+	}
+	mid.mid = mp->mp_pgno;
+	mid.mptr = mp;
+	rc = insert(txn->mt_u.dirty_list, &mid);
+	mdb_tassert(txn, rc == 0);
+	txn->mt_dirty_room--;
+}
+
+/** Allocate page numbers and memory for writing.  Maintain me_pglast,
+ * me_pghead and mt_next_pgno.  Set #MDB_TXN_ERROR on failure.
+ *
+ * If there are free pages available from older transactions, they
+ * are re-used first. Otherwise allocate a new page at mt_next_pgno.
+ * Do not modify the freedB, just merge freeDB records into me_pghead[]
+ * and move me_pglast to say which records were consumed.  Only this
+ * function can create me_pghead and move me_pglast/mt_next_pgno.
+ * When #MDB_DEVEL & 2, it is not affected by #mdb_freelist_save(): it
+ * then uses the transaction's original snapshot of the freeDB.
+ * @param[in] mc cursor A cursor handle identifying the transaction and
+ *	database for which we are allocating.
+ * @param[in] num the number of pages to allocate.
+ * @param[out] mp Address of the allocated page(s). Requests for multiple pages
+ *  will always be satisfied by a single contiguous chunk of memory.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_alloc(MDB_cursor *mc, int num, MDB_page **mp)
+{
+#ifdef MDB_PARANOID	/* Seems like we can ignore this now */
+	/* Get at most <Max_retries> more freeDB records once me_pghead
+	 * has enough pages.  If not enough, use new pages from the map.
+	 * If <Paranoid> and mc is updating the freeDB, only get new
+	 * records if me_pghead is empty. Then the freelist cannot play
+	 * catch-up with itself by growing while trying to save it.
+	 */
+	enum { Paranoid = 1, Max_retries = 500 };
+#else
+	enum { Paranoid = 0, Max_retries = INT_MAX /*infinite*/ };
+#endif
+	int rc, retry = num * 60;
+	MDB_txn *txn = mc->mc_txn;
+	MDB_env *env = txn->mt_env;
+	pgno_t pgno, *mop = env->me_pghead;
+	unsigned i, j, mop_len = mop ? mop[0] : 0, n2 = num-1;
+	MDB_page *np;
+	txnid_t oldest = 0, last;
+	MDB_cursor_op op;
+	MDB_cursor m2;
+	int found_old = 0;
+
+	/* If there are any loose pages, just use them */
+	if (num == 1 && txn->mt_loose_pgs) {
+		np = txn->mt_loose_pgs;
+		txn->mt_loose_pgs = NEXT_LOOSE_PAGE(np);
+		txn->mt_loose_count--;
+		DPRINTF(("db %d use loose page %"Yu, DDBI(mc), np->mp_pgno));
+		*mp = np;
+		return MDB_SUCCESS;
+	}
+
+	*mp = NULL;
+
+	/* If our dirty list is already full, we can't do anything */
+	if (txn->mt_dirty_room == 0) {
+		rc = MDB_TXN_FULL;
+		goto fail;
+	}
+
+	for (op = MDB_FIRST;; op = MDB_NEXT) {
+		MDB_val key, data;
+		MDB_node *leaf;
+		pgno_t *idl;
+
+		/* Seek a big enough contiguous page range. Prefer
+		 * pages at the tail, just truncating the list.
+		 */
+		if (mop_len > n2) {
+			i = mop_len;
+			do {
+				pgno = mop[i];
+				if (mop[i-n2] == pgno+n2)
+					goto search_done;
+			} while (--i > n2);
+			if (--retry < 0)
+				break;
+		}
+
+		if (op == MDB_FIRST) {	/* 1st iteration */
+			/* Prepare to fetch more and coalesce */
+			last = env->me_pglast;
+			oldest = env->me_pgoldest;
+			mdb_cursor_init(&m2, txn, FREE_DBI, NULL);
+#if (MDB_DEVEL) & 2	/* "& 2" so MDB_DEVEL=1 won't hide bugs breaking freeDB */
+			/* Use original snapshot. TODO: Should need less care in code
+			 * which modifies the database. Maybe we can delete some code?
+			 */
+			m2.mc_flags |= C_ORIG_RDONLY;
+			m2.mc_db = &env->me_metas[(txn->mt_txnid-1) & 1]->mm_dbs[FREE_DBI];
+			m2.mc_dbflag = (unsigned char *)""; /* probably unnecessary */
+#endif
+			if (last) {
+				op = MDB_SET_RANGE;
+				key.mv_data = &last; /* will look up last+1 */
+				key.mv_size = sizeof(last);
+			}
+			if (Paranoid && mc->mc_dbi == FREE_DBI)
+				retry = -1;
+		}
+		if (Paranoid && retry < 0 && mop_len)
+			break;
+
+		last++;
+		/* Do not fetch more if the record will be too recent */
+		if (oldest <= last) {
+			if (!found_old) {
+				oldest = mdb_find_oldest(txn);
+				env->me_pgoldest = oldest;
+				found_old = 1;
+			}
+			if (oldest <= last)
+				break;
+		}
+		rc = mdb_cursor_get(&m2, &key, NULL, op);
+		if (rc) {
+			if (rc == MDB_NOTFOUND)
+				break;
+			goto fail;
+		}
+		last = *(txnid_t*)key.mv_data;
+		if (oldest <= last) {
+			if (!found_old) {
+				oldest = mdb_find_oldest(txn);
+				env->me_pgoldest = oldest;
+				found_old = 1;
+			}
+			if (oldest <= last)
+				break;
+		}
+		np = m2.mc_pg[m2.mc_top];
+		leaf = NODEPTR(np, m2.mc_ki[m2.mc_top]);
+		if ((rc = mdb_node_read(&m2, leaf, &data)) != MDB_SUCCESS)
+			goto fail;
+
+		idl = (MDB_ID *) data.mv_data;
+		i = idl[0];
+		if (!mop) {
+			if (!(env->me_pghead = mop = mdb_midl_alloc(i))) {
+				rc = ENOMEM;
+				goto fail;
+			}
+		} else {
+			if ((rc = mdb_midl_need(&env->me_pghead, i)) != 0)
+				goto fail;
+			mop = env->me_pghead;
+		}
+		env->me_pglast = last;
+#if (MDB_DEBUG) > 1
+		DPRINTF(("IDL read txn %"Yu" root %"Yu" num %u",
+			last, txn->mt_dbs[FREE_DBI].md_root, i));
+		for (j = i; j; j--)
+			DPRINTF(("IDL %"Yu, idl[j]));
+#endif
+		/* Merge in descending sorted order */
+		mdb_midl_xmerge(mop, idl);
+		mop_len = mop[0];
+	}
+
+	/* Use new pages from the map when nothing suitable in the freeDB */
+	i = 0;
+	pgno = txn->mt_next_pgno;
+	if (pgno + num >= env->me_maxpg) {
+			DPUTS("DB size maxed out");
+			rc = MDB_MAP_FULL;
+			goto fail;
+	}
+#if defined(_WIN32) && !defined(MDB_VL32)
+	if (!(env->me_flags & MDB_RDONLY)) {
+		void *p;
+		p = (MDB_page *)(env->me_map + env->me_psize * pgno);
+		p = VirtualAlloc(p, env->me_psize * num, MEM_COMMIT,
+			(env->me_flags & MDB_WRITEMAP) ? PAGE_READWRITE:
+			PAGE_READONLY);
+		if (!p) {
+			DPUTS("VirtualAlloc failed");
+			rc = ErrCode();
+			goto fail;
+		}
+	}
+#endif
+
+search_done:
+	if (env->me_flags & MDB_WRITEMAP) {
+		np = (MDB_page *)(env->me_map + env->me_psize * pgno);
+	} else {
+		if (!(np = mdb_page_malloc(txn, num))) {
+			rc = ENOMEM;
+			goto fail;
+		}
+	}
+	if (i) {
+		mop[0] = mop_len -= num;
+		/* Move any stragglers down */
+		for (j = i-num; j < mop_len; )
+			mop[++j] = mop[++i];
+	} else {
+		txn->mt_next_pgno = pgno + num;
+	}
+	np->mp_pgno = pgno;
+	mdb_page_dirty(txn, np);
+	*mp = np;
+
+	return MDB_SUCCESS;
+
+fail:
+	txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+/** Copy the used portions of a non-overflow page.
+ * @param[in] dst page to copy into
+ * @param[in] src page to copy from
+ * @param[in] psize size of a page
+ */
+static void
+mdb_page_copy(MDB_page *dst, MDB_page *src, unsigned int psize)
+{
+	enum { Align = sizeof(pgno_t) };
+	indx_t upper = src->mp_upper, lower = src->mp_lower, unused = upper-lower;
+
+	/* If page isn't full, just copy the used portion. Adjust
+	 * alignment so memcpy may copy words instead of bytes.
+	 */
+	if ((unused &= -Align) && !IS_LEAF2(src)) {
+		upper = (upper + PAGEBASE) & -Align;
+		memcpy(dst, src, (lower + PAGEBASE + (Align-1)) & -Align);
+		memcpy((pgno_t *)((char *)dst+upper), (pgno_t *)((char *)src+upper),
+			psize - upper);
+	} else {
+		memcpy(dst, src, psize - unused);
+	}
+}
+
+/** Pull a page off the txn's spill list, if present.
+ * If a page being referenced was spilled to disk in this txn, bring
+ * it back and make it dirty/writable again.
+ * @param[in] txn the transaction handle.
+ * @param[in] mp the page being referenced. It must not be dirty.
+ * @param[out] ret the writable page, if any. ret is unchanged if
+ * mp wasn't spilled.
+ */
+static int
+mdb_page_unspill(MDB_txn *txn, MDB_page *mp, MDB_page **ret)
+{
+	MDB_env *env = txn->mt_env;
+	const MDB_txn *tx2;
+	unsigned x;
+	pgno_t pgno = mp->mp_pgno, pn = pgno << 1;
+
+	for (tx2 = txn; tx2; tx2=tx2->mt_parent) {
+		if (!tx2->mt_spill_pgs)
+			continue;
+		x = mdb_midl_search(tx2->mt_spill_pgs, pn);
+		if (x <= tx2->mt_spill_pgs[0] && tx2->mt_spill_pgs[x] == pn) {
+			MDB_page *np;
+			int num;
+			if (txn->mt_dirty_room == 0)
+				return MDB_TXN_FULL;
+			if (IS_OVERFLOW(mp))
+				num = mp->mp_pages;
+			else
+				num = 1;
+			if (env->me_flags & MDB_WRITEMAP) {
+				np = mp;
+			} else {
+				np = mdb_page_malloc(txn, num);
+				if (!np)
+					return ENOMEM;
+				if (num > 1)
+					memcpy(np, mp, num * env->me_psize);
+				else
+					mdb_page_copy(np, mp, env->me_psize);
+			}
+			if (tx2 == txn) {
+				/* If in current txn, this page is no longer spilled.
+				 * If it happens to be the last page, truncate the spill list.
+				 * Otherwise mark it as deleted by setting the LSB.
+				 */
+				if (x == txn->mt_spill_pgs[0])
+					txn->mt_spill_pgs[0]--;
+				else
+					txn->mt_spill_pgs[x] |= 1;
+			}	/* otherwise, if belonging to a parent txn, the
+				 * page remains spilled until child commits
+				 */
+
+			mdb_page_dirty(txn, np);
+			np->mp_flags |= P_DIRTY;
+			*ret = np;
+			break;
+		}
+	}
+	return MDB_SUCCESS;
+}
+
+/** Touch a page: make it dirty and re-insert into tree with updated pgno.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in] mc cursor pointing to the page to be touched
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_touch(MDB_cursor *mc)
+{
+	MDB_page *mp = mc->mc_pg[mc->mc_top], *np;
+	MDB_txn *txn = mc->mc_txn;
+	MDB_cursor *m2, *m3;
+	pgno_t	pgno;
+	int rc;
+
+	if (!F_ISSET(mp->mp_flags, P_DIRTY)) {
+		if (txn->mt_flags & MDB_TXN_SPILLS) {
+			np = NULL;
+			rc = mdb_page_unspill(txn, mp, &np);
+			if (rc)
+				goto fail;
+			if (np)
+				goto done;
+		}
+		if ((rc = mdb_midl_need(&txn->mt_free_pgs, 1)) ||
+			(rc = mdb_page_alloc(mc, 1, &np)))
+			goto fail;
+		pgno = np->mp_pgno;
+		DPRINTF(("touched db %d page %"Yu" -> %"Yu, DDBI(mc),
+			mp->mp_pgno, pgno));
+		mdb_cassert(mc, mp->mp_pgno != pgno);
+		mdb_midl_xappend(txn->mt_free_pgs, mp->mp_pgno);
+		/* Update the parent page, if any, to point to the new page */
+		if (mc->mc_top) {
+			MDB_page *parent = mc->mc_pg[mc->mc_top-1];
+			MDB_node *node = NODEPTR(parent, mc->mc_ki[mc->mc_top-1]);
+			SETPGNO(node, pgno);
+		} else {
+			mc->mc_db->md_root = pgno;
+		}
+	} else if (txn->mt_parent && !IS_SUBP(mp)) {
+		MDB_ID2 mid, *dl = txn->mt_u.dirty_list;
+		pgno = mp->mp_pgno;
+		/* If txn has a parent, make sure the page is in our
+		 * dirty list.
+		 */
+		if (dl[0].mid) {
+			unsigned x = mdb_mid2l_search(dl, pgno);
+			if (x <= dl[0].mid && dl[x].mid == pgno) {
+				if (mp != dl[x].mptr) { /* bad cursor? */
+					mc->mc_flags &= ~(C_INITIALIZED|C_EOF);
+					txn->mt_flags |= MDB_TXN_ERROR;
+					return MDB_PROBLEM;
+				}
+				return 0;
+			}
+		}
+		mdb_cassert(mc, dl[0].mid < MDB_IDL_UM_MAX);
+		/* No - copy it */
+		np = mdb_page_malloc(txn, 1);
+		if (!np)
+			return ENOMEM;
+		mid.mid = pgno;
+		mid.mptr = np;
+		rc = mdb_mid2l_insert(dl, &mid);
+		mdb_cassert(mc, rc == 0);
+	} else {
+		return 0;
+	}
+
+	mdb_page_copy(np, mp, txn->mt_env->me_psize);
+	np->mp_pgno = pgno;
+	np->mp_flags |= P_DIRTY;
+
+done:
+	/* Adjust cursors pointing to mp */
+	mc->mc_pg[mc->mc_top] = np;
+	m2 = txn->mt_cursors[mc->mc_dbi];
+	if (mc->mc_flags & C_SUB) {
+		for (; m2; m2=m2->mc_next) {
+			m3 = &m2->mc_xcursor->mx_cursor;
+			if (m3->mc_snum < mc->mc_snum) continue;
+			if (m3->mc_pg[mc->mc_top] == mp)
+				m3->mc_pg[mc->mc_top] = np;
+		}
+	} else {
+		for (; m2; m2=m2->mc_next) {
+			if (m2->mc_snum < mc->mc_snum) continue;
+			if (m2 == mc) continue;
+			if (m2->mc_pg[mc->mc_top] == mp) {
+				m2->mc_pg[mc->mc_top] = np;
+				if (IS_LEAF(np))
+					XCURSOR_REFRESH(m2, mc->mc_top, np);
+			}
+		}
+	}
+	MDB_PAGE_UNREF(mc->mc_txn, mp);
+	return 0;
+
+fail:
+	txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+int
+mdb_env_sync0(MDB_env *env, int force, pgno_t numpgs)
+{
+	int rc = 0;
+	if (env->me_flags & MDB_RDONLY)
+		return EACCES;
+	if (force || !F_ISSET(env->me_flags, MDB_NOSYNC)) {
+		if (env->me_flags & MDB_WRITEMAP) {
+			int flags = ((env->me_flags & MDB_MAPASYNC) && !force)
+				? MS_ASYNC : MS_SYNC;
+			if (MDB_MSYNC(env->me_map, env->me_psize * numpgs, flags))
+				rc = ErrCode();
+#ifdef _WIN32
+			else if (flags == MS_SYNC && MDB_FDATASYNC(env->me_fd))
+				rc = ErrCode();
+#endif
+		} else {
+#ifdef BROKEN_FDATASYNC
+			if (env->me_flags & MDB_FSYNCONLY) {
+				if (fsync(env->me_fd))
+					rc = ErrCode();
+			} else
+#endif
+			if (MDB_FDATASYNC(env->me_fd))
+				rc = ErrCode();
+		}
+	}
+	return rc;
+}
+
+int
+mdb_env_sync(MDB_env *env, int force)
+{
+	MDB_meta *m = mdb_env_pick_meta(env);
+	return mdb_env_sync0(env, force, m->mm_last_pg+1);
+}
+
+/** Back up parent txn's cursors, then grab the originals for tracking */
+static int
+mdb_cursor_shadow(MDB_txn *src, MDB_txn *dst)
+{
+	MDB_cursor *mc, *bk;
+	MDB_xcursor *mx;
+	size_t size;
+	int i;
+
+	for (i = src->mt_numdbs; --i >= 0; ) {
+		if ((mc = src->mt_cursors[i]) != NULL) {
+			size = sizeof(MDB_cursor);
+			if (mc->mc_xcursor)
+				size += sizeof(MDB_xcursor);
+			for (; mc; mc = bk->mc_next) {
+				bk = malloc(size);
+				if (!bk)
+					return ENOMEM;
+				*bk = *mc;
+				mc->mc_backup = bk;
+				mc->mc_db = &dst->mt_dbs[i];
+				/* Kill pointers into src to reduce abuse: The
+				 * user may not use mc until dst ends. But we need a valid
+				 * txn pointer here for cursor fixups to keep working.
+				 */
+				mc->mc_txn    = dst;
+				mc->mc_dbflag = &dst->mt_dbflags[i];
+				if ((mx = mc->mc_xcursor) != NULL) {
+					*(MDB_xcursor *)(bk+1) = *mx;
+					mx->mx_cursor.mc_txn = dst;
+				}
+				mc->mc_next = dst->mt_cursors[i];
+				dst->mt_cursors[i] = mc;
+			}
+		}
+	}
+	return MDB_SUCCESS;
+}
+
+/** Close this write txn's cursors, give parent txn's cursors back to parent.
+ * @param[in] txn the transaction handle.
+ * @param[in] merge true to keep changes to parent cursors, false to revert.
+ * @return 0 on success, non-zero on failure.
+ */
+static void
+mdb_cursors_close(MDB_txn *txn, unsigned merge)
+{
+	MDB_cursor **cursors = txn->mt_cursors, *mc, *next, *bk;
+	MDB_xcursor *mx;
+	int i;
+
+	for (i = txn->mt_numdbs; --i >= 0; ) {
+		for (mc = cursors[i]; mc; mc = next) {
+			next = mc->mc_next;
+			if ((bk = mc->mc_backup) != NULL) {
+				if (merge) {
+					/* Commit changes to parent txn */
+					mc->mc_next = bk->mc_next;
+					mc->mc_backup = bk->mc_backup;
+					mc->mc_txn = bk->mc_txn;
+					mc->mc_db = bk->mc_db;
+					mc->mc_dbflag = bk->mc_dbflag;
+					if ((mx = mc->mc_xcursor) != NULL)
+						mx->mx_cursor.mc_txn = bk->mc_txn;
+				} else {
+					/* Abort nested txn */
+					*mc = *bk;
+					if ((mx = mc->mc_xcursor) != NULL)
+						*mx = *(MDB_xcursor *)(bk+1);
+				}
+				mc = bk;
+			}
+			/* Only malloced cursors are permanently tracked. */
+			free(mc);
+		}
+		cursors[i] = NULL;
+	}
+}
+
+#if !(MDB_PIDLOCK)		/* Currently the same as defined(_WIN32) */
+enum Pidlock_op {
+	Pidset, Pidcheck
+};
+#else
+enum Pidlock_op {
+	Pidset = F_SETLK, Pidcheck = F_GETLK
+};
+#endif
+
+/** Set or check a pid lock. Set returns 0 on success.
+ * Check returns 0 if the process is certainly dead, nonzero if it may
+ * be alive (the lock exists or an error happened so we do not know).
+ *
+ * On Windows Pidset is a no-op, we merely check for the existence
+ * of the process with the given pid. On POSIX we use a single byte
+ * lock on the lockfile, set at an offset equal to the pid.
+ */
+static int
+mdb_reader_pid(MDB_env *env, enum Pidlock_op op, MDB_PID_T pid)
+{
+#if !(MDB_PIDLOCK)		/* Currently the same as defined(_WIN32) */
+	int ret = 0;
+	HANDLE h;
+	if (op == Pidcheck) {
+		h = OpenProcess(env->me_pidquery, FALSE, pid);
+		/* No documented "no such process" code, but other program use this: */
+		if (!h)
+			return ErrCode() != ERROR_INVALID_PARAMETER;
+		/* A process exists until all handles to it close. Has it exited? */
+		ret = WaitForSingleObject(h, 0) != 0;
+		CloseHandle(h);
+	}
+	return ret;
+#else
+	for (;;) {
+		int rc;
+		struct flock lock_info;
+		memset(&lock_info, 0, sizeof(lock_info));
+		lock_info.l_type = F_WRLCK;
+		lock_info.l_whence = SEEK_SET;
+		lock_info.l_start = pid;
+		lock_info.l_len = 1;
+		if ((rc = fcntl(env->me_lfd, op, &lock_info)) == 0) {
+			if (op == F_GETLK && lock_info.l_type != F_UNLCK)
+				rc = -1;
+		} else if ((rc = ErrCode()) == EINTR) {
+			continue;
+		}
+		return rc;
+	}
+#endif
+}
+
+/** Common code for #mdb_txn_begin() and #mdb_txn_renew().
+ * @param[in] txn the transaction handle to initialize
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_txn_renew0(MDB_txn *txn)
+{
+	MDB_env *env = txn->mt_env;
+	MDB_txninfo *ti = env->me_txns;
+	MDB_meta *meta;
+	unsigned int i, nr, flags = txn->mt_flags;
+	uint16_t x;
+	int rc, new_notls = 0;
+
+	if ((flags &= MDB_TXN_RDONLY) != 0) {
+		if (!ti) {
+			meta = mdb_env_pick_meta(env);
+			txn->mt_txnid = meta->mm_txnid;
+			txn->mt_u.reader = NULL;
+		} else {
+			MDB_reader *r = (env->me_flags & MDB_NOTLS) ? txn->mt_u.reader :
+				pthread_getspecific(env->me_txkey);
+			if (r) {
+				if (r->mr_pid != env->me_pid || r->mr_txnid != (txnid_t)-1)
+					return MDB_BAD_RSLOT;
+			} else {
+				MDB_PID_T pid = env->me_pid;
+				MDB_THR_T tid = pthread_self();
+				mdb_mutexref_t rmutex = env->me_rmutex;
+
+				if (!env->me_live_reader) {
+					rc = mdb_reader_pid(env, Pidset, pid);
+					if (rc)
+						return rc;
+					env->me_live_reader = 1;
+				}
+
+				if (LOCK_MUTEX(rc, env, rmutex))
+					return rc;
+				nr = ti->mti_numreaders;
+				for (i=0; i<nr; i++)
+					if (ti->mti_readers[i].mr_pid == 0)
+						break;
+				if (i == env->me_maxreaders) {
+					UNLOCK_MUTEX(rmutex);
+					return MDB_READERS_FULL;
+				}
+				r = &ti->mti_readers[i];
+				/* Claim the reader slot, carefully since other code
+				 * uses the reader table un-mutexed: First reset the
+				 * slot, next publish it in mti_numreaders.  After
+				 * that, it is safe for mdb_env_close() to touch it.
+				 * When it will be closed, we can finally claim it.
+				 */
+				r->mr_pid = 0;
+				r->mr_txnid = (txnid_t)-1;
+				r->mr_tid = tid;
+				if (i == nr)
+					ti->mti_numreaders = ++nr;
+				env->me_close_readers = nr;
+				r->mr_pid = pid;
+				UNLOCK_MUTEX(rmutex);
+
+				new_notls = (env->me_flags & MDB_NOTLS);
+				if (!new_notls && (rc=pthread_setspecific(env->me_txkey, r))) {
+					r->mr_pid = 0;
+					return rc;
+				}
+			}
+			do /* LY: Retry on a race, ITS#7970. */
+				r->mr_txnid = ti->mti_txnid;
+			while(r->mr_txnid != ti->mti_txnid);
+			txn->mt_txnid = r->mr_txnid;
+			txn->mt_u.reader = r;
+			meta = env->me_metas[txn->mt_txnid & 1];
+		}
+
+	} else {
+		/* Not yet touching txn == env->me_txn0, it may be active */
+		if (ti) {
+			if (LOCK_MUTEX(rc, env, env->me_wmutex))
+				return rc;
+			txn->mt_txnid = ti->mti_txnid;
+			meta = env->me_metas[txn->mt_txnid & 1];
+		} else {
+			meta = mdb_env_pick_meta(env);
+			txn->mt_txnid = meta->mm_txnid;
+		}
+		txn->mt_txnid++;
+#if MDB_DEBUG
+		if (txn->mt_txnid == mdb_debug_start)
+			mdb_debug = 1;
+#endif
+		txn->mt_child = NULL;
+		txn->mt_loose_pgs = NULL;
+		txn->mt_loose_count = 0;
+		txn->mt_dirty_room = MDB_IDL_UM_MAX;
+		txn->mt_u.dirty_list = env->me_dirty_list;
+		txn->mt_u.dirty_list[0].mid = 0;
+		txn->mt_free_pgs = env->me_free_pgs;
+		txn->mt_free_pgs[0] = 0;
+		txn->mt_spill_pgs = NULL;
+		env->me_txn = txn;
+		memcpy(txn->mt_dbiseqs, env->me_dbiseqs, env->me_maxdbs * sizeof(unsigned int));
+	}
+
+	/* Copy the DB info and flags */
+	memcpy(txn->mt_dbs, meta->mm_dbs, CORE_DBS * sizeof(MDB_db));
+
+	/* Moved to here to avoid a data race in read TXNs */
+	txn->mt_next_pgno = meta->mm_last_pg+1;
+#ifdef MDB_VL32
+	txn->mt_last_pgno = txn->mt_next_pgno - 1;
+#endif
+
+	txn->mt_flags = flags;
+
+	/* Setup db info */
+	txn->mt_numdbs = env->me_numdbs;
+	for (i=CORE_DBS; i<txn->mt_numdbs; i++) {
+		x = env->me_dbflags[i];
+		txn->mt_dbs[i].md_flags = x & PERSISTENT_FLAGS;
+		txn->mt_dbflags[i] = (x & MDB_VALID) ? DB_VALID|DB_USRVALID|DB_STALE : 0;
+	}
+	txn->mt_dbflags[MAIN_DBI] = DB_VALID|DB_USRVALID;
+	txn->mt_dbflags[FREE_DBI] = DB_VALID;
+
+	if (env->me_flags & MDB_FATAL_ERROR) {
+		DPUTS("environment had fatal error, must shutdown!");
+		rc = MDB_PANIC;
+	} else if (env->me_maxpg < txn->mt_next_pgno) {
+		rc = MDB_MAP_RESIZED;
+	} else {
+		return MDB_SUCCESS;
+	}
+	mdb_txn_end(txn, new_notls /*0 or MDB_END_SLOT*/ | MDB_END_FAIL_BEGIN);
+	return rc;
+}
+
+int
+mdb_txn_renew(MDB_txn *txn)
+{
+	int rc;
+
+	if (!txn || !F_ISSET(txn->mt_flags, MDB_TXN_RDONLY|MDB_TXN_FINISHED))
+		return EINVAL;
+
+	rc = mdb_txn_renew0(txn);
+	if (rc == MDB_SUCCESS) {
+		DPRINTF(("renew txn %"Yu"%c %p on mdbenv %p, root page %"Yu,
+			txn->mt_txnid, (txn->mt_flags & MDB_TXN_RDONLY) ? 'r' : 'w',
+			(void *)txn, (void *)txn->mt_env, txn->mt_dbs[MAIN_DBI].md_root));
+	}
+	return rc;
+}
+
+int
+mdb_txn_begin(MDB_env *env, MDB_txn *parent, unsigned int flags, MDB_txn **ret)
+{
+	MDB_txn *txn;
+	MDB_ntxn *ntxn;
+	int rc, size, tsize;
+
+	flags &= MDB_TXN_BEGIN_FLAGS;
+	flags |= env->me_flags & MDB_WRITEMAP;
+
+	if (env->me_flags & MDB_RDONLY & ~flags) /* write txn in RDONLY env */
+		return EACCES;
+
+	if (parent) {
+		/* Nested transactions: Max 1 child, write txns only, no writemap */
+		flags |= parent->mt_flags;
+		if (flags & (MDB_RDONLY|MDB_WRITEMAP|MDB_TXN_BLOCKED)) {
+			return (parent->mt_flags & MDB_TXN_RDONLY) ? EINVAL : MDB_BAD_TXN;
+		}
+		/* Child txns save MDB_pgstate and use own copy of cursors */
+		size = env->me_maxdbs * (sizeof(MDB_db)+sizeof(MDB_cursor *)+1);
+		size += tsize = sizeof(MDB_ntxn);
+	} else if (flags & MDB_RDONLY) {
+		size = env->me_maxdbs * (sizeof(MDB_db)+1);
+		size += tsize = sizeof(MDB_txn);
+	} else {
+		/* Reuse preallocated write txn. However, do not touch it until
+		 * mdb_txn_renew0() succeeds, since it currently may be active.
+		 */
+		txn = env->me_txn0;
+		goto renew;
+	}
+	if ((txn = calloc(1, size)) == NULL) {
+		DPRINTF(("calloc: %s", strerror(errno)));
+		return ENOMEM;
+	}
+#ifdef MDB_VL32
+	if (!parent) {
+		txn->mt_rpages = malloc(MDB_TRPAGE_SIZE * sizeof(MDB_ID3));
+		if (!txn->mt_rpages) {
+			free(txn);
+			return ENOMEM;
+		}
+		txn->mt_rpages[0].mid = 0;
+		txn->mt_rpcheck = MDB_TRPAGE_SIZE/2;
+	}
+#endif
+	txn->mt_dbxs = env->me_dbxs;	/* static */
+	txn->mt_dbs = (MDB_db *) ((char *)txn + tsize);
+	txn->mt_dbflags = (unsigned char *)txn + size - env->me_maxdbs;
+	txn->mt_flags = flags;
+	txn->mt_env = env;
+
+	if (parent) {
+		unsigned int i;
+		txn->mt_cursors = (MDB_cursor **)(txn->mt_dbs + env->me_maxdbs);
+		txn->mt_dbiseqs = parent->mt_dbiseqs;
+		txn->mt_u.dirty_list = malloc(sizeof(MDB_ID2)*MDB_IDL_UM_SIZE);
+		if (!txn->mt_u.dirty_list ||
+			!(txn->mt_free_pgs = mdb_midl_alloc(MDB_IDL_UM_MAX)))
+		{
+			free(txn->mt_u.dirty_list);
+			free(txn);
+			return ENOMEM;
+		}
+		txn->mt_txnid = parent->mt_txnid;
+		txn->mt_dirty_room = parent->mt_dirty_room;
+		txn->mt_u.dirty_list[0].mid = 0;
+		txn->mt_spill_pgs = NULL;
+		txn->mt_next_pgno = parent->mt_next_pgno;
+		parent->mt_flags |= MDB_TXN_HAS_CHILD;
+		parent->mt_child = txn;
+		txn->mt_parent = parent;
+		txn->mt_numdbs = parent->mt_numdbs;
+#ifdef MDB_VL32
+		txn->mt_rpages = parent->mt_rpages;
+#endif
+		memcpy(txn->mt_dbs, parent->mt_dbs, txn->mt_numdbs * sizeof(MDB_db));
+		/* Copy parent's mt_dbflags, but clear DB_NEW */
+		for (i=0; i<txn->mt_numdbs; i++)
+			txn->mt_dbflags[i] = parent->mt_dbflags[i] & ~DB_NEW;
+		rc = 0;
+		ntxn = (MDB_ntxn *)txn;
+		ntxn->mnt_pgstate = env->me_pgstate; /* save parent me_pghead & co */
+		if (env->me_pghead) {
+			size = MDB_IDL_SIZEOF(env->me_pghead);
+			env->me_pghead = mdb_midl_alloc(env->me_pghead[0]);
+			if (env->me_pghead)
+				memcpy(env->me_pghead, ntxn->mnt_pgstate.mf_pghead, size);
+			else
+				rc = ENOMEM;
+		}
+		if (!rc)
+			rc = mdb_cursor_shadow(parent, txn);
+		if (rc)
+			mdb_txn_end(txn, MDB_END_FAIL_BEGINCHILD);
+	} else { /* MDB_RDONLY */
+		txn->mt_dbiseqs = env->me_dbiseqs;
+renew:
+		rc = mdb_txn_renew0(txn);
+	}
+	if (rc) {
+		if (txn != env->me_txn0) {
+#ifdef MDB_VL32
+			free(txn->mt_rpages);
+#endif
+			free(txn);
+		}
+	} else {
+		txn->mt_flags |= flags;	/* could not change txn=me_txn0 earlier */
+		*ret = txn;
+		DPRINTF(("begin txn %"Yu"%c %p on mdbenv %p, root page %"Yu,
+			txn->mt_txnid, (flags & MDB_RDONLY) ? 'r' : 'w',
+			(void *) txn, (void *) env, txn->mt_dbs[MAIN_DBI].md_root));
+	}
+
+	return rc;
+}
+
+MDB_env *
+mdb_txn_env(MDB_txn *txn)
+{
+	if(!txn) return NULL;
+	return txn->mt_env;
+}
+
+mdb_size_t
+mdb_txn_id(MDB_txn *txn)
+{
+    if(!txn) return 0;
+    return txn->mt_txnid;
+}
+
+/** Export or close DBI handles opened in this txn. */
+static void
+mdb_dbis_update(MDB_txn *txn, int keep)
+{
+	int i;
+	MDB_dbi n = txn->mt_numdbs;
+	MDB_env *env = txn->mt_env;
+	unsigned char *tdbflags = txn->mt_dbflags;
+
+	for (i = n; --i >= CORE_DBS;) {
+		if (tdbflags[i] & DB_NEW) {
+			if (keep) {
+				env->me_dbflags[i] = txn->mt_dbs[i].md_flags | MDB_VALID;
+			} else {
+				char *ptr = env->me_dbxs[i].md_name.mv_data;
+				if (ptr) {
+					env->me_dbxs[i].md_name.mv_data = NULL;
+					env->me_dbxs[i].md_name.mv_size = 0;
+					env->me_dbflags[i] = 0;
+					env->me_dbiseqs[i]++;
+					free(ptr);
+				}
+			}
+		}
+	}
+	if (keep && env->me_numdbs < n)
+		env->me_numdbs = n;
+}
+
+/** End a transaction, except successful commit of a nested transaction.
+ * May be called twice for readonly txns: First reset it, then abort.
+ * @param[in] txn the transaction handle to end
+ * @param[in] mode why and how to end the transaction
+ */
+static void
+mdb_txn_end(MDB_txn *txn, unsigned mode)
+{
+	MDB_env	*env = txn->mt_env;
+#if MDB_DEBUG
+	static const char *const names[] = MDB_END_NAMES;
+#endif
+
+	/* Export or close DBI handles opened in this txn */
+	mdb_dbis_update(txn, mode & MDB_END_UPDATE);
+
+	DPRINTF(("%s txn %"Yu"%c %p on mdbenv %p, root page %"Yu,
+		names[mode & MDB_END_OPMASK],
+		txn->mt_txnid, (txn->mt_flags & MDB_TXN_RDONLY) ? 'r' : 'w',
+		(void *) txn, (void *)env, txn->mt_dbs[MAIN_DBI].md_root));
+
+	if (F_ISSET(txn->mt_flags, MDB_TXN_RDONLY)) {
+		if (txn->mt_u.reader) {
+			txn->mt_u.reader->mr_txnid = (txnid_t)-1;
+			if (!(env->me_flags & MDB_NOTLS)) {
+				txn->mt_u.reader = NULL; /* txn does not own reader */
+			} else if (mode & MDB_END_SLOT) {
+				txn->mt_u.reader->mr_pid = 0;
+				txn->mt_u.reader = NULL;
+			} /* else txn owns the slot until it does MDB_END_SLOT */
+		}
+		txn->mt_numdbs = 0;		/* prevent further DBI activity */
+		txn->mt_flags |= MDB_TXN_FINISHED;
+
+	} else if (!F_ISSET(txn->mt_flags, MDB_TXN_FINISHED)) {
+		pgno_t *pghead = env->me_pghead;
+
+		if (!(mode & MDB_END_UPDATE)) /* !(already closed cursors) */
+			mdb_cursors_close(txn, 0);
+		if (!(env->me_flags & MDB_WRITEMAP)) {
+			mdb_dlist_free(txn);
+		}
+
+		txn->mt_numdbs = 0;
+		txn->mt_flags = MDB_TXN_FINISHED;
+
+		if (!txn->mt_parent) {
+			mdb_midl_shrink(&txn->mt_free_pgs);
+			env->me_free_pgs = txn->mt_free_pgs;
+			/* me_pgstate: */
+			env->me_pghead = NULL;
+			env->me_pglast = 0;
+
+			env->me_txn = NULL;
+			mode = 0;	/* txn == env->me_txn0, do not free() it */
+
+			/* The writer mutex was locked in mdb_txn_begin. */
+			if (env->me_txns)
+				UNLOCK_MUTEX(env->me_wmutex);
+		} else {
+			txn->mt_parent->mt_child = NULL;
+			txn->mt_parent->mt_flags &= ~MDB_TXN_HAS_CHILD;
+			env->me_pgstate = ((MDB_ntxn *)txn)->mnt_pgstate;
+			mdb_midl_free(txn->mt_free_pgs);
+			mdb_midl_free(txn->mt_spill_pgs);
+			free(txn->mt_u.dirty_list);
+		}
+
+		mdb_midl_free(pghead);
+	}
+#ifdef MDB_VL32
+	if (!txn->mt_parent) {
+		MDB_ID3L el = env->me_rpages, tl = txn->mt_rpages;
+		unsigned i, x, n = tl[0].mid;
+		pthread_mutex_lock(&env->me_rpmutex);
+		for (i = 1; i <= n; i++) {
+			if (tl[i].mid & (MDB_RPAGE_CHUNK-1)) {
+				/* tmp overflow pages that we didn't share in env */
+				munmap(tl[i].mptr, tl[i].mcnt * env->me_psize);
+			} else {
+				x = mdb_mid3l_search(el, tl[i].mid);
+				if (tl[i].mptr == el[x].mptr) {
+					el[x].mref--;
+				} else {
+					/* another tmp overflow page */
+					munmap(tl[i].mptr, tl[i].mcnt * env->me_psize);
+				}
+			}
+		}
+		pthread_mutex_unlock(&env->me_rpmutex);
+		tl[0].mid = 0;
+		if (mode & MDB_END_FREE)
+			free(tl);
+	}
+#endif
+	if (mode & MDB_END_FREE)
+		free(txn);
+}
+
+void
+mdb_txn_reset(MDB_txn *txn)
+{
+	if (txn == NULL)
+		return;
+
+	/* This call is only valid for read-only txns */
+	if (!(txn->mt_flags & MDB_TXN_RDONLY))
+		return;
+
+	mdb_txn_end(txn, MDB_END_RESET);
+}
+
+void
+mdb_txn_abort(MDB_txn *txn)
+{
+	if (txn == NULL)
+		return;
+
+	if (txn->mt_child)
+		mdb_txn_abort(txn->mt_child);
+
+	mdb_txn_end(txn, MDB_END_ABORT|MDB_END_SLOT|MDB_END_FREE);
+}
+
+/** Save the freelist as of this transaction to the freeDB.
+ * This changes the freelist. Keep trying until it stabilizes.
+ *
+ * When (MDB_DEVEL) & 2, the changes do not affect #mdb_page_alloc(),
+ * it then uses the transaction's original snapshot of the freeDB.
+ */
+static int
+mdb_freelist_save(MDB_txn *txn)
+{
+	/* env->me_pghead[] can grow and shrink during this call.
+	 * env->me_pglast and txn->mt_free_pgs[] can only grow.
+	 * Page numbers cannot disappear from txn->mt_free_pgs[].
+	 */
+	MDB_cursor mc;
+	MDB_env	*env = txn->mt_env;
+	int rc, maxfree_1pg = env->me_maxfree_1pg, more = 1;
+	txnid_t	pglast = 0, head_id = 0;
+	pgno_t	freecnt = 0, *free_pgs, *mop;
+	ssize_t	head_room = 0, total_room = 0, mop_len, clean_limit;
+
+	mdb_cursor_init(&mc, txn, FREE_DBI, NULL);
+
+	if (env->me_pghead) {
+		/* Make sure first page of freeDB is touched and on freelist */
+		rc = mdb_page_search(&mc, NULL, MDB_PS_FIRST|MDB_PS_MODIFY);
+		if (rc && rc != MDB_NOTFOUND)
+			return rc;
+	}
+
+	if (!env->me_pghead && txn->mt_loose_pgs) {
+		/* Put loose page numbers in mt_free_pgs, since
+		 * we may be unable to return them to me_pghead.
+		 */
+		MDB_page *mp = txn->mt_loose_pgs;
+		if ((rc = mdb_midl_need(&txn->mt_free_pgs, txn->mt_loose_count)) != 0)
+			return rc;
+		for (; mp; mp = NEXT_LOOSE_PAGE(mp))
+			mdb_midl_xappend(txn->mt_free_pgs, mp->mp_pgno);
+		txn->mt_loose_pgs = NULL;
+		txn->mt_loose_count = 0;
+	}
+
+	/* MDB_RESERVE cancels meminit in ovpage malloc (when no WRITEMAP) */
+	clean_limit = (env->me_flags & (MDB_NOMEMINIT|MDB_WRITEMAP))
+		? SSIZE_MAX : maxfree_1pg;
+
+	for (;;) {
+		/* Come back here after each Put() in case freelist changed */
+		MDB_val key, data;
+		pgno_t *pgs;
+		ssize_t j;
+
+		/* If using records from freeDB which we have not yet
+		 * deleted, delete them and any we reserved for me_pghead.
+		 */
+		while (pglast < env->me_pglast) {
+			rc = mdb_cursor_first(&mc, &key, NULL);
+			if (rc)
+				return rc;
+			pglast = head_id = *(txnid_t *)key.mv_data;
+			total_room = head_room = 0;
+			mdb_tassert(txn, pglast <= env->me_pglast);
+			rc = mdb_cursor_del(&mc, 0);
+			if (rc)
+				return rc;
+		}
+
+		/* Save the IDL of pages freed by this txn, to a single record */
+		if (freecnt < txn->mt_free_pgs[0]) {
+			if (!freecnt) {
+				/* Make sure last page of freeDB is touched and on freelist */
+				rc = mdb_page_search(&mc, NULL, MDB_PS_LAST|MDB_PS_MODIFY);
+				if (rc && rc != MDB_NOTFOUND)
+					return rc;
+			}
+			free_pgs = txn->mt_free_pgs;
+			/* Write to last page of freeDB */
+			key.mv_size = sizeof(txn->mt_txnid);
+			key.mv_data = &txn->mt_txnid;
+			do {
+				freecnt = free_pgs[0];
+				data.mv_size = MDB_IDL_SIZEOF(free_pgs);
+				rc = mdb_cursor_put(&mc, &key, &data, MDB_RESERVE);
+				if (rc)
+					return rc;
+				/* Retry if mt_free_pgs[] grew during the Put() */
+				free_pgs = txn->mt_free_pgs;
+			} while (freecnt < free_pgs[0]);
+			mdb_midl_sort(free_pgs);
+			memcpy(data.mv_data, free_pgs, data.mv_size);
+#if (MDB_DEBUG) > 1
+			{
+				unsigned int i = free_pgs[0];
+				DPRINTF(("IDL write txn %"Yu" root %"Yu" num %u",
+					txn->mt_txnid, txn->mt_dbs[FREE_DBI].md_root, i));
+				for (; i; i--)
+					DPRINTF(("IDL %"Yu, free_pgs[i]));
+			}
+#endif
+			continue;
+		}
+
+		mop = env->me_pghead;
+		mop_len = (mop ? mop[0] : 0) + txn->mt_loose_count;
+
+		/* Reserve records for me_pghead[]. Split it if multi-page,
+		 * to avoid searching freeDB for a page range. Use keys in
+		 * range [1,me_pglast]: Smaller than txnid of oldest reader.
+		 */
+		if (total_room >= mop_len) {
+			if (total_room == mop_len || --more < 0)
+				break;
+		} else if (head_room >= maxfree_1pg && head_id > 1) {
+			/* Keep current record (overflow page), add a new one */
+			head_id--;
+			head_room = 0;
+		}
+		/* (Re)write {key = head_id, IDL length = head_room} */
+		total_room -= head_room;
+		head_room = mop_len - total_room;
+		if (head_room > maxfree_1pg && head_id > 1) {
+			/* Overflow multi-page for part of me_pghead */
+			head_room /= head_id; /* amortize page sizes */
+			head_room += maxfree_1pg - head_room % (maxfree_1pg + 1);
+		} else if (head_room < 0) {
+			/* Rare case, not bothering to delete this record */
+			head_room = 0;
+		}
+		key.mv_size = sizeof(head_id);
+		key.mv_data = &head_id;
+		data.mv_size = (head_room + 1) * sizeof(pgno_t);
+		rc = mdb_cursor_put(&mc, &key, &data, MDB_RESERVE);
+		if (rc)
+			return rc;
+		/* IDL is initially empty, zero out at least the length */
+		pgs = (pgno_t *)data.mv_data;
+		j = head_room > clean_limit ? head_room : 0;
+		do {
+			pgs[j] = 0;
+		} while (--j >= 0);
+		total_room += head_room;
+	}
+
+	/* Return loose page numbers to me_pghead, though usually none are
+	 * left at this point.  The pages themselves remain in dirty_list.
+	 */
+	if (txn->mt_loose_pgs) {
+		MDB_page *mp = txn->mt_loose_pgs;
+		unsigned count = txn->mt_loose_count;
+		MDB_IDL loose;
+		/* Room for loose pages + temp IDL with same */
+		if ((rc = mdb_midl_need(&env->me_pghead, 2*count+1)) != 0)
+			return rc;
+		mop = env->me_pghead;
+		loose = mop + MDB_IDL_ALLOCLEN(mop) - count;
+		for (count = 0; mp; mp = NEXT_LOOSE_PAGE(mp))
+			loose[ ++count ] = mp->mp_pgno;
+		loose[0] = count;
+		mdb_midl_sort(loose);
+		mdb_midl_xmerge(mop, loose);
+		txn->mt_loose_pgs = NULL;
+		txn->mt_loose_count = 0;
+		mop_len = mop[0];
+	}
+
+	/* Fill in the reserved me_pghead records */
+	rc = MDB_SUCCESS;
+	if (mop_len) {
+		MDB_val key, data;
+
+		mop += mop_len;
+		rc = mdb_cursor_first(&mc, &key, &data);
+		for (; !rc; rc = mdb_cursor_next(&mc, &key, &data, MDB_NEXT)) {
+			txnid_t id = *(txnid_t *)key.mv_data;
+			ssize_t	len = (ssize_t)(data.mv_size / sizeof(MDB_ID)) - 1;
+			MDB_ID save;
+
+			mdb_tassert(txn, len >= 0 && id <= env->me_pglast);
+			key.mv_data = &id;
+			if (len > mop_len) {
+				len = mop_len;
+				data.mv_size = (len + 1) * sizeof(MDB_ID);
+			}
+			data.mv_data = mop -= len;
+			save = mop[0];
+			mop[0] = len;
+			rc = mdb_cursor_put(&mc, &key, &data, MDB_CURRENT);
+			mop[0] = save;
+			if (rc || !(mop_len -= len))
+				break;
+		}
+	}
+	return rc;
+}
+
+/** Flush (some) dirty pages to the map, after clearing their dirty flag.
+ * @param[in] txn the transaction that's being committed
+ * @param[in] keep number of initial pages in dirty_list to keep dirty.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_flush(MDB_txn *txn, int keep)
+{
+	MDB_env		*env = txn->mt_env;
+	MDB_ID2L	dl = txn->mt_u.dirty_list;
+	unsigned	psize = env->me_psize, j;
+	int			i, pagecount = dl[0].mid, rc;
+	size_t		size = 0;
+	off_t		pos = 0;
+	pgno_t		pgno = 0;
+	MDB_page	*dp = NULL;
+#ifdef _WIN32
+	OVERLAPPED	ov;
+#else
+	struct iovec iov[MDB_COMMIT_PAGES];
+	ssize_t		wsize = 0, wres;
+	off_t		wpos = 0, next_pos = 1; /* impossible pos, so pos != next_pos */
+	int			n = 0;
+#endif
+
+	j = i = keep;
+
+	if (env->me_flags & MDB_WRITEMAP) {
+		/* Clear dirty flags */
+		while (++i <= pagecount) {
+			dp = dl[i].mptr;
+			/* Don't flush this page yet */
+			if (dp->mp_flags & (P_LOOSE|P_KEEP)) {
+				dp->mp_flags &= ~P_KEEP;
+				dl[++j] = dl[i];
+				continue;
+			}
+			dp->mp_flags &= ~P_DIRTY;
+		}
+		goto done;
+	}
+
+	/* Write the pages */
+	for (;;) {
+		if (++i <= pagecount) {
+			dp = dl[i].mptr;
+			/* Don't flush this page yet */
+			if (dp->mp_flags & (P_LOOSE|P_KEEP)) {
+				dp->mp_flags &= ~P_KEEP;
+				dl[i].mid = 0;
+				continue;
+			}
+			pgno = dl[i].mid;
+			/* clear dirty flag */
+			dp->mp_flags &= ~P_DIRTY;
+			pos = pgno * psize;
+			size = psize;
+			if (IS_OVERFLOW(dp)) size *= dp->mp_pages;
+		}
+#ifdef _WIN32
+		else break;
+
+		/* Windows actually supports scatter/gather I/O, but only on
+		 * unbuffered file handles. Since we're relying on the OS page
+		 * cache for all our data, that's self-defeating. So we just
+		 * write pages one at a time. We use the ov structure to set
+		 * the write offset, to at least save the overhead of a Seek
+		 * system call.
+		 */
+		DPRINTF(("committing page %"Yu, pgno));
+		memset(&ov, 0, sizeof(ov));
+		ov.Offset = pos & 0xffffffff;
+		ov.OffsetHigh = pos >> 16 >> 16;
+		if (!WriteFile(env->me_fd, dp, size, NULL, &ov)) {
+			rc = ErrCode();
+			DPRINTF(("WriteFile: %d", rc));
+			return rc;
+		}
+#else
+		/* Write up to MDB_COMMIT_PAGES dirty pages at a time. */
+		if (pos!=next_pos || n==MDB_COMMIT_PAGES || wsize+size>MAX_WRITE) {
+			if (n) {
+retry_write:
+				/* Write previous page(s) */
+#ifdef MDB_USE_PWRITEV
+				wres = pwritev(env->me_fd, iov, n, wpos);
+#else
+				if (n == 1) {
+					wres = pwrite(env->me_fd, iov[0].iov_base, wsize, wpos);
+				} else {
+retry_seek:
+					if (lseek(env->me_fd, wpos, SEEK_SET) == -1) {
+						rc = ErrCode();
+						if (rc == EINTR)
+							goto retry_seek;
+						DPRINTF(("lseek: %s", strerror(rc)));
+						return rc;
+					}
+					wres = writev(env->me_fd, iov, n);
+				}
+#endif
+				if (wres != wsize) {
+					if (wres < 0) {
+						rc = ErrCode();
+						if (rc == EINTR)
+							goto retry_write;
+						DPRINTF(("Write error: %s", strerror(rc)));
+					} else {
+						rc = EIO; /* TODO: Use which error code? */
+						DPUTS("short write, filesystem full?");
+					}
+					return rc;
+				}
+				n = 0;
+			}
+			if (i > pagecount)
+				break;
+			wpos = pos;
+			wsize = 0;
+		}
+		DPRINTF(("committing page %"Yu, pgno));
+		next_pos = pos + size;
+		iov[n].iov_len = size;
+		iov[n].iov_base = (char *)dp;
+		wsize += size;
+		n++;
+#endif	/* _WIN32 */
+	}
+#ifdef MDB_VL32
+	if (pgno > txn->mt_last_pgno)
+		txn->mt_last_pgno = pgno;
+#endif
+
+	/* MIPS has cache coherency issues, this is a no-op everywhere else
+	 * Note: for any size >= on-chip cache size, entire on-chip cache is
+	 * flushed.
+	 */
+	CACHEFLUSH(env->me_map, txn->mt_next_pgno * env->me_psize, DCACHE);
+
+	for (i = keep; ++i <= pagecount; ) {
+		dp = dl[i].mptr;
+		/* This is a page we skipped above */
+		if (!dl[i].mid) {
+			dl[++j] = dl[i];
+			dl[j].mid = dp->mp_pgno;
+			continue;
+		}
+		mdb_dpage_free(env, dp);
+	}
+
+done:
+	i--;
+	txn->mt_dirty_room += i - j;
+	dl[0].mid = j;
+	return MDB_SUCCESS;
+}
+
+int
+mdb_txn_commit(MDB_txn *txn)
+{
+	int		rc;
+	unsigned int i, end_mode;
+	MDB_env	*env;
+
+	if (txn == NULL)
+		return EINVAL;
+
+	/* mdb_txn_end() mode for a commit which writes nothing */
+	end_mode = MDB_END_EMPTY_COMMIT|MDB_END_UPDATE|MDB_END_SLOT|MDB_END_FREE;
+
+	if (txn->mt_child) {
+		rc = mdb_txn_commit(txn->mt_child);
+		if (rc)
+			goto fail;
+	}
+
+	env = txn->mt_env;
+
+	if (F_ISSET(txn->mt_flags, MDB_TXN_RDONLY)) {
+		goto done;
+	}
+
+	if (txn->mt_flags & (MDB_TXN_FINISHED|MDB_TXN_ERROR)) {
+		DPUTS("txn has failed/finished, can't commit");
+		if (txn->mt_parent)
+			txn->mt_parent->mt_flags |= MDB_TXN_ERROR;
+		rc = MDB_BAD_TXN;
+		goto fail;
+	}
+
+	if (txn->mt_parent) {
+		MDB_txn *parent = txn->mt_parent;
+		MDB_page **lp;
+		MDB_ID2L dst, src;
+		MDB_IDL pspill;
+		unsigned x, y, len, ps_len;
+
+		/* Append our free list to parent's */
+		rc = mdb_midl_append_list(&parent->mt_free_pgs, txn->mt_free_pgs);
+		if (rc)
+			goto fail;
+		mdb_midl_free(txn->mt_free_pgs);
+		/* Failures after this must either undo the changes
+		 * to the parent or set MDB_TXN_ERROR in the parent.
+		 */
+
+		parent->mt_next_pgno = txn->mt_next_pgno;
+		parent->mt_flags = txn->mt_flags;
+
+		/* Merge our cursors into parent's and close them */
+		mdb_cursors_close(txn, 1);
+
+		/* Update parent's DB table. */
+		memcpy(parent->mt_dbs, txn->mt_dbs, txn->mt_numdbs * sizeof(MDB_db));
+		parent->mt_numdbs = txn->mt_numdbs;
+		parent->mt_dbflags[FREE_DBI] = txn->mt_dbflags[FREE_DBI];
+		parent->mt_dbflags[MAIN_DBI] = txn->mt_dbflags[MAIN_DBI];
+		for (i=CORE_DBS; i<txn->mt_numdbs; i++) {
+			/* preserve parent's DB_NEW status */
+			x = parent->mt_dbflags[i] & DB_NEW;
+			parent->mt_dbflags[i] = txn->mt_dbflags[i] | x;
+		}
+
+		dst = parent->mt_u.dirty_list;
+		src = txn->mt_u.dirty_list;
+		/* Remove anything in our dirty list from parent's spill list */
+		if ((pspill = parent->mt_spill_pgs) && (ps_len = pspill[0])) {
+			x = y = ps_len;
+			pspill[0] = (pgno_t)-1;
+			/* Mark our dirty pages as deleted in parent spill list */
+			for (i=0, len=src[0].mid; ++i <= len; ) {
+				MDB_ID pn = src[i].mid << 1;
+				while (pn > pspill[x])
+					x--;
+				if (pn == pspill[x]) {
+					pspill[x] = 1;
+					y = --x;
+				}
+			}
+			/* Squash deleted pagenums if we deleted any */
+			for (x=y; ++x <= ps_len; )
+				if (!(pspill[x] & 1))
+					pspill[++y] = pspill[x];
+			pspill[0] = y;
+		}
+
+		/* Remove anything in our spill list from parent's dirty list */
+		if (txn->mt_spill_pgs && txn->mt_spill_pgs[0]) {
+			for (i=1; i<=txn->mt_spill_pgs[0]; i++) {
+				MDB_ID pn = txn->mt_spill_pgs[i];
+				if (pn & 1)
+					continue;	/* deleted spillpg */
+				pn >>= 1;
+				y = mdb_mid2l_search(dst, pn);
+				if (y <= dst[0].mid && dst[y].mid == pn) {
+					free(dst[y].mptr);
+					while (y < dst[0].mid) {
+						dst[y] = dst[y+1];
+						y++;
+					}
+					dst[0].mid--;
+				}
+			}
+		}
+
+		/* Find len = length of merging our dirty list with parent's */
+		x = dst[0].mid;
+		dst[0].mid = 0;		/* simplify loops */
+		if (parent->mt_parent) {
+			len = x + src[0].mid;
+			y = mdb_mid2l_search(src, dst[x].mid + 1) - 1;
+			for (i = x; y && i; y--) {
+				pgno_t yp = src[y].mid;
+				while (yp < dst[i].mid)
+					i--;
+				if (yp == dst[i].mid) {
+					i--;
+					len--;
+				}
+			}
+		} else { /* Simplify the above for single-ancestor case */
+			len = MDB_IDL_UM_MAX - txn->mt_dirty_room;
+		}
+		/* Merge our dirty list with parent's */
+		y = src[0].mid;
+		for (i = len; y; dst[i--] = src[y--]) {
+			pgno_t yp = src[y].mid;
+			while (yp < dst[x].mid)
+				dst[i--] = dst[x--];
+			if (yp == dst[x].mid)
+				free(dst[x--].mptr);
+		}
+		mdb_tassert(txn, i == x);
+		dst[0].mid = len;
+		free(txn->mt_u.dirty_list);
+		parent->mt_dirty_room = txn->mt_dirty_room;
+		if (txn->mt_spill_pgs) {
+			if (parent->mt_spill_pgs) {
+				/* TODO: Prevent failure here, so parent does not fail */
+				rc = mdb_midl_append_list(&parent->mt_spill_pgs, txn->mt_spill_pgs);
+				if (rc)
+					parent->mt_flags |= MDB_TXN_ERROR;
+				mdb_midl_free(txn->mt_spill_pgs);
+				mdb_midl_sort(parent->mt_spill_pgs);
+			} else {
+				parent->mt_spill_pgs = txn->mt_spill_pgs;
+			}
+		}
+
+		/* Append our loose page list to parent's */
+		for (lp = &parent->mt_loose_pgs; *lp; lp = &NEXT_LOOSE_PAGE(*lp))
+			;
+		*lp = txn->mt_loose_pgs;
+		parent->mt_loose_count += txn->mt_loose_count;
+
+		parent->mt_child = NULL;
+		mdb_midl_free(((MDB_ntxn *)txn)->mnt_pgstate.mf_pghead);
+		free(txn);
+		return rc;
+	}
+
+	if (txn != env->me_txn) {
+		DPUTS("attempt to commit unknown transaction");
+		rc = EINVAL;
+		goto fail;
+	}
+
+	mdb_cursors_close(txn, 0);
+
+	if (!txn->mt_u.dirty_list[0].mid &&
+		!(txn->mt_flags & (MDB_TXN_DIRTY|MDB_TXN_SPILLS)))
+		goto done;
+
+	DPRINTF(("committing txn %"Yu" %p on mdbenv %p, root page %"Yu,
+	    txn->mt_txnid, (void*)txn, (void*)env, txn->mt_dbs[MAIN_DBI].md_root));
+
+	/* Update DB root pointers */
+	if (txn->mt_numdbs > CORE_DBS) {
+		MDB_cursor mc;
+		MDB_dbi i;
+		MDB_val data;
+		data.mv_size = sizeof(MDB_db);
+
+		mdb_cursor_init(&mc, txn, MAIN_DBI, NULL);
+		for (i = CORE_DBS; i < txn->mt_numdbs; i++) {
+			if (txn->mt_dbflags[i] & DB_DIRTY) {
+				if (TXN_DBI_CHANGED(txn, i)) {
+					rc = MDB_BAD_DBI;
+					goto fail;
+				}
+				data.mv_data = &txn->mt_dbs[i];
+				rc = mdb_cursor_put(&mc, &txn->mt_dbxs[i].md_name, &data,
+					F_SUBDATA);
+				if (rc)
+					goto fail;
+			}
+		}
+	}
+
+	rc = mdb_freelist_save(txn);
+	if (rc)
+		goto fail;
+
+	mdb_midl_free(env->me_pghead);
+	env->me_pghead = NULL;
+	mdb_midl_shrink(&txn->mt_free_pgs);
+
+#if (MDB_DEBUG) > 2
+	mdb_audit(txn);
+#endif
+
+	if ((rc = mdb_page_flush(txn, 0)))
+		goto fail;
+	if (!F_ISSET(txn->mt_flags, MDB_TXN_NOSYNC) &&
+		(rc = mdb_env_sync0(env, 0, txn->mt_next_pgno)))
+		goto fail;
+	if ((rc = mdb_env_write_meta(txn)))
+		goto fail;
+	end_mode = MDB_END_COMMITTED|MDB_END_UPDATE;
+
+done:
+	mdb_txn_end(txn, end_mode);
+	return MDB_SUCCESS;
+
+fail:
+	mdb_txn_abort(txn);
+	return rc;
+}
+
+/** Read the environment parameters of a DB environment before
+ * mapping it into memory.
+ * @param[in] env the environment handle
+ * @param[in] prev whether to read the backup meta page
+ * @param[out] meta address of where to store the meta information
+ * @return 0 on success, non-zero on failure.
+ */
+static int ESECT
+mdb_env_read_header(MDB_env *env, int prev, MDB_meta *meta)
+{
+	MDB_metabuf	pbuf;
+	MDB_page	*p;
+	MDB_meta	*m;
+	int			i, rc, off;
+	enum { Size = sizeof(pbuf) };
+
+	/* We don't know the page size yet, so use a minimum value.
+	 * Read both meta pages so we can use the latest one.
+	 */
+
+	for (i=off=0; i<NUM_METAS; i++, off += meta->mm_psize) {
+#ifdef _WIN32
+		DWORD len;
+		OVERLAPPED ov;
+		memset(&ov, 0, sizeof(ov));
+		ov.Offset = off;
+		rc = ReadFile(env->me_fd, &pbuf, Size, &len, &ov) ? (int)len : -1;
+		if (rc == -1 && ErrCode() == ERROR_HANDLE_EOF)
+			rc = 0;
+#else
+		rc = pread(env->me_fd, &pbuf, Size, off);
+#endif
+		if (rc != Size) {
+			if (rc == 0 && off == 0)
+				return ENOENT;
+			rc = rc < 0 ? (int) ErrCode() : MDB_INVALID;
+			DPRINTF(("read: %s", mdb_strerror(rc)));
+			return rc;
+		}
+
+		p = (MDB_page *)&pbuf;
+
+		if (!F_ISSET(p->mp_flags, P_META)) {
+			DPRINTF(("page %"Yu" not a meta page", p->mp_pgno));
+			return MDB_INVALID;
+		}
+
+		m = METADATA(p);
+		if (m->mm_magic != MDB_MAGIC) {
+			DPUTS("meta has invalid magic");
+			return MDB_INVALID;
+		}
+
+		if (m->mm_version != MDB_DATA_VERSION) {
+			DPRINTF(("database is version %u, expected version %u",
+				m->mm_version, MDB_DATA_VERSION));
+			return MDB_VERSION_MISMATCH;
+		}
+
+		if (off == 0 || (prev ? m->mm_txnid < meta->mm_txnid : m->mm_txnid > meta->mm_txnid))
+			*meta = *m;
+	}
+	return 0;
+}
+
+/** Fill in most of the zeroed #MDB_meta for an empty database environment */
+static void ESECT
+mdb_env_init_meta0(MDB_env *env, MDB_meta *meta)
+{
+	meta->mm_magic = MDB_MAGIC;
+	meta->mm_version = MDB_DATA_VERSION;
+	meta->mm_mapsize = env->me_mapsize;
+	meta->mm_psize = env->me_psize;
+	meta->mm_last_pg = NUM_METAS-1;
+	meta->mm_flags = env->me_flags & 0xffff;
+	meta->mm_flags |= MDB_INTEGERKEY; /* this is mm_dbs[FREE_DBI].md_flags */
+	meta->mm_dbs[FREE_DBI].md_root = P_INVALID;
+	meta->mm_dbs[MAIN_DBI].md_root = P_INVALID;
+}
+
+/** Write the environment parameters of a freshly created DB environment.
+ * @param[in] env the environment handle
+ * @param[in] meta the #MDB_meta to write
+ * @return 0 on success, non-zero on failure.
+ */
+static int ESECT
+mdb_env_init_meta(MDB_env *env, MDB_meta *meta)
+{
+	MDB_page *p, *q;
+	int rc;
+	unsigned int	 psize;
+#ifdef _WIN32
+	DWORD len;
+	OVERLAPPED ov;
+	memset(&ov, 0, sizeof(ov));
+#define DO_PWRITE(rc, fd, ptr, size, len, pos)	do { \
+	ov.Offset = pos;	\
+	rc = WriteFile(fd, ptr, size, &len, &ov);	} while(0)
+#else
+	int len;
+#define DO_PWRITE(rc, fd, ptr, size, len, pos)	do { \
+	len = pwrite(fd, ptr, size, pos);	\
+	if (len == -1 && ErrCode() == EINTR) continue; \
+	rc = (len >= 0); break; } while(1)
+#endif
+
+	DPUTS("writing new meta page");
+
+	psize = env->me_psize;
+
+	p = calloc(NUM_METAS, psize);
+	if (!p)
+		return ENOMEM;
+	p->mp_pgno = 0;
+	p->mp_flags = P_META;
+	*(MDB_meta *)METADATA(p) = *meta;
+
+	q = (MDB_page *)((char *)p + psize);
+	q->mp_pgno = 1;
+	q->mp_flags = P_META;
+	*(MDB_meta *)METADATA(q) = *meta;
+
+	DO_PWRITE(rc, env->me_fd, p, psize * NUM_METAS, len, 0);
+	if (!rc)
+		rc = ErrCode();
+	else if ((unsigned) len == psize * NUM_METAS)
+		rc = MDB_SUCCESS;
+	else
+		rc = ENOSPC;
+	free(p);
+	return rc;
+}
+
+/** Update the environment info to commit a transaction.
+ * @param[in] txn the transaction that's being committed
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_env_write_meta(MDB_txn *txn)
+{
+	MDB_env *env;
+	MDB_meta	meta, metab, *mp;
+	unsigned flags;
+	mdb_size_t mapsize;
+	off_t off;
+	int rc, len, toggle;
+	char *ptr;
+	HANDLE mfd;
+#ifdef _WIN32
+	OVERLAPPED ov;
+#else
+	int r2;
+#endif
+
+	toggle = txn->mt_txnid & 1;
+	DPRINTF(("writing meta page %d for root page %"Yu,
+		toggle, txn->mt_dbs[MAIN_DBI].md_root));
+
+	env = txn->mt_env;
+	flags = txn->mt_flags | env->me_flags;
+	mp = env->me_metas[toggle];
+	mapsize = env->me_metas[toggle ^ 1]->mm_mapsize;
+	/* Persist any increases of mapsize config */
+	if (mapsize < env->me_mapsize)
+		mapsize = env->me_mapsize;
+
+	if (flags & MDB_WRITEMAP) {
+		mp->mm_mapsize = mapsize;
+		mp->mm_dbs[FREE_DBI] = txn->mt_dbs[FREE_DBI];
+		mp->mm_dbs[MAIN_DBI] = txn->mt_dbs[MAIN_DBI];
+		mp->mm_last_pg = txn->mt_next_pgno - 1;
+#if (__GNUC__ * 100 + __GNUC_MINOR__ >= 404) && /* TODO: portability */	\
+	!(defined(__i386__) || defined(__x86_64__))
+		/* LY: issue a memory barrier, if not x86. ITS#7969 */
+		__sync_synchronize();
+#endif
+		mp->mm_txnid = txn->mt_txnid;
+		if (!(flags & (MDB_NOMETASYNC|MDB_NOSYNC))) {
+			unsigned meta_size = env->me_psize;
+			rc = (env->me_flags & MDB_MAPASYNC) ? MS_ASYNC : MS_SYNC;
+			ptr = (char *)mp - PAGEHDRSZ;
+#ifndef _WIN32	/* POSIX msync() requires ptr = start of OS page */
+			r2 = (ptr - env->me_map) & (env->me_os_psize - 1);
+			ptr -= r2;
+			meta_size += r2;
+#endif
+			if (MDB_MSYNC(ptr, meta_size, rc)) {
+				rc = ErrCode();
+				goto fail;
+			}
+		}
+		goto done;
+	}
+	metab.mm_txnid = mp->mm_txnid;
+	metab.mm_last_pg = mp->mm_last_pg;
+
+	meta.mm_mapsize = mapsize;
+	meta.mm_dbs[FREE_DBI] = txn->mt_dbs[FREE_DBI];
+	meta.mm_dbs[MAIN_DBI] = txn->mt_dbs[MAIN_DBI];
+	meta.mm_last_pg = txn->mt_next_pgno - 1;
+	meta.mm_txnid = txn->mt_txnid;
+
+	off = offsetof(MDB_meta, mm_mapsize);
+	ptr = (char *)&meta + off;
+	len = sizeof(MDB_meta) - off;
+	off += (char *)mp - env->me_map;
+
+	/* Write to the SYNC fd unless MDB_NOSYNC/MDB_NOMETASYNC.
+	 * (me_mfd goes to the same file as me_fd, but writing to it
+	 * also syncs to disk.  Avoids a separate fdatasync() call.)
+	 */
+	mfd = (flags & (MDB_NOSYNC|MDB_NOMETASYNC)) ? env->me_fd : env->me_mfd;
+#ifdef _WIN32
+	{
+		memset(&ov, 0, sizeof(ov));
+		ov.Offset = off;
+		if (!WriteFile(mfd, ptr, len, (DWORD *)&rc, &ov))
+			rc = -1;
+	}
+#else
+retry_write:
+	rc = pwrite(mfd, ptr, len, off);
+#endif
+	if (rc != len) {
+		rc = rc < 0 ? ErrCode() : EIO;
+#ifndef _WIN32
+		if (rc == EINTR)
+			goto retry_write;
+#endif
+		DPUTS("write failed, disk error?");
+		/* On a failure, the pagecache still contains the new data.
+		 * Write some old data back, to prevent it from being used.
+		 * Use the non-SYNC fd; we know it will fail anyway.
+		 */
+		meta.mm_last_pg = metab.mm_last_pg;
+		meta.mm_txnid = metab.mm_txnid;
+#ifdef _WIN32
+		memset(&ov, 0, sizeof(ov));
+		ov.Offset = off;
+		WriteFile(env->me_fd, ptr, len, NULL, &ov);
+#else
+		r2 = pwrite(env->me_fd, ptr, len, off);
+		(void)r2;	/* Silence warnings. We don't care about pwrite's return value */
+#endif
+fail:
+		env->me_flags |= MDB_FATAL_ERROR;
+		return rc;
+	}
+	/* MIPS has cache coherency issues, this is a no-op everywhere else */
+	CACHEFLUSH(env->me_map + off, len, DCACHE);
+done:
+	/* Memory ordering issues are irrelevant; since the entire writer
+	 * is wrapped by wmutex, all of these changes will become visible
+	 * after the wmutex is unlocked. Since the DB is multi-version,
+	 * readers will get consistent data regardless of how fresh or
+	 * how stale their view of these values is.
+	 */
+	if (env->me_txns)
+		env->me_txns->mti_txnid = txn->mt_txnid;
+
+	return MDB_SUCCESS;
+}
+
+/** Check both meta pages to see which one is newer.
+ * @param[in] env the environment handle
+ * @return newest #MDB_meta.
+ */
+static MDB_meta *
+mdb_env_pick_meta(const MDB_env *env)
+{
+	MDB_meta *const *metas = env->me_metas;
+	return metas[ metas[0]->mm_txnid < metas[1]->mm_txnid ];
+}
+
+int ESECT
+mdb_env_create(MDB_env **env)
+{
+	MDB_env *e;
+
+	e = calloc(1, sizeof(MDB_env));
+	if (!e)
+		return ENOMEM;
+
+	e->me_maxreaders = DEFAULT_READERS;
+	e->me_maxdbs = e->me_numdbs = CORE_DBS;
+	e->me_fd = INVALID_HANDLE_VALUE;
+	e->me_lfd = INVALID_HANDLE_VALUE;
+	e->me_mfd = INVALID_HANDLE_VALUE;
+#ifdef MDB_USE_POSIX_SEM
+	e->me_rmutex = SEM_FAILED;
+	e->me_wmutex = SEM_FAILED;
+#elif defined MDB_USE_SYSV_SEM
+	e->me_rmutex->semid = -1;
+	e->me_wmutex->semid = -1;
+#endif
+	e->me_pid = getpid();
+	GET_PAGESIZE(e->me_os_psize);
+	VGMEMP_CREATE(e,0,0);
+	*env = e;
+	return MDB_SUCCESS;
+}
+
+#ifdef _WIN32
+/** @brief Map a result from an NTAPI call to WIN32. */
+static DWORD
+mdb_nt2win32(NTSTATUS st)
+{
+	OVERLAPPED o = {0};
+	DWORD br;
+	o.Internal = st;
+	GetOverlappedResult(NULL, &o, &br, FALSE);
+	return GetLastError();
+}
+#endif
+
+static int ESECT
+mdb_env_map(MDB_env *env, void *addr)
+{
+	MDB_page *p;
+	unsigned int flags = env->me_flags;
+#ifdef _WIN32
+	int rc;
+	int access = SECTION_MAP_READ;
+	HANDLE mh;
+	void *map;
+	SIZE_T msize;
+	ULONG pageprot = PAGE_READONLY, secprot, alloctype;
+
+	if (flags & MDB_WRITEMAP) {
+		access |= SECTION_MAP_WRITE;
+		pageprot = PAGE_READWRITE;
+	}
+	if (flags & MDB_RDONLY) {
+		secprot = PAGE_READONLY;
+		msize = 0;
+		alloctype = 0;
+	} else {
+		secprot = PAGE_READWRITE;
+		msize = env->me_mapsize;
+		alloctype = MEM_RESERVE;
+	}
+
+	rc = NtCreateSection(&mh, access, NULL, NULL, secprot, SEC_RESERVE, env->me_fd);
+	if (rc)
+		return mdb_nt2win32(rc);
+	map = addr;
+#ifdef MDB_VL32
+	msize = NUM_METAS * env->me_psize;
+#endif
+	rc = NtMapViewOfSection(mh, GetCurrentProcess(), &map, 0, 0, NULL, &msize, ViewUnmap, alloctype, pageprot);
+#ifdef MDB_VL32
+	env->me_fmh = mh;
+#else
+	NtClose(mh);
+#endif
+	if (rc)
+		return mdb_nt2win32(rc);
+	env->me_map = map;
+#else
+#ifdef MDB_VL32
+	(void) flags;
+	env->me_map = mmap(addr, NUM_METAS * env->me_psize, PROT_READ, MAP_SHARED,
+		env->me_fd, 0);
+	if (env->me_map == MAP_FAILED) {
+		env->me_map = NULL;
+		return ErrCode();
+	}
+#else
+	int prot = PROT_READ;
+	if (flags & MDB_WRITEMAP) {
+		prot |= PROT_WRITE;
+		if (ftruncate(env->me_fd, env->me_mapsize) < 0)
+			return ErrCode();
+	}
+	env->me_map = mmap(addr, env->me_mapsize, prot, MAP_SHARED,
+		env->me_fd, 0);
+	if (env->me_map == MAP_FAILED) {
+		env->me_map = NULL;
+		return ErrCode();
+	}
+
+	if (flags & MDB_NORDAHEAD) {
+		/* Turn off readahead. It's harmful when the DB is larger than RAM. */
+#ifdef MADV_RANDOM
+		madvise(env->me_map, env->me_mapsize, MADV_RANDOM);
+#else
+#ifdef POSIX_MADV_RANDOM
+		posix_madvise(env->me_map, env->me_mapsize, POSIX_MADV_RANDOM);
+#endif /* POSIX_MADV_RANDOM */
+#endif /* MADV_RANDOM */
+	}
+#endif /* _WIN32 */
+
+	/* Can happen because the address argument to mmap() is just a
+	 * hint.  mmap() can pick another, e.g. if the range is in use.
+	 * The MAP_FIXED flag would prevent that, but then mmap could
+	 * instead unmap existing pages to make room for the new map.
+	 */
+	if (addr && env->me_map != addr)
+		return EBUSY;	/* TODO: Make a new MDB_* error code? */
+#endif
+
+	p = (MDB_page *)env->me_map;
+	env->me_metas[0] = METADATA(p);
+	env->me_metas[1] = (MDB_meta *)((char *)env->me_metas[0] + env->me_psize);
+
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_set_mapsize(MDB_env *env, mdb_size_t size)
+{
+	/* If env is already open, caller is responsible for making
+	 * sure there are no active txns.
+	 */
+	if (env->me_map) {
+		MDB_meta *meta;
+#ifndef MDB_VL32
+		void *old;
+		int rc;
+#endif
+		if (env->me_txn)
+			return EINVAL;
+		meta = mdb_env_pick_meta(env);
+		if (!size)
+			size = meta->mm_mapsize;
+		{
+			/* Silently round up to minimum if the size is too small */
+			mdb_size_t minsize = (meta->mm_last_pg + 1) * env->me_psize;
+			if (size < minsize)
+				size = minsize;
+		}
+#ifndef MDB_VL32
+		/* For MDB_VL32 this bit is a noop since we dynamically remap
+		 * chunks of the DB anyway.
+		 */
+		munmap(env->me_map, env->me_mapsize);
+		env->me_mapsize = size;
+		old = (env->me_flags & MDB_FIXEDMAP) ? env->me_map : NULL;
+		rc = mdb_env_map(env, old);
+		if (rc)
+			return rc;
+#endif /* !MDB_VL32 */
+	}
+	env->me_mapsize = size;
+	if (env->me_psize)
+		env->me_maxpg = env->me_mapsize / env->me_psize;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_set_maxdbs(MDB_env *env, MDB_dbi dbs)
+{
+	if (env->me_map)
+		return EINVAL;
+	env->me_maxdbs = dbs + CORE_DBS;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_set_maxreaders(MDB_env *env, unsigned int readers)
+{
+	if (env->me_map || readers < 1)
+		return EINVAL;
+	env->me_maxreaders = readers;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_get_maxreaders(MDB_env *env, unsigned int *readers)
+{
+	if (!env || !readers)
+		return EINVAL;
+	*readers = env->me_maxreaders;
+	return MDB_SUCCESS;
+}
+
+static int ESECT
+mdb_fsize(HANDLE fd, mdb_size_t *size)
+{
+#ifdef _WIN32
+	LARGE_INTEGER fsize;
+
+	if (!GetFileSizeEx(fd, &fsize))
+		return ErrCode();
+
+	*size = fsize.QuadPart;
+#else
+	struct stat st;
+
+	if (fstat(fd, &st))
+		return ErrCode();
+
+	*size = st.st_size;
+#endif
+	return MDB_SUCCESS;
+}
+
+
+#ifdef _WIN32
+typedef wchar_t	mdb_nchar_t;
+# define MDB_NAME(str)	L##str
+# define mdb_name_cpy	wcscpy
+#else
+/** Character type for file names: char on Unix, wchar_t on Windows */
+typedef char	mdb_nchar_t;
+# define MDB_NAME(str)	str		/**< #mdb_nchar_t[] string literal */
+# define mdb_name_cpy	strcpy	/**< Copy name (#mdb_nchar_t string) */
+#endif
+
+/** Filename - string of #mdb_nchar_t[] */
+typedef struct MDB_name {
+	int mn_len;					/**< Length  */
+	int mn_alloced;				/**< True if #mn_val was malloced */
+	mdb_nchar_t	*mn_val;		/**< Contents */
+} MDB_name;
+
+/** Filename suffixes [datafile,lockfile][without,with MDB_NOSUBDIR] */
+static const mdb_nchar_t *const mdb_suffixes[2][2] = {
+	{ MDB_NAME("/data.mdb"), MDB_NAME("")      },
+	{ MDB_NAME("/lock.mdb"), MDB_NAME("-lock") }
+};
+
+#define MDB_SUFFLEN 9	/**< Max string length in #mdb_suffixes[] */
+
+/** Set up filename + scratch area for filename suffix, for opening files.
+ * It should be freed with #mdb_fname_destroy().
+ * On Windows, paths are converted from char *UTF-8 to wchar_t *UTF-16.
+ *
+ * @param[in] path Pathname for #mdb_env_open().
+ * @param[in] envflags Whether a subdir and/or lockfile will be used.
+ * @param[out] fname Resulting filename, with room for a suffix if necessary.
+ */
+static int ESECT
+mdb_fname_init(const char *path, unsigned envflags, MDB_name *fname)
+{
+	int no_suffix = F_ISSET(envflags, MDB_NOSUBDIR|MDB_NOLOCK);
+	fname->mn_alloced = 0;
+#ifdef _WIN32
+	return utf8_to_utf16(path, fname, no_suffix ? 0 : MDB_SUFFLEN);
+#else
+	fname->mn_len = strlen(path);
+	if (no_suffix)
+		fname->mn_val = (char *) path;
+	else if ((fname->mn_val = malloc(fname->mn_len + MDB_SUFFLEN+1)) != NULL) {
+		fname->mn_alloced = 1;
+		strcpy(fname->mn_val, path);
+	}
+	else
+		return ENOMEM;
+	return MDB_SUCCESS;
+#endif
+}
+
+/** Destroy \b fname from #mdb_fname_init() */
+#define mdb_fname_destroy(fname) \
+	do { if ((fname).mn_alloced) free((fname).mn_val); } while (0)
+
+#ifdef O_CLOEXEC /* POSIX.1-2008: Set FD_CLOEXEC atomically at open() */
+# define MDB_CLOEXEC		O_CLOEXEC
+#else
+# define MDB_CLOEXEC		0
+#endif
+
+/** File type, access mode etc. for #mdb_fopen() */
+enum mdb_fopen_type {
+#ifdef _WIN32
+	MDB_O_RDONLY, MDB_O_RDWR, MDB_O_META, MDB_O_COPY, MDB_O_LOCKS
+#else
+	/* A comment in mdb_fopen() explains some O_* flag choices. */
+	MDB_O_RDONLY= O_RDONLY,                            /**< for RDONLY me_fd */
+	MDB_O_RDWR  = O_RDWR  |O_CREAT,                    /**< for me_fd */
+	MDB_O_META  = O_WRONLY|MDB_DSYNC     |MDB_CLOEXEC, /**< for me_mfd */
+	MDB_O_COPY  = O_WRONLY|O_CREAT|O_EXCL|MDB_CLOEXEC, /**< for #mdb_env_copy() */
+	/** Bitmask for open() flags in enum #mdb_fopen_type.  The other bits
+	 * distinguish otherwise-equal MDB_O_* constants from each other.
+	 */
+	MDB_O_MASK  = MDB_O_RDWR|MDB_CLOEXEC | MDB_O_RDONLY|MDB_O_META|MDB_O_COPY,
+	MDB_O_LOCKS = MDB_O_RDWR|MDB_CLOEXEC | ((MDB_O_MASK+1) & ~MDB_O_MASK) /**< for me_lfd */
+#endif
+};
+
+/** Open an LMDB file.
+ * @param[in] env	The LMDB environment.
+ * @param[in,out] fname	Path from from #mdb_fname_init().  A suffix is
+ * appended if necessary to create the filename, without changing mn_len.
+ * @param[in] which	Determines file type, access mode, etc.
+ * @param[in] mode	The Unix permissions for the file, if we create it.
+ * @param[out] res	Resulting file handle.
+ * @return 0 on success, non-zero on failure.
+ */
+static int ESECT
+mdb_fopen(const MDB_env *env, MDB_name *fname,
+	enum mdb_fopen_type which, mdb_mode_t mode,
+	HANDLE *res)
+{
+	int rc = MDB_SUCCESS;
+	HANDLE fd;
+#ifdef _WIN32
+	DWORD acc, share, disp, attrs;
+#else
+	int flags;
+#endif
+
+	if (fname->mn_alloced)		/* modifiable copy */
+		mdb_name_cpy(fname->mn_val + fname->mn_len,
+			mdb_suffixes[which==MDB_O_LOCKS][F_ISSET(env->me_flags, MDB_NOSUBDIR)]);
+
+	/* The directory must already exist.  Usually the file need not.
+	 * MDB_O_META requires the file because we already created it using
+	 * MDB_O_RDWR.  MDB_O_COPY must not overwrite an existing file.
+	 *
+	 * With MDB_O_COPY we do not want the OS to cache the writes, since
+	 * the source data is already in the OS cache.
+	 *
+	 * The lockfile needs FD_CLOEXEC (close file descriptor on exec*())
+	 * to avoid the flock() issues noted under Caveats in lmdb.h.
+	 * Also set it for other filehandles which the user cannot get at
+	 * and close himself, which he may need after fork().  I.e. all but
+	 * me_fd, which programs do use via mdb_env_get_fd().
+	 */
+
+#ifdef _WIN32
+	acc = GENERIC_READ|GENERIC_WRITE;
+	share = FILE_SHARE_READ|FILE_SHARE_WRITE;
+	disp = OPEN_ALWAYS;
+	attrs = FILE_ATTRIBUTE_NORMAL;
+	switch (which) {
+	case MDB_O_RDONLY:			/* read-only datafile */
+		acc = GENERIC_READ;
+		disp = OPEN_EXISTING;
+		break;
+	case MDB_O_META:			/* for writing metapages */
+		acc = GENERIC_WRITE;
+		disp = OPEN_EXISTING;
+		attrs = FILE_ATTRIBUTE_NORMAL|FILE_FLAG_WRITE_THROUGH;
+		break;
+	case MDB_O_COPY:			/* mdb_env_copy() & co */
+		acc = GENERIC_WRITE;
+		share = 0;
+		disp = CREATE_NEW;
+		attrs = FILE_FLAG_NO_BUFFERING|FILE_FLAG_WRITE_THROUGH;
+		break;
+	default: break;	/* silence gcc -Wswitch (not all enum values handled) */
+	}
+	fd = CreateFileW(fname->mn_val, acc, share, NULL, disp, attrs, NULL);
+#else
+	fd = open(fname->mn_val, which & MDB_O_MASK, mode);
+#endif
+
+	if (fd == INVALID_HANDLE_VALUE)
+		rc = ErrCode();
+#ifndef _WIN32
+	else {
+		if (which != MDB_O_RDONLY && which != MDB_O_RDWR) {
+			/* Set CLOEXEC if we could not pass it to open() */
+			if (!MDB_CLOEXEC && (flags = fcntl(fd, F_GETFD)) != -1)
+				(void) fcntl(fd, F_SETFD, flags | FD_CLOEXEC);
+		}
+		if (which == MDB_O_COPY && env->me_psize >= env->me_os_psize) {
+			/* This may require buffer alignment.  There is no portable
+			 * way to ask how much, so we require OS pagesize alignment.
+			 */
+# ifdef F_NOCACHE	/* __APPLE__ */
+			(void) fcntl(fd, F_NOCACHE, 1);
+# elif defined O_DIRECT
+			/* open(...O_DIRECT...) would break on filesystems without
+			 * O_DIRECT support (ITS#7682). Try to set it here instead.
+			 */
+			if ((flags = fcntl(fd, F_GETFL)) != -1)
+				(void) fcntl(fd, F_SETFL, flags | O_DIRECT);
+# endif
+		}
+	}
+#endif	/* !_WIN32 */
+
+	*res = fd;
+	return rc;
+}
+
+
+#ifdef BROKEN_FDATASYNC
+#include <sys/utsname.h>
+#include <sys/vfs.h>
+#endif
+
+/** Further setup required for opening an LMDB environment
+ */
+static int ESECT
+mdb_env_open2(MDB_env *env, int prev)
+{
+	unsigned int flags = env->me_flags;
+	int i, newenv = 0, rc;
+	MDB_meta meta;
+
+#ifdef _WIN32
+	/* See if we should use QueryLimited */
+	rc = GetVersion();
+	if ((rc & 0xff) > 5)
+		env->me_pidquery = MDB_PROCESS_QUERY_LIMITED_INFORMATION;
+	else
+		env->me_pidquery = PROCESS_QUERY_INFORMATION;
+	/* Grab functions we need from NTDLL */
+	if (!NtCreateSection) {
+		HMODULE h = GetModuleHandle("NTDLL.DLL");
+		if (!h)
+			return MDB_PROBLEM;
+		NtClose = (NtCloseFunc *)GetProcAddress(h, "NtClose");
+		if (!NtClose)
+			return MDB_PROBLEM;
+		NtMapViewOfSection = (NtMapViewOfSectionFunc *)GetProcAddress(h, "NtMapViewOfSection");
+		if (!NtMapViewOfSection)
+			return MDB_PROBLEM;
+		NtCreateSection = (NtCreateSectionFunc *)GetProcAddress(h, "NtCreateSection");
+		if (!NtCreateSection)
+			return MDB_PROBLEM;
+	}
+#endif /* _WIN32 */
+
+#ifdef BROKEN_FDATASYNC
+	/* ext3/ext4 fdatasync is broken on some older Linux kernels.
+	 * https://lkml.org/lkml/2012/9/3/83
+	 * Kernels after 3.6-rc6 are known good.
+	 * https://lkml.org/lkml/2012/9/10/556
+	 * See if the DB is on ext3/ext4, then check for new enough kernel
+	 * Kernels 2.6.32.60, 2.6.34.15, 3.2.30, and 3.5.4 are also known
+	 * to be patched.
+	 */
+	{
+		struct statfs st;
+		fstatfs(env->me_fd, &st);
+		while (st.f_type == 0xEF53) {
+			struct utsname uts;
+			int i;
+			uname(&uts);
+			if (uts.release[0] < '3') {
+				if (!strncmp(uts.release, "2.6.32.", 7)) {
+					i = atoi(uts.release+7);
+					if (i >= 60)
+						break;	/* 2.6.32.60 and newer is OK */
+				} else if (!strncmp(uts.release, "2.6.34.", 7)) {
+					i = atoi(uts.release+7);
+					if (i >= 15)
+						break;	/* 2.6.34.15 and newer is OK */
+				}
+			} else if (uts.release[0] == '3') {
+				i = atoi(uts.release+2);
+				if (i > 5)
+					break;	/* 3.6 and newer is OK */
+				if (i == 5) {
+					i = atoi(uts.release+4);
+					if (i >= 4)
+						break;	/* 3.5.4 and newer is OK */
+				} else if (i == 2) {
+					i = atoi(uts.release+4);
+					if (i >= 30)
+						break;	/* 3.2.30 and newer is OK */
+				}
+			} else {	/* 4.x and newer is OK */
+				break;
+			}
+			env->me_flags |= MDB_FSYNCONLY;
+			break;
+		}
+	}
+#endif
+
+	if ((i = mdb_env_read_header(env, prev, &meta)) != 0) {
+		if (i != ENOENT)
+			return i;
+		DPUTS("new mdbenv");
+		newenv = 1;
+		env->me_psize = env->me_os_psize;
+		if (env->me_psize > MAX_PAGESIZE)
+			env->me_psize = MAX_PAGESIZE;
+		memset(&meta, 0, sizeof(meta));
+		mdb_env_init_meta0(env, &meta);
+		meta.mm_mapsize = DEFAULT_MAPSIZE;
+	} else {
+		env->me_psize = meta.mm_psize;
+	}
+
+	/* Was a mapsize configured? */
+	if (!env->me_mapsize) {
+		env->me_mapsize = meta.mm_mapsize;
+	}
+	{
+		/* Make sure mapsize >= committed data size.  Even when using
+		 * mm_mapsize, which could be broken in old files (ITS#7789).
+		 */
+		mdb_size_t minsize = (meta.mm_last_pg + 1) * meta.mm_psize;
+		if (env->me_mapsize < minsize)
+			env->me_mapsize = minsize;
+	}
+	meta.mm_mapsize = env->me_mapsize;
+
+	if (newenv && !(flags & MDB_FIXEDMAP)) {
+		/* mdb_env_map() may grow the datafile.  Write the metapages
+		 * first, so the file will be valid if initialization fails.
+		 * Except with FIXEDMAP, since we do not yet know mm_address.
+		 * We could fill in mm_address later, but then a different
+		 * program might end up doing that - one with a memory layout
+		 * and map address which does not suit the main program.
+		 */
+		rc = mdb_env_init_meta(env, &meta);
+		if (rc)
+			return rc;
+		newenv = 0;
+	}
+#ifdef _WIN32
+	/* For FIXEDMAP, make sure the file is non-empty before we attempt to map it */
+	if (newenv) {
+		char dummy = 0;
+		DWORD len;
+		rc = WriteFile(env->me_fd, &dummy, 1, &len, NULL);
+		if (!rc) {
+			rc = ErrCode();
+			return rc;
+		}
+	}
+#endif
+
+	rc = mdb_env_map(env, (flags & MDB_FIXEDMAP) ? meta.mm_address : NULL);
+	if (rc)
+		return rc;
+
+	if (newenv) {
+		if (flags & MDB_FIXEDMAP)
+			meta.mm_address = env->me_map;
+		i = mdb_env_init_meta(env, &meta);
+		if (i != MDB_SUCCESS) {
+			return i;
+		}
+	}
+
+	env->me_maxfree_1pg = (env->me_psize - PAGEHDRSZ) / sizeof(pgno_t) - 1;
+	env->me_nodemax = (((env->me_psize - PAGEHDRSZ) / MDB_MINKEYS) & -2)
+		- sizeof(indx_t);
+#if !(MDB_MAXKEYSIZE)
+	env->me_maxkey = env->me_nodemax - (NODESIZE + sizeof(MDB_db));
+#endif
+	env->me_maxpg = env->me_mapsize / env->me_psize;
+
+#if MDB_DEBUG
+	{
+		MDB_meta *meta = mdb_env_pick_meta(env);
+		MDB_db *db = &meta->mm_dbs[MAIN_DBI];
+
+		DPRINTF(("opened database version %u, pagesize %u",
+			meta->mm_version, env->me_psize));
+		DPRINTF(("using meta page %d",  (int) (meta->mm_txnid & 1)));
+		DPRINTF(("depth: %u",           db->md_depth));
+		DPRINTF(("entries: %"Yu,        db->md_entries));
+		DPRINTF(("branch pages: %"Yu,   db->md_branch_pages));
+		DPRINTF(("leaf pages: %"Yu,     db->md_leaf_pages));
+		DPRINTF(("overflow pages: %"Yu, db->md_overflow_pages));
+		DPRINTF(("root: %"Yu,           db->md_root));
+	}
+#endif
+
+	return MDB_SUCCESS;
+}
+
+
+/** Release a reader thread's slot in the reader lock table.
+ *	This function is called automatically when a thread exits.
+ * @param[in] ptr This points to the slot in the reader lock table.
+ */
+static void
+mdb_env_reader_dest(void *ptr)
+{
+	MDB_reader *reader = ptr;
+
+#ifndef _WIN32
+	if (reader->mr_pid == getpid()) /* catch pthread_exit() in child process */
+#endif
+		/* We omit the mutex, so do this atomically (i.e. skip mr_txnid) */
+		reader->mr_pid = 0;
+}
+
+#ifdef _WIN32
+/** Junk for arranging thread-specific callbacks on Windows. This is
+ *	necessarily platform and compiler-specific. Windows supports up
+ *	to 1088 keys. Let's assume nobody opens more than 64 environments
+ *	in a single process, for now. They can override this if needed.
+ */
+#ifndef MAX_TLS_KEYS
+#define MAX_TLS_KEYS	64
+#endif
+static pthread_key_t mdb_tls_keys[MAX_TLS_KEYS];
+static int mdb_tls_nkeys;
+
+static void NTAPI mdb_tls_callback(PVOID module, DWORD reason, PVOID ptr)
+{
+	int i;
+	switch(reason) {
+	case DLL_PROCESS_ATTACH: break;
+	case DLL_THREAD_ATTACH: break;
+	case DLL_THREAD_DETACH:
+		for (i=0; i<mdb_tls_nkeys; i++) {
+			MDB_reader *r = pthread_getspecific(mdb_tls_keys[i]);
+			if (r) {
+				mdb_env_reader_dest(r);
+			}
+		}
+		break;
+	case DLL_PROCESS_DETACH: break;
+	}
+}
+#ifdef __GNUC__
+#ifdef _WIN64
+const PIMAGE_TLS_CALLBACK mdb_tls_cbp __attribute__((section (".CRT$XLB"))) = mdb_tls_callback;
+#else
+PIMAGE_TLS_CALLBACK mdb_tls_cbp __attribute__((section (".CRT$XLB"))) = mdb_tls_callback;
+#endif
+#else
+#ifdef _WIN64
+/* Force some symbol references.
+ *	_tls_used forces the linker to create the TLS directory if not already done
+ *	mdb_tls_cbp prevents whole-program-optimizer from dropping the symbol.
+ */
+#pragma comment(linker, "/INCLUDE:_tls_used")
+#pragma comment(linker, "/INCLUDE:mdb_tls_cbp")
+#pragma const_seg(".CRT$XLB")
+extern const PIMAGE_TLS_CALLBACK mdb_tls_cbp;
+const PIMAGE_TLS_CALLBACK mdb_tls_cbp = mdb_tls_callback;
+#pragma const_seg()
+#else	/* _WIN32 */
+#pragma comment(linker, "/INCLUDE:__tls_used")
+#pragma comment(linker, "/INCLUDE:_mdb_tls_cbp")
+#pragma data_seg(".CRT$XLB")
+PIMAGE_TLS_CALLBACK mdb_tls_cbp = mdb_tls_callback;
+#pragma data_seg()
+#endif	/* WIN 32/64 */
+#endif	/* !__GNUC__ */
+#endif
+
+/** Downgrade the exclusive lock on the region back to shared */
+static int ESECT
+mdb_env_share_locks(MDB_env *env, int *excl)
+{
+	int rc = 0;
+	MDB_meta *meta = mdb_env_pick_meta(env);
+
+	env->me_txns->mti_txnid = meta->mm_txnid;
+
+#ifdef _WIN32
+	{
+		OVERLAPPED ov;
+		/* First acquire a shared lock. The Unlock will
+		 * then release the existing exclusive lock.
+		 */
+		memset(&ov, 0, sizeof(ov));
+		if (!LockFileEx(env->me_lfd, 0, 0, 1, 0, &ov)) {
+			rc = ErrCode();
+		} else {
+			UnlockFile(env->me_lfd, 0, 0, 1, 0);
+			*excl = 0;
+		}
+	}
+#else
+	{
+		struct flock lock_info;
+		/* The shared lock replaces the existing lock */
+		memset((void *)&lock_info, 0, sizeof(lock_info));
+		lock_info.l_type = F_RDLCK;
+		lock_info.l_whence = SEEK_SET;
+		lock_info.l_start = 0;
+		lock_info.l_len = 1;
+		while ((rc = fcntl(env->me_lfd, F_SETLK, &lock_info)) &&
+				(rc = ErrCode()) == EINTR) ;
+		*excl = rc ? -1 : 0;	/* error may mean we lost the lock */
+	}
+#endif
+
+	return rc;
+}
+
+/** Try to get exclusive lock, otherwise shared.
+ *	Maintain *excl = -1: no/unknown lock, 0: shared, 1: exclusive.
+ */
+static int ESECT
+mdb_env_excl_lock(MDB_env *env, int *excl)
+{
+	int rc = 0;
+#ifdef _WIN32
+	if (LockFile(env->me_lfd, 0, 0, 1, 0)) {
+		*excl = 1;
+	} else {
+		OVERLAPPED ov;
+		memset(&ov, 0, sizeof(ov));
+		if (LockFileEx(env->me_lfd, 0, 0, 1, 0, &ov)) {
+			*excl = 0;
+		} else {
+			rc = ErrCode();
+		}
+	}
+#else
+	struct flock lock_info;
+	memset((void *)&lock_info, 0, sizeof(lock_info));
+	lock_info.l_type = F_WRLCK;
+	lock_info.l_whence = SEEK_SET;
+	lock_info.l_start = 0;
+	lock_info.l_len = 1;
+	while ((rc = fcntl(env->me_lfd, F_SETLK, &lock_info)) &&
+			(rc = ErrCode()) == EINTR) ;
+	if (!rc) {
+		*excl = 1;
+	} else
+# ifndef MDB_USE_POSIX_MUTEX
+	if (*excl < 0) /* always true when MDB_USE_POSIX_MUTEX */
+# endif
+	{
+		lock_info.l_type = F_RDLCK;
+		while ((rc = fcntl(env->me_lfd, F_SETLKW, &lock_info)) &&
+				(rc = ErrCode()) == EINTR) ;
+		if (rc == 0)
+			*excl = 0;
+	}
+#endif
+	return rc;
+}
+
+#ifdef MDB_USE_HASH
+/*
+ * hash_64 - 64 bit Fowler/Noll/Vo-0 FNV-1a hash code
+ *
+ * @(#) $Revision: 5.1 $
+ * @(#) $Id: hash_64a.c,v 5.1 2009/06/30 09:01:38 chongo Exp $
+ * @(#) $Source: /usr/local/src/cmd/fnv/RCS/hash_64a.c,v $
+ *
+ *	  http://www.isthe.com/chongo/tech/comp/fnv/index.html
+ *
+ ***
+ *
+ * Please do not copyright this code.  This code is in the public domain.
+ *
+ * LANDON CURT NOLL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+ * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO
+ * EVENT SHALL LANDON CURT NOLL BE LIABLE FOR ANY SPECIAL, INDIRECT OR
+ * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+ * USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+ * OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+ * PERFORMANCE OF THIS SOFTWARE.
+ *
+ * By:
+ *	chongo <Landon Curt Noll> /\oo/\
+ *	  http://www.isthe.com/chongo/
+ *
+ * Share and Enjoy!	:-)
+ */
+
+/** perform a 64 bit Fowler/Noll/Vo FNV-1a hash on a buffer
+ * @param[in] val	value to hash
+ * @param[in] len	length of value
+ * @return 64 bit hash
+ */
+static mdb_hash_t
+mdb_hash(const void *val, size_t len)
+{
+	const unsigned char *s = (const unsigned char *) val, *end = s + len;
+	mdb_hash_t hval = 0xcbf29ce484222325ULL;
+	/*
+	 * FNV-1a hash each octet of the buffer
+	 */
+	while (s < end) {
+		hval = (hval ^ *s++) * 0x100000001b3ULL;
+	}
+	/* return our new hash value */
+	return hval;
+}
+
+/** Hash the string and output the encoded hash.
+ * This uses modified RFC1924 Ascii85 encoding to accommodate systems with
+ * very short name limits. We don't care about the encoding being reversible,
+ * we just want to preserve as many bits of the input as possible in a
+ * small printable string.
+ * @param[in] str string to hash
+ * @param[out] encbuf an array of 11 chars to hold the hash
+ */
+static const char mdb_a85[]= "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!#$%&()*+-;<=>?@^_`{|}~";
+
+static void ESECT
+mdb_pack85(unsigned long long l, char *out)
+{
+	int i;
+
+	for (i=0; i<10 && l; i++) {
+		*out++ = mdb_a85[l % 85];
+		l /= 85;
+	}
+	*out = '\0';
+}
+
+/** Init #MDB_env.me_mutexname[] except the char which #MUTEXNAME() will set.
+ *	Changes to this code must be reflected in #MDB_LOCK_FORMAT.
+ */
+static void ESECT
+mdb_env_mname_init(MDB_env *env)
+{
+	char *nm = env->me_mutexname;
+	strcpy(nm, MUTEXNAME_PREFIX);
+	mdb_pack85(env->me_txns->mti_mutexid, nm + sizeof(MUTEXNAME_PREFIX));
+}
+
+/** Return env->me_mutexname after filling in ch ('r'/'w') for convenience */
+#define MUTEXNAME(env, ch) ( \
+		(void) ((env)->me_mutexname[sizeof(MUTEXNAME_PREFIX)-1] = (ch)), \
+		(env)->me_mutexname)
+
+#endif
+
+/** Open and/or initialize the lock region for the environment.
+ * @param[in] env The LMDB environment.
+ * @param[in] fname Filename + scratch area, from #mdb_fname_init().
+ * @param[in] mode The Unix permissions for the file, if we create it.
+ * @param[in,out] excl In -1, out lock type: -1 none, 0 shared, 1 exclusive
+ * @return 0 on success, non-zero on failure.
+ */
+static int ESECT
+mdb_env_setup_locks(MDB_env *env, MDB_name *fname, int mode, int *excl)
+{
+#ifdef _WIN32
+#	define MDB_ERRCODE_ROFS	ERROR_WRITE_PROTECT
+#else
+#	define MDB_ERRCODE_ROFS	EROFS
+#endif
+#ifdef MDB_USE_SYSV_SEM
+	int semid;
+	union semun semu;
+#endif
+	int rc;
+	off_t size, rsize;
+
+	rc = mdb_fopen(env, fname, MDB_O_LOCKS, mode, &env->me_lfd);
+	if (rc) {
+		/* Omit lockfile if read-only env on read-only filesystem */
+		if (rc == MDB_ERRCODE_ROFS && (env->me_flags & MDB_RDONLY)) {
+			return MDB_SUCCESS;
+		}
+		goto fail;
+	}
+
+	if (!(env->me_flags & MDB_NOTLS)) {
+		rc = pthread_key_create(&env->me_txkey, mdb_env_reader_dest);
+		if (rc)
+			goto fail;
+		env->me_flags |= MDB_ENV_TXKEY;
+#ifdef _WIN32
+		/* Windows TLS callbacks need help finding their TLS info. */
+		if (mdb_tls_nkeys >= MAX_TLS_KEYS) {
+			rc = MDB_TLS_FULL;
+			goto fail;
+		}
+		mdb_tls_keys[mdb_tls_nkeys++] = env->me_txkey;
+#endif
+	}
+
+	/* Try to get exclusive lock. If we succeed, then
+	 * nobody is using the lock region and we should initialize it.
+	 */
+	if ((rc = mdb_env_excl_lock(env, excl))) goto fail;
+
+#ifdef _WIN32
+	size = GetFileSize(env->me_lfd, NULL);
+#else
+	size = lseek(env->me_lfd, 0, SEEK_END);
+	if (size == -1) goto fail_errno;
+#endif
+	rsize = (env->me_maxreaders-1) * sizeof(MDB_reader) + sizeof(MDB_txninfo);
+	if (size < rsize && *excl > 0) {
+#ifdef _WIN32
+		if (SetFilePointer(env->me_lfd, rsize, NULL, FILE_BEGIN) != (DWORD)rsize
+			|| !SetEndOfFile(env->me_lfd))
+			goto fail_errno;
+#else
+		if (ftruncate(env->me_lfd, rsize) != 0) goto fail_errno;
+#endif
+	} else {
+		rsize = size;
+		size = rsize - sizeof(MDB_txninfo);
+		env->me_maxreaders = size/sizeof(MDB_reader) + 1;
+	}
+	{
+#ifdef _WIN32
+		HANDLE mh;
+		mh = CreateFileMapping(env->me_lfd, NULL, PAGE_READWRITE,
+			0, 0, NULL);
+		if (!mh) goto fail_errno;
+		env->me_txns = MapViewOfFileEx(mh, FILE_MAP_WRITE, 0, 0, rsize, NULL);
+		CloseHandle(mh);
+		if (!env->me_txns) goto fail_errno;
+#else
+		void *m = mmap(NULL, rsize, PROT_READ|PROT_WRITE, MAP_SHARED,
+			env->me_lfd, 0);
+		if (m == MAP_FAILED) goto fail_errno;
+		env->me_txns = m;
+#endif
+	}
+	if (*excl > 0) {
+#ifdef _WIN32
+		BY_HANDLE_FILE_INFORMATION stbuf;
+		struct {
+			DWORD volume;
+			DWORD nhigh;
+			DWORD nlow;
+		} idbuf;
+
+		if (!mdb_sec_inited) {
+			InitializeSecurityDescriptor(&mdb_null_sd,
+				SECURITY_DESCRIPTOR_REVISION);
+			SetSecurityDescriptorDacl(&mdb_null_sd, TRUE, 0, FALSE);
+			mdb_all_sa.nLength = sizeof(SECURITY_ATTRIBUTES);
+			mdb_all_sa.bInheritHandle = FALSE;
+			mdb_all_sa.lpSecurityDescriptor = &mdb_null_sd;
+			mdb_sec_inited = 1;
+		}
+		if (!GetFileInformationByHandle(env->me_lfd, &stbuf)) goto fail_errno;
+		idbuf.volume = stbuf.dwVolumeSerialNumber;
+		idbuf.nhigh  = stbuf.nFileIndexHigh;
+		idbuf.nlow   = stbuf.nFileIndexLow;
+		env->me_txns->mti_mutexid = mdb_hash(&idbuf, sizeof(idbuf));
+		mdb_env_mname_init(env);
+		env->me_rmutex = CreateMutexA(&mdb_all_sa, FALSE, MUTEXNAME(env, 'r'));
+		if (!env->me_rmutex) goto fail_errno;
+		env->me_wmutex = CreateMutexA(&mdb_all_sa, FALSE, MUTEXNAME(env, 'w'));
+		if (!env->me_wmutex) goto fail_errno;
+#elif defined(MDB_USE_POSIX_SEM)
+		struct stat stbuf;
+		struct {
+			dev_t dev;
+			ino_t ino;
+		} idbuf;
+
+#if defined(__NetBSD__)
+#define	MDB_SHORT_SEMNAMES	1	/* limited to 14 chars */
+#endif
+		if (fstat(env->me_lfd, &stbuf)) goto fail_errno;
+		memset(&idbuf, 0, sizeof(idbuf));
+		idbuf.dev = stbuf.st_dev;
+		idbuf.ino = stbuf.st_ino;
+		env->me_txns->mti_mutexid = mdb_hash(&idbuf, sizeof(idbuf))
+#ifdef MDB_SHORT_SEMNAMES
+			/* Max 9 base85-digits.  We truncate here instead of in
+			 * mdb_env_mname_init() to keep the latter portable.
+			 */
+			% ((mdb_hash_t)85*85*85*85*85*85*85*85*85)
+#endif
+			;
+		mdb_env_mname_init(env);
+		/* Clean up after a previous run, if needed:  Try to
+		 * remove both semaphores before doing anything else.
+		 */
+		sem_unlink(MUTEXNAME(env, 'r'));
+		sem_unlink(MUTEXNAME(env, 'w'));
+		env->me_rmutex = sem_open(MUTEXNAME(env, 'r'), O_CREAT|O_EXCL, mode, 1);
+		if (env->me_rmutex == SEM_FAILED) goto fail_errno;
+		env->me_wmutex = sem_open(MUTEXNAME(env, 'w'), O_CREAT|O_EXCL, mode, 1);
+		if (env->me_wmutex == SEM_FAILED) goto fail_errno;
+#elif defined(MDB_USE_SYSV_SEM)
+		unsigned short vals[2] = {1, 1};
+		key_t key = ftok(fname->mn_val, 'M'); /* fname is lockfile path now */
+		if (key == -1)
+			goto fail_errno;
+		semid = semget(key, 2, (mode & 0777) | IPC_CREAT);
+		if (semid < 0)
+			goto fail_errno;
+		semu.array = vals;
+		if (semctl(semid, 0, SETALL, semu) < 0)
+			goto fail_errno;
+		env->me_txns->mti_semid = semid;
+		env->me_txns->mti_rlocked = 0;
+		env->me_txns->mti_wlocked = 0;
+#else	/* MDB_USE_POSIX_MUTEX: */
+		pthread_mutexattr_t mattr;
+
+		/* Solaris needs this before initing a robust mutex.  Otherwise
+		 * it may skip the init and return EBUSY "seems someone already
+		 * inited" or EINVAL "it was inited differently".
+		 */
+		memset(env->me_txns->mti_rmutex, 0, sizeof(*env->me_txns->mti_rmutex));
+		memset(env->me_txns->mti_wmutex, 0, sizeof(*env->me_txns->mti_wmutex));
+
+		if ((rc = pthread_mutexattr_init(&mattr)) != 0)
+			goto fail;
+		rc = pthread_mutexattr_setpshared(&mattr, PTHREAD_PROCESS_SHARED);
+#ifdef MDB_ROBUST_SUPPORTED
+		if (!rc) rc = pthread_mutexattr_setrobust(&mattr, PTHREAD_MUTEX_ROBUST);
+#endif
+		if (!rc) rc = pthread_mutex_init(env->me_txns->mti_rmutex, &mattr);
+		if (!rc) rc = pthread_mutex_init(env->me_txns->mti_wmutex, &mattr);
+		pthread_mutexattr_destroy(&mattr);
+		if (rc)
+			goto fail;
+#endif	/* _WIN32 || ... */
+
+		env->me_txns->mti_magic = MDB_MAGIC;
+		env->me_txns->mti_format = MDB_LOCK_FORMAT;
+		env->me_txns->mti_txnid = 0;
+		env->me_txns->mti_numreaders = 0;
+
+	} else {
+#ifdef MDB_USE_SYSV_SEM
+		struct semid_ds buf;
+#endif
+		if (env->me_txns->mti_magic != MDB_MAGIC) {
+			DPUTS("lock region has invalid magic");
+			rc = MDB_INVALID;
+			goto fail;
+		}
+		if (env->me_txns->mti_format != MDB_LOCK_FORMAT) {
+			DPRINTF(("lock region has format+version 0x%x, expected 0x%x",
+				env->me_txns->mti_format, MDB_LOCK_FORMAT));
+			rc = MDB_VERSION_MISMATCH;
+			goto fail;
+		}
+		rc = ErrCode();
+		if (rc && rc != EACCES && rc != EAGAIN) {
+			goto fail;
+		}
+#ifdef _WIN32
+		mdb_env_mname_init(env);
+		env->me_rmutex = OpenMutexA(SYNCHRONIZE, FALSE, MUTEXNAME(env, 'r'));
+		if (!env->me_rmutex) goto fail_errno;
+		env->me_wmutex = OpenMutexA(SYNCHRONIZE, FALSE, MUTEXNAME(env, 'w'));
+		if (!env->me_wmutex) goto fail_errno;
+#elif defined(MDB_USE_POSIX_SEM)
+		mdb_env_mname_init(env);
+		env->me_rmutex = sem_open(MUTEXNAME(env, 'r'), 0);
+		if (env->me_rmutex == SEM_FAILED) goto fail_errno;
+		env->me_wmutex = sem_open(MUTEXNAME(env, 'w'), 0);
+		if (env->me_wmutex == SEM_FAILED) goto fail_errno;
+#elif defined(MDB_USE_SYSV_SEM)
+		semid = env->me_txns->mti_semid;
+		semu.buf = &buf;
+		/* check for read access */
+		if (semctl(semid, 0, IPC_STAT, semu) < 0)
+			goto fail_errno;
+		/* check for write access */
+		if (semctl(semid, 0, IPC_SET, semu) < 0)
+			goto fail_errno;
+#endif
+	}
+#ifdef MDB_USE_SYSV_SEM
+	env->me_rmutex->semid = semid;
+	env->me_wmutex->semid = semid;
+	env->me_rmutex->semnum = 0;
+	env->me_wmutex->semnum = 1;
+	env->me_rmutex->locked = &env->me_txns->mti_rlocked;
+	env->me_wmutex->locked = &env->me_txns->mti_wlocked;
+#endif
+
+	return MDB_SUCCESS;
+
+fail_errno:
+	rc = ErrCode();
+fail:
+	return rc;
+}
+
+	/** Only a subset of the @ref mdb_env flags can be changed
+	 *	at runtime. Changing other flags requires closing the
+	 *	environment and re-opening it with the new flags.
+	 */
+#define	CHANGEABLE	(MDB_NOSYNC|MDB_NOMETASYNC|MDB_MAPASYNC|MDB_NOMEMINIT)
+#define	CHANGELESS	(MDB_FIXEDMAP|MDB_NOSUBDIR|MDB_RDONLY| \
+	MDB_WRITEMAP|MDB_NOTLS|MDB_NOLOCK|MDB_NORDAHEAD|MDB_PREVMETA)
+
+#if VALID_FLAGS & PERSISTENT_FLAGS & (CHANGEABLE|CHANGELESS)
+# error "Persistent DB flags & env flags overlap, but both go in mm_flags"
+#endif
+
+int ESECT
+mdb_env_open(MDB_env *env, const char *path, unsigned int flags, mdb_mode_t mode)
+{
+	int rc, excl = -1;
+	MDB_name fname;
+
+	if (env->me_fd!=INVALID_HANDLE_VALUE || (flags & ~(CHANGEABLE|CHANGELESS)))
+		return EINVAL;
+
+#ifdef MDB_VL32
+	if (flags & MDB_WRITEMAP) {
+		/* silently ignore WRITEMAP in 32 bit mode */
+		flags ^= MDB_WRITEMAP;
+	}
+	if (flags & MDB_FIXEDMAP) {
+		/* cannot support FIXEDMAP */
+		return EINVAL;
+	}
+#endif
+	flags |= env->me_flags;
+
+	rc = mdb_fname_init(path, flags, &fname);
+	if (rc)
+		return rc;
+
+#ifdef MDB_VL32
+#ifdef _WIN32
+	env->me_rpmutex = CreateMutex(NULL, FALSE, NULL);
+	if (!env->me_rpmutex) {
+		rc = ErrCode();
+		goto leave;
+	}
+#else
+	rc = pthread_mutex_init(&env->me_rpmutex, NULL);
+	if (rc)
+		goto leave;
+#endif
+#endif
+	flags |= MDB_ENV_ACTIVE;	/* tell mdb_env_close0() to clean up */
+
+	if (flags & MDB_RDONLY) {
+		/* silently ignore WRITEMAP when we're only getting read access */
+		flags &= ~MDB_WRITEMAP;
+	} else {
+		if (!((env->me_free_pgs = mdb_midl_alloc(MDB_IDL_UM_MAX)) &&
+			  (env->me_dirty_list = calloc(MDB_IDL_UM_SIZE, sizeof(MDB_ID2)))))
+			rc = ENOMEM;
+	}
+
+	env->me_flags = flags;
+	if (rc)
+		goto leave;
+
+#ifdef MDB_VL32
+	{
+		env->me_rpages = malloc(MDB_ERPAGE_SIZE * sizeof(MDB_ID3));
+		if (!env->me_rpages) {
+			rc = ENOMEM;
+			goto leave;
+		}
+		env->me_rpages[0].mid = 0;
+		env->me_rpcheck = MDB_ERPAGE_SIZE/2;
+	}
+#endif
+
+	env->me_path = strdup(path);
+	env->me_dbxs = calloc(env->me_maxdbs, sizeof(MDB_dbx));
+	env->me_dbflags = calloc(env->me_maxdbs, sizeof(uint16_t));
+	env->me_dbiseqs = calloc(env->me_maxdbs, sizeof(unsigned int));
+	if (!(env->me_dbxs && env->me_path && env->me_dbflags && env->me_dbiseqs)) {
+		rc = ENOMEM;
+		goto leave;
+	}
+	env->me_dbxs[FREE_DBI].md_cmp = mdb_cmp_long; /* aligned MDB_INTEGERKEY */
+
+	/* For RDONLY, get lockfile after we know datafile exists */
+	if (!(flags & (MDB_RDONLY|MDB_NOLOCK))) {
+		rc = mdb_env_setup_locks(env, &fname, mode, &excl);
+		if (rc)
+			goto leave;
+	}
+
+	rc = mdb_fopen(env, &fname,
+		(flags & MDB_RDONLY) ? MDB_O_RDONLY : MDB_O_RDWR,
+		mode, &env->me_fd);
+	if (rc)
+		goto leave;
+
+	if ((flags & (MDB_RDONLY|MDB_NOLOCK)) == MDB_RDONLY) {
+		rc = mdb_env_setup_locks(env, &fname, mode, &excl);
+		if (rc)
+			goto leave;
+	}
+
+	if ((rc = mdb_env_open2(env, flags & MDB_PREVMETA)) == MDB_SUCCESS) {
+		if (!(flags & (MDB_RDONLY|MDB_WRITEMAP))) {
+			/* Synchronous fd for meta writes. Needed even with
+			 * MDB_NOSYNC/MDB_NOMETASYNC, in case these get reset.
+			 */
+			rc = mdb_fopen(env, &fname, MDB_O_META, mode, &env->me_mfd);
+			if (rc)
+				goto leave;
+		}
+		DPRINTF(("opened dbenv %p", (void *) env));
+		if (excl > 0) {
+			rc = mdb_env_share_locks(env, &excl);
+			if (rc)
+				goto leave;
+		}
+		if (!(flags & MDB_RDONLY)) {
+			MDB_txn *txn;
+			int tsize = sizeof(MDB_txn), size = tsize + env->me_maxdbs *
+				(sizeof(MDB_db)+sizeof(MDB_cursor *)+sizeof(unsigned int)+1);
+			if ((env->me_pbuf = calloc(1, env->me_psize)) &&
+				(txn = calloc(1, size)))
+			{
+				txn->mt_dbs = (MDB_db *)((char *)txn + tsize);
+				txn->mt_cursors = (MDB_cursor **)(txn->mt_dbs + env->me_maxdbs);
+				txn->mt_dbiseqs = (unsigned int *)(txn->mt_cursors + env->me_maxdbs);
+				txn->mt_dbflags = (unsigned char *)(txn->mt_dbiseqs + env->me_maxdbs);
+				txn->mt_env = env;
+#ifdef MDB_VL32
+				txn->mt_rpages = malloc(MDB_TRPAGE_SIZE * sizeof(MDB_ID3));
+				if (!txn->mt_rpages) {
+					free(txn);
+					rc = ENOMEM;
+					goto leave;
+				}
+				txn->mt_rpages[0].mid = 0;
+				txn->mt_rpcheck = MDB_TRPAGE_SIZE/2;
+#endif
+				txn->mt_dbxs = env->me_dbxs;
+				txn->mt_flags = MDB_TXN_FINISHED;
+				env->me_txn0 = txn;
+			} else {
+				rc = ENOMEM;
+			}
+		}
+	}
+
+leave:
+	if (rc) {
+		mdb_env_close0(env, excl);
+	}
+	mdb_fname_destroy(fname);
+	return rc;
+}
+
+/** Destroy resources from mdb_env_open(), clear our readers & DBIs */
+static void ESECT
+mdb_env_close0(MDB_env *env, int excl)
+{
+	int i;
+
+	if (!(env->me_flags & MDB_ENV_ACTIVE))
+		return;
+
+	/* Doing this here since me_dbxs may not exist during mdb_env_close */
+	if (env->me_dbxs) {
+		for (i = env->me_maxdbs; --i >= CORE_DBS; )
+			free(env->me_dbxs[i].md_name.mv_data);
+		free(env->me_dbxs);
+	}
+
+	free(env->me_pbuf);
+	free(env->me_dbiseqs);
+	free(env->me_dbflags);
+	free(env->me_path);
+	free(env->me_dirty_list);
+#ifdef MDB_VL32
+	if (env->me_txn0 && env->me_txn0->mt_rpages)
+		free(env->me_txn0->mt_rpages);
+	if (env->me_rpages) {
+		MDB_ID3L el = env->me_rpages;
+		unsigned int x;
+		for (x=1; x<=el[0].mid; x++)
+			munmap(el[x].mptr, el[x].mcnt * env->me_psize);
+		free(el);
+	}
+#endif
+	free(env->me_txn0);
+	mdb_midl_free(env->me_free_pgs);
+
+	if (env->me_flags & MDB_ENV_TXKEY) {
+		pthread_key_delete(env->me_txkey);
+#ifdef _WIN32
+		/* Delete our key from the global list */
+		for (i=0; i<mdb_tls_nkeys; i++)
+			if (mdb_tls_keys[i] == env->me_txkey) {
+				mdb_tls_keys[i] = mdb_tls_keys[mdb_tls_nkeys-1];
+				mdb_tls_nkeys--;
+				break;
+			}
+#endif
+	}
+
+	if (env->me_map) {
+#ifdef MDB_VL32
+		munmap(env->me_map, NUM_METAS*env->me_psize);
+#else
+		munmap(env->me_map, env->me_mapsize);
+#endif
+	}
+	if (env->me_mfd != INVALID_HANDLE_VALUE)
+		(void) close(env->me_mfd);
+	if (env->me_fd != INVALID_HANDLE_VALUE)
+		(void) close(env->me_fd);
+	if (env->me_txns) {
+		MDB_PID_T pid = getpid();
+		/* Clearing readers is done in this function because
+		 * me_txkey with its destructor must be disabled first.
+		 *
+		 * We skip the the reader mutex, so we touch only
+		 * data owned by this process (me_close_readers and
+		 * our readers), and clear each reader atomically.
+		 */
+		for (i = env->me_close_readers; --i >= 0; )
+			if (env->me_txns->mti_readers[i].mr_pid == pid)
+				env->me_txns->mti_readers[i].mr_pid = 0;
+#ifdef _WIN32
+		if (env->me_rmutex) {
+			CloseHandle(env->me_rmutex);
+			if (env->me_wmutex) CloseHandle(env->me_wmutex);
+		}
+		/* Windows automatically destroys the mutexes when
+		 * the last handle closes.
+		 */
+#elif defined(MDB_USE_POSIX_SEM)
+		if (env->me_rmutex != SEM_FAILED) {
+			sem_close(env->me_rmutex);
+			if (env->me_wmutex != SEM_FAILED)
+				sem_close(env->me_wmutex);
+			/* If we have the filelock:  If we are the
+			 * only remaining user, clean up semaphores.
+			 */
+			if (excl == 0)
+				mdb_env_excl_lock(env, &excl);
+			if (excl > 0) {
+				sem_unlink(MUTEXNAME(env, 'r'));
+				sem_unlink(MUTEXNAME(env, 'w'));
+			}
+		}
+#elif defined(MDB_USE_SYSV_SEM)
+		if (env->me_rmutex->semid != -1) {
+			/* If we have the filelock:  If we are the
+			 * only remaining user, clean up semaphores.
+			 */
+			if (excl == 0)
+				mdb_env_excl_lock(env, &excl);
+			if (excl > 0)
+				semctl(env->me_rmutex->semid, 0, IPC_RMID);
+		}
+#endif
+		munmap((void *)env->me_txns, (env->me_maxreaders-1)*sizeof(MDB_reader)+sizeof(MDB_txninfo));
+	}
+	if (env->me_lfd != INVALID_HANDLE_VALUE) {
+#ifdef _WIN32
+		if (excl >= 0) {
+			/* Unlock the lockfile.  Windows would have unlocked it
+			 * after closing anyway, but not necessarily at once.
+			 */
+			UnlockFile(env->me_lfd, 0, 0, 1, 0);
+		}
+#endif
+		(void) close(env->me_lfd);
+	}
+#ifdef MDB_VL32
+#ifdef _WIN32
+	if (env->me_fmh) CloseHandle(env->me_fmh);
+	if (env->me_rpmutex) CloseHandle(env->me_rpmutex);
+#else
+	pthread_mutex_destroy(&env->me_rpmutex);
+#endif
+#endif
+
+	env->me_flags &= ~(MDB_ENV_ACTIVE|MDB_ENV_TXKEY);
+}
+
+void ESECT
+mdb_env_close(MDB_env *env)
+{
+	MDB_page *dp;
+
+	if (env == NULL)
+		return;
+
+	VGMEMP_DESTROY(env);
+	while ((dp = env->me_dpages) != NULL) {
+		VGMEMP_DEFINED(&dp->mp_next, sizeof(dp->mp_next));
+		env->me_dpages = dp->mp_next;
+		free(dp);
+	}
+
+	mdb_env_close0(env, 0);
+	free(env);
+}
+
+/** Compare two items pointing at aligned #mdb_size_t's */
+static int
+mdb_cmp_long(const MDB_val *a, const MDB_val *b)
+{
+	return (*(mdb_size_t *)a->mv_data < *(mdb_size_t *)b->mv_data) ? -1 :
+		*(mdb_size_t *)a->mv_data > *(mdb_size_t *)b->mv_data;
+}
+
+/** Compare two items pointing at aligned unsigned int's.
+ *
+ *	This is also set as #MDB_INTEGERDUP|#MDB_DUPFIXED's #MDB_dbx.%md_dcmp,
+ *	but #mdb_cmp_clong() is called instead if the data type is #mdb_size_t.
+ */
+static int
+mdb_cmp_int(const MDB_val *a, const MDB_val *b)
+{
+	return (*(unsigned int *)a->mv_data < *(unsigned int *)b->mv_data) ? -1 :
+		*(unsigned int *)a->mv_data > *(unsigned int *)b->mv_data;
+}
+
+/** Compare two items pointing at unsigned ints of unknown alignment.
+ *	Nodes and keys are guaranteed to be 2-byte aligned.
+ */
+static int
+mdb_cmp_cint(const MDB_val *a, const MDB_val *b)
+{
+#if BYTE_ORDER == LITTLE_ENDIAN
+	unsigned short *u, *c;
+	int x;
+
+	u = (unsigned short *) ((char *) a->mv_data + a->mv_size);
+	c = (unsigned short *) ((char *) b->mv_data + a->mv_size);
+	do {
+		x = *--u - *--c;
+	} while(!x && u > (unsigned short *)a->mv_data);
+	return x;
+#else
+	unsigned short *u, *c, *end;
+	int x;
+
+	end = (unsigned short *) ((char *) a->mv_data + a->mv_size);
+	u = (unsigned short *)a->mv_data;
+	c = (unsigned short *)b->mv_data;
+	do {
+		x = *u++ - *c++;
+	} while(!x && u < end);
+	return x;
+#endif
+}
+
+/** Compare two items lexically */
+static int
+mdb_cmp_memn(const MDB_val *a, const MDB_val *b)
+{
+	int diff;
+	ssize_t len_diff;
+	unsigned int len;
+
+	len = a->mv_size;
+	len_diff = (ssize_t) a->mv_size - (ssize_t) b->mv_size;
+	if (len_diff > 0) {
+		len = b->mv_size;
+		len_diff = 1;
+	}
+
+	diff = memcmp(a->mv_data, b->mv_data, len);
+	return diff ? diff : len_diff<0 ? -1 : len_diff;
+}
+
+/** Compare two items in reverse byte order */
+static int
+mdb_cmp_memnr(const MDB_val *a, const MDB_val *b)
+{
+	const unsigned char	*p1, *p2, *p1_lim;
+	ssize_t len_diff;
+	int diff;
+
+	p1_lim = (const unsigned char *)a->mv_data;
+	p1 = (const unsigned char *)a->mv_data + a->mv_size;
+	p2 = (const unsigned char *)b->mv_data + b->mv_size;
+
+	len_diff = (ssize_t) a->mv_size - (ssize_t) b->mv_size;
+	if (len_diff > 0) {
+		p1_lim += len_diff;
+		len_diff = 1;
+	}
+
+	while (p1 > p1_lim) {
+		diff = *--p1 - *--p2;
+		if (diff)
+			return diff;
+	}
+	return len_diff<0 ? -1 : len_diff;
+}
+
+/** Search for key within a page, using binary search.
+ * Returns the smallest entry larger or equal to the key.
+ * If exactp is non-null, stores whether the found entry was an exact match
+ * in *exactp (1 or 0).
+ * Updates the cursor index with the index of the found entry.
+ * If no entry larger or equal to the key is found, returns NULL.
+ */
+static MDB_node *
+mdb_node_search(MDB_cursor *mc, MDB_val *key, int *exactp)
+{
+	unsigned int	 i = 0, nkeys;
+	int		 low, high;
+	int		 rc = 0;
+	MDB_page *mp = mc->mc_pg[mc->mc_top];
+	MDB_node	*node = NULL;
+	MDB_val	 nodekey;
+	MDB_cmp_func *cmp;
+	DKBUF;
+
+	nkeys = NUMKEYS(mp);
+
+	DPRINTF(("searching %u keys in %s %spage %"Yu,
+	    nkeys, IS_LEAF(mp) ? "leaf" : "branch", IS_SUBP(mp) ? "sub-" : "",
+	    mdb_dbg_pgno(mp)));
+
+	low = IS_LEAF(mp) ? 0 : 1;
+	high = nkeys - 1;
+	cmp = mc->mc_dbx->md_cmp;
+
+	/* Branch pages have no data, so if using integer keys,
+	 * alignment is guaranteed. Use faster mdb_cmp_int.
+	 */
+	if (cmp == mdb_cmp_cint && IS_BRANCH(mp)) {
+		if (NODEPTR(mp, 1)->mn_ksize == sizeof(mdb_size_t))
+			cmp = mdb_cmp_long;
+		else
+			cmp = mdb_cmp_int;
+	}
+
+	if (IS_LEAF2(mp)) {
+		nodekey.mv_size = mc->mc_db->md_pad;
+		node = NODEPTR(mp, 0);	/* fake */
+		while (low <= high) {
+			i = (low + high) >> 1;
+			nodekey.mv_data = LEAF2KEY(mp, i, nodekey.mv_size);
+			rc = cmp(key, &nodekey);
+			DPRINTF(("found leaf index %u [%s], rc = %i",
+			    i, DKEY(&nodekey), rc));
+			if (rc == 0)
+				break;
+			if (rc > 0)
+				low = i + 1;
+			else
+				high = i - 1;
+		}
+	} else {
+		while (low <= high) {
+			i = (low + high) >> 1;
+
+			node = NODEPTR(mp, i);
+			nodekey.mv_size = NODEKSZ(node);
+			nodekey.mv_data = NODEKEY(node);
+
+			rc = cmp(key, &nodekey);
+#if MDB_DEBUG
+			if (IS_LEAF(mp))
+				DPRINTF(("found leaf index %u [%s], rc = %i",
+				    i, DKEY(&nodekey), rc));
+			else
+				DPRINTF(("found branch index %u [%s -> %"Yu"], rc = %i",
+				    i, DKEY(&nodekey), NODEPGNO(node), rc));
+#endif
+			if (rc == 0)
+				break;
+			if (rc > 0)
+				low = i + 1;
+			else
+				high = i - 1;
+		}
+	}
+
+	if (rc > 0) {	/* Found entry is less than the key. */
+		i++;	/* Skip to get the smallest entry larger than key. */
+		if (!IS_LEAF2(mp))
+			node = NODEPTR(mp, i);
+	}
+	if (exactp)
+		*exactp = (rc == 0 && nkeys > 0);
+	/* store the key index */
+	mc->mc_ki[mc->mc_top] = i;
+	if (i >= nkeys)
+		/* There is no entry larger or equal to the key. */
+		return NULL;
+
+	/* nodeptr is fake for LEAF2 */
+	return node;
+}
+
+#if 0
+static void
+mdb_cursor_adjust(MDB_cursor *mc, func)
+{
+	MDB_cursor *m2;
+
+	for (m2 = mc->mc_txn->mt_cursors[mc->mc_dbi]; m2; m2=m2->mc_next) {
+		if (m2->mc_pg[m2->mc_top] == mc->mc_pg[mc->mc_top]) {
+			func(mc, m2);
+		}
+	}
+}
+#endif
+
+/** Pop a page off the top of the cursor's stack. */
+static void
+mdb_cursor_pop(MDB_cursor *mc)
+{
+	if (mc->mc_snum) {
+		DPRINTF(("popping page %"Yu" off db %d cursor %p",
+			mc->mc_pg[mc->mc_top]->mp_pgno, DDBI(mc), (void *) mc));
+
+		mc->mc_snum--;
+		if (mc->mc_snum) {
+			mc->mc_top--;
+		} else {
+			mc->mc_flags &= ~C_INITIALIZED;
+		}
+	}
+}
+
+/** Push a page onto the top of the cursor's stack.
+ * Set #MDB_TXN_ERROR on failure.
+ */
+static int
+mdb_cursor_push(MDB_cursor *mc, MDB_page *mp)
+{
+	DPRINTF(("pushing page %"Yu" on db %d cursor %p", mp->mp_pgno,
+		DDBI(mc), (void *) mc));
+
+	if (mc->mc_snum >= CURSOR_STACK) {
+		mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+		return MDB_CURSOR_FULL;
+	}
+
+	mc->mc_top = mc->mc_snum++;
+	mc->mc_pg[mc->mc_top] = mp;
+	mc->mc_ki[mc->mc_top] = 0;
+
+	return MDB_SUCCESS;
+}
+
+#ifdef MDB_VL32
+/** Map a read-only page.
+ * There are two levels of tracking in use, a per-txn list and a per-env list.
+ * ref'ing and unref'ing the per-txn list is faster since it requires no
+ * locking. Pages are cached in the per-env list for global reuse, and a lock
+ * is required. Pages are not immediately unmapped when their refcnt goes to
+ * zero; they hang around in case they will be reused again soon.
+ *
+ * When the per-txn list gets full, all pages with refcnt=0 are purged from the
+ * list and their refcnts in the per-env list are decremented.
+ *
+ * When the per-env list gets full, all pages with refcnt=0 are purged from the
+ * list and their pages are unmapped.
+ *
+ * @note "full" means the list has reached its respective rpcheck threshold.
+ * This threshold slowly raises if no pages could be purged on a given check,
+ * and returns to its original value when enough pages were purged.
+ *
+ * If purging doesn't free any slots, filling the per-txn list will return
+ * MDB_TXN_FULL, and filling the per-env list returns MDB_MAP_FULL.
+ *
+ * Reference tracking in a txn is imperfect, pages can linger with non-zero
+ * refcnt even without active references. It was deemed to be too invasive
+ * to add unrefs in every required location. However, all pages are unref'd
+ * at the end of the transaction. This guarantees that no stale references
+ * linger in the per-env list.
+ *
+ * Usually we map chunks of 16 pages at a time, but if an overflow page begins
+ * at the tail of the chunk we extend the chunk to include the entire overflow
+ * page. Unfortunately, pages can be turned into overflow pages after their
+ * chunk was already mapped. In that case we must remap the chunk if the
+ * overflow page is referenced. If the chunk's refcnt is 0 we can just remap
+ * it, otherwise we temporarily map a new chunk just for the overflow page.
+ *
+ * @note this chunk handling means we cannot guarantee that a data item
+ * returned from the DB will stay alive for the duration of the transaction:
+ *   We unref pages as soon as a cursor moves away from the page
+ *   A subsequent op may cause a purge, which may unmap any unref'd chunks
+ * The caller must copy the data if it must be used later in the same txn.
+ *
+ * Also - our reference counting revolves around cursors, but overflow pages
+ * aren't pointed to by a cursor's page stack. We have to remember them
+ * explicitly, in the added mc_ovpg field. A single cursor can only hold a
+ * reference to one overflow page at a time.
+ *
+ * @param[in] txn the transaction for this access.
+ * @param[in] pgno the page number for the page to retrieve.
+ * @param[out] ret address of a pointer where the page's address will be stored.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_rpage_get(MDB_txn *txn, pgno_t pg0, MDB_page **ret)
+{
+	MDB_env *env = txn->mt_env;
+	MDB_page *p;
+	MDB_ID3L tl = txn->mt_rpages;
+	MDB_ID3L el = env->me_rpages;
+	MDB_ID3 id3;
+	unsigned x, rem;
+	pgno_t pgno;
+	int rc, retries = 1;
+#ifdef _WIN32
+	LARGE_INTEGER off;
+	SIZE_T len;
+#define SET_OFF(off,val)	off.QuadPart = val
+#define MAP(rc,env,addr,len,off)	\
+	addr = NULL; \
+	rc = NtMapViewOfSection(env->me_fmh, GetCurrentProcess(), &addr, 0, \
+		len, &off, &len, ViewUnmap, (env->me_flags & MDB_RDONLY) ? 0 : MEM_RESERVE, PAGE_READONLY); \
+	if (rc) rc = mdb_nt2win32(rc)
+#else
+	off_t off;
+	size_t len;
+#define SET_OFF(off,val)	off = val
+#define MAP(rc,env,addr,len,off)	\
+	addr = mmap(NULL, len, PROT_READ, MAP_SHARED, env->me_fd, off); \
+	rc = (addr == MAP_FAILED) ? errno : 0
+#endif
+
+	/* remember the offset of the actual page number, so we can
+	 * return the correct pointer at the end.
+	 */
+	rem = pg0 & (MDB_RPAGE_CHUNK-1);
+	pgno = pg0 ^ rem;
+
+	id3.mid = 0;
+	x = mdb_mid3l_search(tl, pgno);
+	if (x <= tl[0].mid && tl[x].mid == pgno) {
+		if (x != tl[0].mid && tl[x+1].mid == pg0)
+			x++;
+		/* check for overflow size */
+		p = (MDB_page *)((char *)tl[x].mptr + rem * env->me_psize);
+		if (IS_OVERFLOW(p) && p->mp_pages + rem > tl[x].mcnt) {
+			id3.mcnt = p->mp_pages + rem;
+			len = id3.mcnt * env->me_psize;
+			SET_OFF(off, pgno * env->me_psize);
+			MAP(rc, env, id3.mptr, len, off);
+			if (rc)
+				return rc;
+			/* check for local-only page */
+			if (rem) {
+				mdb_tassert(txn, tl[x].mid != pg0);
+				/* hope there's room to insert this locally.
+				 * setting mid here tells later code to just insert
+				 * this id3 instead of searching for a match.
+				 */
+				id3.mid = pg0;
+				goto notlocal;
+			} else {
+				/* ignore the mapping we got from env, use new one */
+				tl[x].mptr = id3.mptr;
+				tl[x].mcnt = id3.mcnt;
+				/* if no active ref, see if we can replace in env */
+				if (!tl[x].mref) {
+					unsigned i;
+					pthread_mutex_lock(&env->me_rpmutex);
+					i = mdb_mid3l_search(el, tl[x].mid);
+					if (el[i].mref == 1) {
+						/* just us, replace it */
+						munmap(el[i].mptr, el[i].mcnt * env->me_psize);
+						el[i].mptr = tl[x].mptr;
+						el[i].mcnt = tl[x].mcnt;
+					} else {
+						/* there are others, remove ourself */
+						el[i].mref--;
+					}
+					pthread_mutex_unlock(&env->me_rpmutex);
+				}
+			}
+		}
+		id3.mptr = tl[x].mptr;
+		id3.mcnt = tl[x].mcnt;
+		tl[x].mref++;
+		goto ok;
+	}
+
+notlocal:
+	if (tl[0].mid >= MDB_TRPAGE_MAX - txn->mt_rpcheck) {
+		unsigned i, y;
+		/* purge unref'd pages from our list and unref in env */
+		pthread_mutex_lock(&env->me_rpmutex);
+retry:
+		y = 0;
+		for (i=1; i<=tl[0].mid; i++) {
+			if (!tl[i].mref) {
+				if (!y) y = i;
+				/* tmp overflow pages don't go to env */
+				if (tl[i].mid & (MDB_RPAGE_CHUNK-1)) {
+					munmap(tl[i].mptr, tl[i].mcnt * env->me_psize);
+					continue;
+				}
+				x = mdb_mid3l_search(el, tl[i].mid);
+				el[x].mref--;
+			}
+		}
+		pthread_mutex_unlock(&env->me_rpmutex);
+		if (!y) {
+			/* we didn't find any unref'd chunks.
+			 * if we're out of room, fail.
+			 */
+			if (tl[0].mid >= MDB_TRPAGE_MAX)
+				return MDB_TXN_FULL;
+			/* otherwise, raise threshold for next time around
+			 * and let this go.
+			 */
+			txn->mt_rpcheck /= 2;
+		} else {
+			/* we found some unused; consolidate the list */
+			for (i=y+1; i<= tl[0].mid; i++)
+				if (tl[i].mref)
+					tl[y++] = tl[i];
+			tl[0].mid = y-1;
+			/* decrease the check threshold toward its original value */
+			if (!txn->mt_rpcheck)
+				txn->mt_rpcheck = 1;
+			while (txn->mt_rpcheck < tl[0].mid && txn->mt_rpcheck < MDB_TRPAGE_SIZE/2)
+				txn->mt_rpcheck *= 2;
+		}
+	}
+	if (tl[0].mid < MDB_TRPAGE_SIZE) {
+		id3.mref = 1;
+		if (id3.mid)
+			goto found;
+		/* don't map past last written page in read-only envs */
+		if ((env->me_flags & MDB_RDONLY) && pgno + MDB_RPAGE_CHUNK-1 > txn->mt_last_pgno)
+			id3.mcnt = txn->mt_last_pgno + 1 - pgno;
+		else
+			id3.mcnt = MDB_RPAGE_CHUNK;
+		len = id3.mcnt * env->me_psize;
+		id3.mid = pgno;
+
+		/* search for page in env */
+		pthread_mutex_lock(&env->me_rpmutex);
+		x = mdb_mid3l_search(el, pgno);
+		if (x <= el[0].mid && el[x].mid == pgno) {
+			id3.mptr = el[x].mptr;
+			id3.mcnt = el[x].mcnt;
+			/* check for overflow size */
+			p = (MDB_page *)((char *)id3.mptr + rem * env->me_psize);
+			if (IS_OVERFLOW(p) && p->mp_pages + rem > id3.mcnt) {
+				id3.mcnt = p->mp_pages + rem;
+				len = id3.mcnt * env->me_psize;
+				SET_OFF(off, pgno * env->me_psize);
+				MAP(rc, env, id3.mptr, len, off);
+				if (rc)
+					goto fail;
+				if (!el[x].mref) {
+					munmap(el[x].mptr, env->me_psize * el[x].mcnt);
+					el[x].mptr = id3.mptr;
+					el[x].mcnt = id3.mcnt;
+				} else {
+					id3.mid = pg0;
+					pthread_mutex_unlock(&env->me_rpmutex);
+					goto found;
+				}
+			}
+			el[x].mref++;
+			pthread_mutex_unlock(&env->me_rpmutex);
+			goto found;
+		}
+		if (el[0].mid >= MDB_ERPAGE_MAX - env->me_rpcheck) {
+			/* purge unref'd pages */
+			unsigned i, y = 0;
+			for (i=1; i<=el[0].mid; i++) {
+				if (!el[i].mref) {
+					if (!y) y = i;
+					munmap(el[i].mptr, env->me_psize * el[i].mcnt);
+				}
+			}
+			if (!y) {
+				if (retries) {
+					/* see if we can unref some local pages */
+					retries--;
+					id3.mid = 0;
+					goto retry;
+				}
+				if (el[0].mid >= MDB_ERPAGE_MAX) {
+					pthread_mutex_unlock(&env->me_rpmutex);
+					return MDB_MAP_FULL;
+				}
+				env->me_rpcheck /= 2;
+			} else {
+				for (i=y+1; i<= el[0].mid; i++)
+					if (el[i].mref)
+						el[y++] = el[i];
+				el[0].mid = y-1;
+				if (!env->me_rpcheck)
+					env->me_rpcheck = 1;
+				while (env->me_rpcheck < el[0].mid && env->me_rpcheck < MDB_ERPAGE_SIZE/2)
+					env->me_rpcheck *= 2;
+			}
+		}
+		SET_OFF(off, pgno * env->me_psize);
+		MAP(rc, env, id3.mptr, len, off);
+		if (rc) {
+fail:
+			pthread_mutex_unlock(&env->me_rpmutex);
+			return rc;
+		}
+		/* check for overflow size */
+		p = (MDB_page *)((char *)id3.mptr + rem * env->me_psize);
+		if (IS_OVERFLOW(p) && p->mp_pages + rem > id3.mcnt) {
+			id3.mcnt = p->mp_pages + rem;
+			munmap(id3.mptr, len);
+			len = id3.mcnt * env->me_psize;
+			MAP(rc, env, id3.mptr, len, off);
+			if (rc)
+				goto fail;
+		}
+		mdb_mid3l_insert(el, &id3);
+		pthread_mutex_unlock(&env->me_rpmutex);
+found:
+		mdb_mid3l_insert(tl, &id3);
+	} else {
+		return MDB_TXN_FULL;
+	}
+ok:
+	p = (MDB_page *)((char *)id3.mptr + rem * env->me_psize);
+#if MDB_DEBUG	/* we don't need this check any more */
+	if (IS_OVERFLOW(p)) {
+		mdb_tassert(txn, p->mp_pages + rem <= id3.mcnt);
+	}
+#endif
+	*ret = p;
+	return MDB_SUCCESS;
+}
+#endif
+
+/** Find the address of the page corresponding to a given page number.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in] mc the cursor accessing the page.
+ * @param[in] pgno the page number for the page to retrieve.
+ * @param[out] ret address of a pointer where the page's address will be stored.
+ * @param[out] lvl dirty_list inheritance level of found page. 1=current txn, 0=mapped page.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_get(MDB_cursor *mc, pgno_t pgno, MDB_page **ret, int *lvl)
+{
+	MDB_txn *txn = mc->mc_txn;
+	MDB_page *p = NULL;
+	int level;
+
+	if (! (mc->mc_flags & (C_ORIG_RDONLY|C_WRITEMAP))) {
+		MDB_txn *tx2 = txn;
+		level = 1;
+		do {
+			MDB_ID2L dl = tx2->mt_u.dirty_list;
+			unsigned x;
+			/* Spilled pages were dirtied in this txn and flushed
+			 * because the dirty list got full. Bring this page
+			 * back in from the map (but don't unspill it here,
+			 * leave that unless page_touch happens again).
+			 */
+			if (tx2->mt_spill_pgs) {
+				MDB_ID pn = pgno << 1;
+				x = mdb_midl_search(tx2->mt_spill_pgs, pn);
+				if (x <= tx2->mt_spill_pgs[0] && tx2->mt_spill_pgs[x] == pn) {
+					goto mapped;
+				}
+			}
+			if (dl[0].mid) {
+				unsigned x = mdb_mid2l_search(dl, pgno);
+				if (x <= dl[0].mid && dl[x].mid == pgno) {
+					p = dl[x].mptr;
+					goto done;
+				}
+			}
+			level++;
+		} while ((tx2 = tx2->mt_parent) != NULL);
+	}
+
+	if (pgno >= txn->mt_next_pgno) {
+		DPRINTF(("page %"Yu" not found", pgno));
+		txn->mt_flags |= MDB_TXN_ERROR;
+		return MDB_PAGE_NOTFOUND;
+	}
+
+	level = 0;
+
+mapped:
+	{
+#ifdef MDB_VL32
+		int rc = mdb_rpage_get(txn, pgno, &p);
+		if (rc) {
+			txn->mt_flags |= MDB_TXN_ERROR;
+			return rc;
+		}
+#else
+		MDB_env *env = txn->mt_env;
+		p = (MDB_page *)(env->me_map + env->me_psize * pgno);
+#endif
+	}
+
+done:
+	*ret = p;
+	if (lvl)
+		*lvl = level;
+	return MDB_SUCCESS;
+}
+
+/** Finish #mdb_page_search() / #mdb_page_search_lowest().
+ *	The cursor is at the root page, set up the rest of it.
+ */
+static int
+mdb_page_search_root(MDB_cursor *mc, MDB_val *key, int flags)
+{
+	MDB_page	*mp = mc->mc_pg[mc->mc_top];
+	int rc;
+	DKBUF;
+
+	while (IS_BRANCH(mp)) {
+		MDB_node	*node;
+		indx_t		i;
+
+		DPRINTF(("branch page %"Yu" has %u keys", mp->mp_pgno, NUMKEYS(mp)));
+		/* Don't assert on branch pages in the FreeDB. We can get here
+		 * while in the process of rebalancing a FreeDB branch page; we must
+		 * let that proceed. ITS#8336
+		 */
+		mdb_cassert(mc, !mc->mc_dbi || NUMKEYS(mp) > 1);
+		DPRINTF(("found index 0 to page %"Yu, NODEPGNO(NODEPTR(mp, 0))));
+
+		if (flags & (MDB_PS_FIRST|MDB_PS_LAST)) {
+			i = 0;
+			if (flags & MDB_PS_LAST) {
+				i = NUMKEYS(mp) - 1;
+				/* if already init'd, see if we're already in right place */
+				if (mc->mc_flags & C_INITIALIZED) {
+					if (mc->mc_ki[mc->mc_top] == i) {
+						mc->mc_top = mc->mc_snum++;
+						mp = mc->mc_pg[mc->mc_top];
+						goto ready;
+					}
+				}
+			}
+		} else {
+			int	 exact;
+			node = mdb_node_search(mc, key, &exact);
+			if (node == NULL)
+				i = NUMKEYS(mp) - 1;
+			else {
+				i = mc->mc_ki[mc->mc_top];
+				if (!exact) {
+					mdb_cassert(mc, i > 0);
+					i--;
+				}
+			}
+			DPRINTF(("following index %u for key [%s]", i, DKEY(key)));
+		}
+
+		mdb_cassert(mc, i < NUMKEYS(mp));
+		node = NODEPTR(mp, i);
+
+		if ((rc = mdb_page_get(mc, NODEPGNO(node), &mp, NULL)) != 0)
+			return rc;
+
+		mc->mc_ki[mc->mc_top] = i;
+		if ((rc = mdb_cursor_push(mc, mp)))
+			return rc;
+
+ready:
+		if (flags & MDB_PS_MODIFY) {
+			if ((rc = mdb_page_touch(mc)) != 0)
+				return rc;
+			mp = mc->mc_pg[mc->mc_top];
+		}
+	}
+
+	if (!IS_LEAF(mp)) {
+		DPRINTF(("internal error, index points to a %02X page!?",
+		    mp->mp_flags));
+		mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+		return MDB_CORRUPTED;
+	}
+
+	DPRINTF(("found leaf page %"Yu" for key [%s]", mp->mp_pgno,
+	    key ? DKEY(key) : "null"));
+	mc->mc_flags |= C_INITIALIZED;
+	mc->mc_flags &= ~C_EOF;
+
+	return MDB_SUCCESS;
+}
+
+/** Search for the lowest key under the current branch page.
+ * This just bypasses a NUMKEYS check in the current page
+ * before calling mdb_page_search_root(), because the callers
+ * are all in situations where the current page is known to
+ * be underfilled.
+ */
+static int
+mdb_page_search_lowest(MDB_cursor *mc)
+{
+	MDB_page	*mp = mc->mc_pg[mc->mc_top];
+	MDB_node	*node = NODEPTR(mp, 0);
+	int rc;
+
+	if ((rc = mdb_page_get(mc, NODEPGNO(node), &mp, NULL)) != 0)
+		return rc;
+
+	mc->mc_ki[mc->mc_top] = 0;
+	if ((rc = mdb_cursor_push(mc, mp)))
+		return rc;
+	return mdb_page_search_root(mc, NULL, MDB_PS_FIRST);
+}
+
+/** Search for the page a given key should be in.
+ * Push it and its parent pages on the cursor stack.
+ * @param[in,out] mc the cursor for this operation.
+ * @param[in] key the key to search for, or NULL for first/last page.
+ * @param[in] flags If MDB_PS_MODIFY is set, visited pages in the DB
+ *   are touched (updated with new page numbers).
+ *   If MDB_PS_FIRST or MDB_PS_LAST is set, find first or last leaf.
+ *   This is used by #mdb_cursor_first() and #mdb_cursor_last().
+ *   If MDB_PS_ROOTONLY set, just fetch root node, no further lookups.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_search(MDB_cursor *mc, MDB_val *key, int flags)
+{
+	int		 rc;
+	pgno_t		 root;
+
+	/* Make sure the txn is still viable, then find the root from
+	 * the txn's db table and set it as the root of the cursor's stack.
+	 */
+	if (mc->mc_txn->mt_flags & MDB_TXN_BLOCKED) {
+		DPUTS("transaction may not be used now");
+		return MDB_BAD_TXN;
+	} else {
+		/* Make sure we're using an up-to-date root */
+		if (*mc->mc_dbflag & DB_STALE) {
+				MDB_cursor mc2;
+				if (TXN_DBI_CHANGED(mc->mc_txn, mc->mc_dbi))
+					return MDB_BAD_DBI;
+				mdb_cursor_init(&mc2, mc->mc_txn, MAIN_DBI, NULL);
+				rc = mdb_page_search(&mc2, &mc->mc_dbx->md_name, 0);
+				if (rc)
+					return rc;
+				{
+					MDB_val data;
+					int exact = 0;
+					uint16_t flags;
+					MDB_node *leaf = mdb_node_search(&mc2,
+						&mc->mc_dbx->md_name, &exact);
+					if (!exact)
+						return MDB_NOTFOUND;
+					if ((leaf->mn_flags & (F_DUPDATA|F_SUBDATA)) != F_SUBDATA)
+						return MDB_INCOMPATIBLE; /* not a named DB */
+					rc = mdb_node_read(&mc2, leaf, &data);
+					if (rc)
+						return rc;
+					memcpy(&flags, ((char *) data.mv_data + offsetof(MDB_db, md_flags)),
+						sizeof(uint16_t));
+					/* The txn may not know this DBI, or another process may
+					 * have dropped and recreated the DB with other flags.
+					 */
+					if ((mc->mc_db->md_flags & PERSISTENT_FLAGS) != flags)
+						return MDB_INCOMPATIBLE;
+					memcpy(mc->mc_db, data.mv_data, sizeof(MDB_db));
+				}
+				*mc->mc_dbflag &= ~DB_STALE;
+		}
+		root = mc->mc_db->md_root;
+
+		if (root == P_INVALID) {		/* Tree is empty. */
+			DPUTS("tree is empty");
+			return MDB_NOTFOUND;
+		}
+	}
+
+	mdb_cassert(mc, root > 1);
+	if (!mc->mc_pg[0] || mc->mc_pg[0]->mp_pgno != root) {
+#ifdef MDB_VL32
+		if (mc->mc_pg[0])
+			MDB_PAGE_UNREF(mc->mc_txn, mc->mc_pg[0]);
+#endif
+		if ((rc = mdb_page_get(mc, root, &mc->mc_pg[0], NULL)) != 0)
+			return rc;
+	}
+
+#ifdef MDB_VL32
+	{
+		int i;
+		for (i=1; i<mc->mc_snum; i++)
+			MDB_PAGE_UNREF(mc->mc_txn, mc->mc_pg[i]);
+	}
+#endif
+	mc->mc_snum = 1;
+	mc->mc_top = 0;
+
+	DPRINTF(("db %d root page %"Yu" has flags 0x%X",
+		DDBI(mc), root, mc->mc_pg[0]->mp_flags));
+
+	if (flags & MDB_PS_MODIFY) {
+		if ((rc = mdb_page_touch(mc)))
+			return rc;
+	}
+
+	if (flags & MDB_PS_ROOTONLY)
+		return MDB_SUCCESS;
+
+	return mdb_page_search_root(mc, key, flags);
+}
+
+static int
+mdb_ovpage_free(MDB_cursor *mc, MDB_page *mp)
+{
+	MDB_txn *txn = mc->mc_txn;
+	pgno_t pg = mp->mp_pgno;
+	unsigned x = 0, ovpages = mp->mp_pages;
+	MDB_env *env = txn->mt_env;
+	MDB_IDL sl = txn->mt_spill_pgs;
+	MDB_ID pn = pg << 1;
+	int rc;
+
+	DPRINTF(("free ov page %"Yu" (%d)", pg, ovpages));
+	/* If the page is dirty or on the spill list we just acquired it,
+	 * so we should give it back to our current free list, if any.
+	 * Otherwise put it onto the list of pages we freed in this txn.
+	 *
+	 * Won't create me_pghead: me_pglast must be inited along with it.
+	 * Unsupported in nested txns: They would need to hide the page
+	 * range in ancestor txns' dirty and spilled lists.
+	 */
+	if (env->me_pghead &&
+		!txn->mt_parent &&
+		((mp->mp_flags & P_DIRTY) ||
+		 (sl && (x = mdb_midl_search(sl, pn)) <= sl[0] && sl[x] == pn)))
+	{
+		unsigned i, j;
+		pgno_t *mop;
+		MDB_ID2 *dl, ix, iy;
+		rc = mdb_midl_need(&env->me_pghead, ovpages);
+		if (rc)
+			return rc;
+		if (!(mp->mp_flags & P_DIRTY)) {
+			/* This page is no longer spilled */
+			if (x == sl[0])
+				sl[0]--;
+			else
+				sl[x] |= 1;
+			goto release;
+		}
+		/* Remove from dirty list */
+		dl = txn->mt_u.dirty_list;
+		x = dl[0].mid--;
+		for (ix = dl[x]; ix.mptr != mp; ix = iy) {
+			if (x > 1) {
+				x--;
+				iy = dl[x];
+				dl[x] = ix;
+			} else {
+				mdb_cassert(mc, x > 1);
+				j = ++(dl[0].mid);
+				dl[j] = ix;		/* Unsorted. OK when MDB_TXN_ERROR. */
+				txn->mt_flags |= MDB_TXN_ERROR;
+				return MDB_PROBLEM;
+			}
+		}
+		txn->mt_dirty_room++;
+		if (!(env->me_flags & MDB_WRITEMAP))
+			mdb_dpage_free(env, mp);
+release:
+		/* Insert in me_pghead */
+		mop = env->me_pghead;
+		j = mop[0] + ovpages;
+		for (i = mop[0]; i && mop[i] < pg; i--)
+			mop[j--] = mop[i];
+		while (j>i)
+			mop[j--] = pg++;
+		mop[0] += ovpages;
+	} else {
+		rc = mdb_midl_append_range(&txn->mt_free_pgs, pg, ovpages);
+		if (rc)
+			return rc;
+	}
+#ifdef MDB_VL32
+	if (mc->mc_ovpg == mp)
+		mc->mc_ovpg = NULL;
+#endif
+	mc->mc_db->md_overflow_pages -= ovpages;
+	return 0;
+}
+
+/** Return the data associated with a given node.
+ * @param[in] mc The cursor for this operation.
+ * @param[in] leaf The node being read.
+ * @param[out] data Updated to point to the node's data.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_node_read(MDB_cursor *mc, MDB_node *leaf, MDB_val *data)
+{
+	MDB_page	*omp;		/* overflow page */
+	pgno_t		 pgno;
+	int rc;
+
+	if (MC_OVPG(mc)) {
+		MDB_PAGE_UNREF(mc->mc_txn, MC_OVPG(mc));
+		MC_SET_OVPG(mc, NULL);
+	}
+	if (!F_ISSET(leaf->mn_flags, F_BIGDATA)) {
+		data->mv_size = NODEDSZ(leaf);
+		data->mv_data = NODEDATA(leaf);
+		return MDB_SUCCESS;
+	}
+
+	/* Read overflow data.
+	 */
+	data->mv_size = NODEDSZ(leaf);
+	memcpy(&pgno, NODEDATA(leaf), sizeof(pgno));
+	if ((rc = mdb_page_get(mc, pgno, &omp, NULL)) != 0) {
+		DPRINTF(("read overflow page %"Yu" failed", pgno));
+		return rc;
+	}
+	data->mv_data = METADATA(omp);
+	MC_SET_OVPG(mc, omp);
+
+	return MDB_SUCCESS;
+}
+
+int
+mdb_get(MDB_txn *txn, MDB_dbi dbi,
+    MDB_val *key, MDB_val *data)
+{
+	MDB_cursor	mc;
+	MDB_xcursor	mx;
+	int exact = 0, rc;
+	DKBUF;
+
+	DPRINTF(("===> get db %u key [%s]", dbi, DKEY(key)));
+
+	if (!key || !data || !TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	if (txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	mdb_cursor_init(&mc, txn, dbi, &mx);
+	rc = mdb_cursor_set(&mc, key, data, MDB_SET, &exact);
+	/* unref all the pages when MDB_VL32 - caller must copy the data
+	 * before doing anything else
+	 */
+	MDB_CURSOR_UNREF(&mc, 1);
+	return rc;
+}
+
+/** Find a sibling for a page.
+ * Replaces the page at the top of the cursor's stack with the
+ * specified sibling, if one exists.
+ * @param[in] mc The cursor for this operation.
+ * @param[in] move_right Non-zero if the right sibling is requested,
+ * otherwise the left sibling.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_cursor_sibling(MDB_cursor *mc, int move_right)
+{
+	int		 rc;
+	MDB_node	*indx;
+	MDB_page	*mp;
+#ifdef MDB_VL32
+	MDB_page	*op;
+#endif
+
+	if (mc->mc_snum < 2) {
+		return MDB_NOTFOUND;		/* root has no siblings */
+	}
+
+#ifdef MDB_VL32
+	op = mc->mc_pg[mc->mc_top];
+#endif
+	mdb_cursor_pop(mc);
+	DPRINTF(("parent page is page %"Yu", index %u",
+		mc->mc_pg[mc->mc_top]->mp_pgno, mc->mc_ki[mc->mc_top]));
+
+	if (move_right ? (mc->mc_ki[mc->mc_top] + 1u >= NUMKEYS(mc->mc_pg[mc->mc_top]))
+		       : (mc->mc_ki[mc->mc_top] == 0)) {
+		DPRINTF(("no more keys left, moving to %s sibling",
+		    move_right ? "right" : "left"));
+		if ((rc = mdb_cursor_sibling(mc, move_right)) != MDB_SUCCESS) {
+			/* undo cursor_pop before returning */
+			mc->mc_top++;
+			mc->mc_snum++;
+			return rc;
+		}
+	} else {
+		if (move_right)
+			mc->mc_ki[mc->mc_top]++;
+		else
+			mc->mc_ki[mc->mc_top]--;
+		DPRINTF(("just moving to %s index key %u",
+		    move_right ? "right" : "left", mc->mc_ki[mc->mc_top]));
+	}
+	mdb_cassert(mc, IS_BRANCH(mc->mc_pg[mc->mc_top]));
+
+	MDB_PAGE_UNREF(mc->mc_txn, op);
+
+	indx = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+	if ((rc = mdb_page_get(mc, NODEPGNO(indx), &mp, NULL)) != 0) {
+		/* mc will be inconsistent if caller does mc_snum++ as above */
+		mc->mc_flags &= ~(C_INITIALIZED|C_EOF);
+		return rc;
+	}
+
+	mdb_cursor_push(mc, mp);
+	if (!move_right)
+		mc->mc_ki[mc->mc_top] = NUMKEYS(mp)-1;
+
+	return MDB_SUCCESS;
+}
+
+/** Move the cursor to the next data item. */
+static int
+mdb_cursor_next(MDB_cursor *mc, MDB_val *key, MDB_val *data, MDB_cursor_op op)
+{
+	MDB_page	*mp;
+	MDB_node	*leaf;
+	int rc;
+
+	if ((mc->mc_flags & C_DEL && op == MDB_NEXT_DUP))
+		return MDB_NOTFOUND;
+
+	if (!(mc->mc_flags & C_INITIALIZED))
+		return mdb_cursor_first(mc, key, data);
+
+	mp = mc->mc_pg[mc->mc_top];
+
+	if (mc->mc_flags & C_EOF) {
+		if (mc->mc_ki[mc->mc_top] >= NUMKEYS(mp)-1)
+			return MDB_NOTFOUND;
+		mc->mc_flags ^= C_EOF;
+	}
+
+	if (mc->mc_db->md_flags & MDB_DUPSORT) {
+		leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			if (op == MDB_NEXT || op == MDB_NEXT_DUP) {
+				rc = mdb_cursor_next(&mc->mc_xcursor->mx_cursor, data, NULL, MDB_NEXT);
+				if (op != MDB_NEXT || rc != MDB_NOTFOUND) {
+					if (rc == MDB_SUCCESS)
+						MDB_GET_KEY(leaf, key);
+					return rc;
+				}
+			}
+			else {
+				MDB_CURSOR_UNREF(&mc->mc_xcursor->mx_cursor, 0);
+			}
+		} else {
+			mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+			if (op == MDB_NEXT_DUP)
+				return MDB_NOTFOUND;
+		}
+	}
+
+	DPRINTF(("cursor_next: top page is %"Yu" in cursor %p",
+		mdb_dbg_pgno(mp), (void *) mc));
+	if (mc->mc_flags & C_DEL) {
+		mc->mc_flags ^= C_DEL;
+		goto skip;
+	}
+
+	if (mc->mc_ki[mc->mc_top] + 1u >= NUMKEYS(mp)) {
+		DPUTS("=====> move to next sibling page");
+		if ((rc = mdb_cursor_sibling(mc, 1)) != MDB_SUCCESS) {
+			mc->mc_flags |= C_EOF;
+			return rc;
+		}
+		mp = mc->mc_pg[mc->mc_top];
+		DPRINTF(("next page is %"Yu", key index %u", mp->mp_pgno, mc->mc_ki[mc->mc_top]));
+	} else
+		mc->mc_ki[mc->mc_top]++;
+
+skip:
+	DPRINTF(("==> cursor points to page %"Yu" with %u keys, key index %u",
+	    mdb_dbg_pgno(mp), NUMKEYS(mp), mc->mc_ki[mc->mc_top]));
+
+	if (IS_LEAF2(mp)) {
+		key->mv_size = mc->mc_db->md_pad;
+		key->mv_data = LEAF2KEY(mp, mc->mc_ki[mc->mc_top], key->mv_size);
+		return MDB_SUCCESS;
+	}
+
+	mdb_cassert(mc, IS_LEAF(mp));
+	leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+
+	if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+		mdb_xcursor_init1(mc, leaf);
+	}
+	if (data) {
+		if ((rc = mdb_node_read(mc, leaf, data)) != MDB_SUCCESS)
+			return rc;
+
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			rc = mdb_cursor_first(&mc->mc_xcursor->mx_cursor, data, NULL);
+			if (rc != MDB_SUCCESS)
+				return rc;
+		}
+	}
+
+	MDB_GET_KEY(leaf, key);
+	return MDB_SUCCESS;
+}
+
+/** Move the cursor to the previous data item. */
+static int
+mdb_cursor_prev(MDB_cursor *mc, MDB_val *key, MDB_val *data, MDB_cursor_op op)
+{
+	MDB_page	*mp;
+	MDB_node	*leaf;
+	int rc;
+
+	if (!(mc->mc_flags & C_INITIALIZED)) {
+		rc = mdb_cursor_last(mc, key, data);
+		if (rc)
+			return rc;
+		mc->mc_ki[mc->mc_top]++;
+	}
+
+	mp = mc->mc_pg[mc->mc_top];
+
+	if (mc->mc_db->md_flags & MDB_DUPSORT) {
+		leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			if (op == MDB_PREV || op == MDB_PREV_DUP) {
+				rc = mdb_cursor_prev(&mc->mc_xcursor->mx_cursor, data, NULL, MDB_PREV);
+				if (op != MDB_PREV || rc != MDB_NOTFOUND) {
+					if (rc == MDB_SUCCESS) {
+						MDB_GET_KEY(leaf, key);
+						mc->mc_flags &= ~C_EOF;
+					}
+					return rc;
+				}
+			}
+			else {
+				MDB_CURSOR_UNREF(&mc->mc_xcursor->mx_cursor, 0);
+			}
+		} else {
+			mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+			if (op == MDB_PREV_DUP)
+				return MDB_NOTFOUND;
+		}
+	}
+
+	DPRINTF(("cursor_prev: top page is %"Yu" in cursor %p",
+		mdb_dbg_pgno(mp), (void *) mc));
+
+	mc->mc_flags &= ~(C_EOF|C_DEL);
+
+	if (mc->mc_ki[mc->mc_top] == 0)  {
+		DPUTS("=====> move to prev sibling page");
+		if ((rc = mdb_cursor_sibling(mc, 0)) != MDB_SUCCESS) {
+			return rc;
+		}
+		mp = mc->mc_pg[mc->mc_top];
+		mc->mc_ki[mc->mc_top] = NUMKEYS(mp) - 1;
+		DPRINTF(("prev page is %"Yu", key index %u", mp->mp_pgno, mc->mc_ki[mc->mc_top]));
+	} else
+		mc->mc_ki[mc->mc_top]--;
+
+	DPRINTF(("==> cursor points to page %"Yu" with %u keys, key index %u",
+	    mdb_dbg_pgno(mp), NUMKEYS(mp), mc->mc_ki[mc->mc_top]));
+
+	if (IS_LEAF2(mp)) {
+		key->mv_size = mc->mc_db->md_pad;
+		key->mv_data = LEAF2KEY(mp, mc->mc_ki[mc->mc_top], key->mv_size);
+		return MDB_SUCCESS;
+	}
+
+	mdb_cassert(mc, IS_LEAF(mp));
+	leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+
+	if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+		mdb_xcursor_init1(mc, leaf);
+	}
+	if (data) {
+		if ((rc = mdb_node_read(mc, leaf, data)) != MDB_SUCCESS)
+			return rc;
+
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			rc = mdb_cursor_last(&mc->mc_xcursor->mx_cursor, data, NULL);
+			if (rc != MDB_SUCCESS)
+				return rc;
+		}
+	}
+
+	MDB_GET_KEY(leaf, key);
+	return MDB_SUCCESS;
+}
+
+/** Set the cursor on a specific data item. */
+static int
+mdb_cursor_set(MDB_cursor *mc, MDB_val *key, MDB_val *data,
+    MDB_cursor_op op, int *exactp)
+{
+	int		 rc;
+	MDB_page	*mp;
+	MDB_node	*leaf = NULL;
+	DKBUF;
+
+	if (key->mv_size == 0)
+		return MDB_BAD_VALSIZE;
+
+	if (mc->mc_xcursor) {
+		MDB_CURSOR_UNREF(&mc->mc_xcursor->mx_cursor, 0);
+		mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+	}
+
+	/* See if we're already on the right page */
+	if (mc->mc_flags & C_INITIALIZED) {
+		MDB_val nodekey;
+
+		mp = mc->mc_pg[mc->mc_top];
+		if (!NUMKEYS(mp)) {
+			mc->mc_ki[mc->mc_top] = 0;
+			return MDB_NOTFOUND;
+		}
+		if (mp->mp_flags & P_LEAF2) {
+			nodekey.mv_size = mc->mc_db->md_pad;
+			nodekey.mv_data = LEAF2KEY(mp, 0, nodekey.mv_size);
+		} else {
+			leaf = NODEPTR(mp, 0);
+			MDB_GET_KEY2(leaf, nodekey);
+		}
+		rc = mc->mc_dbx->md_cmp(key, &nodekey);
+		if (rc == 0) {
+			/* Probably happens rarely, but first node on the page
+			 * was the one we wanted.
+			 */
+			mc->mc_ki[mc->mc_top] = 0;
+			if (exactp)
+				*exactp = 1;
+			goto set1;
+		}
+		if (rc > 0) {
+			unsigned int i;
+			unsigned int nkeys = NUMKEYS(mp);
+			if (nkeys > 1) {
+				if (mp->mp_flags & P_LEAF2) {
+					nodekey.mv_data = LEAF2KEY(mp,
+						 nkeys-1, nodekey.mv_size);
+				} else {
+					leaf = NODEPTR(mp, nkeys-1);
+					MDB_GET_KEY2(leaf, nodekey);
+				}
+				rc = mc->mc_dbx->md_cmp(key, &nodekey);
+				if (rc == 0) {
+					/* last node was the one we wanted */
+					mc->mc_ki[mc->mc_top] = nkeys-1;
+					if (exactp)
+						*exactp = 1;
+					goto set1;
+				}
+				if (rc < 0) {
+					if (mc->mc_ki[mc->mc_top] < NUMKEYS(mp)) {
+						/* This is definitely the right page, skip search_page */
+						if (mp->mp_flags & P_LEAF2) {
+							nodekey.mv_data = LEAF2KEY(mp,
+								 mc->mc_ki[mc->mc_top], nodekey.mv_size);
+						} else {
+							leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+							MDB_GET_KEY2(leaf, nodekey);
+						}
+						rc = mc->mc_dbx->md_cmp(key, &nodekey);
+						if (rc == 0) {
+							/* current node was the one we wanted */
+							if (exactp)
+								*exactp = 1;
+							goto set1;
+						}
+					}
+					rc = 0;
+					mc->mc_flags &= ~C_EOF;
+					goto set2;
+				}
+			}
+			/* If any parents have right-sibs, search.
+			 * Otherwise, there's nothing further.
+			 */
+			for (i=0; i<mc->mc_top; i++)
+				if (mc->mc_ki[i] <
+					NUMKEYS(mc->mc_pg[i])-1)
+					break;
+			if (i == mc->mc_top) {
+				/* There are no other pages */
+				mc->mc_ki[mc->mc_top] = nkeys;
+				return MDB_NOTFOUND;
+			}
+		}
+		if (!mc->mc_top) {
+			/* There are no other pages */
+			mc->mc_ki[mc->mc_top] = 0;
+			if (op == MDB_SET_RANGE && !exactp) {
+				rc = 0;
+				goto set1;
+			} else
+				return MDB_NOTFOUND;
+		}
+	} else {
+		mc->mc_pg[0] = 0;
+	}
+
+	rc = mdb_page_search(mc, key, 0);
+	if (rc != MDB_SUCCESS)
+		return rc;
+
+	mp = mc->mc_pg[mc->mc_top];
+	mdb_cassert(mc, IS_LEAF(mp));
+
+set2:
+	leaf = mdb_node_search(mc, key, exactp);
+	if (exactp != NULL && !*exactp) {
+		/* MDB_SET specified and not an exact match. */
+		return MDB_NOTFOUND;
+	}
+
+	if (leaf == NULL) {
+		DPUTS("===> inexact leaf not found, goto sibling");
+		if ((rc = mdb_cursor_sibling(mc, 1)) != MDB_SUCCESS) {
+			mc->mc_flags |= C_EOF;
+			return rc;		/* no entries matched */
+		}
+		mp = mc->mc_pg[mc->mc_top];
+		mdb_cassert(mc, IS_LEAF(mp));
+		leaf = NODEPTR(mp, 0);
+	}
+
+set1:
+	mc->mc_flags |= C_INITIALIZED;
+	mc->mc_flags &= ~C_EOF;
+
+	if (IS_LEAF2(mp)) {
+		if (op == MDB_SET_RANGE || op == MDB_SET_KEY) {
+			key->mv_size = mc->mc_db->md_pad;
+			key->mv_data = LEAF2KEY(mp, mc->mc_ki[mc->mc_top], key->mv_size);
+		}
+		return MDB_SUCCESS;
+	}
+
+	if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+		mdb_xcursor_init1(mc, leaf);
+	}
+	if (data) {
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			if (op == MDB_SET || op == MDB_SET_KEY || op == MDB_SET_RANGE) {
+				rc = mdb_cursor_first(&mc->mc_xcursor->mx_cursor, data, NULL);
+			} else {
+				int ex2, *ex2p;
+				if (op == MDB_GET_BOTH) {
+					ex2p = &ex2;
+					ex2 = 0;
+				} else {
+					ex2p = NULL;
+				}
+				rc = mdb_cursor_set(&mc->mc_xcursor->mx_cursor, data, NULL, MDB_SET_RANGE, ex2p);
+				if (rc != MDB_SUCCESS)
+					return rc;
+			}
+		} else if (op == MDB_GET_BOTH || op == MDB_GET_BOTH_RANGE) {
+			MDB_val olddata;
+			MDB_cmp_func *dcmp;
+			if ((rc = mdb_node_read(mc, leaf, &olddata)) != MDB_SUCCESS)
+				return rc;
+			dcmp = mc->mc_dbx->md_dcmp;
+			if (NEED_CMP_CLONG(dcmp, olddata.mv_size))
+				dcmp = mdb_cmp_clong;
+			rc = dcmp(data, &olddata);
+			if (rc) {
+				if (op == MDB_GET_BOTH || rc > 0)
+					return MDB_NOTFOUND;
+				rc = 0;
+			}
+			*data = olddata;
+
+		} else {
+			if (mc->mc_xcursor)
+				mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+			if ((rc = mdb_node_read(mc, leaf, data)) != MDB_SUCCESS)
+				return rc;
+		}
+	}
+
+	/* The key already matches in all other cases */
+	if (op == MDB_SET_RANGE || op == MDB_SET_KEY)
+		MDB_GET_KEY(leaf, key);
+	DPRINTF(("==> cursor placed on key [%s]", DKEY(key)));
+
+	return rc;
+}
+
+/** Move the cursor to the first item in the database. */
+static int
+mdb_cursor_first(MDB_cursor *mc, MDB_val *key, MDB_val *data)
+{
+	int		 rc;
+	MDB_node	*leaf;
+
+	if (mc->mc_xcursor) {
+		MDB_CURSOR_UNREF(&mc->mc_xcursor->mx_cursor, 0);
+		mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+	}
+
+	if (!(mc->mc_flags & C_INITIALIZED) || mc->mc_top) {
+		rc = mdb_page_search(mc, NULL, MDB_PS_FIRST);
+		if (rc != MDB_SUCCESS)
+			return rc;
+	}
+	mdb_cassert(mc, IS_LEAF(mc->mc_pg[mc->mc_top]));
+
+	leaf = NODEPTR(mc->mc_pg[mc->mc_top], 0);
+	mc->mc_flags |= C_INITIALIZED;
+	mc->mc_flags &= ~C_EOF;
+
+	mc->mc_ki[mc->mc_top] = 0;
+
+	if (IS_LEAF2(mc->mc_pg[mc->mc_top])) {
+		key->mv_size = mc->mc_db->md_pad;
+		key->mv_data = LEAF2KEY(mc->mc_pg[mc->mc_top], 0, key->mv_size);
+		return MDB_SUCCESS;
+	}
+
+	if (data) {
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			mdb_xcursor_init1(mc, leaf);
+			rc = mdb_cursor_first(&mc->mc_xcursor->mx_cursor, data, NULL);
+			if (rc)
+				return rc;
+		} else {
+			if ((rc = mdb_node_read(mc, leaf, data)) != MDB_SUCCESS)
+				return rc;
+		}
+	}
+	MDB_GET_KEY(leaf, key);
+	return MDB_SUCCESS;
+}
+
+/** Move the cursor to the last item in the database. */
+static int
+mdb_cursor_last(MDB_cursor *mc, MDB_val *key, MDB_val *data)
+{
+	int		 rc;
+	MDB_node	*leaf;
+
+	if (mc->mc_xcursor) {
+		MDB_CURSOR_UNREF(&mc->mc_xcursor->mx_cursor, 0);
+		mc->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+	}
+
+	if (!(mc->mc_flags & C_INITIALIZED) || mc->mc_top) {
+		rc = mdb_page_search(mc, NULL, MDB_PS_LAST);
+		if (rc != MDB_SUCCESS)
+			return rc;
+	}
+	mdb_cassert(mc, IS_LEAF(mc->mc_pg[mc->mc_top]));
+
+	mc->mc_ki[mc->mc_top] = NUMKEYS(mc->mc_pg[mc->mc_top]) - 1;
+	mc->mc_flags |= C_INITIALIZED|C_EOF;
+	leaf = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+
+	if (IS_LEAF2(mc->mc_pg[mc->mc_top])) {
+		key->mv_size = mc->mc_db->md_pad;
+		key->mv_data = LEAF2KEY(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top], key->mv_size);
+		return MDB_SUCCESS;
+	}
+
+	if (data) {
+		if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+			mdb_xcursor_init1(mc, leaf);
+			rc = mdb_cursor_last(&mc->mc_xcursor->mx_cursor, data, NULL);
+			if (rc)
+				return rc;
+		} else {
+			if ((rc = mdb_node_read(mc, leaf, data)) != MDB_SUCCESS)
+				return rc;
+		}
+	}
+
+	MDB_GET_KEY(leaf, key);
+	return MDB_SUCCESS;
+}
+
+int
+mdb_cursor_get(MDB_cursor *mc, MDB_val *key, MDB_val *data,
+    MDB_cursor_op op)
+{
+	int		 rc;
+	int		 exact = 0;
+	int		 (*mfunc)(MDB_cursor *mc, MDB_val *key, MDB_val *data);
+
+	if (mc == NULL)
+		return EINVAL;
+
+	if (mc->mc_txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	switch (op) {
+	case MDB_GET_CURRENT:
+		if (!(mc->mc_flags & C_INITIALIZED)) {
+			rc = EINVAL;
+		} else {
+			MDB_page *mp = mc->mc_pg[mc->mc_top];
+			int nkeys = NUMKEYS(mp);
+			if (!nkeys || mc->mc_ki[mc->mc_top] >= nkeys) {
+				mc->mc_ki[mc->mc_top] = nkeys;
+				rc = MDB_NOTFOUND;
+				break;
+			}
+			rc = MDB_SUCCESS;
+			if (IS_LEAF2(mp)) {
+				key->mv_size = mc->mc_db->md_pad;
+				key->mv_data = LEAF2KEY(mp, mc->mc_ki[mc->mc_top], key->mv_size);
+			} else {
+				MDB_node *leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+				MDB_GET_KEY(leaf, key);
+				if (data) {
+					if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+						rc = mdb_cursor_get(&mc->mc_xcursor->mx_cursor, data, NULL, MDB_GET_CURRENT);
+					} else {
+						rc = mdb_node_read(mc, leaf, data);
+					}
+				}
+			}
+		}
+		break;
+	case MDB_GET_BOTH:
+	case MDB_GET_BOTH_RANGE:
+		if (data == NULL) {
+			rc = EINVAL;
+			break;
+		}
+		if (mc->mc_xcursor == NULL) {
+			rc = MDB_INCOMPATIBLE;
+			break;
+		}
+		/* FALLTHRU */
+	case MDB_SET:
+	case MDB_SET_KEY:
+	case MDB_SET_RANGE:
+		if (key == NULL) {
+			rc = EINVAL;
+		} else {
+			rc = mdb_cursor_set(mc, key, data, op,
+				op == MDB_SET_RANGE ? NULL : &exact);
+		}
+		break;
+	case MDB_GET_MULTIPLE:
+		if (data == NULL || !(mc->mc_flags & C_INITIALIZED)) {
+			rc = EINVAL;
+			break;
+		}
+		if (!(mc->mc_db->md_flags & MDB_DUPFIXED)) {
+			rc = MDB_INCOMPATIBLE;
+			break;
+		}
+		rc = MDB_SUCCESS;
+		if (!(mc->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED) ||
+			(mc->mc_xcursor->mx_cursor.mc_flags & C_EOF))
+			break;
+		goto fetchm;
+	case MDB_NEXT_MULTIPLE:
+		if (data == NULL) {
+			rc = EINVAL;
+			break;
+		}
+		if (!(mc->mc_db->md_flags & MDB_DUPFIXED)) {
+			rc = MDB_INCOMPATIBLE;
+			break;
+		}
+		rc = mdb_cursor_next(mc, key, data, MDB_NEXT_DUP);
+		if (rc == MDB_SUCCESS) {
+			if (mc->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED) {
+				MDB_cursor *mx;
+fetchm:
+				mx = &mc->mc_xcursor->mx_cursor;
+				data->mv_size = NUMKEYS(mx->mc_pg[mx->mc_top]) *
+					mx->mc_db->md_pad;
+				data->mv_data = METADATA(mx->mc_pg[mx->mc_top]);
+				mx->mc_ki[mx->mc_top] = NUMKEYS(mx->mc_pg[mx->mc_top])-1;
+			} else {
+				rc = MDB_NOTFOUND;
+			}
+		}
+		break;
+	case MDB_PREV_MULTIPLE:
+		if (data == NULL) {
+			rc = EINVAL;
+			break;
+		}
+		if (!(mc->mc_db->md_flags & MDB_DUPFIXED)) {
+			rc = MDB_INCOMPATIBLE;
+			break;
+		}
+		if (!(mc->mc_flags & C_INITIALIZED))
+			rc = mdb_cursor_last(mc, key, data);
+		else
+			rc = MDB_SUCCESS;
+		if (rc == MDB_SUCCESS) {
+			MDB_cursor *mx = &mc->mc_xcursor->mx_cursor;
+			if (mx->mc_flags & C_INITIALIZED) {
+				rc = mdb_cursor_sibling(mx, 0);
+				if (rc == MDB_SUCCESS)
+					goto fetchm;
+			} else {
+				rc = MDB_NOTFOUND;
+			}
+		}
+		break;
+	case MDB_NEXT:
+	case MDB_NEXT_DUP:
+	case MDB_NEXT_NODUP:
+		rc = mdb_cursor_next(mc, key, data, op);
+		break;
+	case MDB_PREV:
+	case MDB_PREV_DUP:
+	case MDB_PREV_NODUP:
+		rc = mdb_cursor_prev(mc, key, data, op);
+		break;
+	case MDB_FIRST:
+		rc = mdb_cursor_first(mc, key, data);
+		break;
+	case MDB_FIRST_DUP:
+		mfunc = mdb_cursor_first;
+	mmove:
+		if (data == NULL || !(mc->mc_flags & C_INITIALIZED)) {
+			rc = EINVAL;
+			break;
+		}
+		if (mc->mc_xcursor == NULL) {
+			rc = MDB_INCOMPATIBLE;
+			break;
+		}
+		if (mc->mc_ki[mc->mc_top] >= NUMKEYS(mc->mc_pg[mc->mc_top])) {
+			mc->mc_ki[mc->mc_top] = NUMKEYS(mc->mc_pg[mc->mc_top]);
+			rc = MDB_NOTFOUND;
+			break;
+		}
+		{
+			MDB_node *leaf = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+			if (!F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+				MDB_GET_KEY(leaf, key);
+				rc = mdb_node_read(mc, leaf, data);
+				break;
+			}
+		}
+		if (!(mc->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED)) {
+			rc = EINVAL;
+			break;
+		}
+		rc = mfunc(&mc->mc_xcursor->mx_cursor, data, NULL);
+		break;
+	case MDB_LAST:
+		rc = mdb_cursor_last(mc, key, data);
+		break;
+	case MDB_LAST_DUP:
+		mfunc = mdb_cursor_last;
+		goto mmove;
+	default:
+		DPRINTF(("unhandled/unimplemented cursor operation %u", op));
+		rc = EINVAL;
+		break;
+	}
+
+	if (mc->mc_flags & C_DEL)
+		mc->mc_flags ^= C_DEL;
+
+	return rc;
+}
+
+/** Touch all the pages in the cursor stack. Set mc_top.
+ *	Makes sure all the pages are writable, before attempting a write operation.
+ * @param[in] mc The cursor to operate on.
+ */
+static int
+mdb_cursor_touch(MDB_cursor *mc)
+{
+	int rc = MDB_SUCCESS;
+
+	if (mc->mc_dbi >= CORE_DBS && !(*mc->mc_dbflag & (DB_DIRTY|DB_DUPDATA))) {
+		/* Touch DB record of named DB */
+		MDB_cursor mc2;
+		MDB_xcursor mcx;
+		if (TXN_DBI_CHANGED(mc->mc_txn, mc->mc_dbi))
+			return MDB_BAD_DBI;
+		mdb_cursor_init(&mc2, mc->mc_txn, MAIN_DBI, &mcx);
+		rc = mdb_page_search(&mc2, &mc->mc_dbx->md_name, MDB_PS_MODIFY);
+		if (rc)
+			 return rc;
+		*mc->mc_dbflag |= DB_DIRTY;
+	}
+	mc->mc_top = 0;
+	if (mc->mc_snum) {
+		do {
+			rc = mdb_page_touch(mc);
+		} while (!rc && ++(mc->mc_top) < mc->mc_snum);
+		mc->mc_top = mc->mc_snum-1;
+	}
+	return rc;
+}
+
+/** Do not spill pages to disk if txn is getting full, may fail instead */
+#define MDB_NOSPILL	0x8000
+
+int
+mdb_cursor_put(MDB_cursor *mc, MDB_val *key, MDB_val *data,
+    unsigned int flags)
+{
+	MDB_env		*env;
+	MDB_node	*leaf = NULL;
+	MDB_page	*fp, *mp, *sub_root = NULL;
+	uint16_t	fp_flags;
+	MDB_val		xdata, *rdata, dkey, olddata;
+	MDB_db dummy;
+	int do_sub = 0, insert_key, insert_data;
+	unsigned int mcount = 0, dcount = 0, nospill;
+	size_t nsize;
+	int rc, rc2;
+	unsigned int nflags;
+	DKBUF;
+
+	if (mc == NULL || key == NULL)
+		return EINVAL;
+
+	env = mc->mc_txn->mt_env;
+
+	/* Check this first so counter will always be zero on any
+	 * early failures.
+	 */
+	if (flags & MDB_MULTIPLE) {
+		dcount = data[1].mv_size;
+		data[1].mv_size = 0;
+		if (!F_ISSET(mc->mc_db->md_flags, MDB_DUPFIXED))
+			return MDB_INCOMPATIBLE;
+	}
+
+	nospill = flags & MDB_NOSPILL;
+	flags &= ~MDB_NOSPILL;
+
+	if (mc->mc_txn->mt_flags & (MDB_TXN_RDONLY|MDB_TXN_BLOCKED))
+		return (mc->mc_txn->mt_flags & MDB_TXN_RDONLY) ? EACCES : MDB_BAD_TXN;
+
+	if (key->mv_size-1 >= ENV_MAXKEY(env))
+		return MDB_BAD_VALSIZE;
+
+#if SIZE_MAX > MAXDATASIZE
+	if (data->mv_size > ((mc->mc_db->md_flags & MDB_DUPSORT) ? ENV_MAXKEY(env) : MAXDATASIZE))
+		return MDB_BAD_VALSIZE;
+#else
+	if ((mc->mc_db->md_flags & MDB_DUPSORT) && data->mv_size > ENV_MAXKEY(env))
+		return MDB_BAD_VALSIZE;
+#endif
+
+	DPRINTF(("==> put db %d key [%s], size %"Z"u, data size %"Z"u",
+		DDBI(mc), DKEY(key), key ? key->mv_size : 0, data->mv_size));
+
+	dkey.mv_size = 0;
+
+	if (flags == MDB_CURRENT) {
+		if (!(mc->mc_flags & C_INITIALIZED))
+			return EINVAL;
+		rc = MDB_SUCCESS;
+	} else if (mc->mc_db->md_root == P_INVALID) {
+		/* new database, cursor has nothing to point to */
+		mc->mc_snum = 0;
+		mc->mc_top = 0;
+		mc->mc_flags &= ~C_INITIALIZED;
+		rc = MDB_NO_ROOT;
+	} else {
+		int exact = 0;
+		MDB_val d2;
+		if (flags & MDB_APPEND) {
+			MDB_val k2;
+			rc = mdb_cursor_last(mc, &k2, &d2);
+			if (rc == 0) {
+				rc = mc->mc_dbx->md_cmp(key, &k2);
+				if (rc > 0) {
+					rc = MDB_NOTFOUND;
+					mc->mc_ki[mc->mc_top]++;
+				} else {
+					/* new key is <= last key */
+					rc = MDB_KEYEXIST;
+				}
+			}
+		} else {
+			rc = mdb_cursor_set(mc, key, &d2, MDB_SET, &exact);
+		}
+		if ((flags & MDB_NOOVERWRITE) && rc == 0) {
+			DPRINTF(("duplicate key [%s]", DKEY(key)));
+			*data = d2;
+			return MDB_KEYEXIST;
+		}
+		if (rc && rc != MDB_NOTFOUND)
+			return rc;
+	}
+
+	if (mc->mc_flags & C_DEL)
+		mc->mc_flags ^= C_DEL;
+
+	/* Cursor is positioned, check for room in the dirty list */
+	if (!nospill) {
+		if (flags & MDB_MULTIPLE) {
+			rdata = &xdata;
+			xdata.mv_size = data->mv_size * dcount;
+		} else {
+			rdata = data;
+		}
+		if ((rc2 = mdb_page_spill(mc, key, rdata)))
+			return rc2;
+	}
+
+	if (rc == MDB_NO_ROOT) {
+		MDB_page *np;
+		/* new database, write a root leaf page */
+		DPUTS("allocating new root leaf page");
+		if ((rc2 = mdb_page_new(mc, P_LEAF, 1, &np))) {
+			return rc2;
+		}
+		mdb_cursor_push(mc, np);
+		mc->mc_db->md_root = np->mp_pgno;
+		mc->mc_db->md_depth++;
+		*mc->mc_dbflag |= DB_DIRTY;
+		if ((mc->mc_db->md_flags & (MDB_DUPSORT|MDB_DUPFIXED))
+			== MDB_DUPFIXED)
+			np->mp_flags |= P_LEAF2;
+		mc->mc_flags |= C_INITIALIZED;
+	} else {
+		/* make sure all cursor pages are writable */
+		rc2 = mdb_cursor_touch(mc);
+		if (rc2)
+			return rc2;
+	}
+
+	insert_key = insert_data = rc;
+	if (insert_key) {
+		/* The key does not exist */
+		DPRINTF(("inserting key at index %i", mc->mc_ki[mc->mc_top]));
+		if ((mc->mc_db->md_flags & MDB_DUPSORT) &&
+			LEAFSIZE(key, data) > env->me_nodemax)
+		{
+			/* Too big for a node, insert in sub-DB.  Set up an empty
+			 * "old sub-page" for prep_subDB to expand to a full page.
+			 */
+			fp_flags = P_LEAF|P_DIRTY;
+			fp = env->me_pbuf;
+			fp->mp_pad = data->mv_size; /* used if MDB_DUPFIXED */
+			fp->mp_lower = fp->mp_upper = (PAGEHDRSZ-PAGEBASE);
+			olddata.mv_size = PAGEHDRSZ;
+			goto prep_subDB;
+		}
+	} else {
+		/* there's only a key anyway, so this is a no-op */
+		if (IS_LEAF2(mc->mc_pg[mc->mc_top])) {
+			char *ptr;
+			unsigned int ksize = mc->mc_db->md_pad;
+			if (key->mv_size != ksize)
+				return MDB_BAD_VALSIZE;
+			ptr = LEAF2KEY(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top], ksize);
+			memcpy(ptr, key->mv_data, ksize);
+fix_parent:
+			/* if overwriting slot 0 of leaf, need to
+			 * update branch key if there is a parent page
+			 */
+			if (mc->mc_top && !mc->mc_ki[mc->mc_top]) {
+				unsigned short dtop = 1;
+				mc->mc_top--;
+				/* slot 0 is always an empty key, find real slot */
+				while (mc->mc_top && !mc->mc_ki[mc->mc_top]) {
+					mc->mc_top--;
+					dtop++;
+				}
+				if (mc->mc_ki[mc->mc_top])
+					rc2 = mdb_update_key(mc, key);
+				else
+					rc2 = MDB_SUCCESS;
+				mc->mc_top += dtop;
+				if (rc2)
+					return rc2;
+			}
+			return MDB_SUCCESS;
+		}
+
+more:
+		leaf = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+		olddata.mv_size = NODEDSZ(leaf);
+		olddata.mv_data = NODEDATA(leaf);
+
+		/* DB has dups? */
+		if (F_ISSET(mc->mc_db->md_flags, MDB_DUPSORT)) {
+			/* Prepare (sub-)page/sub-DB to accept the new item,
+			 * if needed.  fp: old sub-page or a header faking
+			 * it.  mp: new (sub-)page.  offset: growth in page
+			 * size.  xdata: node data with new page or DB.
+			 */
+			unsigned	i, offset = 0;
+			mp = fp = xdata.mv_data = env->me_pbuf;
+			mp->mp_pgno = mc->mc_pg[mc->mc_top]->mp_pgno;
+
+			/* Was a single item before, must convert now */
+			if (!F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+				MDB_cmp_func *dcmp;
+				/* Just overwrite the current item */
+				if (flags == MDB_CURRENT)
+					goto current;
+				dcmp = mc->mc_dbx->md_dcmp;
+				if (NEED_CMP_CLONG(dcmp, olddata.mv_size))
+					dcmp = mdb_cmp_clong;
+				/* does data match? */
+				if (!dcmp(data, &olddata)) {
+					if (flags & (MDB_NODUPDATA|MDB_APPENDDUP))
+						return MDB_KEYEXIST;
+					/* overwrite it */
+					goto current;
+				}
+
+				/* Back up original data item */
+				dkey.mv_size = olddata.mv_size;
+				dkey.mv_data = memcpy(fp+1, olddata.mv_data, olddata.mv_size);
+
+				/* Make sub-page header for the dup items, with dummy body */
+				fp->mp_flags = P_LEAF|P_DIRTY|P_SUBP;
+				fp->mp_lower = (PAGEHDRSZ-PAGEBASE);
+				xdata.mv_size = PAGEHDRSZ + dkey.mv_size + data->mv_size;
+				if (mc->mc_db->md_flags & MDB_DUPFIXED) {
+					fp->mp_flags |= P_LEAF2;
+					fp->mp_pad = data->mv_size;
+					xdata.mv_size += 2 * data->mv_size;	/* leave space for 2 more */
+				} else {
+					xdata.mv_size += 2 * (sizeof(indx_t) + NODESIZE) +
+						(dkey.mv_size & 1) + (data->mv_size & 1);
+				}
+				fp->mp_upper = xdata.mv_size - PAGEBASE;
+				olddata.mv_size = xdata.mv_size; /* pretend olddata is fp */
+			} else if (leaf->mn_flags & F_SUBDATA) {
+				/* Data is on sub-DB, just store it */
+				flags |= F_DUPDATA|F_SUBDATA;
+				goto put_sub;
+			} else {
+				/* Data is on sub-page */
+				fp = olddata.mv_data;
+				switch (flags) {
+				default:
+					if (!(mc->mc_db->md_flags & MDB_DUPFIXED)) {
+						offset = EVEN(NODESIZE + sizeof(indx_t) +
+							data->mv_size);
+						break;
+					}
+					offset = fp->mp_pad;
+					if (SIZELEFT(fp) < offset) {
+						offset *= 4; /* space for 4 more */
+						break;
+					}
+					/* FALLTHRU: Big enough MDB_DUPFIXED sub-page */
+					__attribute__ ((fallthrough));
+				case MDB_CURRENT:
+					fp->mp_flags |= P_DIRTY;
+					COPY_PGNO(fp->mp_pgno, mp->mp_pgno);
+					mc->mc_xcursor->mx_cursor.mc_pg[0] = fp;
+					flags |= F_DUPDATA;
+					goto put_sub;
+				}
+				xdata.mv_size = olddata.mv_size + offset;
+			}
+
+			fp_flags = fp->mp_flags;
+			if (NODESIZE + NODEKSZ(leaf) + xdata.mv_size > env->me_nodemax) {
+					/* Too big for a sub-page, convert to sub-DB */
+					fp_flags &= ~P_SUBP;
+prep_subDB:
+					if (mc->mc_db->md_flags & MDB_DUPFIXED) {
+						fp_flags |= P_LEAF2;
+						dummy.md_pad = fp->mp_pad;
+						dummy.md_flags = MDB_DUPFIXED;
+						if (mc->mc_db->md_flags & MDB_INTEGERDUP)
+							dummy.md_flags |= MDB_INTEGERKEY;
+					} else {
+						dummy.md_pad = 0;
+						dummy.md_flags = 0;
+					}
+					dummy.md_depth = 1;
+					dummy.md_branch_pages = 0;
+					dummy.md_leaf_pages = 1;
+					dummy.md_overflow_pages = 0;
+					dummy.md_entries = NUMKEYS(fp);
+					xdata.mv_size = sizeof(MDB_db);
+					xdata.mv_data = &dummy;
+					if ((rc = mdb_page_alloc(mc, 1, &mp)))
+						return rc;
+					offset = env->me_psize - olddata.mv_size;
+					flags |= F_DUPDATA|F_SUBDATA;
+					dummy.md_root = mp->mp_pgno;
+					sub_root = mp;
+			}
+			if (mp != fp) {
+				mp->mp_flags = fp_flags | P_DIRTY;
+				mp->mp_pad   = fp->mp_pad;
+				mp->mp_lower = fp->mp_lower;
+				mp->mp_upper = fp->mp_upper + offset;
+				if (fp_flags & P_LEAF2) {
+					memcpy(METADATA(mp), METADATA(fp), NUMKEYS(fp) * fp->mp_pad);
+				} else {
+					memcpy((char *)mp + mp->mp_upper + PAGEBASE, (char *)fp + fp->mp_upper + PAGEBASE,
+						olddata.mv_size - fp->mp_upper - PAGEBASE);
+					memcpy((char *)(&mp->mp_ptrs), (char *)(&fp->mp_ptrs), NUMKEYS(fp) * sizeof(mp->mp_ptrs[0]));
+					for (i=0; i<NUMKEYS(fp); i++)
+						mp->mp_ptrs[i] += offset;
+				}
+			}
+
+			rdata = &xdata;
+			flags |= F_DUPDATA;
+			do_sub = 1;
+			if (!insert_key)
+				mdb_node_del(mc, 0);
+			goto new_sub;
+		}
+current:
+		/* LMDB passes F_SUBDATA in 'flags' to write a DB record */
+		if ((leaf->mn_flags ^ flags) & F_SUBDATA)
+			return MDB_INCOMPATIBLE;
+		/* overflow page overwrites need special handling */
+		if (F_ISSET(leaf->mn_flags, F_BIGDATA)) {
+			MDB_page *omp;
+			pgno_t pg;
+			int level, ovpages, dpages = OVPAGES(data->mv_size, env->me_psize);
+
+			memcpy(&pg, olddata.mv_data, sizeof(pg));
+			if ((rc2 = mdb_page_get(mc, pg, &omp, &level)) != 0)
+				return rc2;
+			ovpages = omp->mp_pages;
+
+			/* Is the ov page large enough? */
+			if (ovpages >= dpages) {
+			  if (!(omp->mp_flags & P_DIRTY) &&
+				  (level || (env->me_flags & MDB_WRITEMAP)))
+			  {
+				rc = mdb_page_unspill(mc->mc_txn, omp, &omp);
+				if (rc)
+					return rc;
+				level = 0;		/* dirty in this txn or clean */
+			  }
+			  /* Is it dirty? */
+			  if (omp->mp_flags & P_DIRTY) {
+				/* yes, overwrite it. Note in this case we don't
+				 * bother to try shrinking the page if the new data
+				 * is smaller than the overflow threshold.
+				 */
+				if (level > 1) {
+					/* It is writable only in a parent txn */
+					size_t sz = (size_t) env->me_psize * ovpages, off;
+					MDB_page *np = mdb_page_malloc(mc->mc_txn, ovpages);
+					MDB_ID2 id2;
+					if (!np)
+						return ENOMEM;
+					id2.mid = pg;
+					id2.mptr = np;
+					/* Note - this page is already counted in parent's dirty_room */
+					rc2 = mdb_mid2l_insert(mc->mc_txn->mt_u.dirty_list, &id2);
+					mdb_cassert(mc, rc2 == 0);
+					/* Currently we make the page look as with put() in the
+					 * parent txn, in case the user peeks at MDB_RESERVEd
+					 * or unused parts. Some users treat ovpages specially.
+					 */
+					if (!(flags & MDB_RESERVE)) {
+						/* Skip the part where LMDB will put *data.
+						 * Copy end of page, adjusting alignment so
+						 * compiler may copy words instead of bytes.
+						 */
+						off = (PAGEHDRSZ + data->mv_size) & -sizeof(size_t);
+						memcpy((size_t *)((char *)np + off),
+							(size_t *)((char *)omp + off), sz - off);
+						sz = PAGEHDRSZ;
+					}
+					memcpy(np, omp, sz); /* Copy beginning of page */
+					omp = np;
+				}
+				SETDSZ(leaf, data->mv_size);
+				if (F_ISSET(flags, MDB_RESERVE))
+					data->mv_data = METADATA(omp);
+				else
+					memcpy(METADATA(omp), data->mv_data, data->mv_size);
+				return MDB_SUCCESS;
+			  }
+			}
+			if ((rc2 = mdb_ovpage_free(mc, omp)) != MDB_SUCCESS)
+				return rc2;
+		} else if (data->mv_size == olddata.mv_size) {
+			/* same size, just replace it. Note that we could
+			 * also reuse this node if the new data is smaller,
+			 * but instead we opt to shrink the node in that case.
+			 */
+			if (F_ISSET(flags, MDB_RESERVE))
+				data->mv_data = olddata.mv_data;
+			else if (!(mc->mc_flags & C_SUB))
+				memcpy(olddata.mv_data, data->mv_data, data->mv_size);
+			else {
+				memcpy(NODEKEY(leaf), key->mv_data, key->mv_size);
+				goto fix_parent;
+			}
+			return MDB_SUCCESS;
+		}
+		mdb_node_del(mc, 0);
+	}
+
+	rdata = data;
+
+new_sub:
+	nflags = flags & NODE_ADD_FLAGS;
+	nsize = IS_LEAF2(mc->mc_pg[mc->mc_top]) ? key->mv_size : mdb_leaf_size(env, key, rdata);
+	if (SIZELEFT(mc->mc_pg[mc->mc_top]) < nsize) {
+		if (( flags & (F_DUPDATA|F_SUBDATA)) == F_DUPDATA )
+			nflags &= ~MDB_APPEND; /* sub-page may need room to grow */
+		if (!insert_key)
+			nflags |= MDB_SPLIT_REPLACE;
+		rc = mdb_page_split(mc, key, rdata, P_INVALID, nflags);
+	} else {
+		/* There is room already in this leaf page. */
+		rc = mdb_node_add(mc, mc->mc_ki[mc->mc_top], key, rdata, 0, nflags);
+		if (rc == 0) {
+			/* Adjust other cursors pointing to mp */
+			MDB_cursor *m2, *m3;
+			MDB_dbi dbi = mc->mc_dbi;
+			unsigned i = mc->mc_top;
+			MDB_page *mp = mc->mc_pg[i];
+
+			for (m2 = mc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+				if (mc->mc_flags & C_SUB)
+					m3 = &m2->mc_xcursor->mx_cursor;
+				else
+					m3 = m2;
+				if (m3 == mc || m3->mc_snum < mc->mc_snum || m3->mc_pg[i] != mp) continue;
+				if (m3->mc_ki[i] >= mc->mc_ki[i] && insert_key) {
+					m3->mc_ki[i]++;
+				}
+				XCURSOR_REFRESH(m3, i, mp);
+			}
+		}
+	}
+
+	if (rc == MDB_SUCCESS) {
+		/* Now store the actual data in the child DB. Note that we're
+		 * storing the user data in the keys field, so there are strict
+		 * size limits on dupdata. The actual data fields of the child
+		 * DB are all zero size.
+		 */
+		if (do_sub) {
+			int xflags, new_dupdata;
+			mdb_size_t ecount;
+put_sub:
+			xdata.mv_size = 0;
+			xdata.mv_data = "";
+			leaf = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+			if (flags & MDB_CURRENT) {
+				xflags = MDB_CURRENT|MDB_NOSPILL;
+			} else {
+				mdb_xcursor_init1(mc, leaf);
+				xflags = (flags & MDB_NODUPDATA) ?
+					MDB_NOOVERWRITE|MDB_NOSPILL : MDB_NOSPILL;
+			}
+			if (sub_root)
+				mc->mc_xcursor->mx_cursor.mc_pg[0] = sub_root;
+			new_dupdata = (int)dkey.mv_size;
+			/* converted, write the original data first */
+			if (dkey.mv_size) {
+				rc = mdb_cursor_put(&mc->mc_xcursor->mx_cursor, &dkey, &xdata, xflags);
+				if (rc)
+					goto bad_sub;
+				/* we've done our job */
+				dkey.mv_size = 0;
+			}
+			if (!(leaf->mn_flags & F_SUBDATA) || sub_root) {
+				/* Adjust other cursors pointing to mp */
+				MDB_cursor *m2;
+				MDB_xcursor *mx = mc->mc_xcursor;
+				unsigned i = mc->mc_top;
+				MDB_page *mp = mc->mc_pg[i];
+
+				for (m2 = mc->mc_txn->mt_cursors[mc->mc_dbi]; m2; m2=m2->mc_next) {
+					if (m2 == mc || m2->mc_snum < mc->mc_snum) continue;
+					if (!(m2->mc_flags & C_INITIALIZED)) continue;
+					if (m2->mc_pg[i] == mp) {
+						if (m2->mc_ki[i] == mc->mc_ki[i]) {
+							mdb_xcursor_init2(m2, mx, new_dupdata);
+						} else if (!insert_key) {
+							XCURSOR_REFRESH(m2, i, mp);
+						}
+					}
+				}
+			}
+			ecount = mc->mc_xcursor->mx_db.md_entries;
+			if (flags & MDB_APPENDDUP)
+				xflags |= MDB_APPEND;
+			rc = mdb_cursor_put(&mc->mc_xcursor->mx_cursor, data, &xdata, xflags);
+			if (flags & F_SUBDATA) {
+				void *db = NODEDATA(leaf);
+				memcpy(db, &mc->mc_xcursor->mx_db, sizeof(MDB_db));
+			}
+			insert_data = mc->mc_xcursor->mx_db.md_entries - ecount;
+		}
+		/* Increment count unless we just replaced an existing item. */
+		if (insert_data)
+			mc->mc_db->md_entries++;
+		if (insert_key) {
+			/* Invalidate txn if we created an empty sub-DB */
+			if (rc)
+				goto bad_sub;
+			/* If we succeeded and the key didn't exist before,
+			 * make sure the cursor is marked valid.
+			 */
+			mc->mc_flags |= C_INITIALIZED;
+		}
+		if (flags & MDB_MULTIPLE) {
+			if (!rc) {
+				mcount++;
+				/* let caller know how many succeeded, if any */
+				data[1].mv_size = mcount;
+				if (mcount < dcount) {
+					data[0].mv_data = (char *)data[0].mv_data + data[0].mv_size;
+					insert_key = insert_data = 0;
+					goto more;
+				}
+			}
+		}
+		return rc;
+bad_sub:
+		if (rc == MDB_KEYEXIST)	/* should not happen, we deleted that item */
+			rc = MDB_PROBLEM;
+	}
+	mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+int
+mdb_cursor_del(MDB_cursor *mc, unsigned int flags)
+{
+	MDB_node	*leaf;
+	MDB_page	*mp;
+	int rc;
+
+	if (mc->mc_txn->mt_flags & (MDB_TXN_RDONLY|MDB_TXN_BLOCKED))
+		return (mc->mc_txn->mt_flags & MDB_TXN_RDONLY) ? EACCES : MDB_BAD_TXN;
+
+	if (!(mc->mc_flags & C_INITIALIZED))
+		return EINVAL;
+
+	if (mc->mc_ki[mc->mc_top] >= NUMKEYS(mc->mc_pg[mc->mc_top]))
+		return MDB_NOTFOUND;
+
+	if (!(flags & MDB_NOSPILL) && (rc = mdb_page_spill(mc, NULL, NULL)))
+		return rc;
+
+	rc = mdb_cursor_touch(mc);
+	if (rc)
+		return rc;
+
+	mp = mc->mc_pg[mc->mc_top];
+	if (IS_LEAF2(mp))
+		goto del_key;
+	leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+
+	if (F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+		if (flags & MDB_NODUPDATA) {
+			/* mdb_cursor_del0() will subtract the final entry */
+			mc->mc_db->md_entries -= mc->mc_xcursor->mx_db.md_entries - 1;
+			mc->mc_xcursor->mx_cursor.mc_flags &= ~C_INITIALIZED;
+		} else {
+			if (!F_ISSET(leaf->mn_flags, F_SUBDATA)) {
+				mc->mc_xcursor->mx_cursor.mc_pg[0] = NODEDATA(leaf);
+			}
+			rc = mdb_cursor_del(&mc->mc_xcursor->mx_cursor, MDB_NOSPILL);
+			if (rc)
+				return rc;
+			/* If sub-DB still has entries, we're done */
+			if (mc->mc_xcursor->mx_db.md_entries) {
+				if (leaf->mn_flags & F_SUBDATA) {
+					/* update subDB info */
+					void *db = NODEDATA(leaf);
+					memcpy(db, &mc->mc_xcursor->mx_db, sizeof(MDB_db));
+				} else {
+					MDB_cursor *m2;
+					/* shrink fake page */
+					mdb_node_shrink(mp, mc->mc_ki[mc->mc_top]);
+					leaf = NODEPTR(mp, mc->mc_ki[mc->mc_top]);
+					mc->mc_xcursor->mx_cursor.mc_pg[0] = NODEDATA(leaf);
+					/* fix other sub-DB cursors pointed at fake pages on this page */
+					for (m2 = mc->mc_txn->mt_cursors[mc->mc_dbi]; m2; m2=m2->mc_next) {
+						if (m2 == mc || m2->mc_snum < mc->mc_snum) continue;
+						if (!(m2->mc_flags & C_INITIALIZED)) continue;
+						if (m2->mc_pg[mc->mc_top] == mp) {
+							XCURSOR_REFRESH(m2, mc->mc_top, mp);
+						}
+					}
+				}
+				mc->mc_db->md_entries--;
+				return rc;
+			} else {
+				mc->mc_xcursor->mx_cursor.mc_flags &= ~C_INITIALIZED;
+			}
+			/* otherwise fall thru and delete the sub-DB */
+		}
+
+		if (leaf->mn_flags & F_SUBDATA) {
+			/* add all the child DB's pages to the free list */
+			rc = mdb_drop0(&mc->mc_xcursor->mx_cursor, 0);
+			if (rc)
+				goto fail;
+		}
+	}
+	/* LMDB passes F_SUBDATA in 'flags' to delete a DB record */
+	else if ((leaf->mn_flags ^ flags) & F_SUBDATA) {
+		rc = MDB_INCOMPATIBLE;
+		goto fail;
+	}
+
+	/* add overflow pages to free list */
+	if (F_ISSET(leaf->mn_flags, F_BIGDATA)) {
+		MDB_page *omp;
+		pgno_t pg;
+
+		memcpy(&pg, NODEDATA(leaf), sizeof(pg));
+		if ((rc = mdb_page_get(mc, pg, &omp, NULL)) ||
+			(rc = mdb_ovpage_free(mc, omp)))
+			goto fail;
+	}
+
+del_key:
+	return mdb_cursor_del0(mc);
+
+fail:
+	mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+/** Allocate and initialize new pages for a database.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in] mc a cursor on the database being added to.
+ * @param[in] flags flags defining what type of page is being allocated.
+ * @param[in] num the number of pages to allocate. This is usually 1,
+ * unless allocating overflow pages for a large record.
+ * @param[out] mp Address of a page, or NULL on failure.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_new(MDB_cursor *mc, uint32_t flags, int num, MDB_page **mp)
+{
+	MDB_page	*np;
+	int rc;
+
+	if ((rc = mdb_page_alloc(mc, num, &np)))
+		return rc;
+	DPRINTF(("allocated new mpage %"Yu", page size %u",
+	    np->mp_pgno, mc->mc_txn->mt_env->me_psize));
+	np->mp_flags = flags | P_DIRTY;
+	np->mp_lower = (PAGEHDRSZ-PAGEBASE);
+	np->mp_upper = mc->mc_txn->mt_env->me_psize - PAGEBASE;
+
+	if (IS_BRANCH(np))
+		mc->mc_db->md_branch_pages++;
+	else if (IS_LEAF(np))
+		mc->mc_db->md_leaf_pages++;
+	else if (IS_OVERFLOW(np)) {
+		mc->mc_db->md_overflow_pages += num;
+		np->mp_pages = num;
+	}
+	*mp = np;
+
+	return 0;
+}
+
+/** Calculate the size of a leaf node.
+ * The size depends on the environment's page size; if a data item
+ * is too large it will be put onto an overflow page and the node
+ * size will only include the key and not the data. Sizes are always
+ * rounded up to an even number of bytes, to guarantee 2-byte alignment
+ * of the #MDB_node headers.
+ * @param[in] env The environment handle.
+ * @param[in] key The key for the node.
+ * @param[in] data The data for the node.
+ * @return The number of bytes needed to store the node.
+ */
+static size_t
+mdb_leaf_size(MDB_env *env, MDB_val *key, MDB_val *data)
+{
+	size_t		 sz;
+
+	sz = LEAFSIZE(key, data);
+	if (sz > env->me_nodemax) {
+		/* put on overflow page */
+		sz -= data->mv_size - sizeof(pgno_t);
+	}
+
+	return EVEN(sz + sizeof(indx_t));
+}
+
+/** Calculate the size of a branch node.
+ * The size should depend on the environment's page size but since
+ * we currently don't support spilling large keys onto overflow
+ * pages, it's simply the size of the #MDB_node header plus the
+ * size of the key. Sizes are always rounded up to an even number
+ * of bytes, to guarantee 2-byte alignment of the #MDB_node headers.
+ * @param[in] env The environment handle.
+ * @param[in] key The key for the node.
+ * @return The number of bytes needed to store the node.
+ */
+static size_t
+mdb_branch_size(MDB_env *env, MDB_val *key)
+{
+	size_t		 sz;
+
+	sz = INDXSIZE(key);
+	if (sz > env->me_nodemax) {
+		/* put on overflow page */
+		/* not implemented */
+		/* sz -= key->size - sizeof(pgno_t); */
+	}
+
+	return sz + sizeof(indx_t);
+}
+
+/** Add a node to the page pointed to by the cursor.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in] mc The cursor for this operation.
+ * @param[in] indx The index on the page where the new node should be added.
+ * @param[in] key The key for the new node.
+ * @param[in] data The data for the new node, if any.
+ * @param[in] pgno The page number, if adding a branch node.
+ * @param[in] flags Flags for the node.
+ * @return 0 on success, non-zero on failure. Possible errors are:
+ * <ul>
+ *	<li>ENOMEM - failed to allocate overflow pages for the node.
+ *	<li>MDB_PAGE_FULL - there is insufficient room in the page. This error
+ *	should never happen since all callers already calculate the
+ *	page's free space before calling this function.
+ * </ul>
+ */
+static int
+mdb_node_add(MDB_cursor *mc, indx_t indx,
+    MDB_val *key, MDB_val *data, pgno_t pgno, unsigned int flags)
+{
+	unsigned int	 i;
+	size_t		 node_size = NODESIZE;
+	ssize_t		 room;
+	indx_t		 ofs;
+	MDB_node	*node;
+	MDB_page	*mp = mc->mc_pg[mc->mc_top];
+	MDB_page	*ofp = NULL;		/* overflow page */
+	void		*ndata;
+	DKBUF;
+
+	mdb_cassert(mc, mp->mp_upper >= mp->mp_lower);
+
+	DPRINTF(("add to %s %spage %"Yu" index %i, data size %"Z"u key size %"Z"u [%s]",
+	    IS_LEAF(mp) ? "leaf" : "branch",
+		IS_SUBP(mp) ? "sub-" : "",
+		mdb_dbg_pgno(mp), indx, data ? data->mv_size : 0,
+		key ? key->mv_size : 0, key ? DKEY(key) : "null"));
+
+	if (IS_LEAF2(mp)) {
+		/* Move higher keys up one slot. */
+		int ksize = mc->mc_db->md_pad, dif;
+		char *ptr = LEAF2KEY(mp, indx, ksize);
+		dif = NUMKEYS(mp) - indx;
+		if (dif > 0)
+			memmove(ptr+ksize, ptr, dif*ksize);
+		/* insert new key */
+		memcpy(ptr, key->mv_data, ksize);
+
+		/* Just using these for counting */
+		mp->mp_lower += sizeof(indx_t);
+		mp->mp_upper -= ksize - sizeof(indx_t);
+		return MDB_SUCCESS;
+	}
+
+	room = (ssize_t)SIZELEFT(mp) - (ssize_t)sizeof(indx_t);
+	if (key != NULL)
+		node_size += key->mv_size;
+	if (IS_LEAF(mp)) {
+		mdb_cassert(mc, key && data);
+		if (F_ISSET(flags, F_BIGDATA)) {
+			/* Data already on overflow page. */
+			node_size += sizeof(pgno_t);
+		} else if (node_size + data->mv_size > mc->mc_txn->mt_env->me_nodemax) {
+			int ovpages = OVPAGES(data->mv_size, mc->mc_txn->mt_env->me_psize);
+			int rc;
+			/* Put data on overflow page. */
+			DPRINTF(("data size is %"Z"u, node would be %"Z"u, put data on overflow page",
+			    data->mv_size, node_size+data->mv_size));
+			node_size = EVEN(node_size + sizeof(pgno_t));
+			if ((ssize_t)node_size > room)
+				goto full;
+			if ((rc = mdb_page_new(mc, P_OVERFLOW, ovpages, &ofp)))
+				return rc;
+			DPRINTF(("allocated overflow page %"Yu, ofp->mp_pgno));
+			flags |= F_BIGDATA;
+			goto update;
+		} else {
+			node_size += data->mv_size;
+		}
+	}
+	node_size = EVEN(node_size);
+	if ((ssize_t)node_size > room)
+		goto full;
+
+update:
+	/* Move higher pointers up one slot. */
+	for (i = NUMKEYS(mp); i > indx; i--)
+		mp->mp_ptrs[i] = mp->mp_ptrs[i - 1];
+
+	/* Adjust free space offsets. */
+	ofs = mp->mp_upper - node_size;
+	mdb_cassert(mc, ofs >= mp->mp_lower + sizeof(indx_t));
+	mp->mp_ptrs[indx] = ofs;
+	mp->mp_upper = ofs;
+	mp->mp_lower += sizeof(indx_t);
+
+	/* Write the node data. */
+	node = NODEPTR(mp, indx);
+	node->mn_ksize = (key == NULL) ? 0 : key->mv_size;
+	node->mn_flags = flags;
+	if (IS_LEAF(mp))
+		SETDSZ(node,data->mv_size);
+	else
+		SETPGNO(node,pgno);
+
+	if (key)
+		memcpy(NODEKEY(node), key->mv_data, key->mv_size);
+
+	if (IS_LEAF(mp)) {
+		ndata = NODEDATA(node);
+		if (ofp == NULL) {
+			if (F_ISSET(flags, F_BIGDATA))
+				memcpy(ndata, data->mv_data, sizeof(pgno_t));
+			else if (F_ISSET(flags, MDB_RESERVE))
+				data->mv_data = ndata;
+			else
+				memcpy(ndata, data->mv_data, data->mv_size);
+		} else {
+			memcpy(ndata, &ofp->mp_pgno, sizeof(pgno_t));
+			ndata = METADATA(ofp);
+			if (F_ISSET(flags, MDB_RESERVE))
+				data->mv_data = ndata;
+			else
+				memcpy(ndata, data->mv_data, data->mv_size);
+		}
+	}
+
+	return MDB_SUCCESS;
+
+full:
+	DPRINTF(("not enough room in page %"Yu", got %u ptrs",
+		mdb_dbg_pgno(mp), NUMKEYS(mp)));
+	DPRINTF(("upper-lower = %u - %u = %"Z"d", mp->mp_upper,mp->mp_lower,room));
+	DPRINTF(("node size = %"Z"u", node_size));
+	mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+	return MDB_PAGE_FULL;
+}
+
+/** Delete the specified node from a page.
+ * @param[in] mc Cursor pointing to the node to delete.
+ * @param[in] ksize The size of a node. Only used if the page is
+ * part of a #MDB_DUPFIXED database.
+ */
+static void
+mdb_node_del(MDB_cursor *mc, int ksize)
+{
+	MDB_page *mp = mc->mc_pg[mc->mc_top];
+	indx_t	indx = mc->mc_ki[mc->mc_top];
+	unsigned int	 sz;
+	indx_t		 i, j, numkeys, ptr;
+	MDB_node	*node;
+	char		*base;
+
+	DPRINTF(("delete node %u on %s page %"Yu, indx,
+	    IS_LEAF(mp) ? "leaf" : "branch", mdb_dbg_pgno(mp)));
+	numkeys = NUMKEYS(mp);
+	mdb_cassert(mc, indx < numkeys);
+
+	if (IS_LEAF2(mp)) {
+		int x = numkeys - 1 - indx;
+		base = LEAF2KEY(mp, indx, ksize);
+		if (x)
+			memmove(base, base + ksize, x * ksize);
+		mp->mp_lower -= sizeof(indx_t);
+		mp->mp_upper += ksize - sizeof(indx_t);
+		return;
+	}
+
+	node = NODEPTR(mp, indx);
+	sz = NODESIZE + node->mn_ksize;
+	if (IS_LEAF(mp)) {
+		if (F_ISSET(node->mn_flags, F_BIGDATA))
+			sz += sizeof(pgno_t);
+		else
+			sz += NODEDSZ(node);
+	}
+	sz = EVEN(sz);
+
+	ptr = mp->mp_ptrs[indx];
+	for (i = j = 0; i < numkeys; i++) {
+		if (i != indx) {
+			mp->mp_ptrs[j] = mp->mp_ptrs[i];
+			if (mp->mp_ptrs[i] < ptr)
+				mp->mp_ptrs[j] += sz;
+			j++;
+		}
+	}
+
+	base = (char *)mp + mp->mp_upper + PAGEBASE;
+	memmove(base + sz, base, ptr - mp->mp_upper);
+
+	mp->mp_lower -= sizeof(indx_t);
+	mp->mp_upper += sz;
+}
+
+/** Compact the main page after deleting a node on a subpage.
+ * @param[in] mp The main page to operate on.
+ * @param[in] indx The index of the subpage on the main page.
+ */
+static void
+mdb_node_shrink(MDB_page *mp, indx_t indx)
+{
+	MDB_node *node;
+	MDB_page *sp, *xp;
+	char *base;
+	indx_t delta, nsize, len, ptr;
+	int i;
+
+	node = NODEPTR(mp, indx);
+	sp = (MDB_page *)NODEDATA(node);
+	delta = SIZELEFT(sp);
+	nsize = NODEDSZ(node) - delta;
+
+	/* Prepare to shift upward, set len = length(subpage part to shift) */
+	if (IS_LEAF2(sp)) {
+		len = nsize;
+		if (nsize & 1)
+			return;		/* do not make the node uneven-sized */
+	} else {
+		xp = (MDB_page *)((char *)sp + delta); /* destination subpage */
+		for (i = NUMKEYS(sp); --i >= 0; )
+			xp->mp_ptrs[i] = sp->mp_ptrs[i] - delta;
+		len = PAGEHDRSZ;
+	}
+	sp->mp_upper = sp->mp_lower;
+	COPY_PGNO(sp->mp_pgno, mp->mp_pgno);
+	SETDSZ(node, nsize);
+
+	/* Shift <lower nodes...initial part of subpage> upward */
+	base = (char *)mp + mp->mp_upper + PAGEBASE;
+	memmove(base + delta, base, (char *)sp + len - base);
+
+	ptr = mp->mp_ptrs[indx];
+	for (i = NUMKEYS(mp); --i >= 0; ) {
+		if (mp->mp_ptrs[i] <= ptr)
+			mp->mp_ptrs[i] += delta;
+	}
+	mp->mp_upper += delta;
+}
+
+/** Initial setup of a sorted-dups cursor.
+ * Sorted duplicates are implemented as a sub-database for the given key.
+ * The duplicate data items are actually keys of the sub-database.
+ * Operations on the duplicate data items are performed using a sub-cursor
+ * initialized when the sub-database is first accessed. This function does
+ * the preliminary setup of the sub-cursor, filling in the fields that
+ * depend only on the parent DB.
+ * @param[in] mc The main cursor whose sorted-dups cursor is to be initialized.
+ */
+static void
+mdb_xcursor_init0(MDB_cursor *mc)
+{
+	MDB_xcursor *mx = mc->mc_xcursor;
+
+	mx->mx_cursor.mc_xcursor = NULL;
+	mx->mx_cursor.mc_txn = mc->mc_txn;
+	mx->mx_cursor.mc_db = &mx->mx_db;
+	mx->mx_cursor.mc_dbx = &mx->mx_dbx;
+	mx->mx_cursor.mc_dbi = mc->mc_dbi;
+	mx->mx_cursor.mc_dbflag = &mx->mx_dbflag;
+	mx->mx_cursor.mc_snum = 0;
+	mx->mx_cursor.mc_top = 0;
+	MC_SET_OVPG(&mx->mx_cursor, NULL);
+	mx->mx_cursor.mc_flags = C_SUB | (mc->mc_flags & (C_ORIG_RDONLY|C_WRITEMAP));
+	mx->mx_dbx.md_name.mv_size = 0;
+	mx->mx_dbx.md_name.mv_data = NULL;
+	mx->mx_dbx.md_cmp = mc->mc_dbx->md_dcmp;
+	mx->mx_dbx.md_dcmp = NULL;
+	mx->mx_dbx.md_rel = mc->mc_dbx->md_rel;
+}
+
+/** Final setup of a sorted-dups cursor.
+ *	Sets up the fields that depend on the data from the main cursor.
+ * @param[in] mc The main cursor whose sorted-dups cursor is to be initialized.
+ * @param[in] node The data containing the #MDB_db record for the
+ * sorted-dup database.
+ */
+static void
+mdb_xcursor_init1(MDB_cursor *mc, MDB_node *node)
+{
+	MDB_xcursor *mx = mc->mc_xcursor;
+
+	mx->mx_cursor.mc_flags &= C_SUB|C_ORIG_RDONLY|C_WRITEMAP;
+	if (node->mn_flags & F_SUBDATA) {
+		memcpy(&mx->mx_db, NODEDATA(node), sizeof(MDB_db));
+		mx->mx_cursor.mc_pg[0] = 0;
+		mx->mx_cursor.mc_snum = 0;
+		mx->mx_cursor.mc_top = 0;
+	} else {
+		MDB_page *fp = NODEDATA(node);
+		mx->mx_db.md_pad = 0;
+		mx->mx_db.md_flags = 0;
+		mx->mx_db.md_depth = 1;
+		mx->mx_db.md_branch_pages = 0;
+		mx->mx_db.md_leaf_pages = 1;
+		mx->mx_db.md_overflow_pages = 0;
+		mx->mx_db.md_entries = NUMKEYS(fp);
+		COPY_PGNO(mx->mx_db.md_root, fp->mp_pgno);
+		mx->mx_cursor.mc_snum = 1;
+		mx->mx_cursor.mc_top = 0;
+		mx->mx_cursor.mc_flags |= C_INITIALIZED;
+		mx->mx_cursor.mc_pg[0] = fp;
+		mx->mx_cursor.mc_ki[0] = 0;
+		if (mc->mc_db->md_flags & MDB_DUPFIXED) {
+			mx->mx_db.md_flags = MDB_DUPFIXED;
+			mx->mx_db.md_pad = fp->mp_pad;
+			if (mc->mc_db->md_flags & MDB_INTEGERDUP)
+				mx->mx_db.md_flags |= MDB_INTEGERKEY;
+		}
+	}
+	DPRINTF(("Sub-db -%u root page %"Yu, mx->mx_cursor.mc_dbi,
+		mx->mx_db.md_root));
+	mx->mx_dbflag = DB_VALID|DB_USRVALID|DB_DUPDATA;
+	if (NEED_CMP_CLONG(mx->mx_dbx.md_cmp, mx->mx_db.md_pad))
+		mx->mx_dbx.md_cmp = mdb_cmp_clong;
+}
+
+
+/** Fixup a sorted-dups cursor due to underlying update.
+ *	Sets up some fields that depend on the data from the main cursor.
+ *	Almost the same as init1, but skips initialization steps if the
+ *	xcursor had already been used.
+ * @param[in] mc The main cursor whose sorted-dups cursor is to be fixed up.
+ * @param[in] src_mx The xcursor of an up-to-date cursor.
+ * @param[in] new_dupdata True if converting from a non-#F_DUPDATA item.
+ */
+static void
+mdb_xcursor_init2(MDB_cursor *mc, MDB_xcursor *src_mx, int new_dupdata)
+{
+	MDB_xcursor *mx = mc->mc_xcursor;
+
+	if (new_dupdata) {
+		mx->mx_cursor.mc_snum = 1;
+		mx->mx_cursor.mc_top = 0;
+		mx->mx_cursor.mc_flags |= C_INITIALIZED;
+		mx->mx_cursor.mc_ki[0] = 0;
+		mx->mx_dbflag = DB_VALID|DB_USRVALID|DB_DUPDATA;
+#if UINT_MAX < MDB_SIZE_MAX	/* matches mdb_xcursor_init1:NEED_CMP_CLONG() */
+		mx->mx_dbx.md_cmp = src_mx->mx_dbx.md_cmp;
+#endif
+	} else if (!(mx->mx_cursor.mc_flags & C_INITIALIZED)) {
+		return;
+	}
+	mx->mx_db = src_mx->mx_db;
+	mx->mx_cursor.mc_pg[0] = src_mx->mx_cursor.mc_pg[0];
+	DPRINTF(("Sub-db -%u root page %"Yu, mx->mx_cursor.mc_dbi,
+		mx->mx_db.md_root));
+}
+
+/** Initialize a cursor for a given transaction and database. */
+static void
+mdb_cursor_init(MDB_cursor *mc, MDB_txn *txn, MDB_dbi dbi, MDB_xcursor *mx)
+{
+	mc->mc_next = NULL;
+	mc->mc_backup = NULL;
+	mc->mc_dbi = dbi;
+	mc->mc_txn = txn;
+	mc->mc_db = &txn->mt_dbs[dbi];
+	mc->mc_dbx = &txn->mt_dbxs[dbi];
+	mc->mc_dbflag = &txn->mt_dbflags[dbi];
+	mc->mc_snum = 0;
+	mc->mc_top = 0;
+	mc->mc_pg[0] = 0;
+	mc->mc_ki[0] = 0;
+	MC_SET_OVPG(mc, NULL);
+	mc->mc_flags = txn->mt_flags & (C_ORIG_RDONLY|C_WRITEMAP);
+	if (txn->mt_dbs[dbi].md_flags & MDB_DUPSORT) {
+		mdb_tassert(txn, mx != NULL);
+		mc->mc_xcursor = mx;
+		mdb_xcursor_init0(mc);
+	} else {
+		mc->mc_xcursor = NULL;
+	}
+	if (*mc->mc_dbflag & DB_STALE) {
+		mdb_page_search(mc, NULL, MDB_PS_ROOTONLY);
+	}
+}
+
+int
+mdb_cursor_open(MDB_txn *txn, MDB_dbi dbi, MDB_cursor **ret)
+{
+	MDB_cursor	*mc;
+	size_t size = sizeof(MDB_cursor);
+
+	if (!ret || !TXN_DBI_EXIST(txn, dbi, DB_VALID))
+		return EINVAL;
+
+	if (txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	if (dbi == FREE_DBI && !F_ISSET(txn->mt_flags, MDB_TXN_RDONLY))
+		return EINVAL;
+
+	if (txn->mt_dbs[dbi].md_flags & MDB_DUPSORT)
+		size += sizeof(MDB_xcursor);
+
+	if ((mc = malloc(size)) != NULL) {
+		mdb_cursor_init(mc, txn, dbi, (MDB_xcursor *)(mc + 1));
+		if (txn->mt_cursors) {
+			mc->mc_next = txn->mt_cursors[dbi];
+			txn->mt_cursors[dbi] = mc;
+			mc->mc_flags |= C_UNTRACK;
+		}
+	} else {
+		return ENOMEM;
+	}
+
+	*ret = mc;
+
+	return MDB_SUCCESS;
+}
+
+int
+mdb_cursor_renew(MDB_txn *txn, MDB_cursor *mc)
+{
+	if (!mc || !TXN_DBI_EXIST(txn, mc->mc_dbi, DB_VALID))
+		return EINVAL;
+
+	if ((mc->mc_flags & C_UNTRACK) || txn->mt_cursors)
+		return EINVAL;
+
+	if (txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	mdb_cursor_init(mc, txn, mc->mc_dbi, mc->mc_xcursor);
+	return MDB_SUCCESS;
+}
+
+/* Return the count of duplicate data items for the current key */
+int
+mdb_cursor_count(MDB_cursor *mc, mdb_size_t *countp)
+{
+	MDB_node	*leaf;
+
+	if (mc == NULL || countp == NULL)
+		return EINVAL;
+
+	if (mc->mc_xcursor == NULL)
+		return MDB_INCOMPATIBLE;
+
+	if (mc->mc_txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	if (!(mc->mc_flags & C_INITIALIZED))
+		return EINVAL;
+
+	if (!mc->mc_snum)
+		return MDB_NOTFOUND;
+
+	if (mc->mc_flags & C_EOF) {
+		if (mc->mc_ki[mc->mc_top] >= NUMKEYS(mc->mc_pg[mc->mc_top]))
+			return MDB_NOTFOUND;
+		mc->mc_flags ^= C_EOF;
+	}
+
+	leaf = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+	if (!F_ISSET(leaf->mn_flags, F_DUPDATA)) {
+		*countp = 1;
+	} else {
+		if (!(mc->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED))
+			return EINVAL;
+
+		*countp = mc->mc_xcursor->mx_db.md_entries;
+	}
+	return MDB_SUCCESS;
+}
+
+void
+mdb_cursor_close(MDB_cursor *mc)
+{
+	if (mc) {
+		MDB_CURSOR_UNREF(mc, 0);
+	}
+	if (mc && !mc->mc_backup) {
+		/* Remove from txn, if tracked.
+		 * A read-only txn (!C_UNTRACK) may have been freed already,
+		 * so do not peek inside it.  Only write txns track cursors.
+		 */
+		if ((mc->mc_flags & C_UNTRACK) && mc->mc_txn->mt_cursors) {
+			MDB_cursor **prev = &mc->mc_txn->mt_cursors[mc->mc_dbi];
+			while (*prev && *prev != mc) prev = &(*prev)->mc_next;
+			if (*prev == mc)
+				*prev = mc->mc_next;
+		}
+		free(mc);
+	}
+}
+
+MDB_txn *
+mdb_cursor_txn(MDB_cursor *mc)
+{
+	if (!mc) return NULL;
+	return mc->mc_txn;
+}
+
+MDB_dbi
+mdb_cursor_dbi(MDB_cursor *mc)
+{
+	return mc->mc_dbi;
+}
+
+/** Replace the key for a branch node with a new key.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in] mc Cursor pointing to the node to operate on.
+ * @param[in] key The new key to use.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_update_key(MDB_cursor *mc, MDB_val *key)
+{
+	MDB_page		*mp;
+	MDB_node		*node;
+	char			*base;
+	size_t			 len;
+	int				 delta, ksize, oksize;
+	indx_t			 ptr, i, numkeys, indx;
+	DKBUF;
+
+	indx = mc->mc_ki[mc->mc_top];
+	mp = mc->mc_pg[mc->mc_top];
+	node = NODEPTR(mp, indx);
+	ptr = mp->mp_ptrs[indx];
+#if MDB_DEBUG
+	{
+		MDB_val	k2;
+		char kbuf2[DKBUF_MAXKEYSIZE*2+1];
+		k2.mv_data = NODEKEY(node);
+		k2.mv_size = node->mn_ksize;
+		DPRINTF(("update key %u (ofs %u) [%s] to [%s] on page %"Yu,
+			indx, ptr,
+			mdb_dkey(&k2, kbuf2),
+			DKEY(key),
+			mp->mp_pgno));
+	}
+#endif
+
+	/* Sizes must be 2-byte aligned. */
+	ksize = EVEN(key->mv_size);
+	oksize = EVEN(node->mn_ksize);
+	delta = ksize - oksize;
+
+	/* Shift node contents if EVEN(key length) changed. */
+	if (delta) {
+		if (delta > 0 && SIZELEFT(mp) < delta) {
+			pgno_t pgno;
+			/* not enough space left, do a delete and split */
+			DPRINTF(("Not enough room, delta = %d, splitting...", delta));
+			pgno = NODEPGNO(node);
+			mdb_node_del(mc, 0);
+			return mdb_page_split(mc, key, NULL, pgno, MDB_SPLIT_REPLACE);
+		}
+
+		numkeys = NUMKEYS(mp);
+		for (i = 0; i < numkeys; i++) {
+			if (mp->mp_ptrs[i] <= ptr)
+				mp->mp_ptrs[i] -= delta;
+		}
+
+		base = (char *)mp + mp->mp_upper + PAGEBASE;
+		len = ptr - mp->mp_upper + NODESIZE;
+		memmove(base - delta, base, len);
+		mp->mp_upper -= delta;
+
+		node = NODEPTR(mp, indx);
+	}
+
+	/* But even if no shift was needed, update ksize */
+	if (node->mn_ksize != key->mv_size)
+		node->mn_ksize = key->mv_size;
+
+	if (key->mv_size)
+		memcpy(NODEKEY(node), key->mv_data, key->mv_size);
+
+	return MDB_SUCCESS;
+}
+
+static void
+mdb_cursor_copy(const MDB_cursor *csrc, MDB_cursor *cdst);
+
+/** Perform \b act while tracking temporary cursor \b mn */
+#define WITH_CURSOR_TRACKING(mn, act) do { \
+	MDB_cursor dummy, *tracked, **tp = &(mn).mc_txn->mt_cursors[mn.mc_dbi]; \
+	if ((mn).mc_flags & C_SUB) { \
+		dummy.mc_flags =  C_INITIALIZED; \
+		dummy.mc_xcursor = (MDB_xcursor *)&(mn);	\
+		tracked = &dummy; \
+	} else { \
+		tracked = &(mn); \
+	} \
+	tracked->mc_next = *tp; \
+	*tp = tracked; \
+	{ act; } \
+	*tp = tracked->mc_next; \
+} while (0)
+
+/** Move a node from csrc to cdst.
+ */
+static int
+mdb_node_move(MDB_cursor *csrc, MDB_cursor *cdst, int fromleft)
+{
+	MDB_node		*srcnode;
+	MDB_val		 key, data;
+	pgno_t	srcpg;
+	MDB_cursor mn;
+	int			 rc;
+	unsigned short flags;
+
+	DKBUF;
+
+	/* Mark src and dst as dirty. */
+	if ((rc = mdb_page_touch(csrc)) ||
+	    (rc = mdb_page_touch(cdst)))
+		return rc;
+
+	if (IS_LEAF2(csrc->mc_pg[csrc->mc_top])) {
+		key.mv_size = csrc->mc_db->md_pad;
+		key.mv_data = LEAF2KEY(csrc->mc_pg[csrc->mc_top], csrc->mc_ki[csrc->mc_top], key.mv_size);
+		data.mv_size = 0;
+		data.mv_data = NULL;
+		srcpg = 0;
+		flags = 0;
+	} else {
+		srcnode = NODEPTR(csrc->mc_pg[csrc->mc_top], csrc->mc_ki[csrc->mc_top]);
+		mdb_cassert(csrc, !((size_t)srcnode & 1));
+		srcpg = NODEPGNO(srcnode);
+		flags = srcnode->mn_flags;
+		if (csrc->mc_ki[csrc->mc_top] == 0 && IS_BRANCH(csrc->mc_pg[csrc->mc_top])) {
+			unsigned int snum = csrc->mc_snum;
+			MDB_node *s2;
+			/* must find the lowest key below src */
+			rc = mdb_page_search_lowest(csrc);
+			if (rc)
+				return rc;
+			if (IS_LEAF2(csrc->mc_pg[csrc->mc_top])) {
+				key.mv_size = csrc->mc_db->md_pad;
+				key.mv_data = LEAF2KEY(csrc->mc_pg[csrc->mc_top], 0, key.mv_size);
+			} else {
+				s2 = NODEPTR(csrc->mc_pg[csrc->mc_top], 0);
+				key.mv_size = NODEKSZ(s2);
+				key.mv_data = NODEKEY(s2);
+			}
+			csrc->mc_snum = snum--;
+			csrc->mc_top = snum;
+		} else {
+			key.mv_size = NODEKSZ(srcnode);
+			key.mv_data = NODEKEY(srcnode);
+		}
+		data.mv_size = NODEDSZ(srcnode);
+		data.mv_data = NODEDATA(srcnode);
+	}
+	mn.mc_xcursor = NULL;
+	if (IS_BRANCH(cdst->mc_pg[cdst->mc_top]) && cdst->mc_ki[cdst->mc_top] == 0) {
+		unsigned int snum = cdst->mc_snum;
+		MDB_node *s2;
+		MDB_val bkey;
+		/* must find the lowest key below dst */
+		mdb_cursor_copy(cdst, &mn);
+		rc = mdb_page_search_lowest(&mn);
+		if (rc)
+			return rc;
+		if (IS_LEAF2(mn.mc_pg[mn.mc_top])) {
+			bkey.mv_size = mn.mc_db->md_pad;
+			bkey.mv_data = LEAF2KEY(mn.mc_pg[mn.mc_top], 0, bkey.mv_size);
+		} else {
+			s2 = NODEPTR(mn.mc_pg[mn.mc_top], 0);
+			bkey.mv_size = NODEKSZ(s2);
+			bkey.mv_data = NODEKEY(s2);
+		}
+		mn.mc_snum = snum--;
+		mn.mc_top = snum;
+		mn.mc_ki[snum] = 0;
+		rc = mdb_update_key(&mn, &bkey);
+		if (rc)
+			return rc;
+	}
+
+	DPRINTF(("moving %s node %u [%s] on page %"Yu" to node %u on page %"Yu,
+	    IS_LEAF(csrc->mc_pg[csrc->mc_top]) ? "leaf" : "branch",
+	    csrc->mc_ki[csrc->mc_top],
+		DKEY(&key),
+	    csrc->mc_pg[csrc->mc_top]->mp_pgno,
+	    cdst->mc_ki[cdst->mc_top], cdst->mc_pg[cdst->mc_top]->mp_pgno));
+
+	/* Add the node to the destination page.
+	 */
+	rc = mdb_node_add(cdst, cdst->mc_ki[cdst->mc_top], &key, &data, srcpg, flags);
+	if (rc != MDB_SUCCESS)
+		return rc;
+
+	/* Delete the node from the source page.
+	 */
+	mdb_node_del(csrc, key.mv_size);
+
+	{
+		/* Adjust other cursors pointing to mp */
+		MDB_cursor *m2, *m3;
+		MDB_dbi dbi = csrc->mc_dbi;
+		MDB_page *mpd, *mps;
+
+		mps = csrc->mc_pg[csrc->mc_top];
+		/* If we're adding on the left, bump others up */
+		if (fromleft) {
+			mpd = cdst->mc_pg[csrc->mc_top];
+			for (m2 = csrc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+				if (csrc->mc_flags & C_SUB)
+					m3 = &m2->mc_xcursor->mx_cursor;
+				else
+					m3 = m2;
+				if (!(m3->mc_flags & C_INITIALIZED) || m3->mc_top < csrc->mc_top)
+					continue;
+				if (m3 != cdst &&
+					m3->mc_pg[csrc->mc_top] == mpd &&
+					m3->mc_ki[csrc->mc_top] >= cdst->mc_ki[csrc->mc_top]) {
+					m3->mc_ki[csrc->mc_top]++;
+				}
+				if (m3 !=csrc &&
+					m3->mc_pg[csrc->mc_top] == mps &&
+					m3->mc_ki[csrc->mc_top] == csrc->mc_ki[csrc->mc_top]) {
+					m3->mc_pg[csrc->mc_top] = cdst->mc_pg[cdst->mc_top];
+					m3->mc_ki[csrc->mc_top] = cdst->mc_ki[cdst->mc_top];
+					m3->mc_ki[csrc->mc_top-1]++;
+				}
+				if (IS_LEAF(mps))
+					XCURSOR_REFRESH(m3, csrc->mc_top, m3->mc_pg[csrc->mc_top]);
+			}
+		} else
+		/* Adding on the right, bump others down */
+		{
+			for (m2 = csrc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+				if (csrc->mc_flags & C_SUB)
+					m3 = &m2->mc_xcursor->mx_cursor;
+				else
+					m3 = m2;
+				if (m3 == csrc) continue;
+				if (!(m3->mc_flags & C_INITIALIZED) || m3->mc_top < csrc->mc_top)
+					continue;
+				if (m3->mc_pg[csrc->mc_top] == mps) {
+					if (!m3->mc_ki[csrc->mc_top]) {
+						m3->mc_pg[csrc->mc_top] = cdst->mc_pg[cdst->mc_top];
+						m3->mc_ki[csrc->mc_top] = cdst->mc_ki[cdst->mc_top];
+						m3->mc_ki[csrc->mc_top-1]--;
+					} else {
+						m3->mc_ki[csrc->mc_top]--;
+					}
+					if (IS_LEAF(mps))
+						XCURSOR_REFRESH(m3, csrc->mc_top, m3->mc_pg[csrc->mc_top]);
+				}
+			}
+		}
+	}
+
+	/* Update the parent separators.
+	 */
+	if (csrc->mc_ki[csrc->mc_top] == 0) {
+		if (csrc->mc_ki[csrc->mc_top-1] != 0) {
+			if (IS_LEAF2(csrc->mc_pg[csrc->mc_top])) {
+				key.mv_data = LEAF2KEY(csrc->mc_pg[csrc->mc_top], 0, key.mv_size);
+			} else {
+				srcnode = NODEPTR(csrc->mc_pg[csrc->mc_top], 0);
+				key.mv_size = NODEKSZ(srcnode);
+				key.mv_data = NODEKEY(srcnode);
+			}
+			DPRINTF(("update separator for source page %"Yu" to [%s]",
+				csrc->mc_pg[csrc->mc_top]->mp_pgno, DKEY(&key)));
+			mdb_cursor_copy(csrc, &mn);
+			mn.mc_snum--;
+			mn.mc_top--;
+			/* We want mdb_rebalance to find mn when doing fixups */
+			WITH_CURSOR_TRACKING(mn,
+				rc = mdb_update_key(&mn, &key));
+			if (rc)
+				return rc;
+		}
+		if (IS_BRANCH(csrc->mc_pg[csrc->mc_top])) {
+			MDB_val	 nullkey;
+			indx_t	ix = csrc->mc_ki[csrc->mc_top];
+			nullkey.mv_size = 0;
+			csrc->mc_ki[csrc->mc_top] = 0;
+			rc = mdb_update_key(csrc, &nullkey);
+			csrc->mc_ki[csrc->mc_top] = ix;
+			mdb_cassert(csrc, rc == MDB_SUCCESS);
+		}
+	}
+
+	if (cdst->mc_ki[cdst->mc_top] == 0) {
+		if (cdst->mc_ki[cdst->mc_top-1] != 0) {
+			if (IS_LEAF2(csrc->mc_pg[csrc->mc_top])) {
+				key.mv_data = LEAF2KEY(cdst->mc_pg[cdst->mc_top], 0, key.mv_size);
+			} else {
+				srcnode = NODEPTR(cdst->mc_pg[cdst->mc_top], 0);
+				key.mv_size = NODEKSZ(srcnode);
+				key.mv_data = NODEKEY(srcnode);
+			}
+			DPRINTF(("update separator for destination page %"Yu" to [%s]",
+				cdst->mc_pg[cdst->mc_top]->mp_pgno, DKEY(&key)));
+			mdb_cursor_copy(cdst, &mn);
+			mn.mc_snum--;
+			mn.mc_top--;
+			/* We want mdb_rebalance to find mn when doing fixups */
+			WITH_CURSOR_TRACKING(mn,
+				rc = mdb_update_key(&mn, &key));
+			if (rc)
+				return rc;
+		}
+		if (IS_BRANCH(cdst->mc_pg[cdst->mc_top])) {
+			MDB_val	 nullkey;
+			indx_t	ix = cdst->mc_ki[cdst->mc_top];
+			nullkey.mv_size = 0;
+			cdst->mc_ki[cdst->mc_top] = 0;
+			rc = mdb_update_key(cdst, &nullkey);
+			cdst->mc_ki[cdst->mc_top] = ix;
+			mdb_cassert(cdst, rc == MDB_SUCCESS);
+		}
+	}
+
+	return MDB_SUCCESS;
+}
+
+/** Merge one page into another.
+ *  The nodes from the page pointed to by \b csrc will
+ *	be copied to the page pointed to by \b cdst and then
+ *	the \b csrc page will be freed.
+ * @param[in] csrc Cursor pointing to the source page.
+ * @param[in] cdst Cursor pointing to the destination page.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_merge(MDB_cursor *csrc, MDB_cursor *cdst)
+{
+	MDB_page	*psrc, *pdst;
+	MDB_node	*srcnode;
+	MDB_val		 key, data;
+	unsigned	 nkeys;
+	int			 rc;
+	indx_t		 i, j;
+
+	psrc = csrc->mc_pg[csrc->mc_top];
+	pdst = cdst->mc_pg[cdst->mc_top];
+
+	DPRINTF(("merging page %"Yu" into %"Yu, psrc->mp_pgno, pdst->mp_pgno));
+
+	mdb_cassert(csrc, csrc->mc_snum > 1);	/* can't merge root page */
+	mdb_cassert(csrc, cdst->mc_snum > 1);
+
+	/* Mark dst as dirty. */
+	if ((rc = mdb_page_touch(cdst)))
+		return rc;
+
+	/* get dst page again now that we've touched it. */
+	pdst = cdst->mc_pg[cdst->mc_top];
+
+	/* Move all nodes from src to dst.
+	 */
+	j = nkeys = NUMKEYS(pdst);
+	if (IS_LEAF2(psrc)) {
+		key.mv_size = csrc->mc_db->md_pad;
+		key.mv_data = METADATA(psrc);
+		for (i = 0; i < NUMKEYS(psrc); i++, j++) {
+			rc = mdb_node_add(cdst, j, &key, NULL, 0, 0);
+			if (rc != MDB_SUCCESS)
+				return rc;
+			key.mv_data = (char *)key.mv_data + key.mv_size;
+		}
+	} else {
+		for (i = 0; i < NUMKEYS(psrc); i++, j++) {
+			srcnode = NODEPTR(psrc, i);
+			if (i == 0 && IS_BRANCH(psrc)) {
+				MDB_cursor mn;
+				MDB_node *s2;
+				mdb_cursor_copy(csrc, &mn);
+				mn.mc_xcursor = NULL;
+				/* must find the lowest key below src */
+				rc = mdb_page_search_lowest(&mn);
+				if (rc)
+					return rc;
+				if (IS_LEAF2(mn.mc_pg[mn.mc_top])) {
+					key.mv_size = mn.mc_db->md_pad;
+					key.mv_data = LEAF2KEY(mn.mc_pg[mn.mc_top], 0, key.mv_size);
+				} else {
+					s2 = NODEPTR(mn.mc_pg[mn.mc_top], 0);
+					key.mv_size = NODEKSZ(s2);
+					key.mv_data = NODEKEY(s2);
+				}
+			} else {
+				key.mv_size = srcnode->mn_ksize;
+				key.mv_data = NODEKEY(srcnode);
+			}
+
+			data.mv_size = NODEDSZ(srcnode);
+			data.mv_data = NODEDATA(srcnode);
+			rc = mdb_node_add(cdst, j, &key, &data, NODEPGNO(srcnode), srcnode->mn_flags);
+			if (rc != MDB_SUCCESS)
+				return rc;
+		}
+	}
+
+	DPRINTF(("dst page %"Yu" now has %u keys (%.1f%% filled)",
+	    pdst->mp_pgno, NUMKEYS(pdst),
+		(float)PAGEFILL(cdst->mc_txn->mt_env, pdst) / 10));
+
+	/* Unlink the src page from parent and add to free list.
+	 */
+	csrc->mc_top--;
+	mdb_node_del(csrc, 0);
+	if (csrc->mc_ki[csrc->mc_top] == 0) {
+		key.mv_size = 0;
+		rc = mdb_update_key(csrc, &key);
+		if (rc) {
+			csrc->mc_top++;
+			return rc;
+		}
+	}
+	csrc->mc_top++;
+
+	psrc = csrc->mc_pg[csrc->mc_top];
+	/* If not operating on FreeDB, allow this page to be reused
+	 * in this txn. Otherwise just add to free list.
+	 */
+	rc = mdb_page_loose(csrc, psrc);
+	if (rc)
+		return rc;
+	if (IS_LEAF(psrc))
+		csrc->mc_db->md_leaf_pages--;
+	else
+		csrc->mc_db->md_branch_pages--;
+	{
+		/* Adjust other cursors pointing to mp */
+		MDB_cursor *m2, *m3;
+		MDB_dbi dbi = csrc->mc_dbi;
+		unsigned int top = csrc->mc_top;
+
+		for (m2 = csrc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+			if (csrc->mc_flags & C_SUB)
+				m3 = &m2->mc_xcursor->mx_cursor;
+			else
+				m3 = m2;
+			if (m3 == csrc) continue;
+			if (m3->mc_snum < csrc->mc_snum) continue;
+			if (m3->mc_pg[top] == psrc) {
+				m3->mc_pg[top] = pdst;
+				m3->mc_ki[top] += nkeys;
+				m3->mc_ki[top-1] = cdst->mc_ki[top-1];
+			} else if (m3->mc_pg[top-1] == csrc->mc_pg[top-1] &&
+				m3->mc_ki[top-1] > csrc->mc_ki[top-1]) {
+				m3->mc_ki[top-1]--;
+			}
+			if (IS_LEAF(psrc))
+				XCURSOR_REFRESH(m3, top, m3->mc_pg[top]);
+		}
+	}
+	{
+		unsigned int snum = cdst->mc_snum;
+		uint16_t depth = cdst->mc_db->md_depth;
+		mdb_cursor_pop(cdst);
+		rc = mdb_rebalance(cdst);
+		/* Did the tree height change? */
+		if (depth != cdst->mc_db->md_depth)
+			snum += cdst->mc_db->md_depth - depth;
+		cdst->mc_snum = snum;
+		cdst->mc_top = snum-1;
+	}
+	return rc;
+}
+
+/** Copy the contents of a cursor.
+ * @param[in] csrc The cursor to copy from.
+ * @param[out] cdst The cursor to copy to.
+ */
+static void
+mdb_cursor_copy(const MDB_cursor *csrc, MDB_cursor *cdst)
+{
+	unsigned int i;
+
+	cdst->mc_txn = csrc->mc_txn;
+	cdst->mc_dbi = csrc->mc_dbi;
+	cdst->mc_db  = csrc->mc_db;
+	cdst->mc_dbx = csrc->mc_dbx;
+	cdst->mc_snum = csrc->mc_snum;
+	cdst->mc_top = csrc->mc_top;
+	cdst->mc_flags = csrc->mc_flags;
+	MC_SET_OVPG(cdst, MC_OVPG(csrc));
+
+	for (i=0; i<csrc->mc_snum; i++) {
+		cdst->mc_pg[i] = csrc->mc_pg[i];
+		cdst->mc_ki[i] = csrc->mc_ki[i];
+	}
+}
+
+/** Rebalance the tree after a delete operation.
+ * @param[in] mc Cursor pointing to the page where rebalancing
+ * should begin.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_rebalance(MDB_cursor *mc)
+{
+	MDB_node	*node;
+	int rc, fromleft;
+	unsigned int ptop, minkeys, thresh;
+	MDB_cursor	mn;
+	indx_t oldki;
+
+	if (IS_BRANCH(mc->mc_pg[mc->mc_top])) {
+		minkeys = 2;
+		thresh = 1;
+	} else {
+		minkeys = 1;
+		thresh = FILL_THRESHOLD;
+	}
+	DPRINTF(("rebalancing %s page %"Yu" (has %u keys, %.1f%% full)",
+	    IS_LEAF(mc->mc_pg[mc->mc_top]) ? "leaf" : "branch",
+	    mdb_dbg_pgno(mc->mc_pg[mc->mc_top]), NUMKEYS(mc->mc_pg[mc->mc_top]),
+		(float)PAGEFILL(mc->mc_txn->mt_env, mc->mc_pg[mc->mc_top]) / 10));
+
+	if (PAGEFILL(mc->mc_txn->mt_env, mc->mc_pg[mc->mc_top]) >= thresh &&
+		NUMKEYS(mc->mc_pg[mc->mc_top]) >= minkeys) {
+		DPRINTF(("no need to rebalance page %"Yu", above fill threshold",
+		    mdb_dbg_pgno(mc->mc_pg[mc->mc_top])));
+		return MDB_SUCCESS;
+	}
+
+	if (mc->mc_snum < 2) {
+		MDB_page *mp = mc->mc_pg[0];
+		if (IS_SUBP(mp)) {
+			DPUTS("Can't rebalance a subpage, ignoring");
+			return MDB_SUCCESS;
+		}
+		if (NUMKEYS(mp) == 0) {
+			DPUTS("tree is completely empty");
+			mc->mc_db->md_root = P_INVALID;
+			mc->mc_db->md_depth = 0;
+			mc->mc_db->md_leaf_pages = 0;
+			rc = mdb_midl_append(&mc->mc_txn->mt_free_pgs, mp->mp_pgno);
+			if (rc)
+				return rc;
+			/* Adjust cursors pointing to mp */
+			mc->mc_snum = 0;
+			mc->mc_top = 0;
+			mc->mc_flags &= ~C_INITIALIZED;
+			{
+				MDB_cursor *m2, *m3;
+				MDB_dbi dbi = mc->mc_dbi;
+
+				for (m2 = mc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+					if (mc->mc_flags & C_SUB)
+						m3 = &m2->mc_xcursor->mx_cursor;
+					else
+						m3 = m2;
+					if (!(m3->mc_flags & C_INITIALIZED) || (m3->mc_snum < mc->mc_snum))
+						continue;
+					if (m3->mc_pg[0] == mp) {
+						m3->mc_snum = 0;
+						m3->mc_top = 0;
+						m3->mc_flags &= ~C_INITIALIZED;
+					}
+				}
+			}
+		} else if (IS_BRANCH(mp) && NUMKEYS(mp) == 1) {
+			int i;
+			DPUTS("collapsing root page!");
+			rc = mdb_midl_append(&mc->mc_txn->mt_free_pgs, mp->mp_pgno);
+			if (rc)
+				return rc;
+			mc->mc_db->md_root = NODEPGNO(NODEPTR(mp, 0));
+			rc = mdb_page_get(mc, mc->mc_db->md_root, &mc->mc_pg[0], NULL);
+			if (rc)
+				return rc;
+			mc->mc_db->md_depth--;
+			mc->mc_db->md_branch_pages--;
+			mc->mc_ki[0] = mc->mc_ki[1];
+			for (i = 1; i<mc->mc_db->md_depth; i++) {
+				mc->mc_pg[i] = mc->mc_pg[i+1];
+				mc->mc_ki[i] = mc->mc_ki[i+1];
+			}
+			{
+				/* Adjust other cursors pointing to mp */
+				MDB_cursor *m2, *m3;
+				MDB_dbi dbi = mc->mc_dbi;
+
+				for (m2 = mc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+					if (mc->mc_flags & C_SUB)
+						m3 = &m2->mc_xcursor->mx_cursor;
+					else
+						m3 = m2;
+					if (m3 == mc) continue;
+					if (!(m3->mc_flags & C_INITIALIZED))
+						continue;
+					if (m3->mc_pg[0] == mp) {
+						for (i=0; i<mc->mc_db->md_depth; i++) {
+							m3->mc_pg[i] = m3->mc_pg[i+1];
+							m3->mc_ki[i] = m3->mc_ki[i+1];
+						}
+						m3->mc_snum--;
+						m3->mc_top--;
+					}
+				}
+			}
+		} else
+			DPUTS("root page doesn't need rebalancing");
+		return MDB_SUCCESS;
+	}
+
+	/* The parent (branch page) must have at least 2 pointers,
+	 * otherwise the tree is invalid.
+	 */
+	ptop = mc->mc_top-1;
+	mdb_cassert(mc, NUMKEYS(mc->mc_pg[ptop]) > 1);
+
+	/* Leaf page fill factor is below the threshold.
+	 * Try to move keys from left or right neighbor, or
+	 * merge with a neighbor page.
+	 */
+
+	/* Find neighbors.
+	 */
+	mdb_cursor_copy(mc, &mn);
+	mn.mc_xcursor = NULL;
+
+	oldki = mc->mc_ki[mc->mc_top];
+	if (mc->mc_ki[ptop] == 0) {
+		/* We're the leftmost leaf in our parent.
+		 */
+		DPUTS("reading right neighbor");
+		mn.mc_ki[ptop]++;
+		node = NODEPTR(mc->mc_pg[ptop], mn.mc_ki[ptop]);
+		rc = mdb_page_get(mc, NODEPGNO(node), &mn.mc_pg[mn.mc_top], NULL);
+		if (rc)
+			return rc;
+		mn.mc_ki[mn.mc_top] = 0;
+		mc->mc_ki[mc->mc_top] = NUMKEYS(mc->mc_pg[mc->mc_top]);
+		fromleft = 0;
+	} else {
+		/* There is at least one neighbor to the left.
+		 */
+		DPUTS("reading left neighbor");
+		mn.mc_ki[ptop]--;
+		node = NODEPTR(mc->mc_pg[ptop], mn.mc_ki[ptop]);
+		rc = mdb_page_get(mc, NODEPGNO(node), &mn.mc_pg[mn.mc_top], NULL);
+		if (rc)
+			return rc;
+		mn.mc_ki[mn.mc_top] = NUMKEYS(mn.mc_pg[mn.mc_top]) - 1;
+		mc->mc_ki[mc->mc_top] = 0;
+		fromleft = 1;
+	}
+
+	DPRINTF(("found neighbor page %"Yu" (%u keys, %.1f%% full)",
+	    mn.mc_pg[mn.mc_top]->mp_pgno, NUMKEYS(mn.mc_pg[mn.mc_top]),
+		(float)PAGEFILL(mc->mc_txn->mt_env, mn.mc_pg[mn.mc_top]) / 10));
+
+	/* If the neighbor page is above threshold and has enough keys,
+	 * move one key from it. Otherwise we should try to merge them.
+	 * (A branch page must never have less than 2 keys.)
+	 */
+	if (PAGEFILL(mc->mc_txn->mt_env, mn.mc_pg[mn.mc_top]) >= thresh && NUMKEYS(mn.mc_pg[mn.mc_top]) > minkeys) {
+		rc = mdb_node_move(&mn, mc, fromleft);
+		if (fromleft) {
+			/* if we inserted on left, bump position up */
+			oldki++;
+		}
+	} else {
+		if (!fromleft) {
+			rc = mdb_page_merge(&mn, mc);
+		} else {
+			oldki += NUMKEYS(mn.mc_pg[mn.mc_top]);
+			mn.mc_ki[mn.mc_top] += mc->mc_ki[mn.mc_top] + 1;
+			/* We want mdb_rebalance to find mn when doing fixups */
+			WITH_CURSOR_TRACKING(mn,
+				rc = mdb_page_merge(mc, &mn));
+			mdb_cursor_copy(&mn, mc);
+		}
+		mc->mc_flags &= ~C_EOF;
+	}
+	mc->mc_ki[mc->mc_top] = oldki;
+	return rc;
+}
+
+/** Complete a delete operation started by #mdb_cursor_del(). */
+static int
+mdb_cursor_del0(MDB_cursor *mc)
+{
+	int rc;
+	MDB_page *mp;
+	indx_t ki;
+	unsigned int nkeys;
+	MDB_cursor *m2, *m3;
+	MDB_dbi dbi = mc->mc_dbi;
+
+	ki = mc->mc_ki[mc->mc_top];
+	mp = mc->mc_pg[mc->mc_top];
+	mdb_node_del(mc, mc->mc_db->md_pad);
+	mc->mc_db->md_entries--;
+	{
+		/* Adjust other cursors pointing to mp */
+		for (m2 = mc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+			m3 = (mc->mc_flags & C_SUB) ? &m2->mc_xcursor->mx_cursor : m2;
+			if (! (m2->mc_flags & m3->mc_flags & C_INITIALIZED))
+				continue;
+			if (m3 == mc || m3->mc_snum < mc->mc_snum)
+				continue;
+			if (m3->mc_pg[mc->mc_top] == mp) {
+				if (m3->mc_ki[mc->mc_top] == ki) {
+					m3->mc_flags |= C_DEL;
+					if (mc->mc_db->md_flags & MDB_DUPSORT) {
+						/* Sub-cursor referred into dataset which is gone */
+						m3->mc_xcursor->mx_cursor.mc_flags &= ~(C_INITIALIZED|C_EOF);
+					}
+					continue;
+				} else if (m3->mc_ki[mc->mc_top] > ki) {
+					m3->mc_ki[mc->mc_top]--;
+				}
+				XCURSOR_REFRESH(m3, mc->mc_top, mp);
+			}
+		}
+	}
+	rc = mdb_rebalance(mc);
+
+	if (rc == MDB_SUCCESS) {
+		/* DB is totally empty now, just bail out.
+		 * Other cursors adjustments were already done
+		 * by mdb_rebalance and aren't needed here.
+		 */
+		if (!mc->mc_snum)
+			return rc;
+
+		mp = mc->mc_pg[mc->mc_top];
+		nkeys = NUMKEYS(mp);
+
+		/* Adjust other cursors pointing to mp */
+		for (m2 = mc->mc_txn->mt_cursors[dbi]; !rc && m2; m2=m2->mc_next) {
+			m3 = (mc->mc_flags & C_SUB) ? &m2->mc_xcursor->mx_cursor : m2;
+			if (! (m2->mc_flags & m3->mc_flags & C_INITIALIZED))
+				continue;
+			if (m3->mc_snum < mc->mc_snum)
+				continue;
+			if (m3->mc_pg[mc->mc_top] == mp) {
+				/* if m3 points past last node in page, find next sibling */
+				if (m3->mc_ki[mc->mc_top] >= mc->mc_ki[mc->mc_top]) {
+					if (m3->mc_ki[mc->mc_top] >= nkeys) {
+						rc = mdb_cursor_sibling(m3, 1);
+						if (rc == MDB_NOTFOUND) {
+							m3->mc_flags |= C_EOF;
+							rc = MDB_SUCCESS;
+							continue;
+						}
+					}
+					if (mc->mc_db->md_flags & MDB_DUPSORT) {
+						MDB_node *node = NODEPTR(m3->mc_pg[m3->mc_top], m3->mc_ki[m3->mc_top]);
+						/* If this node has dupdata, it may need to be reinited
+						 * because its data has moved.
+						 * If the xcursor was not initd it must be reinited.
+						 * Else if node points to a subDB, nothing is needed.
+						 * Else (xcursor was initd, not a subDB) needs mc_pg[0] reset.
+						 */
+						if (node->mn_flags & F_DUPDATA) {
+							if (m3->mc_xcursor->mx_cursor.mc_flags & C_INITIALIZED) {
+								if (!(node->mn_flags & F_SUBDATA))
+									m3->mc_xcursor->mx_cursor.mc_pg[0] = NODEDATA(node);
+							} else {
+								mdb_xcursor_init1(m3, node);
+								m3->mc_xcursor->mx_cursor.mc_flags |= C_DEL;
+							}
+						}
+					}
+				}
+			}
+		}
+		mc->mc_flags |= C_DEL;
+	}
+
+	if (rc)
+		mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+int
+mdb_del(MDB_txn *txn, MDB_dbi dbi,
+    MDB_val *key, MDB_val *data)
+{
+	if (!key || !TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	if (txn->mt_flags & (MDB_TXN_RDONLY|MDB_TXN_BLOCKED))
+		return (txn->mt_flags & MDB_TXN_RDONLY) ? EACCES : MDB_BAD_TXN;
+
+	if (!F_ISSET(txn->mt_dbs[dbi].md_flags, MDB_DUPSORT)) {
+		/* must ignore any data */
+		data = NULL;
+	}
+
+	return mdb_del0(txn, dbi, key, data, 0);
+}
+
+static int
+mdb_del0(MDB_txn *txn, MDB_dbi dbi,
+	MDB_val *key, MDB_val *data, unsigned flags)
+{
+	MDB_cursor mc;
+	MDB_xcursor mx;
+	MDB_cursor_op op;
+	MDB_val rdata, *xdata;
+	int		 rc, exact = 0;
+	DKBUF;
+
+	DPRINTF(("====> delete db %u key [%s]", dbi, DKEY(key)));
+
+	mdb_cursor_init(&mc, txn, dbi, &mx);
+
+	if (data) {
+		op = MDB_GET_BOTH;
+		rdata = *data;
+		xdata = &rdata;
+	} else {
+		op = MDB_SET;
+		xdata = NULL;
+		flags |= MDB_NODUPDATA;
+	}
+	rc = mdb_cursor_set(&mc, key, xdata, op, &exact);
+	if (rc == 0) {
+		/* let mdb_page_split know about this cursor if needed:
+		 * delete will trigger a rebalance; if it needs to move
+		 * a node from one page to another, it will have to
+		 * update the parent's separator key(s). If the new sepkey
+		 * is larger than the current one, the parent page may
+		 * run out of space, triggering a split. We need this
+		 * cursor to be consistent until the end of the rebalance.
+		 */
+		mc.mc_next = txn->mt_cursors[dbi];
+		txn->mt_cursors[dbi] = &mc;
+		rc = mdb_cursor_del(&mc, flags);
+		txn->mt_cursors[dbi] = mc.mc_next;
+	}
+	return rc;
+}
+
+/** Split a page and insert a new node.
+ * Set #MDB_TXN_ERROR on failure.
+ * @param[in,out] mc Cursor pointing to the page and desired insertion index.
+ * The cursor will be updated to point to the actual page and index where
+ * the node got inserted after the split.
+ * @param[in] newkey The key for the newly inserted node.
+ * @param[in] newdata The data for the newly inserted node.
+ * @param[in] newpgno The page number, if the new node is a branch node.
+ * @param[in] nflags The #NODE_ADD_FLAGS for the new node.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_page_split(MDB_cursor *mc, MDB_val *newkey, MDB_val *newdata, pgno_t newpgno,
+	unsigned int nflags)
+{
+	unsigned int flags;
+	int		 rc = MDB_SUCCESS, new_root = 0, did_split = 0;
+	indx_t		 newindx;
+	pgno_t		 pgno = 0;
+	int	 i, j, split_indx, nkeys, pmax;
+	MDB_env 	*env = mc->mc_txn->mt_env;
+	MDB_node	*node;
+	MDB_val	 sepkey, rkey, xdata, *rdata = &xdata;
+	MDB_page	*copy = NULL;
+	MDB_page	*mp, *rp, *pp;
+	int ptop;
+	MDB_cursor	mn;
+	DKBUF;
+
+	mp = mc->mc_pg[mc->mc_top];
+	newindx = mc->mc_ki[mc->mc_top];
+	nkeys = NUMKEYS(mp);
+
+	DPRINTF(("-----> splitting %s page %"Yu" and adding [%s] at index %i/%i",
+	    IS_LEAF(mp) ? "leaf" : "branch", mp->mp_pgno,
+	    DKEY(newkey), mc->mc_ki[mc->mc_top], nkeys));
+
+	/* Create a right sibling. */
+	if ((rc = mdb_page_new(mc, mp->mp_flags, 1, &rp)))
+		return rc;
+	rp->mp_pad = mp->mp_pad;
+	DPRINTF(("new right sibling: page %"Yu, rp->mp_pgno));
+
+	/* Usually when splitting the root page, the cursor
+	 * height is 1. But when called from mdb_update_key,
+	 * the cursor height may be greater because it walks
+	 * up the stack while finding the branch slot to update.
+	 */
+	if (mc->mc_top < 1) {
+		if ((rc = mdb_page_new(mc, P_BRANCH, 1, &pp)))
+			goto done;
+		/* shift current top to make room for new parent */
+		for (i=mc->mc_snum; i>0; i--) {
+			mc->mc_pg[i] = mc->mc_pg[i-1];
+			mc->mc_ki[i] = mc->mc_ki[i-1];
+		}
+		mc->mc_pg[0] = pp;
+		mc->mc_ki[0] = 0;
+		mc->mc_db->md_root = pp->mp_pgno;
+		DPRINTF(("root split! new root = %"Yu, pp->mp_pgno));
+		new_root = mc->mc_db->md_depth++;
+
+		/* Add left (implicit) pointer. */
+		if ((rc = mdb_node_add(mc, 0, NULL, NULL, mp->mp_pgno, 0)) != MDB_SUCCESS) {
+			/* undo the pre-push */
+			mc->mc_pg[0] = mc->mc_pg[1];
+			mc->mc_ki[0] = mc->mc_ki[1];
+			mc->mc_db->md_root = mp->mp_pgno;
+			mc->mc_db->md_depth--;
+			goto done;
+		}
+		mc->mc_snum++;
+		mc->mc_top++;
+		ptop = 0;
+	} else {
+		ptop = mc->mc_top-1;
+		DPRINTF(("parent branch page is %"Yu, mc->mc_pg[ptop]->mp_pgno));
+	}
+
+	mdb_cursor_copy(mc, &mn);
+	mn.mc_xcursor = NULL;
+	mn.mc_pg[mn.mc_top] = rp;
+	mn.mc_ki[ptop] = mc->mc_ki[ptop]+1;
+
+	if (nflags & MDB_APPEND) {
+		mn.mc_ki[mn.mc_top] = 0;
+		sepkey = *newkey;
+		split_indx = newindx;
+		nkeys = 0;
+	} else {
+
+		split_indx = (nkeys+1) / 2;
+
+		if (IS_LEAF2(rp)) {
+			char *split, *ins;
+			int x;
+			unsigned int lsize, rsize, ksize;
+			/* Move half of the keys to the right sibling */
+			x = mc->mc_ki[mc->mc_top] - split_indx;
+			ksize = mc->mc_db->md_pad;
+			split = LEAF2KEY(mp, split_indx, ksize);
+			rsize = (nkeys - split_indx) * ksize;
+			lsize = (nkeys - split_indx) * sizeof(indx_t);
+			mp->mp_lower -= lsize;
+			rp->mp_lower += lsize;
+			mp->mp_upper += rsize - lsize;
+			rp->mp_upper -= rsize - lsize;
+			sepkey.mv_size = ksize;
+			if (newindx == split_indx) {
+				sepkey.mv_data = newkey->mv_data;
+			} else {
+				sepkey.mv_data = split;
+			}
+			if (x<0) {
+				ins = LEAF2KEY(mp, mc->mc_ki[mc->mc_top], ksize);
+				memcpy(rp->mp_ptrs, split, rsize);
+				sepkey.mv_data = rp->mp_ptrs;
+				memmove(ins+ksize, ins, (split_indx - mc->mc_ki[mc->mc_top]) * ksize);
+				memcpy(ins, newkey->mv_data, ksize);
+				mp->mp_lower += sizeof(indx_t);
+				mp->mp_upper -= ksize - sizeof(indx_t);
+			} else {
+				if (x)
+					memcpy(rp->mp_ptrs, split, x * ksize);
+				ins = LEAF2KEY(rp, x, ksize);
+				memcpy(ins, newkey->mv_data, ksize);
+				memcpy(ins+ksize, split + x * ksize, rsize - x * ksize);
+				rp->mp_lower += sizeof(indx_t);
+				rp->mp_upper -= ksize - sizeof(indx_t);
+				mc->mc_ki[mc->mc_top] = x;
+			}
+		} else {
+			int psize, nsize, k;
+			/* Maximum free space in an empty page */
+			pmax = env->me_psize - PAGEHDRSZ;
+			if (IS_LEAF(mp))
+				nsize = mdb_leaf_size(env, newkey, newdata);
+			else
+				nsize = mdb_branch_size(env, newkey);
+			nsize = EVEN(nsize);
+
+			/* grab a page to hold a temporary copy */
+			copy = mdb_page_malloc(mc->mc_txn, 1);
+			if (copy == NULL) {
+				rc = ENOMEM;
+				goto done;
+			}
+			copy->mp_pgno  = mp->mp_pgno;
+			copy->mp_flags = mp->mp_flags;
+			copy->mp_lower = (PAGEHDRSZ-PAGEBASE);
+			copy->mp_upper = env->me_psize - PAGEBASE;
+
+			/* prepare to insert */
+			for (i=0, j=0; i<nkeys; i++) {
+				if (i == newindx) {
+					copy->mp_ptrs[j++] = 0;
+				}
+				copy->mp_ptrs[j++] = mp->mp_ptrs[i];
+			}
+
+			/* When items are relatively large the split point needs
+			 * to be checked, because being off-by-one will make the
+			 * difference between success or failure in mdb_node_add.
+			 *
+			 * It's also relevant if a page happens to be laid out
+			 * such that one half of its nodes are all "small" and
+			 * the other half of its nodes are "large." If the new
+			 * item is also "large" and falls on the half with
+			 * "large" nodes, it also may not fit.
+			 *
+			 * As a final tweak, if the new item goes on the last
+			 * spot on the page (and thus, onto the new page), bias
+			 * the split so the new page is emptier than the old page.
+			 * This yields better packing during sequential inserts.
+			 */
+			if (nkeys < 20 || nsize > pmax/16 || newindx >= nkeys) {
+				/* Find split point */
+				psize = 0;
+				if (newindx <= split_indx || newindx >= nkeys) {
+					i = 0; j = 1;
+					k = newindx >= nkeys ? nkeys : split_indx+1+IS_LEAF(mp);
+				} else {
+					i = nkeys; j = -1;
+					k = split_indx-1;
+				}
+				for (; i!=k; i+=j) {
+					if (i == newindx) {
+						psize += nsize;
+						node = NULL;
+					} else {
+						node = (MDB_node *)((char *)mp + copy->mp_ptrs[i] + PAGEBASE);
+						psize += NODESIZE + NODEKSZ(node) + sizeof(indx_t);
+						if (IS_LEAF(mp)) {
+							if (F_ISSET(node->mn_flags, F_BIGDATA))
+								psize += sizeof(pgno_t);
+							else
+								psize += NODEDSZ(node);
+						}
+						psize = EVEN(psize);
+					}
+					if (psize > pmax || i == k-j) {
+						split_indx = i + (j<0);
+						break;
+					}
+				}
+			}
+			if (split_indx == newindx) {
+				sepkey.mv_size = newkey->mv_size;
+				sepkey.mv_data = newkey->mv_data;
+			} else {
+				node = (MDB_node *)((char *)mp + copy->mp_ptrs[split_indx] + PAGEBASE);
+				sepkey.mv_size = node->mn_ksize;
+				sepkey.mv_data = NODEKEY(node);
+			}
+		}
+	}
+
+	DPRINTF(("separator is %d [%s]", split_indx, DKEY(&sepkey)));
+
+	/* Copy separator key to the parent.
+	 */
+	if (SIZELEFT(mn.mc_pg[ptop]) < mdb_branch_size(env, &sepkey)) {
+		int snum = mc->mc_snum;
+		mn.mc_snum--;
+		mn.mc_top--;
+		did_split = 1;
+		/* We want other splits to find mn when doing fixups */
+		WITH_CURSOR_TRACKING(mn,
+			rc = mdb_page_split(&mn, &sepkey, NULL, rp->mp_pgno, 0));
+		if (rc)
+			goto done;
+
+		/* root split? */
+		if (mc->mc_snum > snum) {
+			ptop++;
+		}
+		/* Right page might now have changed parent.
+		 * Check if left page also changed parent.
+		 */
+		if (mn.mc_pg[ptop] != mc->mc_pg[ptop] &&
+		    mc->mc_ki[ptop] >= NUMKEYS(mc->mc_pg[ptop])) {
+			for (i=0; i<ptop; i++) {
+				mc->mc_pg[i] = mn.mc_pg[i];
+				mc->mc_ki[i] = mn.mc_ki[i];
+			}
+			mc->mc_pg[ptop] = mn.mc_pg[ptop];
+			if (mn.mc_ki[ptop]) {
+				mc->mc_ki[ptop] = mn.mc_ki[ptop] - 1;
+			} else {
+				/* find right page's left sibling */
+				mc->mc_ki[ptop] = mn.mc_ki[ptop];
+				rc = mdb_cursor_sibling(mc, 0);
+			}
+		}
+	} else {
+		mn.mc_top--;
+		rc = mdb_node_add(&mn, mn.mc_ki[ptop], &sepkey, NULL, rp->mp_pgno, 0);
+		mn.mc_top++;
+	}
+	if (rc != MDB_SUCCESS) {
+		if (rc == MDB_NOTFOUND) /* improper mdb_cursor_sibling() result */
+			rc = MDB_PROBLEM;
+		goto done;
+	}
+	if (nflags & MDB_APPEND) {
+		mc->mc_pg[mc->mc_top] = rp;
+		mc->mc_ki[mc->mc_top] = 0;
+		rc = mdb_node_add(mc, 0, newkey, newdata, newpgno, nflags);
+		if (rc)
+			goto done;
+		for (i=0; i<mc->mc_top; i++)
+			mc->mc_ki[i] = mn.mc_ki[i];
+	} else if (!IS_LEAF2(mp)) {
+		/* Move nodes */
+		mc->mc_pg[mc->mc_top] = rp;
+		i = split_indx;
+		j = 0;
+		do {
+			if (i == newindx) {
+				rkey.mv_data = newkey->mv_data;
+				rkey.mv_size = newkey->mv_size;
+				if (IS_LEAF(mp)) {
+					rdata = newdata;
+				} else
+					pgno = newpgno;
+				flags = nflags;
+				/* Update index for the new key. */
+				mc->mc_ki[mc->mc_top] = j;
+			} else {
+				node = (MDB_node *)((char *)mp + copy->mp_ptrs[i] + PAGEBASE);
+				rkey.mv_data = NODEKEY(node);
+				rkey.mv_size = node->mn_ksize;
+				if (IS_LEAF(mp)) {
+					xdata.mv_data = NODEDATA(node);
+					xdata.mv_size = NODEDSZ(node);
+					rdata = &xdata;
+				} else
+					pgno = NODEPGNO(node);
+				flags = node->mn_flags;
+			}
+
+			if (!IS_LEAF(mp) && j == 0) {
+				/* First branch index doesn't need key data. */
+				rkey.mv_size = 0;
+			}
+
+			rc = mdb_node_add(mc, j, &rkey, rdata, pgno, flags);
+			if (rc)
+				goto done;
+			if (i == nkeys) {
+				i = 0;
+				j = 0;
+				mc->mc_pg[mc->mc_top] = copy;
+			} else {
+				i++;
+				j++;
+			}
+		} while (i != split_indx);
+
+		nkeys = NUMKEYS(copy);
+		for (i=0; i<nkeys; i++)
+			mp->mp_ptrs[i] = copy->mp_ptrs[i];
+		mp->mp_lower = copy->mp_lower;
+		mp->mp_upper = copy->mp_upper;
+		memcpy(NODEPTR(mp, nkeys-1), NODEPTR(copy, nkeys-1),
+			env->me_psize - copy->mp_upper - PAGEBASE);
+
+		/* reset back to original page */
+		if (newindx < split_indx) {
+			mc->mc_pg[mc->mc_top] = mp;
+		} else {
+			mc->mc_pg[mc->mc_top] = rp;
+			mc->mc_ki[ptop]++;
+			/* Make sure mc_ki is still valid.
+			 */
+			if (mn.mc_pg[ptop] != mc->mc_pg[ptop] &&
+				mc->mc_ki[ptop] >= NUMKEYS(mc->mc_pg[ptop])) {
+				for (i=0; i<=ptop; i++) {
+					mc->mc_pg[i] = mn.mc_pg[i];
+					mc->mc_ki[i] = mn.mc_ki[i];
+				}
+			}
+		}
+		if (nflags & MDB_RESERVE) {
+			node = NODEPTR(mc->mc_pg[mc->mc_top], mc->mc_ki[mc->mc_top]);
+			if (!(node->mn_flags & F_BIGDATA))
+				newdata->mv_data = NODEDATA(node);
+		}
+	} else {
+		if (newindx >= split_indx) {
+			mc->mc_pg[mc->mc_top] = rp;
+			mc->mc_ki[ptop]++;
+			/* Make sure mc_ki is still valid.
+			 */
+			if (mn.mc_pg[ptop] != mc->mc_pg[ptop] &&
+				mc->mc_ki[ptop] >= NUMKEYS(mc->mc_pg[ptop])) {
+				for (i=0; i<=ptop; i++) {
+					mc->mc_pg[i] = mn.mc_pg[i];
+					mc->mc_ki[i] = mn.mc_ki[i];
+				}
+			}
+		}
+	}
+
+	{
+		/* Adjust other cursors pointing to mp */
+		MDB_cursor *m2, *m3;
+		MDB_dbi dbi = mc->mc_dbi;
+		nkeys = NUMKEYS(mp);
+
+		for (m2 = mc->mc_txn->mt_cursors[dbi]; m2; m2=m2->mc_next) {
+			if (mc->mc_flags & C_SUB)
+				m3 = &m2->mc_xcursor->mx_cursor;
+			else
+				m3 = m2;
+			if (m3 == mc)
+				continue;
+			if (!(m2->mc_flags & m3->mc_flags & C_INITIALIZED))
+				continue;
+			if (new_root) {
+				int k;
+				/* sub cursors may be on different DB */
+				if (m3->mc_pg[0] != mp)
+					continue;
+				/* root split */
+				for (k=new_root; k>=0; k--) {
+					m3->mc_ki[k+1] = m3->mc_ki[k];
+					m3->mc_pg[k+1] = m3->mc_pg[k];
+				}
+				if (m3->mc_ki[0] >= nkeys) {
+					m3->mc_ki[0] = 1;
+				} else {
+					m3->mc_ki[0] = 0;
+				}
+				m3->mc_pg[0] = mc->mc_pg[0];
+				m3->mc_snum++;
+				m3->mc_top++;
+			}
+			if (m3->mc_top >= mc->mc_top && m3->mc_pg[mc->mc_top] == mp) {
+				if (m3->mc_ki[mc->mc_top] >= newindx && !(nflags & MDB_SPLIT_REPLACE))
+					m3->mc_ki[mc->mc_top]++;
+				if (m3->mc_ki[mc->mc_top] >= nkeys) {
+					m3->mc_pg[mc->mc_top] = rp;
+					m3->mc_ki[mc->mc_top] -= nkeys;
+					for (i=0; i<mc->mc_top; i++) {
+						m3->mc_ki[i] = mn.mc_ki[i];
+						m3->mc_pg[i] = mn.mc_pg[i];
+					}
+				}
+			} else if (!did_split && m3->mc_top >= ptop && m3->mc_pg[ptop] == mc->mc_pg[ptop] &&
+				m3->mc_ki[ptop] >= mc->mc_ki[ptop]) {
+				m3->mc_ki[ptop]++;
+			}
+			if (IS_LEAF(mp))
+				XCURSOR_REFRESH(m3, mc->mc_top, m3->mc_pg[mc->mc_top]);
+		}
+	}
+	DPRINTF(("mp left: %d, rp left: %d", SIZELEFT(mp), SIZELEFT(rp)));
+
+done:
+	if (copy)					/* tmp page */
+		mdb_page_free(env, copy);
+	if (rc)
+		mc->mc_txn->mt_flags |= MDB_TXN_ERROR;
+	return rc;
+}
+
+int
+mdb_put(MDB_txn *txn, MDB_dbi dbi,
+    MDB_val *key, MDB_val *data, unsigned int flags)
+{
+	MDB_cursor mc;
+	MDB_xcursor mx;
+	int rc;
+
+	if (!key || !data || !TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	if (flags & ~(MDB_NOOVERWRITE|MDB_NODUPDATA|MDB_RESERVE|MDB_APPEND|MDB_APPENDDUP))
+		return EINVAL;
+
+	if (txn->mt_flags & (MDB_TXN_RDONLY|MDB_TXN_BLOCKED))
+		return (txn->mt_flags & MDB_TXN_RDONLY) ? EACCES : MDB_BAD_TXN;
+
+	mdb_cursor_init(&mc, txn, dbi, &mx);
+	mc.mc_next = txn->mt_cursors[dbi];
+	txn->mt_cursors[dbi] = &mc;
+	rc = mdb_cursor_put(&mc, key, data, flags);
+	txn->mt_cursors[dbi] = mc.mc_next;
+	return rc;
+}
+
+#ifndef MDB_WBUF
+#define MDB_WBUF	(1024*1024)
+#endif
+#define MDB_EOF		0x10	/**< #mdb_env_copyfd1() is done reading */
+
+	/** State needed for a double-buffering compacting copy. */
+typedef struct mdb_copy {
+	MDB_env *mc_env;
+	MDB_txn *mc_txn;
+	pthread_mutex_t mc_mutex;
+	pthread_cond_t mc_cond;	/**< Condition variable for #mc_new */
+	char *mc_wbuf[2];
+	char *mc_over[2];
+	int mc_wlen[2];
+	int mc_olen[2];
+	pgno_t mc_next_pgno;
+	HANDLE mc_fd;
+	int mc_toggle;			/**< Buffer number in provider */
+	int mc_new;				/**< (0-2 buffers to write) | (#MDB_EOF at end) */
+	/** Error code.  Never cleared if set.  Both threads can set nonzero
+	 *	to fail the copy.  Not mutex-protected, LMDB expects atomic int.
+	 */
+	volatile int mc_error;
+} mdb_copy;
+
+	/** Dedicated writer thread for compacting copy. */
+static THREAD_RET ESECT CALL_CONV
+mdb_env_copythr(void *arg)
+{
+	mdb_copy *my = arg;
+	char *ptr;
+	int toggle = 0, wsize, rc;
+#ifdef _WIN32
+	DWORD len;
+#define DO_WRITE(rc, fd, ptr, w2, len)	rc = WriteFile(fd, ptr, w2, &len, NULL)
+#else
+	int len;
+#define DO_WRITE(rc, fd, ptr, w2, len)	len = write(fd, ptr, w2); rc = (len >= 0)
+#ifdef SIGPIPE
+	sigset_t set;
+	sigemptyset(&set);
+	sigaddset(&set, SIGPIPE);
+	if ((rc = pthread_sigmask(SIG_BLOCK, &set, NULL)) != 0)
+		my->mc_error = rc;
+#endif
+#endif
+
+	pthread_mutex_lock(&my->mc_mutex);
+	for(;;) {
+		while (!my->mc_new)
+			pthread_cond_wait(&my->mc_cond, &my->mc_mutex);
+		if (my->mc_new == 0 + MDB_EOF) /* 0 buffers, just EOF */
+			break;
+		wsize = my->mc_wlen[toggle];
+		ptr = my->mc_wbuf[toggle];
+again:
+		rc = MDB_SUCCESS;
+		while (wsize > 0 && !my->mc_error) {
+			DO_WRITE(rc, my->mc_fd, ptr, wsize, len);
+			if (!rc) {
+				rc = ErrCode();
+#if defined(SIGPIPE) && !defined(_WIN32)
+				if (rc == EPIPE) {
+					/* Collect the pending SIGPIPE, otherwise at least OS X
+					 * gives it to the process on thread-exit (ITS#8504).
+					 */
+					int tmp;
+					sigwait(&set, &tmp);
+				}
+#endif
+				break;
+			} else if (len > 0) {
+				rc = MDB_SUCCESS;
+				ptr += len;
+				wsize -= len;
+				continue;
+			} else {
+				rc = EIO;
+				break;
+			}
+		}
+		if (rc) {
+			my->mc_error = rc;
+		}
+		/* If there's an overflow page tail, write it too */
+		if (my->mc_olen[toggle]) {
+			wsize = my->mc_olen[toggle];
+			ptr = my->mc_over[toggle];
+			my->mc_olen[toggle] = 0;
+			goto again;
+		}
+		my->mc_wlen[toggle] = 0;
+		toggle ^= 1;
+		/* Return the empty buffer to provider */
+		my->mc_new--;
+		pthread_cond_signal(&my->mc_cond);
+	}
+	pthread_mutex_unlock(&my->mc_mutex);
+	return (THREAD_RET)0;
+#undef DO_WRITE
+}
+
+	/** Give buffer and/or #MDB_EOF to writer thread, await unused buffer.
+	 *
+	 * @param[in] my control structure.
+	 * @param[in] adjust (1 to hand off 1 buffer) | (MDB_EOF when ending).
+	 */
+static int ESECT
+mdb_env_cthr_toggle(mdb_copy *my, int adjust)
+{
+	pthread_mutex_lock(&my->mc_mutex);
+	my->mc_new += adjust;
+	pthread_cond_signal(&my->mc_cond);
+	while (my->mc_new & 2)		/* both buffers in use */
+		pthread_cond_wait(&my->mc_cond, &my->mc_mutex);
+	pthread_mutex_unlock(&my->mc_mutex);
+
+	my->mc_toggle ^= (adjust & 1);
+	/* Both threads reset mc_wlen, to be safe from threading errors */
+	my->mc_wlen[my->mc_toggle] = 0;
+	return my->mc_error;
+}
+
+	/** Depth-first tree traversal for compacting copy.
+	 * @param[in] my control structure.
+	 * @param[in,out] pg database root.
+	 * @param[in] flags includes #F_DUPDATA if it is a sorted-duplicate sub-DB.
+	 */
+static int ESECT
+mdb_env_cwalk(mdb_copy *my, pgno_t *pg, int flags)
+{
+	MDB_cursor mc = {0};
+	MDB_node *ni;
+	MDB_page *mo, *mp, *leaf;
+	char *buf, *ptr;
+	int rc, toggle;
+	unsigned int i;
+
+	/* Empty DB, nothing to do */
+	if (*pg == P_INVALID)
+		return MDB_SUCCESS;
+
+	mc.mc_snum = 1;
+	mc.mc_txn = my->mc_txn;
+	mc.mc_flags = my->mc_txn->mt_flags & (C_ORIG_RDONLY|C_WRITEMAP);
+
+	rc = mdb_page_get(&mc, *pg, &mc.mc_pg[0], NULL);
+	if (rc)
+		return rc;
+	rc = mdb_page_search_root(&mc, NULL, MDB_PS_FIRST);
+	if (rc)
+		return rc;
+
+	/* Make cursor pages writable */
+	buf = ptr = malloc(my->mc_env->me_psize * mc.mc_snum);
+	if (buf == NULL)
+		return ENOMEM;
+
+	for (i=0; i<mc.mc_top; i++) {
+		mdb_page_copy((MDB_page *)ptr, mc.mc_pg[i], my->mc_env->me_psize);
+		mc.mc_pg[i] = (MDB_page *)ptr;
+		ptr += my->mc_env->me_psize;
+	}
+
+	/* This is writable space for a leaf page. Usually not needed. */
+	leaf = (MDB_page *)ptr;
+
+	toggle = my->mc_toggle;
+	while (mc.mc_snum > 0) {
+		unsigned n;
+		mp = mc.mc_pg[mc.mc_top];
+		n = NUMKEYS(mp);
+
+		if (IS_LEAF(mp)) {
+			if (!IS_LEAF2(mp) && !(flags & F_DUPDATA)) {
+				for (i=0; i<n; i++) {
+					ni = NODEPTR(mp, i);
+					if (ni->mn_flags & F_BIGDATA) {
+						MDB_page *omp;
+						pgno_t pg;
+
+						/* Need writable leaf */
+						if (mp != leaf) {
+							mc.mc_pg[mc.mc_top] = leaf;
+							mdb_page_copy(leaf, mp, my->mc_env->me_psize);
+							mp = leaf;
+							ni = NODEPTR(mp, i);
+						}
+
+						memcpy(&pg, NODEDATA(ni), sizeof(pg));
+						memcpy(NODEDATA(ni), &my->mc_next_pgno, sizeof(pgno_t));
+						rc = mdb_page_get(&mc, pg, &omp, NULL);
+						if (rc)
+							goto done;
+						if (my->mc_wlen[toggle] >= MDB_WBUF) {
+							rc = mdb_env_cthr_toggle(my, 1);
+							if (rc)
+								goto done;
+							toggle = my->mc_toggle;
+						}
+						mo = (MDB_page *)(my->mc_wbuf[toggle] + my->mc_wlen[toggle]);
+						memcpy(mo, omp, my->mc_env->me_psize);
+						mo->mp_pgno = my->mc_next_pgno;
+						my->mc_next_pgno += omp->mp_pages;
+						my->mc_wlen[toggle] += my->mc_env->me_psize;
+						if (omp->mp_pages > 1) {
+							my->mc_olen[toggle] = my->mc_env->me_psize * (omp->mp_pages - 1);
+							my->mc_over[toggle] = (char *)omp + my->mc_env->me_psize;
+							rc = mdb_env_cthr_toggle(my, 1);
+							if (rc)
+								goto done;
+							toggle = my->mc_toggle;
+						}
+					} else if (ni->mn_flags & F_SUBDATA) {
+						MDB_db db;
+
+						/* Need writable leaf */
+						if (mp != leaf) {
+							mc.mc_pg[mc.mc_top] = leaf;
+							mdb_page_copy(leaf, mp, my->mc_env->me_psize);
+							mp = leaf;
+							ni = NODEPTR(mp, i);
+						}
+
+						memcpy(&db, NODEDATA(ni), sizeof(db));
+						my->mc_toggle = toggle;
+						rc = mdb_env_cwalk(my, &db.md_root, ni->mn_flags & F_DUPDATA);
+						if (rc)
+							goto done;
+						toggle = my->mc_toggle;
+						memcpy(NODEDATA(ni), &db, sizeof(db));
+					}
+				}
+			}
+		} else {
+			mc.mc_ki[mc.mc_top]++;
+			if (mc.mc_ki[mc.mc_top] < n) {
+				pgno_t pg;
+again:
+				ni = NODEPTR(mp, mc.mc_ki[mc.mc_top]);
+				pg = NODEPGNO(ni);
+				rc = mdb_page_get(&mc, pg, &mp, NULL);
+				if (rc)
+					goto done;
+				mc.mc_top++;
+				mc.mc_snum++;
+				mc.mc_ki[mc.mc_top] = 0;
+				if (IS_BRANCH(mp)) {
+					/* Whenever we advance to a sibling branch page,
+					 * we must proceed all the way down to its first leaf.
+					 */
+					mdb_page_copy(mc.mc_pg[mc.mc_top], mp, my->mc_env->me_psize);
+					goto again;
+				} else
+					mc.mc_pg[mc.mc_top] = mp;
+				continue;
+			}
+		}
+		if (my->mc_wlen[toggle] >= MDB_WBUF) {
+			rc = mdb_env_cthr_toggle(my, 1);
+			if (rc)
+				goto done;
+			toggle = my->mc_toggle;
+		}
+		mo = (MDB_page *)(my->mc_wbuf[toggle] + my->mc_wlen[toggle]);
+		mdb_page_copy(mo, mp, my->mc_env->me_psize);
+		mo->mp_pgno = my->mc_next_pgno++;
+		my->mc_wlen[toggle] += my->mc_env->me_psize;
+		if (mc.mc_top) {
+			/* Update parent if there is one */
+			ni = NODEPTR(mc.mc_pg[mc.mc_top-1], mc.mc_ki[mc.mc_top-1]);
+			SETPGNO(ni, mo->mp_pgno);
+			mdb_cursor_pop(&mc);
+		} else {
+			/* Otherwise we're done */
+			*pg = mo->mp_pgno;
+			break;
+		}
+	}
+done:
+	free(buf);
+	return rc;
+}
+
+	/** Copy environment with compaction. */
+static int ESECT
+mdb_env_copyfd1(MDB_env *env, HANDLE fd)
+{
+	MDB_meta *mm;
+	MDB_page *mp;
+	mdb_copy my = {0};
+	MDB_txn *txn = NULL;
+	pthread_t thr;
+	pgno_t root, new_root;
+	int rc = MDB_SUCCESS;
+
+#ifdef _WIN32
+	if (!(my.mc_mutex = CreateMutex(NULL, FALSE, NULL)) ||
+		!(my.mc_cond = CreateEvent(NULL, FALSE, FALSE, NULL))) {
+		rc = ErrCode();
+		goto done;
+	}
+	my.mc_wbuf[0] = _aligned_malloc(MDB_WBUF*2, env->me_os_psize);
+	if (my.mc_wbuf[0] == NULL) {
+		/* _aligned_malloc() sets errno, but we use Windows error codes */
+		rc = ERROR_NOT_ENOUGH_MEMORY;
+		goto done;
+	}
+#else
+	if ((rc = pthread_mutex_init(&my.mc_mutex, NULL)) != 0)
+		return rc;
+	if ((rc = pthread_cond_init(&my.mc_cond, NULL)) != 0)
+		goto done2;
+#ifdef HAVE_MEMALIGN
+	my.mc_wbuf[0] = memalign(env->me_os_psize, MDB_WBUF*2);
+	if (my.mc_wbuf[0] == NULL) {
+		rc = errno;
+		goto done;
+	}
+#else
+	{
+		void *p;
+		if ((rc = posix_memalign(&p, env->me_os_psize, MDB_WBUF*2)) != 0)
+			goto done;
+		my.mc_wbuf[0] = p;
+	}
+#endif
+#endif
+	memset(my.mc_wbuf[0], 0, MDB_WBUF*2);
+	my.mc_wbuf[1] = my.mc_wbuf[0] + MDB_WBUF;
+	my.mc_next_pgno = NUM_METAS;
+	my.mc_env = env;
+	my.mc_fd = fd;
+	rc = THREAD_CREATE(thr, mdb_env_copythr, &my);
+	if (rc)
+		goto done;
+
+	rc = mdb_txn_begin(env, NULL, MDB_RDONLY, &txn);
+	if (rc)
+		goto finish;
+
+	mp = (MDB_page *)my.mc_wbuf[0];
+	memset(mp, 0, NUM_METAS * env->me_psize);
+	mp->mp_pgno = 0;
+	mp->mp_flags = P_META;
+	mm = (MDB_meta *)METADATA(mp);
+	mdb_env_init_meta0(env, mm);
+	mm->mm_address = env->me_metas[0]->mm_address;
+
+	mp = (MDB_page *)(my.mc_wbuf[0] + env->me_psize);
+	mp->mp_pgno = 1;
+	mp->mp_flags = P_META;
+	*(MDB_meta *)METADATA(mp) = *mm;
+	mm = (MDB_meta *)METADATA(mp);
+
+	/* Set metapage 1 with current main DB */
+	root = new_root = txn->mt_dbs[MAIN_DBI].md_root;
+	if (root != P_INVALID) {
+		/* Count free pages + freeDB pages.  Subtract from last_pg
+		 * to find the new last_pg, which also becomes the new root.
+		 */
+		MDB_ID freecount = 0;
+		MDB_cursor mc;
+		MDB_val key, data;
+		mdb_cursor_init(&mc, txn, FREE_DBI, NULL);
+		while ((rc = mdb_cursor_get(&mc, &key, &data, MDB_NEXT)) == 0)
+			freecount += *(MDB_ID *)data.mv_data;
+		if (rc != MDB_NOTFOUND)
+			goto finish;
+		freecount += txn->mt_dbs[FREE_DBI].md_branch_pages +
+			txn->mt_dbs[FREE_DBI].md_leaf_pages +
+			txn->mt_dbs[FREE_DBI].md_overflow_pages;
+
+		new_root = txn->mt_next_pgno - 1 - freecount;
+		mm->mm_last_pg = new_root;
+		mm->mm_dbs[MAIN_DBI] = txn->mt_dbs[MAIN_DBI];
+		mm->mm_dbs[MAIN_DBI].md_root = new_root;
+	} else {
+		/* When the DB is empty, handle it specially to
+		 * fix any breakage like page leaks from ITS#8174.
+		 */
+		mm->mm_dbs[MAIN_DBI].md_flags = txn->mt_dbs[MAIN_DBI].md_flags;
+	}
+	if (root != P_INVALID || mm->mm_dbs[MAIN_DBI].md_flags) {
+		mm->mm_txnid = 1;		/* use metapage 1 */
+	}
+
+	my.mc_wlen[0] = env->me_psize * NUM_METAS;
+	my.mc_txn = txn;
+	rc = mdb_env_cwalk(&my, &root, 0);
+	if (rc == MDB_SUCCESS && root != new_root) {
+		rc = MDB_INCOMPATIBLE;	/* page leak or corrupt DB */
+	}
+
+finish:
+	if (rc)
+		my.mc_error = rc;
+	mdb_env_cthr_toggle(&my, 1 | MDB_EOF);
+	rc = THREAD_FINISH(thr);
+	mdb_txn_abort(txn);
+
+done:
+#ifdef _WIN32
+	if (my.mc_wbuf[0]) _aligned_free(my.mc_wbuf[0]);
+	if (my.mc_cond)  CloseHandle(my.mc_cond);
+	if (my.mc_mutex) CloseHandle(my.mc_mutex);
+#else
+	free(my.mc_wbuf[0]);
+	pthread_cond_destroy(&my.mc_cond);
+done2:
+	pthread_mutex_destroy(&my.mc_mutex);
+#endif
+	return rc ? rc : my.mc_error;
+}
+
+	/** Copy environment as-is. */
+static int ESECT
+mdb_env_copyfd0(MDB_env *env, HANDLE fd)
+{
+	MDB_txn *txn = NULL;
+	mdb_mutexref_t wmutex = NULL;
+	int rc;
+	mdb_size_t wsize, w3;
+	char *ptr;
+#ifdef _WIN32
+	DWORD len, w2;
+#define DO_WRITE(rc, fd, ptr, w2, len)	rc = WriteFile(fd, ptr, w2, &len, NULL)
+#else
+	ssize_t len;
+	size_t w2;
+#define DO_WRITE(rc, fd, ptr, w2, len)	len = write(fd, ptr, w2); rc = (len >= 0)
+#endif
+
+	/* Do the lock/unlock of the reader mutex before starting the
+	 * write txn.  Otherwise other read txns could block writers.
+	 */
+	rc = mdb_txn_begin(env, NULL, MDB_RDONLY, &txn);
+	if (rc)
+		return rc;
+
+	if (env->me_txns) {
+		/* We must start the actual read txn after blocking writers */
+		mdb_txn_end(txn, MDB_END_RESET_TMP);
+
+		/* Temporarily block writers until we snapshot the meta pages */
+		wmutex = env->me_wmutex;
+		if (LOCK_MUTEX(rc, env, wmutex))
+			goto leave;
+
+		rc = mdb_txn_renew0(txn);
+		if (rc) {
+			UNLOCK_MUTEX(wmutex);
+			goto leave;
+		}
+	}
+
+	wsize = env->me_psize * NUM_METAS;
+	ptr = env->me_map;
+	w2 = wsize;
+	while (w2 > 0) {
+		DO_WRITE(rc, fd, ptr, w2, len);
+		if (!rc) {
+			rc = ErrCode();
+			break;
+		} else if (len > 0) {
+			rc = MDB_SUCCESS;
+			ptr += len;
+			w2 -= len;
+			continue;
+		} else {
+			/* Non-blocking or async handles are not supported */
+			rc = EIO;
+			break;
+		}
+	}
+	if (wmutex)
+		UNLOCK_MUTEX(wmutex);
+
+	if (rc)
+		goto leave;
+
+	w3 = txn->mt_next_pgno * env->me_psize;
+	{
+		mdb_size_t fsize = 0;
+		if ((rc = mdb_fsize(env->me_fd, &fsize)))
+			goto leave;
+		if (w3 > fsize)
+			w3 = fsize;
+	}
+	wsize = w3 - wsize;
+	while (wsize > 0) {
+		if (wsize > MAX_WRITE)
+			w2 = MAX_WRITE;
+		else
+			w2 = wsize;
+		DO_WRITE(rc, fd, ptr, w2, len);
+		if (!rc) {
+			rc = ErrCode();
+			break;
+		} else if (len > 0) {
+			rc = MDB_SUCCESS;
+			ptr += len;
+			wsize -= len;
+			continue;
+		} else {
+			rc = EIO;
+			break;
+		}
+	}
+
+leave:
+	mdb_txn_abort(txn);
+	return rc;
+}
+
+int ESECT
+mdb_env_copyfd2(MDB_env *env, HANDLE fd, unsigned int flags)
+{
+	if (flags & MDB_CP_COMPACT)
+		return mdb_env_copyfd1(env, fd);
+	else
+		return mdb_env_copyfd0(env, fd);
+}
+
+int ESECT
+mdb_env_copyfd(MDB_env *env, HANDLE fd)
+{
+	return mdb_env_copyfd2(env, fd, 0);
+}
+
+int ESECT
+mdb_env_copy2(MDB_env *env, const char *path, unsigned int flags)
+{
+	int rc;
+	MDB_name fname;
+	HANDLE newfd = INVALID_HANDLE_VALUE;
+
+	rc = mdb_fname_init(path, env->me_flags | MDB_NOLOCK, &fname);
+	if (rc == MDB_SUCCESS) {
+		rc = mdb_fopen(env, &fname, MDB_O_COPY, 0666, &newfd);
+		mdb_fname_destroy(fname);
+	}
+	if (rc == MDB_SUCCESS) {
+		rc = mdb_env_copyfd2(env, newfd, flags);
+		if (close(newfd) < 0 && rc == MDB_SUCCESS)
+			rc = ErrCode();
+	}
+	return rc;
+}
+
+int ESECT
+mdb_env_copy(MDB_env *env, const char *path)
+{
+	return mdb_env_copy2(env, path, 0);
+}
+
+int ESECT
+mdb_env_set_flags(MDB_env *env, unsigned int flag, int onoff)
+{
+	if (flag & ~CHANGEABLE)
+		return EINVAL;
+	if (onoff)
+		env->me_flags |= flag;
+	else
+		env->me_flags &= ~flag;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_get_flags(MDB_env *env, unsigned int *arg)
+{
+	if (!env || !arg)
+		return EINVAL;
+
+	*arg = env->me_flags & (CHANGEABLE|CHANGELESS);
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_set_userctx(MDB_env *env, void *ctx)
+{
+	if (!env)
+		return EINVAL;
+	env->me_userctx = ctx;
+	return MDB_SUCCESS;
+}
+
+void * ESECT
+mdb_env_get_userctx(MDB_env *env)
+{
+	return env ? env->me_userctx : NULL;
+}
+
+int ESECT
+mdb_env_set_assert(MDB_env *env, MDB_assert_func *func)
+{
+	if (!env)
+		return EINVAL;
+#ifndef NDEBUG
+	env->me_assert_func = func;
+#endif
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_get_path(MDB_env *env, const char **arg)
+{
+	if (!env || !arg)
+		return EINVAL;
+
+	*arg = env->me_path;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_get_fd(MDB_env *env, mdb_filehandle_t *arg)
+{
+	if (!env || !arg)
+		return EINVAL;
+
+	*arg = env->me_fd;
+	return MDB_SUCCESS;
+}
+
+/** Common code for #mdb_stat() and #mdb_env_stat().
+ * @param[in] env the environment to operate in.
+ * @param[in] db the #MDB_db record containing the stats to return.
+ * @param[out] arg the address of an #MDB_stat structure to receive the stats.
+ * @return 0, this function always succeeds.
+ */
+static int ESECT
+mdb_stat0(MDB_env *env, MDB_db *db, MDB_stat *arg)
+{
+	arg->ms_psize = env->me_psize;
+	arg->ms_depth = db->md_depth;
+	arg->ms_branch_pages = db->md_branch_pages;
+	arg->ms_leaf_pages = db->md_leaf_pages;
+	arg->ms_overflow_pages = db->md_overflow_pages;
+	arg->ms_entries = db->md_entries;
+
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_stat(MDB_env *env, MDB_stat *arg)
+{
+	MDB_meta *meta;
+
+	if (env == NULL || arg == NULL)
+		return EINVAL;
+
+	meta = mdb_env_pick_meta(env);
+
+	return mdb_stat0(env, &meta->mm_dbs[MAIN_DBI], arg);
+}
+
+int ESECT
+mdb_env_info(MDB_env *env, MDB_envinfo *arg)
+{
+	MDB_meta *meta;
+
+	if (env == NULL || arg == NULL)
+		return EINVAL;
+
+	meta = mdb_env_pick_meta(env);
+	arg->me_mapaddr = meta->mm_address;
+	arg->me_last_pgno = meta->mm_last_pg;
+	arg->me_last_txnid = meta->mm_txnid;
+
+	arg->me_mapsize = env->me_mapsize;
+	arg->me_maxreaders = env->me_maxreaders;
+	arg->me_numreaders = env->me_txns ? env->me_txns->mti_numreaders : 0;
+	return MDB_SUCCESS;
+}
+
+/** Set the default comparison functions for a database.
+ * Called immediately after a database is opened to set the defaults.
+ * The user can then override them with #mdb_set_compare() or
+ * #mdb_set_dupsort().
+ * @param[in] txn A transaction handle returned by #mdb_txn_begin()
+ * @param[in] dbi A database handle returned by #mdb_dbi_open()
+ */
+static void
+mdb_default_cmp(MDB_txn *txn, MDB_dbi dbi)
+{
+	uint16_t f = txn->mt_dbs[dbi].md_flags;
+
+	txn->mt_dbxs[dbi].md_cmp =
+		(f & MDB_REVERSEKEY) ? mdb_cmp_memnr :
+		(f & MDB_INTEGERKEY) ? mdb_cmp_cint  : mdb_cmp_memn;
+
+	txn->mt_dbxs[dbi].md_dcmp =
+		!(f & MDB_DUPSORT) ? 0 :
+		((f & MDB_INTEGERDUP)
+		 ? ((f & MDB_DUPFIXED)   ? mdb_cmp_int   : mdb_cmp_cint)
+		 : ((f & MDB_REVERSEDUP) ? mdb_cmp_memnr : mdb_cmp_memn));
+}
+
+int mdb_dbi_open(MDB_txn *txn, const char *name, unsigned int flags, MDB_dbi *dbi)
+{
+	MDB_val key, data;
+	MDB_dbi i;
+	MDB_cursor mc;
+	MDB_db dummy;
+	int rc, dbflag, exact;
+	unsigned int unused = 0, seq;
+	char *namedup;
+	size_t len;
+
+	if (flags & ~VALID_FLAGS)
+		return EINVAL;
+	if (txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	/* main DB? */
+	if (!name) {
+		*dbi = MAIN_DBI;
+		if (flags & PERSISTENT_FLAGS) {
+			uint16_t f2 = flags & PERSISTENT_FLAGS;
+			/* make sure flag changes get committed */
+			if ((txn->mt_dbs[MAIN_DBI].md_flags | f2) != txn->mt_dbs[MAIN_DBI].md_flags) {
+				txn->mt_dbs[MAIN_DBI].md_flags |= f2;
+				txn->mt_flags |= MDB_TXN_DIRTY;
+			}
+		}
+		mdb_default_cmp(txn, MAIN_DBI);
+		return MDB_SUCCESS;
+	}
+
+	if (txn->mt_dbxs[MAIN_DBI].md_cmp == NULL) {
+		mdb_default_cmp(txn, MAIN_DBI);
+	}
+
+	/* Is the DB already open? */
+	len = strlen(name);
+	for (i=CORE_DBS; i<txn->mt_numdbs; i++) {
+		if (!txn->mt_dbxs[i].md_name.mv_size) {
+			/* Remember this free slot */
+			if (!unused) unused = i;
+			continue;
+		}
+		if (len == txn->mt_dbxs[i].md_name.mv_size &&
+			!strncmp(name, txn->mt_dbxs[i].md_name.mv_data, len)) {
+			*dbi = i;
+			return MDB_SUCCESS;
+		}
+	}
+
+	/* If no free slot and max hit, fail */
+	if (!unused && txn->mt_numdbs >= txn->mt_env->me_maxdbs)
+		return MDB_DBS_FULL;
+
+	/* Cannot mix named databases with some mainDB flags */
+	if (txn->mt_dbs[MAIN_DBI].md_flags & (MDB_DUPSORT|MDB_INTEGERKEY))
+		return (flags & MDB_CREATE) ? MDB_INCOMPATIBLE : MDB_NOTFOUND;
+
+	/* Find the DB info */
+	dbflag = DB_NEW|DB_VALID|DB_USRVALID;
+	exact = 0;
+	key.mv_size = len;
+	key.mv_data = (void *)name;
+	mdb_cursor_init(&mc, txn, MAIN_DBI, NULL);
+	rc = mdb_cursor_set(&mc, &key, &data, MDB_SET, &exact);
+	if (rc == MDB_SUCCESS) {
+		/* make sure this is actually a DB */
+		MDB_node *node = NODEPTR(mc.mc_pg[mc.mc_top], mc.mc_ki[mc.mc_top]);
+		if ((node->mn_flags & (F_DUPDATA|F_SUBDATA)) != F_SUBDATA)
+			return MDB_INCOMPATIBLE;
+	} else {
+		if (rc != MDB_NOTFOUND || !(flags & MDB_CREATE))
+			return rc;
+		if (F_ISSET(txn->mt_flags, MDB_TXN_RDONLY))
+			return EACCES;
+	}
+
+	/* Done here so we cannot fail after creating a new DB */
+	if ((namedup = strdup(name)) == NULL)
+		return ENOMEM;
+
+	if (rc) {
+		/* MDB_NOTFOUND and MDB_CREATE: Create new DB */
+		data.mv_size = sizeof(MDB_db);
+		data.mv_data = &dummy;
+		memset(&dummy, 0, sizeof(dummy));
+		dummy.md_root = P_INVALID;
+		dummy.md_flags = flags & PERSISTENT_FLAGS;
+		WITH_CURSOR_TRACKING(mc,
+			rc = mdb_cursor_put(&mc, &key, &data, F_SUBDATA));
+		dbflag |= DB_DIRTY;
+	}
+
+	if (rc) {
+		free(namedup);
+	} else {
+		/* Got info, register DBI in this txn */
+		unsigned int slot = unused ? unused : txn->mt_numdbs;
+		txn->mt_dbxs[slot].md_name.mv_data = namedup;
+		txn->mt_dbxs[slot].md_name.mv_size = len;
+		txn->mt_dbxs[slot].md_rel = NULL;
+		txn->mt_dbflags[slot] = dbflag;
+		/* txn-> and env-> are the same in read txns, use
+		 * tmp variable to avoid undefined assignment
+		 */
+		seq = ++txn->mt_env->me_dbiseqs[slot];
+		txn->mt_dbiseqs[slot] = seq;
+
+		memcpy(&txn->mt_dbs[slot], data.mv_data, sizeof(MDB_db));
+		*dbi = slot;
+		mdb_default_cmp(txn, slot);
+		if (!unused) {
+			txn->mt_numdbs++;
+		}
+	}
+
+	return rc;
+}
+
+int ESECT
+mdb_stat(MDB_txn *txn, MDB_dbi dbi, MDB_stat *arg)
+{
+	if (!arg || !TXN_DBI_EXIST(txn, dbi, DB_VALID))
+		return EINVAL;
+
+	if (txn->mt_flags & MDB_TXN_BLOCKED)
+		return MDB_BAD_TXN;
+
+	if (txn->mt_dbflags[dbi] & DB_STALE) {
+		MDB_cursor mc;
+		MDB_xcursor mx;
+		/* Stale, must read the DB's root. cursor_init does it for us. */
+		mdb_cursor_init(&mc, txn, dbi, &mx);
+	}
+	return mdb_stat0(txn->mt_env, &txn->mt_dbs[dbi], arg);
+}
+
+void mdb_dbi_close(MDB_env *env, MDB_dbi dbi)
+{
+	char *ptr;
+	if (dbi < CORE_DBS || dbi >= env->me_maxdbs)
+		return;
+	ptr = env->me_dbxs[dbi].md_name.mv_data;
+	/* If there was no name, this was already closed */
+	if (ptr) {
+		env->me_dbxs[dbi].md_name.mv_data = NULL;
+		env->me_dbxs[dbi].md_name.mv_size = 0;
+		env->me_dbflags[dbi] = 0;
+		env->me_dbiseqs[dbi]++;
+		free(ptr);
+	}
+}
+
+int mdb_dbi_flags(MDB_txn *txn, MDB_dbi dbi, unsigned int *flags)
+{
+	/* We could return the flags for the FREE_DBI too but what's the point? */
+	if (!TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+	*flags = txn->mt_dbs[dbi].md_flags & PERSISTENT_FLAGS;
+	return MDB_SUCCESS;
+}
+
+/** Add all the DB's pages to the free list.
+ * @param[in] mc Cursor on the DB to free.
+ * @param[in] subs non-Zero to check for sub-DBs in this DB.
+ * @return 0 on success, non-zero on failure.
+ */
+static int
+mdb_drop0(MDB_cursor *mc, int subs)
+{
+	int rc;
+
+	rc = mdb_page_search(mc, NULL, MDB_PS_FIRST);
+	if (rc == MDB_SUCCESS) {
+		MDB_txn *txn = mc->mc_txn;
+		MDB_node *ni;
+		MDB_cursor mx;
+		unsigned int i;
+
+		/* DUPSORT sub-DBs have no ovpages/DBs. Omit scanning leaves.
+		 * This also avoids any P_LEAF2 pages, which have no nodes.
+		 * Also if the DB doesn't have sub-DBs and has no overflow
+		 * pages, omit scanning leaves.
+		 */
+		if ((mc->mc_flags & C_SUB) ||
+			(!subs && !mc->mc_db->md_overflow_pages))
+			mdb_cursor_pop(mc);
+
+		mdb_cursor_copy(mc, &mx);
+#ifdef MDB_VL32
+		/* bump refcount for mx's pages */
+		for (i=0; i<mc->mc_snum; i++)
+			mdb_page_get(&mx, mc->mc_pg[i]->mp_pgno, &mx.mc_pg[i], NULL);
+#endif
+		while (mc->mc_snum > 0) {
+			MDB_page *mp = mc->mc_pg[mc->mc_top];
+			unsigned n = NUMKEYS(mp);
+			if (IS_LEAF(mp)) {
+				for (i=0; i<n; i++) {
+					ni = NODEPTR(mp, i);
+					if (ni->mn_flags & F_BIGDATA) {
+						MDB_page *omp;
+						pgno_t pg;
+						memcpy(&pg, NODEDATA(ni), sizeof(pg));
+						rc = mdb_page_get(mc, pg, &omp, NULL);
+						if (rc != 0)
+							goto done;
+						mdb_cassert(mc, IS_OVERFLOW(omp));
+						rc = mdb_midl_append_range(&txn->mt_free_pgs,
+							pg, omp->mp_pages);
+						if (rc)
+							goto done;
+						mc->mc_db->md_overflow_pages -= omp->mp_pages;
+						if (!mc->mc_db->md_overflow_pages && !subs)
+							break;
+					} else if (subs && (ni->mn_flags & F_SUBDATA)) {
+						mdb_xcursor_init1(mc, ni);
+						rc = mdb_drop0(&mc->mc_xcursor->mx_cursor, 0);
+						if (rc)
+							goto done;
+					}
+				}
+				if (!subs && !mc->mc_db->md_overflow_pages)
+					goto pop;
+			} else {
+				if ((rc = mdb_midl_need(&txn->mt_free_pgs, n)) != 0)
+					goto done;
+				for (i=0; i<n; i++) {
+					pgno_t pg;
+					ni = NODEPTR(mp, i);
+					pg = NODEPGNO(ni);
+					/* free it */
+					mdb_midl_xappend(txn->mt_free_pgs, pg);
+				}
+			}
+			if (!mc->mc_top)
+				break;
+			mc->mc_ki[mc->mc_top] = i;
+			rc = mdb_cursor_sibling(mc, 1);
+			if (rc) {
+				if (rc != MDB_NOTFOUND)
+					goto done;
+				/* no more siblings, go back to beginning
+				 * of previous level.
+				 */
+pop:
+				mdb_cursor_pop(mc);
+				mc->mc_ki[0] = 0;
+				for (i=1; i<mc->mc_snum; i++) {
+					mc->mc_ki[i] = 0;
+					mc->mc_pg[i] = mx.mc_pg[i];
+				}
+			}
+		}
+		/* free it */
+		rc = mdb_midl_append(&txn->mt_free_pgs, mc->mc_db->md_root);
+done:
+		if (rc)
+			txn->mt_flags |= MDB_TXN_ERROR;
+		/* drop refcount for mx's pages */
+		MDB_CURSOR_UNREF(&mx, 0);
+	} else if (rc == MDB_NOTFOUND) {
+		rc = MDB_SUCCESS;
+	}
+	mc->mc_flags &= ~C_INITIALIZED;
+	return rc;
+}
+
+int mdb_drop(MDB_txn *txn, MDB_dbi dbi, int del)
+{
+	MDB_cursor *mc, *m2;
+	int rc;
+
+	if ((unsigned)del > 1 || !TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	if (F_ISSET(txn->mt_flags, MDB_TXN_RDONLY))
+		return EACCES;
+
+	if (TXN_DBI_CHANGED(txn, dbi))
+		return MDB_BAD_DBI;
+
+	rc = mdb_cursor_open(txn, dbi, &mc);
+	if (rc)
+		return rc;
+
+	rc = mdb_drop0(mc, mc->mc_db->md_flags & MDB_DUPSORT);
+	/* Invalidate the dropped DB's cursors */
+	for (m2 = txn->mt_cursors[dbi]; m2; m2 = m2->mc_next)
+		m2->mc_flags &= ~(C_INITIALIZED|C_EOF);
+	if (rc)
+		goto leave;
+
+	/* Can't delete the main DB */
+	if (del && dbi >= CORE_DBS) {
+		rc = mdb_del0(txn, MAIN_DBI, &mc->mc_dbx->md_name, NULL, F_SUBDATA);
+		if (!rc) {
+			txn->mt_dbflags[dbi] = DB_STALE;
+			mdb_dbi_close(txn->mt_env, dbi);
+		} else {
+			txn->mt_flags |= MDB_TXN_ERROR;
+		}
+	} else {
+		/* reset the DB record, mark it dirty */
+		txn->mt_dbflags[dbi] |= DB_DIRTY;
+		txn->mt_dbs[dbi].md_depth = 0;
+		txn->mt_dbs[dbi].md_branch_pages = 0;
+		txn->mt_dbs[dbi].md_leaf_pages = 0;
+		txn->mt_dbs[dbi].md_overflow_pages = 0;
+		txn->mt_dbs[dbi].md_entries = 0;
+		txn->mt_dbs[dbi].md_root = P_INVALID;
+
+		txn->mt_flags |= MDB_TXN_DIRTY;
+	}
+leave:
+	mdb_cursor_close(mc);
+	return rc;
+}
+
+int mdb_set_compare(MDB_txn *txn, MDB_dbi dbi, MDB_cmp_func *cmp)
+{
+	if (!TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	txn->mt_dbxs[dbi].md_cmp = cmp;
+	return MDB_SUCCESS;
+}
+
+int mdb_set_dupsort(MDB_txn *txn, MDB_dbi dbi, MDB_cmp_func *cmp)
+{
+	if (!TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	txn->mt_dbxs[dbi].md_dcmp = cmp;
+	return MDB_SUCCESS;
+}
+
+int mdb_set_relfunc(MDB_txn *txn, MDB_dbi dbi, MDB_rel_func *rel)
+{
+	if (!TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	txn->mt_dbxs[dbi].md_rel = rel;
+	return MDB_SUCCESS;
+}
+
+int mdb_set_relctx(MDB_txn *txn, MDB_dbi dbi, void *ctx)
+{
+	if (!TXN_DBI_EXIST(txn, dbi, DB_USRVALID))
+		return EINVAL;
+
+	txn->mt_dbxs[dbi].md_relctx = ctx;
+	return MDB_SUCCESS;
+}
+
+int ESECT
+mdb_env_get_maxkeysize(MDB_env *env)
+{
+	return ENV_MAXKEY(env);
+}
+
+int ESECT
+mdb_reader_list(MDB_env *env, MDB_msg_func *func, void *ctx)
+{
+	unsigned int i, rdrs;
+	MDB_reader *mr;
+	char buf[64];
+	int rc = 0, first = 1;
+
+	if (!env || !func)
+		return -1;
+	if (!env->me_txns) {
+		return func("(no reader locks)\n", ctx);
+	}
+	rdrs = env->me_txns->mti_numreaders;
+	mr = env->me_txns->mti_readers;
+	for (i=0; i<rdrs; i++) {
+		if (mr[i].mr_pid) {
+			txnid_t	txnid = mr[i].mr_txnid;
+			sprintf(buf, txnid == (txnid_t)-1 ?
+				"%10d %"Z"x -\n" : "%10d %"Z"x %"Yu"\n",
+				(int)mr[i].mr_pid, (size_t)mr[i].mr_tid, txnid);
+			if (first) {
+				first = 0;
+				rc = func("    pid     thread     txnid\n", ctx);
+				if (rc < 0)
+					break;
+			}
+			rc = func(buf, ctx);
+			if (rc < 0)
+				break;
+		}
+	}
+	if (first) {
+		rc = func("(no active readers)\n", ctx);
+	}
+	return rc;
+}
+
+/** Insert pid into list if not already present.
+ * return -1 if already present.
+ */
+static int ESECT
+mdb_pid_insert(MDB_PID_T *ids, MDB_PID_T pid)
+{
+	/* binary search of pid in list */
+	unsigned base = 0;
+	unsigned cursor = 1;
+	int val = 0;
+	unsigned n = ids[0];
+
+	while( 0 < n ) {
+		unsigned pivot = n >> 1;
+		cursor = base + pivot + 1;
+		val = pid - ids[cursor];
+
+		if( val < 0 ) {
+			n = pivot;
+
+		} else if ( val > 0 ) {
+			base = cursor;
+			n -= pivot + 1;
+
+		} else {
+			/* found, so it's a duplicate */
+			return -1;
+		}
+	}
+
+	if( val > 0 ) {
+		++cursor;
+	}
+	ids[0]++;
+	for (n = ids[0]; n > cursor; n--)
+		ids[n] = ids[n-1];
+	ids[n] = pid;
+	return 0;
+}
+
+int ESECT
+mdb_reader_check(MDB_env *env, int *dead)
+{
+	if (!env)
+		return EINVAL;
+	if (dead)
+		*dead = 0;
+	return env->me_txns ? mdb_reader_check0(env, 0, dead) : MDB_SUCCESS;
+}
+
+/** As #mdb_reader_check(). \b rlocked is set if caller locked #me_rmutex. */
+static int ESECT
+mdb_reader_check0(MDB_env *env, int rlocked, int *dead)
+{
+	mdb_mutexref_t rmutex = rlocked ? NULL : env->me_rmutex;
+	unsigned int i, j, rdrs;
+	MDB_reader *mr;
+	MDB_PID_T *pids, pid;
+	int rc = MDB_SUCCESS, count = 0;
+
+	rdrs = env->me_txns->mti_numreaders;
+	pids = malloc((rdrs+1) * sizeof(MDB_PID_T));
+	if (!pids)
+		return ENOMEM;
+	pids[0] = 0;
+	mr = env->me_txns->mti_readers;
+	for (i=0; i<rdrs; i++) {
+		pid = mr[i].mr_pid;
+		if (pid && pid != env->me_pid) {
+			if (mdb_pid_insert(pids, pid) == 0) {
+				if (!mdb_reader_pid(env, Pidcheck, pid)) {
+					/* Stale reader found */
+					j = i;
+					if (rmutex) {
+						if ((rc = LOCK_MUTEX0(rmutex)) != 0) {
+							if ((rc = mdb_mutex_failed(env, rmutex, rc)))
+								break;
+							rdrs = 0; /* the above checked all readers */
+						} else {
+							/* Recheck, a new process may have reused pid */
+							if (mdb_reader_pid(env, Pidcheck, pid))
+								j = rdrs;
+						}
+					}
+					for (; j<rdrs; j++)
+							if (mr[j].mr_pid == pid) {
+								DPRINTF(("clear stale reader pid %u txn %"Yd,
+									(unsigned) pid, mr[j].mr_txnid));
+								mr[j].mr_pid = 0;
+								count++;
+							}
+					if (rmutex)
+						UNLOCK_MUTEX(rmutex);
+				}
+			}
+		}
+	}
+	free(pids);
+	if (dead)
+		*dead = count;
+	return rc;
+}
+
+#ifdef MDB_ROBUST_SUPPORTED
+/** Handle #LOCK_MUTEX0() failure.
+ * Try to repair the lock file if the mutex owner died.
+ * @param[in] env	the environment handle
+ * @param[in] mutex	LOCK_MUTEX0() mutex
+ * @param[in] rc	LOCK_MUTEX0() error (nonzero)
+ * @return 0 on success with the mutex locked, or an error code on failure.
+ */
+static int ESECT
+mdb_mutex_failed(MDB_env *env, mdb_mutexref_t mutex, int rc)
+{
+	int rlocked, rc2;
+	MDB_meta *meta;
+
+	if (rc == MDB_OWNERDEAD) {
+		/* We own the mutex. Clean up after dead previous owner. */
+		rc = MDB_SUCCESS;
+		rlocked = (mutex == env->me_rmutex);
+		if (!rlocked) {
+			/* Keep mti_txnid updated, otherwise next writer can
+			 * overwrite data which latest meta page refers to.
+			 */
+			meta = mdb_env_pick_meta(env);
+			env->me_txns->mti_txnid = meta->mm_txnid;
+			/* env is hosed if the dead thread was ours */
+			if (env->me_txn) {
+				env->me_flags |= MDB_FATAL_ERROR;
+				env->me_txn = NULL;
+				rc = MDB_PANIC;
+			}
+		}
+		DPRINTF(("%cmutex owner died, %s", (rlocked ? 'r' : 'w'),
+			(rc ? "this process' env is hosed" : "recovering")));
+		rc2 = mdb_reader_check0(env, rlocked, NULL);
+		if (rc2 == 0)
+			rc2 = mdb_mutex_consistent(mutex);
+		if (rc || (rc = rc2)) {
+			DPRINTF(("LOCK_MUTEX recovery failed, %s", mdb_strerror(rc)));
+			UNLOCK_MUTEX(mutex);
+		}
+	} else {
+#ifdef _WIN32
+		rc = ErrCode();
+#endif
+		DPRINTF(("LOCK_MUTEX failed, %s", mdb_strerror(rc)));
+	}
+
+	return rc;
+}
+#endif	/* MDB_ROBUST_SUPPORTED */
+
+#if defined(_WIN32)
+/** Convert \b src to new wchar_t[] string with room for \b xtra extra chars */
+static int ESECT
+utf8_to_utf16(const char *src, MDB_name *dst, int xtra)
+{
+	int rc, need = 0;
+	wchar_t *result = NULL;
+	for (;;) {					/* malloc result, then fill it in */
+		need = MultiByteToWideChar(CP_UTF8, 0, src, -1, result, need);
+		if (!need) {
+			rc = ErrCode();
+			free(result);
+			return rc;
+		}
+		if (!result) {
+			result = malloc(sizeof(wchar_t) * (need + xtra));
+			if (!result)
+				return ENOMEM;
+			continue;
+		}
+		dst->mn_alloced = 1;
+		dst->mn_len = need - 1;
+		dst->mn_val = result;
+		return MDB_SUCCESS;
+	}
+}
+#endif /* defined(_WIN32) */
+/** @} */
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.c b/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.c
new file mode 100644
index 000000000..341021cc5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.c
@@ -0,0 +1,421 @@
+/**	@file midl.c
+ *	@brief ldap bdb back-end ID List functions */
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 2000-2018 The OpenLDAP Foundation.
+ * Portions Copyright 2001-2018 Howard Chu, Symas Corp.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted only as authorized by the OpenLDAP
+ * Public License.
+ *
+ * A copy of this license is available in the file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#include <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <sys/types.h>
+#include "midl.h"
+
+/** @defgroup internal	LMDB Internals
+ *	@{
+ */
+/** @defgroup idls	ID List Management
+ *	@{
+ */
+#define CMP(x,y)	 ( (x) < (y) ? -1 : (x) > (y) )
+
+unsigned mdb_midl_search( MDB_IDL ids, MDB_ID id )
+{
+	/*
+	 * binary search of id in ids
+	 * if found, returns position of id
+	 * if not found, returns first position greater than id
+	 */
+	unsigned base = 0;
+	unsigned cursor = 1;
+	int val = 0;
+	unsigned n = ids[0];
+
+	while( 0 < n ) {
+		unsigned pivot = n >> 1;
+		cursor = base + pivot + 1;
+		val = CMP( ids[cursor], id );
+
+		if( val < 0 ) {
+			n = pivot;
+
+		} else if ( val > 0 ) {
+			base = cursor;
+			n -= pivot + 1;
+
+		} else {
+			return cursor;
+		}
+	}
+
+	if( val > 0 ) {
+		++cursor;
+	}
+	return cursor;
+}
+
+#if 0	/* superseded by append/sort */
+int mdb_midl_insert( MDB_IDL ids, MDB_ID id )
+{
+	unsigned x, i;
+
+	x = mdb_midl_search( ids, id );
+	assert( x > 0 );
+
+	if( x < 1 ) {
+		/* internal error */
+		return -2;
+	}
+
+	if ( x <= ids[0] && ids[x] == id ) {
+		/* duplicate */
+		assert(0);
+		return -1;
+	}
+
+	if ( ++ids[0] >= MDB_IDL_DB_MAX ) {
+		/* no room */
+		--ids[0];
+		return -2;
+
+	} else {
+		/* insert id */
+		for (i=ids[0]; i>x; i--)
+			ids[i] = ids[i-1];
+		ids[x] = id;
+	}
+
+	return 0;
+}
+#endif
+
+MDB_IDL mdb_midl_alloc(int num)
+{
+	MDB_IDL ids = malloc((num+2) * sizeof(MDB_ID));
+	if (ids) {
+		*ids++ = num;
+		*ids = 0;
+	}
+	return ids;
+}
+
+void mdb_midl_free(MDB_IDL ids)
+{
+	if (ids)
+		free(ids-1);
+}
+
+void mdb_midl_shrink( MDB_IDL *idp )
+{
+	MDB_IDL ids = *idp;
+	if (*(--ids) > MDB_IDL_UM_MAX &&
+		(ids = realloc(ids, (MDB_IDL_UM_MAX+2) * sizeof(MDB_ID))))
+	{
+		*ids++ = MDB_IDL_UM_MAX;
+		*idp = ids;
+	}
+}
+
+static int mdb_midl_grow( MDB_IDL *idp, int num )
+{
+	MDB_IDL idn = *idp-1;
+	/* grow it */
+	idn = realloc(idn, (*idn + num + 2) * sizeof(MDB_ID));
+	if (!idn)
+		return ENOMEM;
+	*idn++ += num;
+	*idp = idn;
+	return 0;
+}
+
+int mdb_midl_need( MDB_IDL *idp, unsigned num )
+{
+	MDB_IDL ids = *idp;
+	num += ids[0];
+	if (num > ids[-1]) {
+		num = (num + num/4 + (256 + 2)) & -256;
+		if (!(ids = realloc(ids-1, num * sizeof(MDB_ID))))
+			return ENOMEM;
+		*ids++ = num - 2;
+		*idp = ids;
+	}
+	return 0;
+}
+
+int mdb_midl_append( MDB_IDL *idp, MDB_ID id )
+{
+	MDB_IDL ids = *idp;
+	/* Too big? */
+	if (ids[0] >= ids[-1]) {
+		if (mdb_midl_grow(idp, MDB_IDL_UM_MAX))
+			return ENOMEM;
+		ids = *idp;
+	}
+	ids[0]++;
+	ids[ids[0]] = id;
+	return 0;
+}
+
+int mdb_midl_append_list( MDB_IDL *idp, MDB_IDL app )
+{
+	MDB_IDL ids = *idp;
+	/* Too big? */
+	if (ids[0] + app[0] >= ids[-1]) {
+		if (mdb_midl_grow(idp, app[0]))
+			return ENOMEM;
+		ids = *idp;
+	}
+	memcpy(&ids[ids[0]+1], &app[1], app[0] * sizeof(MDB_ID));
+	ids[0] += app[0];
+	return 0;
+}
+
+int mdb_midl_append_range( MDB_IDL *idp, MDB_ID id, unsigned n )
+{
+	MDB_ID *ids = *idp, len = ids[0];
+	/* Too big? */
+	if (len + n > ids[-1]) {
+		if (mdb_midl_grow(idp, n | MDB_IDL_UM_MAX))
+			return ENOMEM;
+		ids = *idp;
+	}
+	ids[0] = len + n;
+	ids += len;
+	while (n)
+		ids[n--] = id++;
+	return 0;
+}
+
+void mdb_midl_xmerge( MDB_IDL idl, MDB_IDL merge )
+{
+	MDB_ID old_id, merge_id, i = merge[0], j = idl[0], k = i+j, total = k;
+	idl[0] = (MDB_ID)-1;		/* delimiter for idl scan below */
+	old_id = idl[j];
+	while (i) {
+		merge_id = merge[i--];
+		for (; old_id < merge_id; old_id = idl[--j])
+			idl[k--] = old_id;
+		idl[k--] = merge_id;
+	}
+	idl[0] = total;
+}
+
+/* Quicksort + Insertion sort for small arrays */
+
+#define SMALL	8
+#define	MIDL_SWAP(a,b)	{ itmp=(a); (a)=(b); (b)=itmp; }
+
+void
+mdb_midl_sort( MDB_IDL ids )
+{
+	/* Max possible depth of int-indexed tree * 2 items/level */
+	int istack[sizeof(int)*CHAR_BIT * 2];
+	int i,j,k,l,ir,jstack;
+	MDB_ID a, itmp;
+
+	ir = (int)ids[0];
+	l = 1;
+	jstack = 0;
+	for(;;) {
+		if (ir - l < SMALL) {	/* Insertion sort */
+			for (j=l+1;j<=ir;j++) {
+				a = ids[j];
+				for (i=j-1;i>=1;i--) {
+					if (ids[i] >= a) break;
+					ids[i+1] = ids[i];
+				}
+				ids[i+1] = a;
+			}
+			if (jstack == 0) break;
+			ir = istack[jstack--];
+			l = istack[jstack--];
+		} else {
+			k = (l + ir) >> 1;	/* Choose median of left, center, right */
+			MIDL_SWAP(ids[k], ids[l+1]);
+			if (ids[l] < ids[ir]) {
+				MIDL_SWAP(ids[l], ids[ir]);
+			}
+			if (ids[l+1] < ids[ir]) {
+				MIDL_SWAP(ids[l+1], ids[ir]);
+			}
+			if (ids[l] < ids[l+1]) {
+				MIDL_SWAP(ids[l], ids[l+1]);
+			}
+			i = l+1;
+			j = ir;
+			a = ids[l+1];
+			for(;;) {
+				do i++; while(ids[i] > a);
+				do j--; while(ids[j] < a);
+				if (j < i) break;
+				MIDL_SWAP(ids[i],ids[j]);
+			}
+			ids[l+1] = ids[j];
+			ids[j] = a;
+			jstack += 2;
+			if (ir-i+1 >= j-l) {
+				istack[jstack] = ir;
+				istack[jstack-1] = i;
+				ir = j-1;
+			} else {
+				istack[jstack] = j-1;
+				istack[jstack-1] = l;
+				l = i;
+			}
+		}
+	}
+}
+
+unsigned mdb_mid2l_search( MDB_ID2L ids, MDB_ID id )
+{
+	/*
+	 * binary search of id in ids
+	 * if found, returns position of id
+	 * if not found, returns first position greater than id
+	 */
+	unsigned base = 0;
+	unsigned cursor = 1;
+	int val = 0;
+	unsigned n = (unsigned)ids[0].mid;
+
+	while( 0 < n ) {
+		unsigned pivot = n >> 1;
+		cursor = base + pivot + 1;
+		val = CMP( id, ids[cursor].mid );
+
+		if( val < 0 ) {
+			n = pivot;
+
+		} else if ( val > 0 ) {
+			base = cursor;
+			n -= pivot + 1;
+
+		} else {
+			return cursor;
+		}
+	}
+
+	if( val > 0 ) {
+		++cursor;
+	}
+	return cursor;
+}
+
+int mdb_mid2l_insert( MDB_ID2L ids, MDB_ID2 *id )
+{
+	unsigned x, i;
+
+	x = mdb_mid2l_search( ids, id->mid );
+
+	if( x < 1 ) {
+		/* internal error */
+		return -2;
+	}
+
+	if ( x <= ids[0].mid && ids[x].mid == id->mid ) {
+		/* duplicate */
+		return -1;
+	}
+
+	if ( ids[0].mid >= MDB_IDL_UM_MAX ) {
+		/* too big */
+		return -2;
+
+	} else {
+		/* insert id */
+		ids[0].mid++;
+		for (i=(unsigned)ids[0].mid; i>x; i--)
+			ids[i] = ids[i-1];
+		ids[x] = *id;
+	}
+
+	return 0;
+}
+
+int mdb_mid2l_append( MDB_ID2L ids, MDB_ID2 *id )
+{
+	/* Too big? */
+	if (ids[0].mid >= MDB_IDL_UM_MAX) {
+		return -2;
+	}
+	ids[0].mid++;
+	ids[ids[0].mid] = *id;
+	return 0;
+}
+
+#ifdef MDB_VL32
+unsigned mdb_mid3l_search( MDB_ID3L ids, MDB_ID id )
+{
+	/*
+	 * binary search of id in ids
+	 * if found, returns position of id
+	 * if not found, returns first position greater than id
+	 */
+	unsigned base = 0;
+	unsigned cursor = 1;
+	int val = 0;
+	unsigned n = (unsigned)ids[0].mid;
+
+	while( 0 < n ) {
+		unsigned pivot = n >> 1;
+		cursor = base + pivot + 1;
+		val = CMP( id, ids[cursor].mid );
+
+		if( val < 0 ) {
+			n = pivot;
+
+		} else if ( val > 0 ) {
+			base = cursor;
+			n -= pivot + 1;
+
+		} else {
+			return cursor;
+		}
+	}
+
+	if( val > 0 ) {
+		++cursor;
+	}
+	return cursor;
+}
+
+int mdb_mid3l_insert( MDB_ID3L ids, MDB_ID3 *id )
+{
+	unsigned x, i;
+
+	x = mdb_mid3l_search( ids, id->mid );
+
+	if( x < 1 ) {
+		/* internal error */
+		return -2;
+	}
+
+	if ( x <= ids[0].mid && ids[x].mid == id->mid ) {
+		/* duplicate */
+		return -1;
+	}
+
+	/* insert id */
+	ids[0].mid++;
+	for (i=(unsigned)ids[0].mid; i>x; i--)
+		ids[i] = ids[i-1];
+	ids[x] = *id;
+
+	return 0;
+}
+#endif /* MDB_VL32 */
+
+/** @} */
+/** @} */
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.h b/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.h
new file mode 100644
index 000000000..a0d5727cf
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/src/midl.h
@@ -0,0 +1,204 @@
+/**	@file midl.h
+ *	@brief LMDB ID List header file.
+ *
+ *	This file was originally part of back-bdb but has been
+ *	modified for use in libmdb. Most of the macros defined
+ *	in this file are unused, just left over from the original.
+ *
+ *	This file is only used internally in libmdb and its definitions
+ *	are not exposed publicly.
+ */
+/* $OpenLDAP$ */
+/* This work is part of OpenLDAP Software <http://www.openldap.org/>.
+ *
+ * Copyright 2000-2018 The OpenLDAP Foundation.
+ * Portions Copyright 2001-2018 Howard Chu, Symas Corp.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted only as authorized by the OpenLDAP
+ * Public License.
+ *
+ * A copy of this license is available in the file LICENSE in the
+ * top-level directory of the distribution or, alternatively, at
+ * <http://www.OpenLDAP.org/license.html>.
+ */
+
+#ifndef _MDB_MIDL_H_
+#define _MDB_MIDL_H_
+
+#include "lmdb.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/** @defgroup internal	LMDB Internals
+ *	@{
+ */
+
+/** @defgroup idls	ID List Management
+ *	@{
+ */
+	/** A generic unsigned ID number. These were entryIDs in back-bdb.
+	 *	Preferably it should have the same size as a pointer.
+	 */
+typedef mdb_size_t MDB_ID;
+
+	/** An IDL is an ID List, a sorted array of IDs. The first
+	 * element of the array is a counter for how many actual
+	 * IDs are in the list. In the original back-bdb code, IDLs are
+	 * sorted in ascending order. For libmdb IDLs are sorted in
+	 * descending order.
+	 */
+typedef MDB_ID *MDB_IDL;
+
+/* IDL sizes - likely should be even bigger
+ *   limiting factors: sizeof(ID), thread stack size
+ */
+#ifdef MDB_VL32
+#define	MDB_IDL_LOGN	14	/* DB_SIZE is 2^14, UM_SIZE is 2^15 */
+#else
+#define	MDB_IDL_LOGN	16	/* DB_SIZE is 2^16, UM_SIZE is 2^17 */
+#endif
+#define MDB_IDL_DB_SIZE		(1<<MDB_IDL_LOGN)
+#define MDB_IDL_UM_SIZE		(1<<(MDB_IDL_LOGN+1))
+
+#define MDB_IDL_DB_MAX		(MDB_IDL_DB_SIZE-1)
+#define MDB_IDL_UM_MAX		(MDB_IDL_UM_SIZE-1)
+
+#define MDB_IDL_SIZEOF(ids)		(((ids)[0]+1) * sizeof(MDB_ID))
+#define MDB_IDL_IS_ZERO(ids) ( (ids)[0] == 0 )
+#define MDB_IDL_CPY( dst, src ) (memcpy( dst, src, MDB_IDL_SIZEOF( src ) ))
+#define MDB_IDL_FIRST( ids )	( (ids)[1] )
+#define MDB_IDL_LAST( ids )		( (ids)[(ids)[0]] )
+
+	/** Current max length of an #mdb_midl_alloc()ed IDL */
+#define MDB_IDL_ALLOCLEN( ids )	( (ids)[-1] )
+
+	/** Append ID to IDL. The IDL must be big enough. */
+#define mdb_midl_xappend(idl, id) do { \
+		MDB_ID *xidl = (idl), xlen = ++(xidl[0]); \
+		xidl[xlen] = (id); \
+	} while (0)
+
+	/** Search for an ID in an IDL.
+	 * @param[in] ids	The IDL to search.
+	 * @param[in] id	The ID to search for.
+	 * @return	The index of the first ID greater than or equal to \b id.
+	 */
+unsigned mdb_midl_search( MDB_IDL ids, MDB_ID id );
+
+	/** Allocate an IDL.
+	 * Allocates memory for an IDL of the given size.
+	 * @return	IDL on success, NULL on failure.
+	 */
+MDB_IDL mdb_midl_alloc(int num);
+
+	/** Free an IDL.
+	 * @param[in] ids	The IDL to free.
+	 */
+void mdb_midl_free(MDB_IDL ids);
+
+	/** Shrink an IDL.
+	 * Return the IDL to the default size if it has grown larger.
+	 * @param[in,out] idp	Address of the IDL to shrink.
+	 */
+void mdb_midl_shrink(MDB_IDL *idp);
+
+	/** Make room for num additional elements in an IDL.
+	 * @param[in,out] idp	Address of the IDL.
+	 * @param[in] num	Number of elements to make room for.
+	 * @return	0 on success, ENOMEM on failure.
+	 */
+int mdb_midl_need(MDB_IDL *idp, unsigned num);
+
+	/** Append an ID onto an IDL.
+	 * @param[in,out] idp	Address of the IDL to append to.
+	 * @param[in] id	The ID to append.
+	 * @return	0 on success, ENOMEM if the IDL is too large.
+	 */
+int mdb_midl_append( MDB_IDL *idp, MDB_ID id );
+
+	/** Append an IDL onto an IDL.
+	 * @param[in,out] idp	Address of the IDL to append to.
+	 * @param[in] app	The IDL to append.
+	 * @return	0 on success, ENOMEM if the IDL is too large.
+	 */
+int mdb_midl_append_list( MDB_IDL *idp, MDB_IDL app );
+
+	/** Append an ID range onto an IDL.
+	 * @param[in,out] idp	Address of the IDL to append to.
+	 * @param[in] id	The lowest ID to append.
+	 * @param[in] n		Number of IDs to append.
+	 * @return	0 on success, ENOMEM if the IDL is too large.
+	 */
+int mdb_midl_append_range( MDB_IDL *idp, MDB_ID id, unsigned n );
+
+	/** Merge an IDL onto an IDL. The destination IDL must be big enough.
+	 * @param[in] idl	The IDL to merge into.
+	 * @param[in] merge	The IDL to merge.
+	 */
+void mdb_midl_xmerge( MDB_IDL idl, MDB_IDL merge );
+
+	/** Sort an IDL.
+	 * @param[in,out] ids	The IDL to sort.
+	 */
+void mdb_midl_sort( MDB_IDL ids );
+
+	/** An ID2 is an ID/pointer pair.
+	 */
+typedef struct MDB_ID2 {
+	MDB_ID mid;		/**< The ID */
+	void *mptr;		/**< The pointer */
+} MDB_ID2;
+
+	/** An ID2L is an ID2 List, a sorted array of ID2s.
+	 * The first element's \b mid member is a count of how many actual
+	 * elements are in the array. The \b mptr member of the first element is unused.
+	 * The array is sorted in ascending order by \b mid.
+	 */
+typedef MDB_ID2 *MDB_ID2L;
+
+	/** Search for an ID in an ID2L.
+	 * @param[in] ids	The ID2L to search.
+	 * @param[in] id	The ID to search for.
+	 * @return	The index of the first ID2 whose \b mid member is greater than or equal to \b id.
+	 */
+unsigned mdb_mid2l_search( MDB_ID2L ids, MDB_ID id );
+
+
+	/** Insert an ID2 into a ID2L.
+	 * @param[in,out] ids	The ID2L to insert into.
+	 * @param[in] id	The ID2 to insert.
+	 * @return	0 on success, -1 if the ID was already present in the ID2L.
+	 */
+int mdb_mid2l_insert( MDB_ID2L ids, MDB_ID2 *id );
+
+	/** Append an ID2 into a ID2L.
+	 * @param[in,out] ids	The ID2L to append into.
+	 * @param[in] id	The ID2 to append.
+	 * @return	0 on success, -2 if the ID2L is too big.
+	 */
+int mdb_mid2l_append( MDB_ID2L ids, MDB_ID2 *id );
+
+#ifdef MDB_VL32
+typedef struct MDB_ID3 {
+	MDB_ID mid;		/**< The ID */
+	void *mptr;		/**< The pointer */
+	unsigned int mcnt;		/**< Number of pages */
+	unsigned int mref;		/**< Refcounter */
+} MDB_ID3;
+
+typedef MDB_ID3 *MDB_ID3L;
+
+unsigned mdb_mid3l_search( MDB_ID3L ids, MDB_ID id );
+int mdb_mid3l_insert( MDB_ID3L ids, MDB_ID3 *id );
+
+#endif /* MDB_VL32 */
+/** @} */
+/** @} */
+#ifdef __cplusplus
+}
+#endif
+#endif	/* _MDB_MIDL_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/test/dune b/vendors/tezos-modded/vendors/ocaml-lmdb/test/dune
new file mode 100644
index 000000000..76ab4659a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/test/dune
@@ -0,0 +1,7 @@
+(executable
+ (name test)
+ (libraries cstruct rresult lmdb alcotest))
+
+(alias
+ (name    runtest-lmdb)
+ (action  (run %{exe:test.exe})))
diff --git a/vendors/tezos-modded/vendors/ocaml-lmdb/test/test.ml b/vendors/tezos-modded/vendors/ocaml-lmdb/test/test.ml
new file mode 100644
index 000000000..42f401b52
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-lmdb/test/test.ml
@@ -0,0 +1,178 @@
+open Rresult
+open Lmdb
+
+let assert_false v =
+  assert (not v)
+
+let assert_error err = function
+  | Ok _ -> invalid_arg "assert_error"
+  | Error e -> if e <> err then invalid_arg "assert_error"
+
+let assert_equal_ba expected ba =
+  assert (expected = Cstruct.(to_string (of_bigarray ba)))
+
+let version () =
+  let { major ; minor ; patch } = version () in
+  assert (major = 0) ;
+  assert (minor = 9) ;
+  assert (patch = 70)
+
+let test_string_of_error () =
+  let errmsg = string_of_error KeyExist in
+  assert (String.length errmsg > 0)
+
+let cleanup () =
+  let files = [ "/tmp/data.mdb" ; "/tmp/lock.mdb" ] in
+  ListLabels.iter files ~f:begin fun fn ->
+    Sys.(if file_exists fn then remove fn)
+  end
+
+let env () =
+  cleanup () ;
+  opendir ~maxreaders:34 ~maxdbs:1 "/tmp" 0o644 >>= fun env ->
+  let _stat = stat env in
+  let _envinfo = envinfo env in
+  let _flags = get_flags env in
+  let _path = get_path env in
+  let _fd = get_fd env in
+  let _maxreaders = get_maxreaders env in
+  let _maxkeysize = get_maxkeysize env in
+  sync env >>= fun () ->
+  Ok ()
+
+let txn () =
+  cleanup () ;
+  opendir ~maxdbs:1 "/tmp" 0o644 >>= fun env ->
+  create_ro_txn env >>= fun rotxn ->
+  reset_ro_txn rotxn ;
+  create_rw_txn env >>= fun rwtxn ->
+  assert (rwtxn = rwtxn) ;
+  let env2 = get_txn_env rwtxn in
+  assert (env = env2) ;
+  opendb rwtxn >>= fun defaultdbi ->
+  opendb ~flags:[Create] rwtxn ~name:"bleh" >>= fun dbi ->
+  put_string rwtxn dbi "test" "test" >>= fun () ->
+  get rwtxn dbi "test" >>= fun buffer ->
+  assert_equal_ba "test" buffer ;
+  assert_error KeyNotFound (del rwtxn dbi "bleh") ;
+  del rwtxn dbi "test" >>= fun () ->
+  db_stat rwtxn dbi >>= fun _stat ->
+  db_flags rwtxn dbi >>= fun _flags ->
+  db_drop rwtxn dbi >>= fun () ->
+  closedir env ;
+  Ok ()
+
+let cursors () =
+  cleanup () ;
+  opendir "/tmp" 0o644 >>= fun env ->
+  create_rw_txn env >>= fun txn ->
+  opendb txn >>= fun db ->
+  opencursor txn db >>= fun cursor ->
+  assert_error KeyNotFound (cursor_first cursor) ;
+  assert_error KeyNotFound (cursor_last cursor) ;
+  cursor_put_string cursor "test" "test" >>= fun () ->
+  cursor_put_string cursor "test2" "test2" >>= fun () ->
+  sync env >>= fun () ->
+  cursor_first cursor >>= fun () ->
+  cursor_at cursor "" >>= fun () ->
+  assert_error KeyNotFound (cursor_prev cursor) ;
+  cursor_last cursor >>= fun () ->
+  assert_error KeyNotFound (cursor_next cursor) ;
+  cursor_prev cursor >>= fun () ->
+  get txn db "test" >>= fun buf ->
+  assert_equal_ba "test" buf ;
+  cursor_get cursor >>= fun (k, v) ->
+  assert_equal_ba "test" k ;
+  assert_equal_ba "test" v ;
+  closedir env ;
+  Ok ()
+
+let cursors_del () =
+  cleanup () ;
+  opendir "/tmp" 0o644 >>= fun env ->
+  with_rw_db env ~f:begin fun txn db ->
+    with_cursor txn db ~f:begin fun cursor ->
+      cursor_put_string cursor "k1" "v1" >>= fun () ->
+      cursor_first cursor >>= fun () ->
+      cursor_fold_left cursor ~init:() ~f:begin fun acc (_k, _v) ->
+        cursor_del cursor
+      end >>= fun () ->
+      assert_error KeyNotFound (cursor_first cursor) ;
+      Ok ()
+    end
+  end
+
+let cursors_del4 () =
+  cleanup () ;
+  opendir "/tmp" 0o644 >>= fun env ->
+  with_rw_db env ~f:begin fun txn db ->
+    with_cursor txn db ~f:begin fun cursor ->
+      cursor_put_string cursor "k1" "v1" >>= fun () ->
+      cursor_put_string cursor "k2" "v2" >>= fun () ->
+      cursor_put_string cursor "k3" "v3" >>= fun () ->
+      cursor_put_string cursor "k4" "v4" >>= fun () ->
+      cursor_first cursor >>= fun () ->
+      cursor_fold_left cursor ~init:() ~f:begin fun acc (_k, _v) ->
+        cursor_del cursor
+      end >>= fun () ->
+      assert_error KeyNotFound (cursor_first cursor) ;
+      Ok ()
+    end
+  end
+
+let fold () =
+  cleanup () ;
+  opendir "/tmp" 0o644 >>= fun env ->
+  with_rw_db env ~f:begin fun txn db ->
+    opencursor txn db >>= fun cursor ->
+    cursor_put_string cursor "k1" "v1" >>= fun () ->
+    cursor_put_string cursor "k2" "v2" >>= fun () ->
+    cursor_put_string cursor "k3" "v3" >>= fun () ->
+    cursor_put_string cursor "k4" "v4" >>= fun () ->
+    cursor_first cursor >>= fun () ->
+    cursor_fold_left ~f:begin fun i (k, v) ->
+      assert_equal_ba ("k" ^ (string_of_int i)) k ;
+      assert_equal_ba ("v" ^ (string_of_int i)) v ;
+      Ok (succ i)
+    end ~init:1 cursor >>= fun _ ->
+    Ok ()
+  end >>= fun () ->
+  closedir env ;
+  Ok ()
+
+let consistency () =
+  cleanup () ;
+  opendir "/tmp" 0o644 >>= fun env ->
+  let v = Cstruct.(to_bigarray (of_string "bleh")) in
+  with_rw_db env ~f:begin fun txn db ->
+    put txn db "bleh" v
+  end >>= fun () ->
+  with_ro_db env ~f:begin fun txn db ->
+    get txn db "bleh" >>= fun v' ->
+    (* assert (v = v') ; *)
+    assert_equal_ba "bleh" v' ;
+    Ok ()
+  end >>= fun () ->
+  Ok ()
+
+let fail_on_error f () =
+  match f () with
+  | Ok _ -> ()
+  | Error err -> failwith (string_of_error err)
+
+let basic = [
+  "version", `Quick, version ;
+  "string_of_error", `Quick, test_string_of_error ;
+  "env", `Quick, fail_on_error env ;
+  "txn", `Quick, fail_on_error txn ;
+  "cursors", `Quick, fail_on_error cursors ;
+  "cursors_del", `Quick, fail_on_error cursors_del ;
+  "cursors_del4", `Quick, fail_on_error cursors_del4 ;
+  "fold", `Quick, fail_on_error fold ;
+  "consistency", `Quick, fail_on_error consistency ;
+]
+
+let () =
+  Alcotest.run "lmdb" [
+    "basic", basic ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/CHANGES.md b/vendors/tezos-modded/vendors/ocaml-pbkdf/CHANGES.md
new file mode 100644
index 000000000..16b9c550f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/CHANGES.md
@@ -0,0 +1,11 @@
+# 0.3.0 (2018-02-16)
+
+* Build: switch to dune
+
+# 0.2.0 (2016-10-31)
+
+* Added topkg dependency
+
+# 0.1.0 (2016-03-14)
+
+* Initial release
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/LICENSE.md b/vendors/tezos-modded/vendors/ocaml-pbkdf/LICENSE.md
new file mode 100644
index 000000000..a453a569b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/LICENSE.md
@@ -0,0 +1,24 @@
+Copyright (c) 2016, Alfredo Beaumont, Sonia Meruelo
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/README.md b/vendors/tezos-modded/vendors/ocaml-pbkdf/README.md
new file mode 100644
index 000000000..c128df630
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/README.md
@@ -0,0 +1,6 @@
+[![docs](https://img.shields.io/badge/doc-online-blue.svg)](https://abeaumont.github.io/ocaml-pbkdf)
+[![Build Status](https://travis-ci.org/abeaumont/ocaml-pbkdf.svg?branch=master)](https://travis-ci.org/abeaumont/ocaml-pbkdf)
+
+# Password based key derivation functions (PBKDF) from PKCS#5
+
+An implementation of PBKDF 1 and 2 as defined by [PKCS#5](https://tools.ietf.org/html/rfc2898) using [nocrypto](https://github.com/mirleft/ocaml-nocrypto)
\ No newline at end of file
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/pbkdf.opam b/vendors/tezos-modded/vendors/ocaml-pbkdf/pbkdf.opam
new file mode 100644
index 000000000..aa6f8c7ce
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/pbkdf.opam
@@ -0,0 +1,21 @@
+opam-version: "2.0"
+name:         "pbkdf"
+version:      "0.3.0"
+homepage:     "https://github.com/abeaumont/ocaml-pbkdf"
+dev-repo:     "git+https://github.com/abeaumont/ocaml-pbkdf.git"
+bug-reports:  "https://github.com/abeaumont/ocaml-pbkdf/issues"
+authors:      ["Alfredo Beaumont <alfredo.beaumont@gmail.com>" "Sonia Meruelo <smeruelo@gmail.com>"]
+maintainer:   ["Alfredo Beaumont <alfredo.beaumont@gmail.com>"]
+license:      "BSD2"
+synopsis:     "Password based key derivation functions from PKCS#5, RFC 2898"
+
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "dune" { build & >= "1.0.1" }
+  "hacl"
+  "bigstring" {>= "0.2"}
+  "ocplib-endian" {>= "1.0"}
+  "alcotest" {with-test & >= "0.8.1"}
+  "hex" {with-test & >= "1.2.0"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/src/dune b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/dune
new file mode 100644
index 000000000..59945d957
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/dune
@@ -0,0 +1,5 @@
+(library
+ (name        pbkdf)
+ (public_name pbkdf)
+ (synopsis "")
+ (libraries bigstring hacl))
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.ml b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.ml
new file mode 100644
index 000000000..0d646ac4c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.ml
@@ -0,0 +1,49 @@
+let xorbuf a b =
+  let alen = Bigstring.length a in
+  if Bigstring.length b <> alen then
+    invalid_arg "xor: both buffers must be of same size" ;
+  for i = 0 to alen - 1 do
+    Bigstring.(set a i Char.(chr (code (get a i) lxor code (get b i))))
+  done ;
+  a
+
+let cdiv x y =
+  (* This is lifted from Nocrypto.Uncommon.(//)
+     (formerly known as [cdiv]). It is part of the documented, publically
+     exposed _internal_ utility library not for public consumption, hence
+     the API break that prompted this copy-pasted function. *)
+  if y < 1 then raise Division_by_zero else
+  if x > 0 then 1 + ((x - 1) / y) else 0 [@@inline]
+
+module type S = sig
+  val pbkdf2 : password:Bigstring.t -> salt:Bigstring.t -> count:int -> dk_len:int32 -> Bigstring.t
+end
+
+module Make (H: Hacl.Hash.S) : S = struct
+  let pbkdf2 ~password ~salt ~count ~dk_len =
+    if count <= 0 then invalid_arg "count must be a positive integer" ;
+    if dk_len <= 0l then invalid_arg "derived key length must be a positive integer" ;
+    let h_len = H.bytes
+    and dk_len = Int32.to_int dk_len in
+    let l = cdiv dk_len h_len in
+    let r = dk_len - (l - 1) * h_len in
+    let block i =
+      let rec f u xor = function
+          0 -> xor
+        | j -> let u = H.HMAC.digest ~key:password ~msg:u in
+            f u (xorbuf xor u) (j - 1)
+      in
+      let int_i = Bigstring.create 4 in
+      EndianBigstring.BigEndian.set_int32 int_i 0 (Int32.of_int i);
+      let u_1 = H.HMAC.digest ~key:password ~msg:(Bigstring.concat "" [salt; int_i]) in
+      f u_1 u_1 (count - 1)
+    in
+    let rec loop blocks = function
+        0 -> blocks
+      | i -> loop ((block i)::blocks) (i - 1)
+    in
+    Bigstring.concat "" (loop [Bigstring.sub (block l) 0 r] (l - 1))
+end
+
+module SHA256 = Make(Hacl.Hash.SHA256)
+module SHA512 = Make(Hacl.Hash.SHA512)
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.mli b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.mli
new file mode 100644
index 000000000..5e3f057d3
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/src/pbkdf.mli
@@ -0,0 +1,14 @@
+(** {{:https://tools.ietf.org/html/rfc2898}RFC 2898} specifies two password-based
+    key derivation functions (PBKDF1 and PBKDF2), which are abstracted over
+    a specific hash/pseudorandom function. *)
+module type S = sig
+  (** [pbkdf2 password salt count dk_len] is [dk], the derived key of [dk_len] octets.
+      @raise Invalid_argument when either [count] or [dk_len] are not valid *)
+  val pbkdf2 : password:Bigstring.t -> salt:Bigstring.t -> count:int -> dk_len:int32 -> Bigstring.t
+end
+
+(** Given a Hash/pseudorandom function, get the PBKDF *)
+module Make (H: Hacl.Hash.S) : S
+
+module SHA256 : S
+module SHA512 : S
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/test/dune b/vendors/tezos-modded/vendors/ocaml-pbkdf/test/dune
new file mode 100644
index 000000000..01ef50a43
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/test/dune
@@ -0,0 +1,7 @@
+(executable
+ (name pbkdf_tests)
+ (libraries pbkdf alcotest))
+
+(alias
+ (name    runtest-pbkdf)
+ (action  (run %{exe:pbkdf_tests.exe})))
diff --git a/vendors/tezos-modded/vendors/ocaml-pbkdf/test/pbkdf_tests.ml b/vendors/tezos-modded/vendors/ocaml-pbkdf/test/pbkdf_tests.ml
new file mode 100644
index 000000000..3b3a1d9a2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-pbkdf/test/pbkdf_tests.ml
@@ -0,0 +1,50 @@
+(* PBKDF2 *)
+let test_pbkdf2 (module A : Hacl.Hash.S) ~password ~salt ~count ~dk_len ~dk =
+  let module P = Pbkdf.Make(A) in
+  let salt = Cstruct.to_bigarray (Hex.to_cstruct (`Hex salt)) in
+  let dk = Cstruct.to_bigarray (Hex.to_cstruct (`Hex dk)) in
+  let password = Bigstring.of_string password in
+  (fun () ->
+     let edk = P.pbkdf2 ~password ~salt ~count ~dk_len in
+     let sedk = Bigstring.to_string edk in
+     let sdk = Bigstring.to_string dk in
+     Alcotest.check Alcotest.string "PBKDF2 test" sedk sdk)
+
+(* let test_pbkdf2_invalid_arg ~prf ~password ~salt ~count ~dk_len ~msg () =
+ *   let salt = Nocrypto.Uncommon.Cs.of_hex salt
+ *   and password = Cstruct.of_string password
+ *   in
+ *   Alcotest.check_raises
+ *     msg
+ *     (Invalid_argument msg)
+ *     (fun () -> ignore (Pbkdf.pbkdf2 ~prf ~password ~salt ~count ~dk_len)) *)
+
+(* Taken from https://github.com/randombit/botan/blob/master/src/tests/data/pbkdf/pbkdf2.vec *)
+
+let pbkdf2_test11 =
+  test_pbkdf2
+    (module Hacl.Hash.SHA256)
+    ~password:"xyz"
+    ~salt:"0001020304050607"
+    ~count: 10000
+    ~dk_len:48l
+    ~dk:"defd2987fa26a4672f4d16d98398432ad95e896bf619f6a6b8d4ed1faf98e8b531b39ffb66966d0e115a6cd8e70b72d0"
+
+let pbkdf2_test13 =
+  test_pbkdf2
+    (module Hacl.Hash.SHA512)
+    ~password:"xyz"
+    ~salt:"0001020304050607"
+    ~count:10000
+    ~dk_len:48l
+    ~dk:"daf8a734327745eb63d19054dbd4018a682cef11086a1bfb63fdbc16158c2f8b0742802f36aef1b1df92accbea5d31a5"
+
+let pbkdf2_tests = [
+  "Test Case 11", `Quick, pbkdf2_test11;
+  "Test Case 13", `Quick, pbkdf2_test13;
+]
+
+let () =
+  Alcotest.run "PBKDF Tests" [
+    "PBKDF2 tests", pbkdf2_tests;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/.gitignore b/vendors/tezos-modded/vendors/ocaml-secp256k1/.gitignore
new file mode 100644
index 000000000..80ffef4ed
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/.gitignore
@@ -0,0 +1,3 @@
+_build
+*.install
+**/.merlin
\ No newline at end of file
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.ml b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.ml
new file mode 100644
index 000000000..3512023ff
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.ml
@@ -0,0 +1,3 @@
+external ml_get_hw_identifier : unit -> string = "ml_get_hw_identifier"
+
+let hw_identifier = ml_get_hw_identifier
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.mli b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.mli
new file mode 100644
index 000000000..97c44adc3
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config.mli
@@ -0,0 +1 @@
+val hw_identifier : unit -> string
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config_stubs.c b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config_stubs.c
new file mode 100644
index 000000000..f4ca8c0d4
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/config_stubs.c
@@ -0,0 +1,15 @@
+#include <sys/utsname.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+
+CAMLprim value ml_get_hw_identifier(value unit) {
+    CAMLparam1(unit);
+    CAMLlocal1(res);
+
+    struct utsname buf;
+    uname(&buf);
+    res = caml_copy_string(buf.machine);
+    CAMLreturn(res);
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/config/discover.ml b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/discover.ml
new file mode 100644
index 000000000..5afb0cfff
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/discover.ml
@@ -0,0 +1,38 @@
+let output_defines ppf symbols =
+  let pp_sep ppf () = Format.pp_print_char ppf ' ' in
+  let pp_symbol ppf sym =
+    match sym with
+    | None -> ()
+    | Some (sym, None) -> Format.fprintf ppf "-D%s" sym
+    | Some (sym, Some def) -> Format.fprintf ppf "-D%s=%s" sym def in
+  let pp = Format.pp_print_list ~pp_sep pp_symbol in
+  Format.fprintf ppf "(%a)%!" pp symbols
+
+let hw = Config.hw_identifier ()
+let sixtyfour = Sys.word_size = 64
+
+let symbols = [
+  (if sixtyfour then Some ("HAVE___INT128", None) else None) ;
+  (if hw = "x86_64" then Some ("USE_ASM_X86_64", None) else None) ;
+  Some ((if sixtyfour then "USE_SCALAR_4X64" else "USE_SCALAR_8X32"), None) ;
+  Some ((if sixtyfour then "USE_FIELD_5X52" else "USE_FIELD_10X26"), None) ;
+  Some ("USE_NUM_GMP", None) ;
+  Some ("USE_SCALAR_INV_NUM", None) ;
+  Some ("USE_FIELD_INV_NUM", None) ;
+  Some ("SECP256K1_INLINE", Some "inline") ;
+  Some ("SECP256K1_RESTRICT", Some "restrict") ;
+
+  Some ("SECP256K1_TAG_PUBKEY_EVEN", Some "0x02") ;
+  Some ("SECP256K1_TAG_PUBKEY_ODD", Some "0x03") ;
+  Some ("SECP256K1_TAG_PUBKEY_UNCOMPRESSED", Some "0x04") ;
+  Some ("SECP256K1_TAG_PUBKEY_HYBRID_EVEN", Some "0x06") ;
+  Some ("SECP256K1_TAG_PUBKEY_HYBRID_ODD", Some "0x07") ;
+
+  Some ("ENABLE_MODULE_RECOVERY", None) ;
+]
+
+let () =
+  let oc = open_out "c_flags.sexp" in
+  let ppf = Format.formatter_of_out_channel oc in
+  output_defines ppf symbols ;
+  close_out oc
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/config/dune b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/dune
new file mode 100644
index 000000000..e3a434e9d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/config/dune
@@ -0,0 +1,9 @@
+(library
+ (name config)
+ (modules config)
+ (c_names config_stubs))
+
+(executable
+ (name discover)
+ (modules discover)
+ (libraries config))
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/secp256k1.opam b/vendors/tezos-modded/vendors/ocaml-secp256k1/secp256k1.opam
new file mode 100644
index 000000000..633362ff2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/secp256k1.opam
@@ -0,0 +1,16 @@
+opam-version: "2.0"
+name: "secp256k1"
+version: "0.1"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+homepage: "https://github.com/vbmithr/ocaml-secp256k1-internal"
+bug-reports: "https://github.com/vbmithr/ocaml-secp256k1-internal/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-secp256k1-internal"
+synopsis: "Bindings to secp256k1 internal functions"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+depends: [
+  "conf-gmp" {build}
+  "dune" {build & >= "1.0.1"}
+  "cstruct" {>= "3.2.1"}
+  "bigstring" {>= "0.1.1"}
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/basic-config.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/basic-config.h
new file mode 100644
index 000000000..fc588061c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/basic-config.h
@@ -0,0 +1,33 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_BASIC_CONFIG_H
+#define SECP256K1_BASIC_CONFIG_H
+
+#ifdef USE_BASIC_CONFIG
+
+#undef USE_ASM_X86_64
+#undef USE_ENDOMORPHISM
+#undef USE_FIELD_10X26
+#undef USE_FIELD_5X52
+#undef USE_FIELD_INV_BUILTIN
+#undef USE_FIELD_INV_NUM
+#undef USE_NUM_GMP
+#undef USE_NUM_NONE
+#undef USE_SCALAR_4X64
+#undef USE_SCALAR_8X32
+#undef USE_SCALAR_INV_BUILTIN
+#undef USE_SCALAR_INV_NUM
+
+#define USE_NUM_NONE 1
+#define USE_FIELD_INV_BUILTIN 1
+#define USE_SCALAR_INV_BUILTIN 1
+#define USE_FIELD_10X26 1
+#define USE_SCALAR_8X32 1
+
+#endif /* USE_BASIC_CONFIG */
+
+#endif /* SECP256K1_BASIC_CONFIG_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/bench.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/bench.h
new file mode 100644
index 000000000..5b59783f6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/bench.h
@@ -0,0 +1,82 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_BENCH_H
+#define SECP256K1_BENCH_H
+
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+#include "sys/time.h"
+
+static double gettimedouble(void) {
+    struct timeval tv;
+    gettimeofday(&tv, NULL);
+    return tv.tv_usec * 0.000001 + tv.tv_sec;
+}
+
+void print_number(double x) {
+    double y = x;
+    int c = 0;
+    if (y < 0.0) {
+        y = -y;
+    }
+    while (y > 0 && y < 100.0) {
+        y *= 10.0;
+        c++;
+    }
+    printf("%.*f", c, x);
+}
+
+void run_benchmark(char *name, void (*benchmark)(void*), void (*setup)(void*), void (*teardown)(void*), void* data, int count, int iter) {
+    int i;
+    double min = HUGE_VAL;
+    double sum = 0.0;
+    double max = 0.0;
+    for (i = 0; i < count; i++) {
+        double begin, total;
+        if (setup != NULL) {
+            setup(data);
+        }
+        begin = gettimedouble();
+        benchmark(data);
+        total = gettimedouble() - begin;
+        if (teardown != NULL) {
+            teardown(data);
+        }
+        if (total < min) {
+            min = total;
+        }
+        if (total > max) {
+            max = total;
+        }
+        sum += total;
+    }
+    printf("%s: min ", name);
+    print_number(min * 1000000.0 / iter);
+    printf("us / avg ");
+    print_number((sum / count) * 1000000.0 / iter);
+    printf("us / max ");
+    print_number(max * 1000000.0 / iter);
+    printf("us\n");
+}
+
+int have_flag(int argc, char** argv, char *flag) {
+    char** argm = argv + argc;
+    argv++;
+    if (argv == argm) {
+        return 1;
+    }
+    while (argv != NULL && argv != argm) {
+        if (strcmp(*argv, flag) == 0) {
+            return 1;
+        }
+        argv++;
+    }
+    return 0;
+}
+
+#endif /* SECP256K1_BENCH_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/dune b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/dune
new file mode 100644
index 000000000..a1f6727dd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/dune
@@ -0,0 +1,13 @@
+(library
+ (name            libsecp256k1)
+ (public_name     secp256k1)
+ (modules         internal external)
+ (libraries       bigstring cstruct)
+ (c_names         secp256k1
+                  secp256k1_wrap)
+ (c_flags         (:include c_flags.sexp))
+ (c_library_flags (-lgmp)))
+
+(rule
+ (targets c_flags.sexp)
+ (action  (run %{exe:../config/discover.exe} -ocamlc %{ocaml})))
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdh.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdh.h
new file mode 100644
index 000000000..71d61b7ef
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdh.h
@@ -0,0 +1,54 @@
+/**********************************************************************
+ * Copyright (c) 2015 Andrew Poelstra                                 *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_MODULE_ECDH_MAIN_H
+#define SECP256K1_MODULE_ECDH_MAIN_H
+
+#include "secp256k1_ecdh.h"
+#include "ecmult_const_impl.h"
+
+int secp256k1_ecdh(const secp256k1_context* ctx, unsigned char *result, const secp256k1_pubkey *point, const unsigned char *scalar) {
+    int ret = 0;
+    int overflow = 0;
+    secp256k1_gej res;
+    secp256k1_ge pt;
+    secp256k1_scalar s;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(result != NULL);
+    ARG_CHECK(point != NULL);
+    ARG_CHECK(scalar != NULL);
+
+    secp256k1_pubkey_load(ctx, &pt, point);
+    secp256k1_scalar_set_b32(&s, scalar, &overflow);
+    if (overflow || secp256k1_scalar_is_zero(&s)) {
+        ret = 0;
+    } else {
+        unsigned char x[32];
+        unsigned char y[1];
+        secp256k1_sha256 sha;
+
+        secp256k1_ecmult_const(&res, &pt, &s);
+        secp256k1_ge_set_gej(&pt, &res);
+        /* Compute a hash of the point in compressed form
+         * Note we cannot use secp256k1_eckey_pubkey_serialize here since it does not
+         * expect its output to be secret and has a timing sidechannel. */
+        secp256k1_fe_normalize(&pt.x);
+        secp256k1_fe_normalize(&pt.y);
+        secp256k1_fe_get_b32(x, &pt.x);
+        y[0] = 0x02 | secp256k1_fe_is_odd(&pt.y);
+
+        secp256k1_sha256_initialize(&sha);
+        secp256k1_sha256_write(&sha, y, sizeof(y));
+        secp256k1_sha256_write(&sha, x, sizeof(x));
+        secp256k1_sha256_finalize(&sha, result);
+        ret = 1;
+    }
+
+    secp256k1_scalar_clear(&s);
+    return ret;
+}
+
+#endif /* SECP256K1_MODULE_ECDH_MAIN_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa.h
new file mode 100644
index 000000000..80590c7cc
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa.h
@@ -0,0 +1,21 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECDSA_H
+#define SECP256K1_ECDSA_H
+
+#include <stddef.h>
+
+#include "scalar.h"
+#include "group.h"
+#include "ecmult.h"
+
+static int secp256k1_ecdsa_sig_parse(secp256k1_scalar *r, secp256k1_scalar *s, const unsigned char *sig, size_t size);
+static int secp256k1_ecdsa_sig_serialize(unsigned char *sig, size_t *size, const secp256k1_scalar *r, const secp256k1_scalar *s);
+static int secp256k1_ecdsa_sig_verify(const secp256k1_ecmult_context *ctx, const secp256k1_scalar* r, const secp256k1_scalar* s, const secp256k1_ge *pubkey, const secp256k1_scalar *message);
+static int secp256k1_ecdsa_sig_sign(const secp256k1_ecmult_gen_context *ctx, secp256k1_scalar* r, secp256k1_scalar* s, const secp256k1_scalar *seckey, const secp256k1_scalar *message, const secp256k1_scalar *nonce, int *recid);
+
+#endif /* SECP256K1_ECDSA_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa_impl.h
new file mode 100644
index 000000000..c3400042d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecdsa_impl.h
@@ -0,0 +1,313 @@
+/**********************************************************************
+ * Copyright (c) 2013-2015 Pieter Wuille                              *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+
+#ifndef SECP256K1_ECDSA_IMPL_H
+#define SECP256K1_ECDSA_IMPL_H
+
+#include "scalar.h"
+#include "field.h"
+#include "group.h"
+#include "ecmult.h"
+#include "ecmult_gen.h"
+#include "ecdsa.h"
+
+/** Group order for secp256k1 defined as 'n' in "Standards for Efficient Cryptography" (SEC2) 2.7.1
+ *  sage: for t in xrange(1023, -1, -1):
+ *     ..   p = 2**256 - 2**32 - t
+ *     ..   if p.is_prime():
+ *     ..     print '%x'%p
+ *     ..     break
+ *   'fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f'
+ *  sage: a = 0
+ *  sage: b = 7
+ *  sage: F = FiniteField (p)
+ *  sage: '%x' % (EllipticCurve ([F (a), F (b)]).order())
+ *   'fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141'
+ */
+static const secp256k1_fe secp256k1_ecdsa_const_order_as_fe = SECP256K1_FE_CONST(
+    0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFEUL,
+    0xBAAEDCE6UL, 0xAF48A03BUL, 0xBFD25E8CUL, 0xD0364141UL
+);
+
+/** Difference between field and order, values 'p' and 'n' values defined in
+ *  "Standards for Efficient Cryptography" (SEC2) 2.7.1.
+ *  sage: p = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F
+ *  sage: a = 0
+ *  sage: b = 7
+ *  sage: F = FiniteField (p)
+ *  sage: '%x' % (p - EllipticCurve ([F (a), F (b)]).order())
+ *   '14551231950b75fc4402da1722fc9baee'
+ */
+static const secp256k1_fe secp256k1_ecdsa_const_p_minus_order = SECP256K1_FE_CONST(
+    0, 0, 0, 1, 0x45512319UL, 0x50B75FC4UL, 0x402DA172UL, 0x2FC9BAEEUL
+);
+
+static int secp256k1_der_read_len(const unsigned char **sigp, const unsigned char *sigend) {
+    int lenleft, b1;
+    size_t ret = 0;
+    if (*sigp >= sigend) {
+        return -1;
+    }
+    b1 = *((*sigp)++);
+    if (b1 == 0xFF) {
+        /* X.690-0207 8.1.3.5.c the value 0xFF shall not be used. */
+        return -1;
+    }
+    if ((b1 & 0x80) == 0) {
+        /* X.690-0207 8.1.3.4 short form length octets */
+        return b1;
+    }
+    if (b1 == 0x80) {
+        /* Indefinite length is not allowed in DER. */
+        return -1;
+    }
+    /* X.690-207 8.1.3.5 long form length octets */
+    lenleft = b1 & 0x7F;
+    if (lenleft > sigend - *sigp) {
+        return -1;
+    }
+    if (**sigp == 0) {
+        /* Not the shortest possible length encoding. */
+        return -1;
+    }
+    if ((size_t)lenleft > sizeof(size_t)) {
+        /* The resulting length would exceed the range of a size_t, so
+         * certainly longer than the passed array size.
+         */
+        return -1;
+    }
+    while (lenleft > 0) {
+        ret = (ret << 8) | **sigp;
+        if (ret + lenleft > (size_t)(sigend - *sigp)) {
+            /* Result exceeds the length of the passed array. */
+            return -1;
+        }
+        (*sigp)++;
+        lenleft--;
+    }
+    if (ret < 128) {
+        /* Not the shortest possible length encoding. */
+        return -1;
+    }
+    return ret;
+}
+
+static int secp256k1_der_parse_integer(secp256k1_scalar *r, const unsigned char **sig, const unsigned char *sigend) {
+    int overflow = 0;
+    unsigned char ra[32] = {0};
+    int rlen;
+
+    if (*sig == sigend || **sig != 0x02) {
+        /* Not a primitive integer (X.690-0207 8.3.1). */
+        return 0;
+    }
+    (*sig)++;
+    rlen = secp256k1_der_read_len(sig, sigend);
+    if (rlen <= 0 || (*sig) + rlen > sigend) {
+        /* Exceeds bounds or not at least length 1 (X.690-0207 8.3.1).  */
+        return 0;
+    }
+    if (**sig == 0x00 && rlen > 1 && (((*sig)[1]) & 0x80) == 0x00) {
+        /* Excessive 0x00 padding. */
+        return 0;
+    }
+    if (**sig == 0xFF && rlen > 1 && (((*sig)[1]) & 0x80) == 0x80) {
+        /* Excessive 0xFF padding. */
+        return 0;
+    }
+    if ((**sig & 0x80) == 0x80) {
+        /* Negative. */
+        overflow = 1;
+    }
+    while (rlen > 0 && **sig == 0) {
+        /* Skip leading zero bytes */
+        rlen--;
+        (*sig)++;
+    }
+    if (rlen > 32) {
+        overflow = 1;
+    }
+    if (!overflow) {
+        memcpy(ra + 32 - rlen, *sig, rlen);
+        secp256k1_scalar_set_b32(r, ra, &overflow);
+    }
+    if (overflow) {
+        secp256k1_scalar_set_int(r, 0);
+    }
+    (*sig) += rlen;
+    return 1;
+}
+
+static int secp256k1_ecdsa_sig_parse(secp256k1_scalar *rr, secp256k1_scalar *rs, const unsigned char *sig, size_t size) {
+    const unsigned char *sigend = sig + size;
+    int rlen;
+    if (sig == sigend || *(sig++) != 0x30) {
+        /* The encoding doesn't start with a constructed sequence (X.690-0207 8.9.1). */
+        return 0;
+    }
+    rlen = secp256k1_der_read_len(&sig, sigend);
+    if (rlen < 0 || sig + rlen > sigend) {
+        /* Tuple exceeds bounds */
+        return 0;
+    }
+    if (sig + rlen != sigend) {
+        /* Garbage after tuple. */
+        return 0;
+    }
+
+    if (!secp256k1_der_parse_integer(rr, &sig, sigend)) {
+        return 0;
+    }
+    if (!secp256k1_der_parse_integer(rs, &sig, sigend)) {
+        return 0;
+    }
+
+    if (sig != sigend) {
+        /* Trailing garbage inside tuple. */
+        return 0;
+    }
+
+    return 1;
+}
+
+static int secp256k1_ecdsa_sig_serialize(unsigned char *sig, size_t *size, const secp256k1_scalar* ar, const secp256k1_scalar* as) {
+    unsigned char r[33] = {0}, s[33] = {0};
+    unsigned char *rp = r, *sp = s;
+    size_t lenR = 33, lenS = 33;
+    secp256k1_scalar_get_b32(&r[1], ar);
+    secp256k1_scalar_get_b32(&s[1], as);
+    while (lenR > 1 && rp[0] == 0 && rp[1] < 0x80) { lenR--; rp++; }
+    while (lenS > 1 && sp[0] == 0 && sp[1] < 0x80) { lenS--; sp++; }
+    if (*size < 6+lenS+lenR) {
+        *size = 6 + lenS + lenR;
+        return 0;
+    }
+    *size = 6 + lenS + lenR;
+    sig[0] = 0x30;
+    sig[1] = 4 + lenS + lenR;
+    sig[2] = 0x02;
+    sig[3] = lenR;
+    memcpy(sig+4, rp, lenR);
+    sig[4+lenR] = 0x02;
+    sig[5+lenR] = lenS;
+    memcpy(sig+lenR+6, sp, lenS);
+    return 1;
+}
+
+static int secp256k1_ecdsa_sig_verify(const secp256k1_ecmult_context *ctx, const secp256k1_scalar *sigr, const secp256k1_scalar *sigs, const secp256k1_ge *pubkey, const secp256k1_scalar *message) {
+    unsigned char c[32];
+    secp256k1_scalar sn, u1, u2;
+#if !defined(EXHAUSTIVE_TEST_ORDER)
+    secp256k1_fe xr;
+#endif
+    secp256k1_gej pubkeyj;
+    secp256k1_gej pr;
+
+    if (secp256k1_scalar_is_zero(sigr) || secp256k1_scalar_is_zero(sigs)) {
+        return 0;
+    }
+
+    secp256k1_scalar_inverse_var(&sn, sigs);
+    secp256k1_scalar_mul(&u1, &sn, message);
+    secp256k1_scalar_mul(&u2, &sn, sigr);
+    secp256k1_gej_set_ge(&pubkeyj, pubkey);
+    secp256k1_ecmult(ctx, &pr, &pubkeyj, &u2, &u1);
+    if (secp256k1_gej_is_infinity(&pr)) {
+        return 0;
+    }
+
+#if defined(EXHAUSTIVE_TEST_ORDER)
+{
+    secp256k1_scalar computed_r;
+    secp256k1_ge pr_ge;
+    secp256k1_ge_set_gej(&pr_ge, &pr);
+    secp256k1_fe_normalize(&pr_ge.x);
+
+    secp256k1_fe_get_b32(c, &pr_ge.x);
+    secp256k1_scalar_set_b32(&computed_r, c, NULL);
+    return secp256k1_scalar_eq(sigr, &computed_r);
+}
+#else
+    secp256k1_scalar_get_b32(c, sigr);
+    secp256k1_fe_set_b32(&xr, c);
+
+    /** We now have the recomputed R point in pr, and its claimed x coordinate (modulo n)
+     *  in xr. Naively, we would extract the x coordinate from pr (requiring a inversion modulo p),
+     *  compute the remainder modulo n, and compare it to xr. However:
+     *
+     *        xr == X(pr) mod n
+     *    <=> exists h. (xr + h * n < p && xr + h * n == X(pr))
+     *    [Since 2 * n > p, h can only be 0 or 1]
+     *    <=> (xr == X(pr)) || (xr + n < p && xr + n == X(pr))
+     *    [In Jacobian coordinates, X(pr) is pr.x / pr.z^2 mod p]
+     *    <=> (xr == pr.x / pr.z^2 mod p) || (xr + n < p && xr + n == pr.x / pr.z^2 mod p)
+     *    [Multiplying both sides of the equations by pr.z^2 mod p]
+     *    <=> (xr * pr.z^2 mod p == pr.x) || (xr + n < p && (xr + n) * pr.z^2 mod p == pr.x)
+     *
+     *  Thus, we can avoid the inversion, but we have to check both cases separately.
+     *  secp256k1_gej_eq_x implements the (xr * pr.z^2 mod p == pr.x) test.
+     */
+    if (secp256k1_gej_eq_x_var(&xr, &pr)) {
+        /* xr * pr.z^2 mod p == pr.x, so the signature is valid. */
+        return 1;
+    }
+    if (secp256k1_fe_cmp_var(&xr, &secp256k1_ecdsa_const_p_minus_order) >= 0) {
+        /* xr + n >= p, so we can skip testing the second case. */
+        return 0;
+    }
+    secp256k1_fe_add(&xr, &secp256k1_ecdsa_const_order_as_fe);
+    if (secp256k1_gej_eq_x_var(&xr, &pr)) {
+        /* (xr + n) * pr.z^2 mod p == pr.x, so the signature is valid. */
+        return 1;
+    }
+    return 0;
+#endif
+}
+
+static int secp256k1_ecdsa_sig_sign(const secp256k1_ecmult_gen_context *ctx, secp256k1_scalar *sigr, secp256k1_scalar *sigs, const secp256k1_scalar *seckey, const secp256k1_scalar *message, const secp256k1_scalar *nonce, int *recid) {
+    unsigned char b[32];
+    secp256k1_gej rp;
+    secp256k1_ge r;
+    secp256k1_scalar n;
+    int overflow = 0;
+
+    secp256k1_ecmult_gen(ctx, &rp, nonce);
+    secp256k1_ge_set_gej(&r, &rp);
+    secp256k1_fe_normalize(&r.x);
+    secp256k1_fe_normalize(&r.y);
+    secp256k1_fe_get_b32(b, &r.x);
+    secp256k1_scalar_set_b32(sigr, b, &overflow);
+    /* These two conditions should be checked before calling */
+    VERIFY_CHECK(!secp256k1_scalar_is_zero(sigr));
+    VERIFY_CHECK(overflow == 0);
+
+    if (recid) {
+        /* The overflow condition is cryptographically unreachable as hitting it requires finding the discrete log
+         * of some P where P.x >= order, and only 1 in about 2^127 points meet this criteria.
+         */
+        *recid = (overflow ? 2 : 0) | (secp256k1_fe_is_odd(&r.y) ? 1 : 0);
+    }
+    secp256k1_scalar_mul(&n, sigr, seckey);
+    secp256k1_scalar_add(&n, &n, message);
+    secp256k1_scalar_inverse(sigs, nonce);
+    secp256k1_scalar_mul(sigs, sigs, &n);
+    secp256k1_scalar_clear(&n);
+    secp256k1_gej_clear(&rp);
+    secp256k1_ge_clear(&r);
+    if (secp256k1_scalar_is_zero(sigs)) {
+        return 0;
+    }
+    if (secp256k1_scalar_is_high(sigs)) {
+        secp256k1_scalar_negate(sigs, sigs);
+        if (recid) {
+            *recid ^= 1;
+        }
+    }
+    return 1;
+}
+
+#endif /* SECP256K1_ECDSA_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey.h
new file mode 100644
index 000000000..b621f1e6c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey.h
@@ -0,0 +1,25 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECKEY_H
+#define SECP256K1_ECKEY_H
+
+#include <stddef.h>
+
+#include "group.h"
+#include "scalar.h"
+#include "ecmult.h"
+#include "ecmult_gen.h"
+
+static int secp256k1_eckey_pubkey_parse(secp256k1_ge *elem, const unsigned char *pub, size_t size);
+static int secp256k1_eckey_pubkey_serialize(secp256k1_ge *elem, unsigned char *pub, size_t *size, int compressed);
+
+static int secp256k1_eckey_privkey_tweak_add(secp256k1_scalar *key, const secp256k1_scalar *tweak);
+static int secp256k1_eckey_pubkey_tweak_add(const secp256k1_ecmult_context *ctx, secp256k1_ge *key, const secp256k1_scalar *tweak);
+static int secp256k1_eckey_privkey_tweak_mul(secp256k1_scalar *key, const secp256k1_scalar *tweak);
+static int secp256k1_eckey_pubkey_tweak_mul(const secp256k1_ecmult_context *ctx, secp256k1_ge *key, const secp256k1_scalar *tweak);
+
+#endif /* SECP256K1_ECKEY_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey_impl.h
new file mode 100644
index 000000000..1ab9a68ec
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/eckey_impl.h
@@ -0,0 +1,100 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECKEY_IMPL_H
+#define SECP256K1_ECKEY_IMPL_H
+
+#include "eckey.h"
+
+#include "scalar.h"
+#include "field.h"
+#include "group.h"
+#include "ecmult_gen.h"
+
+static int secp256k1_eckey_pubkey_parse(secp256k1_ge *elem, const unsigned char *pub, size_t size) {
+    if (size == 33 && (pub[0] == SECP256K1_TAG_PUBKEY_EVEN || pub[0] == SECP256K1_TAG_PUBKEY_ODD)) {
+        secp256k1_fe x;
+        return secp256k1_fe_set_b32(&x, pub+1) && secp256k1_ge_set_xo_var(elem, &x, pub[0] == SECP256K1_TAG_PUBKEY_ODD);
+    } else if (size == 65 && (pub[0] == 0x04 || pub[0] == 0x06 || pub[0] == 0x07)) {
+        secp256k1_fe x, y;
+        if (!secp256k1_fe_set_b32(&x, pub+1) || !secp256k1_fe_set_b32(&y, pub+33)) {
+            return 0;
+        }
+        secp256k1_ge_set_xy(elem, &x, &y);
+        if ((pub[0] == SECP256K1_TAG_PUBKEY_HYBRID_EVEN || pub[0] == SECP256K1_TAG_PUBKEY_HYBRID_ODD) &&
+            secp256k1_fe_is_odd(&y) != (pub[0] == SECP256K1_TAG_PUBKEY_HYBRID_ODD)) {
+            return 0;
+        }
+        return secp256k1_ge_is_valid_var(elem);
+    } else {
+        return 0;
+    }
+}
+
+static int secp256k1_eckey_pubkey_serialize(secp256k1_ge *elem, unsigned char *pub, size_t *size, int compressed) {
+    if (secp256k1_ge_is_infinity(elem)) {
+        return 0;
+    }
+    secp256k1_fe_normalize_var(&elem->x);
+    secp256k1_fe_normalize_var(&elem->y);
+    secp256k1_fe_get_b32(&pub[1], &elem->x);
+    if (compressed) {
+        *size = 33;
+        pub[0] = secp256k1_fe_is_odd(&elem->y) ? SECP256K1_TAG_PUBKEY_ODD : SECP256K1_TAG_PUBKEY_EVEN;
+    } else {
+        *size = 65;
+        pub[0] = SECP256K1_TAG_PUBKEY_UNCOMPRESSED;
+        secp256k1_fe_get_b32(&pub[33], &elem->y);
+    }
+    return 1;
+}
+
+static int secp256k1_eckey_privkey_tweak_add(secp256k1_scalar *key, const secp256k1_scalar *tweak) {
+    secp256k1_scalar_add(key, key, tweak);
+    if (secp256k1_scalar_is_zero(key)) {
+        return 0;
+    }
+    return 1;
+}
+
+static int secp256k1_eckey_pubkey_tweak_add(const secp256k1_ecmult_context *ctx, secp256k1_ge *key, const secp256k1_scalar *tweak) {
+    secp256k1_gej pt;
+    secp256k1_scalar one;
+    secp256k1_gej_set_ge(&pt, key);
+    secp256k1_scalar_set_int(&one, 1);
+    secp256k1_ecmult(ctx, &pt, &pt, &one, tweak);
+
+    if (secp256k1_gej_is_infinity(&pt)) {
+        return 0;
+    }
+    secp256k1_ge_set_gej(key, &pt);
+    return 1;
+}
+
+static int secp256k1_eckey_privkey_tweak_mul(secp256k1_scalar *key, const secp256k1_scalar *tweak) {
+    if (secp256k1_scalar_is_zero(tweak)) {
+        return 0;
+    }
+
+    secp256k1_scalar_mul(key, key, tweak);
+    return 1;
+}
+
+static int secp256k1_eckey_pubkey_tweak_mul(const secp256k1_ecmult_context *ctx, secp256k1_ge *key, const secp256k1_scalar *tweak) {
+    secp256k1_scalar zero;
+    secp256k1_gej pt;
+    if (secp256k1_scalar_is_zero(tweak)) {
+        return 0;
+    }
+
+    secp256k1_scalar_set_int(&zero, 0);
+    secp256k1_gej_set_ge(&pt, key);
+    secp256k1_ecmult(ctx, &pt, &pt, tweak, &zero);
+    secp256k1_ge_set_gej(key, &pt);
+    return 1;
+}
+
+#endif /* SECP256K1_ECKEY_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult.h
new file mode 100644
index 000000000..ea1cd8a21
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult.h
@@ -0,0 +1,47 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014, 2017 Pieter Wuille, Andrew Poelstra      *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECMULT_H
+#define SECP256K1_ECMULT_H
+
+#include "num.h"
+#include "group.h"
+#include "scalar.h"
+#include "scratch.h"
+
+typedef struct {
+    /* For accelerating the computation of a*P + b*G: */
+    secp256k1_ge_storage (*pre_g)[];    /* odd multiples of the generator */
+#ifdef USE_ENDOMORPHISM
+    secp256k1_ge_storage (*pre_g_128)[]; /* odd multiples of 2^128*generator */
+#endif
+} secp256k1_ecmult_context;
+
+static void secp256k1_ecmult_context_init(secp256k1_ecmult_context *ctx);
+static void secp256k1_ecmult_context_build(secp256k1_ecmult_context *ctx, const secp256k1_callback *cb);
+static void secp256k1_ecmult_context_clone(secp256k1_ecmult_context *dst,
+                                           const secp256k1_ecmult_context *src, const secp256k1_callback *cb);
+static void secp256k1_ecmult_context_clear(secp256k1_ecmult_context *ctx);
+static int secp256k1_ecmult_context_is_built(const secp256k1_ecmult_context *ctx);
+
+/** Double multiply: R = na*A + ng*G */
+static void secp256k1_ecmult(const secp256k1_ecmult_context *ctx, secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_scalar *na, const secp256k1_scalar *ng);
+
+typedef int (secp256k1_ecmult_multi_callback)(secp256k1_scalar *sc, secp256k1_ge *pt, size_t idx, void *data);
+
+/**
+ * Multi-multiply: R = inp_g_sc * G + sum_i ni * Ai.
+ * Chooses the right algorithm for a given number of points and scratch space
+ * size. Resets and overwrites the given scratch space. If the points do not
+ * fit in the scratch space the algorithm is repeatedly run with batches of
+ * points.
+ * Returns: 1 on success (including when inp_g_sc is NULL and n is 0)
+ *          0 if there is not enough scratch space for a single point or
+ *          callback returns 0
+ */
+static int secp256k1_ecmult_multi_var(const secp256k1_ecmult_context *ctx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n);
+
+#endif /* SECP256K1_ECMULT_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const.h
new file mode 100644
index 000000000..72bf7d758
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const.h
@@ -0,0 +1,15 @@
+/**********************************************************************
+ * Copyright (c) 2015 Andrew Poelstra                                 *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECMULT_CONST_H
+#define SECP256K1_ECMULT_CONST_H
+
+#include "scalar.h"
+#include "group.h"
+
+static void secp256k1_ecmult_const(secp256k1_gej *r, const secp256k1_ge *a, const secp256k1_scalar *q);
+
+#endif /* SECP256K1_ECMULT_CONST_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const_impl.h
new file mode 100644
index 000000000..fae50020b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_const_impl.h
@@ -0,0 +1,233 @@
+/**********************************************************************
+ * Copyright (c) 2015 Pieter Wuille, Andrew Poelstra                  *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECMULT_CONST_IMPL_H
+#define SECP256K1_ECMULT_CONST_IMPL_H
+
+#include "scalar.h"
+#include "group.h"
+#include "ecmult_const.h"
+#include "ecmult_impl.h"
+
+/* This is like `ECMULT_TABLE_GET_GE` but is constant time */
+#define ECMULT_CONST_TABLE_GET_GE(r,pre,n,w) do { \
+    int m; \
+    int abs_n = (n) * (((n) > 0) * 2 - 1); \
+    int idx_n = abs_n / 2; \
+    secp256k1_fe neg_y; \
+    VERIFY_CHECK(((n) & 1) == 1); \
+    VERIFY_CHECK((n) >= -((1 << ((w)-1)) - 1)); \
+    VERIFY_CHECK((n) <=  ((1 << ((w)-1)) - 1)); \
+    VERIFY_SETUP(secp256k1_fe_clear(&(r)->x)); \
+    VERIFY_SETUP(secp256k1_fe_clear(&(r)->y)); \
+    for (m = 0; m < ECMULT_TABLE_SIZE(w); m++) { \
+        /* This loop is used to avoid secret data in array indices. See
+         * the comment in ecmult_gen_impl.h for rationale. */ \
+        secp256k1_fe_cmov(&(r)->x, &(pre)[m].x, m == idx_n); \
+        secp256k1_fe_cmov(&(r)->y, &(pre)[m].y, m == idx_n); \
+    } \
+    (r)->infinity = 0; \
+    secp256k1_fe_negate(&neg_y, &(r)->y, 1); \
+    secp256k1_fe_cmov(&(r)->y, &neg_y, (n) != abs_n); \
+} while(0)
+
+
+/** Convert a number to WNAF notation.
+ *  The number becomes represented by sum(2^{wi} * wnaf[i], i=0..WNAF_SIZE(w)+1) - return_val.
+ *  It has the following guarantees:
+ *  - each wnaf[i] an odd integer between -(1 << w) and (1 << w)
+ *  - each wnaf[i] is nonzero
+ *  - the number of words set is always WNAF_SIZE(w) + 1
+ *
+ *  Adapted from `The Width-w NAF Method Provides Small Memory and Fast Elliptic Scalar
+ *  Multiplications Secure against Side Channel Attacks`, Okeya and Tagaki. M. Joye (Ed.)
+ *  CT-RSA 2003, LNCS 2612, pp. 328-443, 2003. Springer-Verlagy Berlin Heidelberg 2003
+ *
+ *  Numbers reference steps of `Algorithm SPA-resistant Width-w NAF with Odd Scalar` on pp. 335
+ */
+static int secp256k1_wnaf_const(int *wnaf, secp256k1_scalar s, int w) {
+    int global_sign;
+    int skew = 0;
+    int word = 0;
+
+    /* 1 2 3 */
+    int u_last;
+    int u;
+
+    int flip;
+    int bit;
+    secp256k1_scalar neg_s;
+    int not_neg_one;
+    /* Note that we cannot handle even numbers by negating them to be odd, as is
+     * done in other implementations, since if our scalars were specified to have
+     * width < 256 for performance reasons, their negations would have width 256
+     * and we'd lose any performance benefit. Instead, we use a technique from
+     * Section 4.2 of the Okeya/Tagaki paper, which is to add either 1 (for even)
+     * or 2 (for odd) to the number we are encoding, returning a skew value indicating
+     * this, and having the caller compensate after doing the multiplication. */
+
+    /* Negative numbers will be negated to keep their bit representation below the maximum width */
+    flip = secp256k1_scalar_is_high(&s);
+    /* We add 1 to even numbers, 2 to odd ones, noting that negation flips parity */
+    bit = flip ^ !secp256k1_scalar_is_even(&s);
+    /* We check for negative one, since adding 2 to it will cause an overflow */
+    secp256k1_scalar_negate(&neg_s, &s);
+    not_neg_one = !secp256k1_scalar_is_one(&neg_s);
+    secp256k1_scalar_cadd_bit(&s, bit, not_neg_one);
+    /* If we had negative one, flip == 1, s.d[0] == 0, bit == 1, so caller expects
+     * that we added two to it and flipped it. In fact for -1 these operations are
+     * identical. We only flipped, but since skewing is required (in the sense that
+     * the skew must be 1 or 2, never zero) and flipping is not, we need to change
+     * our flags to claim that we only skewed. */
+    global_sign = secp256k1_scalar_cond_negate(&s, flip);
+    global_sign *= not_neg_one * 2 - 1;
+    skew = 1 << bit;
+
+    /* 4 */
+    u_last = secp256k1_scalar_shr_int(&s, w);
+    while (word * w < WNAF_BITS) {
+        int sign;
+        int even;
+
+        /* 4.1 4.4 */
+        u = secp256k1_scalar_shr_int(&s, w);
+        /* 4.2 */
+        even = ((u & 1) == 0);
+        sign = 2 * (u_last > 0) - 1;
+        u += sign * even;
+        u_last -= sign * even * (1 << w);
+
+        /* 4.3, adapted for global sign change */
+        wnaf[word++] = u_last * global_sign;
+
+        u_last = u;
+    }
+    wnaf[word] = u * global_sign;
+
+    VERIFY_CHECK(secp256k1_scalar_is_zero(&s));
+    VERIFY_CHECK(word == WNAF_SIZE(w));
+    return skew;
+}
+
+
+static void secp256k1_ecmult_const(secp256k1_gej *r, const secp256k1_ge *a, const secp256k1_scalar *scalar) {
+    secp256k1_ge pre_a[ECMULT_TABLE_SIZE(WINDOW_A)];
+    secp256k1_ge tmpa;
+    secp256k1_fe Z;
+
+    int skew_1;
+    int wnaf_1[1 + WNAF_SIZE(WINDOW_A - 1)];
+#ifdef USE_ENDOMORPHISM
+    secp256k1_ge pre_a_lam[ECMULT_TABLE_SIZE(WINDOW_A)];
+    int wnaf_lam[1 + WNAF_SIZE(WINDOW_A - 1)];
+    int skew_lam;
+    secp256k1_scalar q_1, q_lam;
+#endif
+
+    int i;
+    secp256k1_scalar sc = *scalar;
+
+    /* build wnaf representation for q. */
+#ifdef USE_ENDOMORPHISM
+    /* split q into q_1 and q_lam (where q = q_1 + q_lam*lambda, and q_1 and q_lam are ~128 bit) */
+    secp256k1_scalar_split_lambda(&q_1, &q_lam, &sc);
+    skew_1   = secp256k1_wnaf_const(wnaf_1,   q_1,   WINDOW_A - 1);
+    skew_lam = secp256k1_wnaf_const(wnaf_lam, q_lam, WINDOW_A - 1);
+#else
+    skew_1   = secp256k1_wnaf_const(wnaf_1, sc, WINDOW_A - 1);
+#endif
+
+    /* Calculate odd multiples of a.
+     * All multiples are brought to the same Z 'denominator', which is stored
+     * in Z. Due to secp256k1' isomorphism we can do all operations pretending
+     * that the Z coordinate was 1, use affine addition formulae, and correct
+     * the Z coordinate of the result once at the end.
+     */
+    secp256k1_gej_set_ge(r, a);
+    secp256k1_ecmult_odd_multiples_table_globalz_windowa(pre_a, &Z, r);
+    for (i = 0; i < ECMULT_TABLE_SIZE(WINDOW_A); i++) {
+        secp256k1_fe_normalize_weak(&pre_a[i].y);
+    }
+#ifdef USE_ENDOMORPHISM
+    for (i = 0; i < ECMULT_TABLE_SIZE(WINDOW_A); i++) {
+        secp256k1_ge_mul_lambda(&pre_a_lam[i], &pre_a[i]);
+    }
+#endif
+
+    /* first loop iteration (separated out so we can directly set r, rather
+     * than having it start at infinity, get doubled several times, then have
+     * its new value added to it) */
+    i = wnaf_1[WNAF_SIZE(WINDOW_A - 1)];
+    VERIFY_CHECK(i != 0);
+    ECMULT_CONST_TABLE_GET_GE(&tmpa, pre_a, i, WINDOW_A);
+    secp256k1_gej_set_ge(r, &tmpa);
+#ifdef USE_ENDOMORPHISM
+    i = wnaf_lam[WNAF_SIZE(WINDOW_A - 1)];
+    VERIFY_CHECK(i != 0);
+    ECMULT_CONST_TABLE_GET_GE(&tmpa, pre_a_lam, i, WINDOW_A);
+    secp256k1_gej_add_ge(r, r, &tmpa);
+#endif
+    /* remaining loop iterations */
+    for (i = WNAF_SIZE(WINDOW_A - 1) - 1; i >= 0; i--) {
+        int n;
+        int j;
+        for (j = 0; j < WINDOW_A - 1; ++j) {
+            secp256k1_gej_double_nonzero(r, r, NULL);
+        }
+
+        n = wnaf_1[i];
+        ECMULT_CONST_TABLE_GET_GE(&tmpa, pre_a, n, WINDOW_A);
+        VERIFY_CHECK(n != 0);
+        secp256k1_gej_add_ge(r, r, &tmpa);
+#ifdef USE_ENDOMORPHISM
+        n = wnaf_lam[i];
+        ECMULT_CONST_TABLE_GET_GE(&tmpa, pre_a_lam, n, WINDOW_A);
+        VERIFY_CHECK(n != 0);
+        secp256k1_gej_add_ge(r, r, &tmpa);
+#endif
+    }
+
+    secp256k1_fe_mul(&r->z, &r->z, &Z);
+
+    {
+        /* Correct for wNAF skew */
+        secp256k1_ge correction = *a;
+        secp256k1_ge_storage correction_1_stor;
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ge_storage correction_lam_stor;
+#endif
+        secp256k1_ge_storage a2_stor;
+        secp256k1_gej tmpj;
+        secp256k1_gej_set_ge(&tmpj, &correction);
+        secp256k1_gej_double_var(&tmpj, &tmpj, NULL);
+        secp256k1_ge_set_gej(&correction, &tmpj);
+        secp256k1_ge_to_storage(&correction_1_stor, a);
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ge_to_storage(&correction_lam_stor, a);
+#endif
+        secp256k1_ge_to_storage(&a2_stor, &correction);
+
+        /* For odd numbers this is 2a (so replace it), for even ones a (so no-op) */
+        secp256k1_ge_storage_cmov(&correction_1_stor, &a2_stor, skew_1 == 2);
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ge_storage_cmov(&correction_lam_stor, &a2_stor, skew_lam == 2);
+#endif
+
+        /* Apply the correction */
+        secp256k1_ge_from_storage(&correction, &correction_1_stor);
+        secp256k1_ge_neg(&correction, &correction);
+        secp256k1_gej_add_ge(r, r, &correction);
+
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ge_from_storage(&correction, &correction_lam_stor);
+        secp256k1_ge_neg(&correction, &correction);
+        secp256k1_ge_mul_lambda(&correction, &correction);
+        secp256k1_gej_add_ge(r, r, &correction);
+#endif
+    }
+}
+
+#endif /* SECP256K1_ECMULT_CONST_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen.h
new file mode 100644
index 000000000..7564b7015
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen.h
@@ -0,0 +1,43 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECMULT_GEN_H
+#define SECP256K1_ECMULT_GEN_H
+
+#include "scalar.h"
+#include "group.h"
+
+typedef struct {
+    /* For accelerating the computation of a*G:
+     * To harden against timing attacks, use the following mechanism:
+     * * Break up the multiplicand into groups of 4 bits, called n_0, n_1, n_2, ..., n_63.
+     * * Compute sum(n_i * 16^i * G + U_i, i=0..63), where:
+     *   * U_i = U * 2^i (for i=0..62)
+     *   * U_i = U * (1-2^63) (for i=63)
+     *   where U is a point with no known corresponding scalar. Note that sum(U_i, i=0..63) = 0.
+     * For each i, and each of the 16 possible values of n_i, (n_i * 16^i * G + U_i) is
+     * precomputed (call it prec(i, n_i)). The formula now becomes sum(prec(i, n_i), i=0..63).
+     * None of the resulting prec group elements have a known scalar, and neither do any of
+     * the intermediate sums while computing a*G.
+     */
+    secp256k1_ge_storage (*prec)[64][16]; /* prec[j][i] = 16^j * i * G + U_i */
+    secp256k1_scalar blind;
+    secp256k1_gej initial;
+} secp256k1_ecmult_gen_context;
+
+static void secp256k1_ecmult_gen_context_init(secp256k1_ecmult_gen_context* ctx);
+static void secp256k1_ecmult_gen_context_build(secp256k1_ecmult_gen_context* ctx, const secp256k1_callback* cb);
+static void secp256k1_ecmult_gen_context_clone(secp256k1_ecmult_gen_context *dst,
+                                               const secp256k1_ecmult_gen_context* src, const secp256k1_callback* cb);
+static void secp256k1_ecmult_gen_context_clear(secp256k1_ecmult_gen_context* ctx);
+static int secp256k1_ecmult_gen_context_is_built(const secp256k1_ecmult_gen_context* ctx);
+
+/** Multiply with the generator: R = a*G */
+static void secp256k1_ecmult_gen(const secp256k1_ecmult_gen_context* ctx, secp256k1_gej *r, const secp256k1_scalar *a);
+
+static void secp256k1_ecmult_gen_blind(secp256k1_ecmult_gen_context *ctx, const unsigned char *seed32);
+
+#endif /* SECP256K1_ECMULT_GEN_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen_impl.h
new file mode 100644
index 000000000..714f02e94
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_gen_impl.h
@@ -0,0 +1,210 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014, 2015 Pieter Wuille, Gregory Maxwell      *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_ECMULT_GEN_IMPL_H
+#define SECP256K1_ECMULT_GEN_IMPL_H
+
+#include "scalar.h"
+#include "group.h"
+#include "ecmult_gen.h"
+#include "hash_impl.h"
+#ifdef USE_ECMULT_STATIC_PRECOMPUTATION
+#include "ecmult_static_context.h"
+#endif
+static void secp256k1_ecmult_gen_context_init(secp256k1_ecmult_gen_context *ctx) {
+    ctx->prec = NULL;
+}
+
+static void secp256k1_ecmult_gen_context_build(secp256k1_ecmult_gen_context *ctx, const secp256k1_callback* cb) {
+#ifndef USE_ECMULT_STATIC_PRECOMPUTATION
+    secp256k1_ge prec[1024];
+    secp256k1_gej gj;
+    secp256k1_gej nums_gej;
+    int i, j;
+#endif
+
+    if (ctx->prec != NULL) {
+        return;
+    }
+#ifndef USE_ECMULT_STATIC_PRECOMPUTATION
+    ctx->prec = (secp256k1_ge_storage (*)[64][16])checked_malloc(cb, sizeof(*ctx->prec));
+
+    /* get the generator */
+    secp256k1_gej_set_ge(&gj, &secp256k1_ge_const_g);
+
+    /* Construct a group element with no known corresponding scalar (nothing up my sleeve). */
+    {
+        static const unsigned char nums_b32[33] = "The scalar for this x is unknown";
+        secp256k1_fe nums_x;
+        secp256k1_ge nums_ge;
+        int r;
+        r = secp256k1_fe_set_b32(&nums_x, nums_b32);
+        (void)r;
+        VERIFY_CHECK(r);
+        r = secp256k1_ge_set_xo_var(&nums_ge, &nums_x, 0);
+        (void)r;
+        VERIFY_CHECK(r);
+        secp256k1_gej_set_ge(&nums_gej, &nums_ge);
+        /* Add G to make the bits in x uniformly distributed. */
+        secp256k1_gej_add_ge_var(&nums_gej, &nums_gej, &secp256k1_ge_const_g, NULL);
+    }
+
+    /* compute prec. */
+    {
+        secp256k1_gej precj[1024]; /* Jacobian versions of prec. */
+        secp256k1_gej gbase;
+        secp256k1_gej numsbase;
+        gbase = gj; /* 16^j * G */
+        numsbase = nums_gej; /* 2^j * nums. */
+        for (j = 0; j < 64; j++) {
+            /* Set precj[j*16 .. j*16+15] to (numsbase, numsbase + gbase, ..., numsbase + 15*gbase). */
+            precj[j*16] = numsbase;
+            for (i = 1; i < 16; i++) {
+                secp256k1_gej_add_var(&precj[j*16 + i], &precj[j*16 + i - 1], &gbase, NULL);
+            }
+            /* Multiply gbase by 16. */
+            for (i = 0; i < 4; i++) {
+                secp256k1_gej_double_var(&gbase, &gbase, NULL);
+            }
+            /* Multiply numbase by 2. */
+            secp256k1_gej_double_var(&numsbase, &numsbase, NULL);
+            if (j == 62) {
+                /* In the last iteration, numsbase is (1 - 2^j) * nums instead. */
+                secp256k1_gej_neg(&numsbase, &numsbase);
+                secp256k1_gej_add_var(&numsbase, &numsbase, &nums_gej, NULL);
+            }
+        }
+        secp256k1_ge_set_all_gej_var(prec, precj, 1024, cb);
+    }
+    for (j = 0; j < 64; j++) {
+        for (i = 0; i < 16; i++) {
+            secp256k1_ge_to_storage(&(*ctx->prec)[j][i], &prec[j*16 + i]);
+        }
+    }
+#else
+    (void)cb;
+    ctx->prec = (secp256k1_ge_storage (*)[64][16])secp256k1_ecmult_static_context;
+#endif
+    secp256k1_ecmult_gen_blind(ctx, NULL);
+}
+
+static int secp256k1_ecmult_gen_context_is_built(const secp256k1_ecmult_gen_context* ctx) {
+    return ctx->prec != NULL;
+}
+
+static void secp256k1_ecmult_gen_context_clone(secp256k1_ecmult_gen_context *dst,
+                                               const secp256k1_ecmult_gen_context *src, const secp256k1_callback* cb) {
+    if (src->prec == NULL) {
+        dst->prec = NULL;
+    } else {
+#ifndef USE_ECMULT_STATIC_PRECOMPUTATION
+        dst->prec = (secp256k1_ge_storage (*)[64][16])checked_malloc(cb, sizeof(*dst->prec));
+        memcpy(dst->prec, src->prec, sizeof(*dst->prec));
+#else
+        (void)cb;
+        dst->prec = src->prec;
+#endif
+        dst->initial = src->initial;
+        dst->blind = src->blind;
+    }
+}
+
+static void secp256k1_ecmult_gen_context_clear(secp256k1_ecmult_gen_context *ctx) {
+#ifndef USE_ECMULT_STATIC_PRECOMPUTATION
+    free(ctx->prec);
+#endif
+    secp256k1_scalar_clear(&ctx->blind);
+    secp256k1_gej_clear(&ctx->initial);
+    ctx->prec = NULL;
+}
+
+static void secp256k1_ecmult_gen(const secp256k1_ecmult_gen_context *ctx, secp256k1_gej *r, const secp256k1_scalar *gn) {
+    secp256k1_ge add;
+    secp256k1_ge_storage adds;
+    secp256k1_scalar gnb;
+    int bits;
+    int i, j;
+    memset(&adds, 0, sizeof(adds));
+    *r = ctx->initial;
+    /* Blind scalar/point multiplication by computing (n-b)G + bG instead of nG. */
+    secp256k1_scalar_add(&gnb, gn, &ctx->blind);
+    add.infinity = 0;
+    for (j = 0; j < 64; j++) {
+        bits = secp256k1_scalar_get_bits(&gnb, j * 4, 4);
+        for (i = 0; i < 16; i++) {
+            /** This uses a conditional move to avoid any secret data in array indexes.
+             *   _Any_ use of secret indexes has been demonstrated to result in timing
+             *   sidechannels, even when the cache-line access patterns are uniform.
+             *  See also:
+             *   "A word of warning", CHES 2013 Rump Session, by Daniel J. Bernstein and Peter Schwabe
+             *    (https://cryptojedi.org/peter/data/chesrump-20130822.pdf) and
+             *   "Cache Attacks and Countermeasures: the Case of AES", RSA 2006,
+             *    by Dag Arne Osvik, Adi Shamir, and Eran Tromer
+             *    (http://www.tau.ac.il/~tromer/papers/cache.pdf)
+             */
+            secp256k1_ge_storage_cmov(&adds, &(*ctx->prec)[j][i], i == bits);
+        }
+        secp256k1_ge_from_storage(&add, &adds);
+        secp256k1_gej_add_ge(r, r, &add);
+    }
+    bits = 0;
+    secp256k1_ge_clear(&add);
+    secp256k1_scalar_clear(&gnb);
+}
+
+/* Setup blinding values for secp256k1_ecmult_gen. */
+static void secp256k1_ecmult_gen_blind(secp256k1_ecmult_gen_context *ctx, const unsigned char *seed32) {
+    secp256k1_scalar b;
+    secp256k1_gej gb;
+    secp256k1_fe s;
+    unsigned char nonce32[32];
+    secp256k1_rfc6979_hmac_sha256 rng;
+    int retry;
+    unsigned char keydata[64] = {0};
+    if (seed32 == NULL) {
+        /* When seed is NULL, reset the initial point and blinding value. */
+        secp256k1_gej_set_ge(&ctx->initial, &secp256k1_ge_const_g);
+        secp256k1_gej_neg(&ctx->initial, &ctx->initial);
+        secp256k1_scalar_set_int(&ctx->blind, 1);
+    }
+    /* The prior blinding value (if not reset) is chained forward by including it in the hash. */
+    secp256k1_scalar_get_b32(nonce32, &ctx->blind);
+    /** Using a CSPRNG allows a failure free interface, avoids needing large amounts of random data,
+     *   and guards against weak or adversarial seeds.  This is a simpler and safer interface than
+     *   asking the caller for blinding values directly and expecting them to retry on failure.
+     */
+    memcpy(keydata, nonce32, 32);
+    if (seed32 != NULL) {
+        memcpy(keydata + 32, seed32, 32);
+    }
+    secp256k1_rfc6979_hmac_sha256_initialize(&rng, keydata, seed32 ? 64 : 32);
+    memset(keydata, 0, sizeof(keydata));
+    /* Retry for out of range results to achieve uniformity. */
+    do {
+        secp256k1_rfc6979_hmac_sha256_generate(&rng, nonce32, 32);
+        retry = !secp256k1_fe_set_b32(&s, nonce32);
+        retry |= secp256k1_fe_is_zero(&s);
+    } while (retry); /* This branch true is cryptographically unreachable. Requires sha256_hmac output > Fp. */
+    /* Randomize the projection to defend against multiplier sidechannels. */
+    secp256k1_gej_rescale(&ctx->initial, &s);
+    secp256k1_fe_clear(&s);
+    do {
+        secp256k1_rfc6979_hmac_sha256_generate(&rng, nonce32, 32);
+        secp256k1_scalar_set_b32(&b, nonce32, &retry);
+        /* A blinding value of 0 works, but would undermine the projection hardening. */
+        retry |= secp256k1_scalar_is_zero(&b);
+    } while (retry); /* This branch true is cryptographically unreachable. Requires sha256_hmac output > order. */
+    secp256k1_rfc6979_hmac_sha256_finalize(&rng);
+    memset(nonce32, 0, 32);
+    secp256k1_ecmult_gen(ctx, &gb, &b);
+    secp256k1_scalar_negate(&b, &b);
+    ctx->blind = b;
+    ctx->initial = gb;
+    secp256k1_scalar_clear(&b);
+    secp256k1_gej_clear(&gb);
+}
+
+#endif /* SECP256K1_ECMULT_GEN_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_impl.h
new file mode 100644
index 000000000..a9eb77d8b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_impl.h
@@ -0,0 +1,1011 @@
+/*****************************************************************************
+ * Copyright (c) 2013, 2014, 2017 Pieter Wuille, Andrew Poelstra, Jonas Nick *
+ * Distributed under the MIT software license, see the accompanying          *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.       *
+ *****************************************************************************/
+
+#ifndef SECP256K1_ECMULT_IMPL_H
+#define SECP256K1_ECMULT_IMPL_H
+
+#include <string.h>
+#include <stdint.h>
+
+#include "group.h"
+#include "scalar.h"
+#include "ecmult.h"
+
+#if defined(EXHAUSTIVE_TEST_ORDER)
+/* We need to lower these values for exhaustive tests because
+ * the tables cannot have infinities in them (this breaks the
+ * affine-isomorphism stuff which tracks z-ratios) */
+#  if EXHAUSTIVE_TEST_ORDER > 128
+#    define WINDOW_A 5
+#    define WINDOW_G 8
+#  elif EXHAUSTIVE_TEST_ORDER > 8
+#    define WINDOW_A 4
+#    define WINDOW_G 4
+#  else
+#    define WINDOW_A 2
+#    define WINDOW_G 2
+#  endif
+#else
+/* optimal for 128-bit and 256-bit exponents. */
+#define WINDOW_A 5
+/** larger numbers may result in slightly better performance, at the cost of
+    exponentially larger precomputed tables. */
+#ifdef USE_ENDOMORPHISM
+/** Two tables for window size 15: 1.375 MiB. */
+#define WINDOW_G 15
+#else
+/** One table for window size 16: 1.375 MiB. */
+#define WINDOW_G 16
+#endif
+#endif
+
+#ifdef USE_ENDOMORPHISM
+    #define WNAF_BITS 128
+#else
+    #define WNAF_BITS 256
+#endif
+#define WNAF_SIZE(w) ((WNAF_BITS + (w) - 1) / (w))
+
+/** The number of entries a table with precomputed multiples needs to have. */
+#define ECMULT_TABLE_SIZE(w) (1 << ((w)-2))
+
+/* The number of objects allocated on the scratch space for ecmult_multi algorithms */
+#define PIPPENGER_SCRATCH_OBJECTS 6
+#define STRAUSS_SCRATCH_OBJECTS 6
+
+#define PIPPENGER_MAX_BUCKET_WINDOW 12
+
+/* Minimum number of points for which pippenger_wnaf is faster than strauss wnaf */
+#ifdef USE_ENDOMORPHISM
+    #define ECMULT_PIPPENGER_THRESHOLD 88
+#else
+    #define ECMULT_PIPPENGER_THRESHOLD 160
+#endif
+
+#ifdef USE_ENDOMORPHISM
+    #define ECMULT_MAX_POINTS_PER_BATCH 5000000
+#else
+    #define ECMULT_MAX_POINTS_PER_BATCH 10000000
+#endif
+
+/** Fill a table 'prej' with precomputed odd multiples of a. Prej will contain
+ *  the values [1*a,3*a,...,(2*n-1)*a], so it space for n values. zr[0] will
+ *  contain prej[0].z / a.z. The other zr[i] values = prej[i].z / prej[i-1].z.
+ *  Prej's Z values are undefined, except for the last value.
+ */
+static void secp256k1_ecmult_odd_multiples_table(int n, secp256k1_gej *prej, secp256k1_fe *zr, const secp256k1_gej *a) {
+    secp256k1_gej d;
+    secp256k1_ge a_ge, d_ge;
+    int i;
+
+    VERIFY_CHECK(!a->infinity);
+
+    secp256k1_gej_double_var(&d, a, NULL);
+
+    /*
+     * Perform the additions on an isomorphism where 'd' is affine: drop the z coordinate
+     * of 'd', and scale the 1P starting value's x/y coordinates without changing its z.
+     */
+    d_ge.x = d.x;
+    d_ge.y = d.y;
+    d_ge.infinity = 0;
+
+    secp256k1_ge_set_gej_zinv(&a_ge, a, &d.z);
+    prej[0].x = a_ge.x;
+    prej[0].y = a_ge.y;
+    prej[0].z = a->z;
+    prej[0].infinity = 0;
+
+    zr[0] = d.z;
+    for (i = 1; i < n; i++) {
+        secp256k1_gej_add_ge_var(&prej[i], &prej[i-1], &d_ge, &zr[i]);
+    }
+
+    /*
+     * Each point in 'prej' has a z coordinate too small by a factor of 'd.z'. Only
+     * the final point's z coordinate is actually used though, so just update that.
+     */
+    secp256k1_fe_mul(&prej[n-1].z, &prej[n-1].z, &d.z);
+}
+
+/** Fill a table 'pre' with precomputed odd multiples of a.
+ *
+ *  There are two versions of this function:
+ *  - secp256k1_ecmult_odd_multiples_table_globalz_windowa which brings its
+ *    resulting point set to a single constant Z denominator, stores the X and Y
+ *    coordinates as ge_storage points in pre, and stores the global Z in rz.
+ *    It only operates on tables sized for WINDOW_A wnaf multiples.
+ *  - secp256k1_ecmult_odd_multiples_table_storage_var, which converts its
+ *    resulting point set to actually affine points, and stores those in pre.
+ *    It operates on tables of any size, but uses heap-allocated temporaries.
+ *
+ *  To compute a*P + b*G, we compute a table for P using the first function,
+ *  and for G using the second (which requires an inverse, but it only needs to
+ *  happen once).
+ */
+static void secp256k1_ecmult_odd_multiples_table_globalz_windowa(secp256k1_ge *pre, secp256k1_fe *globalz, const secp256k1_gej *a) {
+    secp256k1_gej prej[ECMULT_TABLE_SIZE(WINDOW_A)];
+    secp256k1_fe zr[ECMULT_TABLE_SIZE(WINDOW_A)];
+
+    /* Compute the odd multiples in Jacobian form. */
+    secp256k1_ecmult_odd_multiples_table(ECMULT_TABLE_SIZE(WINDOW_A), prej, zr, a);
+    /* Bring them to the same Z denominator. */
+    secp256k1_ge_globalz_set_table_gej(ECMULT_TABLE_SIZE(WINDOW_A), pre, globalz, prej, zr);
+}
+
+static void secp256k1_ecmult_odd_multiples_table_storage_var(int n, secp256k1_ge_storage *pre, const secp256k1_gej *a, const secp256k1_callback *cb) {
+    secp256k1_gej *prej = (secp256k1_gej*)checked_malloc(cb, sizeof(secp256k1_gej) * n);
+    secp256k1_ge *prea = (secp256k1_ge*)checked_malloc(cb, sizeof(secp256k1_ge) * n);
+    secp256k1_fe *zr = (secp256k1_fe*)checked_malloc(cb, sizeof(secp256k1_fe) * n);
+    int i;
+
+    /* Compute the odd multiples in Jacobian form. */
+    secp256k1_ecmult_odd_multiples_table(n, prej, zr, a);
+    /* Convert them in batch to affine coordinates. */
+    secp256k1_ge_set_table_gej_var(prea, prej, zr, n);
+    /* Convert them to compact storage form. */
+    for (i = 0; i < n; i++) {
+        secp256k1_ge_to_storage(&pre[i], &prea[i]);
+    }
+
+    free(prea);
+    free(prej);
+    free(zr);
+}
+
+/** The following two macro retrieves a particular odd multiple from a table
+ *  of precomputed multiples. */
+#define ECMULT_TABLE_GET_GE(r,pre,n,w) do { \
+    VERIFY_CHECK(((n) & 1) == 1); \
+    VERIFY_CHECK((n) >= -((1 << ((w)-1)) - 1)); \
+    VERIFY_CHECK((n) <=  ((1 << ((w)-1)) - 1)); \
+    if ((n) > 0) { \
+        *(r) = (pre)[((n)-1)/2]; \
+    } else { \
+        secp256k1_ge_neg((r), &(pre)[(-(n)-1)/2]); \
+    } \
+} while(0)
+
+#define ECMULT_TABLE_GET_GE_STORAGE(r,pre,n,w) do { \
+    VERIFY_CHECK(((n) & 1) == 1); \
+    VERIFY_CHECK((n) >= -((1 << ((w)-1)) - 1)); \
+    VERIFY_CHECK((n) <=  ((1 << ((w)-1)) - 1)); \
+    if ((n) > 0) { \
+        secp256k1_ge_from_storage((r), &(pre)[((n)-1)/2]); \
+    } else { \
+        secp256k1_ge_from_storage((r), &(pre)[(-(n)-1)/2]); \
+        secp256k1_ge_neg((r), (r)); \
+    } \
+} while(0)
+
+static void secp256k1_ecmult_context_init(secp256k1_ecmult_context *ctx) {
+    ctx->pre_g = NULL;
+#ifdef USE_ENDOMORPHISM
+    ctx->pre_g_128 = NULL;
+#endif
+}
+
+static void secp256k1_ecmult_context_build(secp256k1_ecmult_context *ctx, const secp256k1_callback *cb) {
+    secp256k1_gej gj;
+
+    if (ctx->pre_g != NULL) {
+        return;
+    }
+
+    /* get the generator */
+    secp256k1_gej_set_ge(&gj, &secp256k1_ge_const_g);
+
+    ctx->pre_g = (secp256k1_ge_storage (*)[])checked_malloc(cb, sizeof((*ctx->pre_g)[0]) * ECMULT_TABLE_SIZE(WINDOW_G));
+
+    /* precompute the tables with odd multiples */
+    secp256k1_ecmult_odd_multiples_table_storage_var(ECMULT_TABLE_SIZE(WINDOW_G), *ctx->pre_g, &gj, cb);
+
+#ifdef USE_ENDOMORPHISM
+    {
+        secp256k1_gej g_128j;
+        int i;
+
+        ctx->pre_g_128 = (secp256k1_ge_storage (*)[])checked_malloc(cb, sizeof((*ctx->pre_g_128)[0]) * ECMULT_TABLE_SIZE(WINDOW_G));
+
+        /* calculate 2^128*generator */
+        g_128j = gj;
+        for (i = 0; i < 128; i++) {
+            secp256k1_gej_double_var(&g_128j, &g_128j, NULL);
+        }
+        secp256k1_ecmult_odd_multiples_table_storage_var(ECMULT_TABLE_SIZE(WINDOW_G), *ctx->pre_g_128, &g_128j, cb);
+    }
+#endif
+}
+
+static void secp256k1_ecmult_context_clone(secp256k1_ecmult_context *dst,
+                                           const secp256k1_ecmult_context *src, const secp256k1_callback *cb) {
+    if (src->pre_g == NULL) {
+        dst->pre_g = NULL;
+    } else {
+        size_t size = sizeof((*dst->pre_g)[0]) * ECMULT_TABLE_SIZE(WINDOW_G);
+        dst->pre_g = (secp256k1_ge_storage (*)[])checked_malloc(cb, size);
+        memcpy(dst->pre_g, src->pre_g, size);
+    }
+#ifdef USE_ENDOMORPHISM
+    if (src->pre_g_128 == NULL) {
+        dst->pre_g_128 = NULL;
+    } else {
+        size_t size = sizeof((*dst->pre_g_128)[0]) * ECMULT_TABLE_SIZE(WINDOW_G);
+        dst->pre_g_128 = (secp256k1_ge_storage (*)[])checked_malloc(cb, size);
+        memcpy(dst->pre_g_128, src->pre_g_128, size);
+    }
+#endif
+}
+
+static int secp256k1_ecmult_context_is_built(const secp256k1_ecmult_context *ctx) {
+    return ctx->pre_g != NULL;
+}
+
+static void secp256k1_ecmult_context_clear(secp256k1_ecmult_context *ctx) {
+    free(ctx->pre_g);
+#ifdef USE_ENDOMORPHISM
+    free(ctx->pre_g_128);
+#endif
+    secp256k1_ecmult_context_init(ctx);
+}
+
+/** Convert a number to WNAF notation. The number becomes represented by sum(2^i * wnaf[i], i=0..bits),
+ *  with the following guarantees:
+ *  - each wnaf[i] is either 0, or an odd integer between -(1<<(w-1) - 1) and (1<<(w-1) - 1)
+ *  - two non-zero entries in wnaf are separated by at least w-1 zeroes.
+ *  - the number of set values in wnaf is returned. This number is at most 256, and at most one more
+ *    than the number of bits in the (absolute value) of the input.
+ */
+static int secp256k1_ecmult_wnaf(int *wnaf, int len, const secp256k1_scalar *a, int w) {
+    secp256k1_scalar s = *a;
+    int last_set_bit = -1;
+    int bit = 0;
+    int sign = 1;
+    int carry = 0;
+
+    VERIFY_CHECK(wnaf != NULL);
+    VERIFY_CHECK(0 <= len && len <= 256);
+    VERIFY_CHECK(a != NULL);
+    VERIFY_CHECK(2 <= w && w <= 31);
+
+    memset(wnaf, 0, len * sizeof(wnaf[0]));
+
+    if (secp256k1_scalar_get_bits(&s, 255, 1)) {
+        secp256k1_scalar_negate(&s, &s);
+        sign = -1;
+    }
+
+    while (bit < len) {
+        int now;
+        int word;
+        if (secp256k1_scalar_get_bits(&s, bit, 1) == (unsigned int)carry) {
+            bit++;
+            continue;
+        }
+
+        now = w;
+        if (now > len - bit) {
+            now = len - bit;
+        }
+
+        word = secp256k1_scalar_get_bits_var(&s, bit, now) + carry;
+
+        carry = (word >> (w-1)) & 1;
+        word -= carry << w;
+
+        wnaf[bit] = sign * word;
+        last_set_bit = bit;
+
+        bit += now;
+    }
+#ifdef VERIFY
+    CHECK(carry == 0);
+    while (bit < 256) {
+        CHECK(secp256k1_scalar_get_bits(&s, bit++, 1) == 0);
+    } 
+#endif
+    return last_set_bit + 1;
+}
+
+struct secp256k1_strauss_point_state {
+#ifdef USE_ENDOMORPHISM
+    secp256k1_scalar na_1, na_lam;
+    int wnaf_na_1[130];
+    int wnaf_na_lam[130];
+    int bits_na_1;
+    int bits_na_lam;
+#else
+    int wnaf_na[256];
+    int bits_na;
+#endif
+    size_t input_pos;
+};
+
+struct secp256k1_strauss_state {
+    secp256k1_gej* prej;
+    secp256k1_fe* zr;
+    secp256k1_ge* pre_a;
+#ifdef USE_ENDOMORPHISM
+    secp256k1_ge* pre_a_lam;
+#endif
+    struct secp256k1_strauss_point_state* ps;
+};
+
+static void secp256k1_ecmult_strauss_wnaf(const secp256k1_ecmult_context *ctx, const struct secp256k1_strauss_state *state, secp256k1_gej *r, int num, const secp256k1_gej *a, const secp256k1_scalar *na, const secp256k1_scalar *ng) {
+    secp256k1_ge tmpa;
+    secp256k1_fe Z;
+#ifdef USE_ENDOMORPHISM
+    /* Splitted G factors. */
+    secp256k1_scalar ng_1, ng_128;
+    int wnaf_ng_1[129];
+    int bits_ng_1 = 0;
+    int wnaf_ng_128[129];
+    int bits_ng_128 = 0;
+#else
+    int wnaf_ng[256];
+    int bits_ng = 0;
+#endif
+    int i;
+    int bits = 0;
+    int np;
+    int no = 0;
+
+    for (np = 0; np < num; ++np) {
+        if (secp256k1_scalar_is_zero(&na[np]) || secp256k1_gej_is_infinity(&a[np])) {
+            continue;
+        }
+        state->ps[no].input_pos = np;
+#ifdef USE_ENDOMORPHISM
+        /* split na into na_1 and na_lam (where na = na_1 + na_lam*lambda, and na_1 and na_lam are ~128 bit) */
+        secp256k1_scalar_split_lambda(&state->ps[no].na_1, &state->ps[no].na_lam, &na[np]);
+
+        /* build wnaf representation for na_1 and na_lam. */
+        state->ps[no].bits_na_1   = secp256k1_ecmult_wnaf(state->ps[no].wnaf_na_1,   130, &state->ps[no].na_1,   WINDOW_A);
+        state->ps[no].bits_na_lam = secp256k1_ecmult_wnaf(state->ps[no].wnaf_na_lam, 130, &state->ps[no].na_lam, WINDOW_A);
+        VERIFY_CHECK(state->ps[no].bits_na_1 <= 130);
+        VERIFY_CHECK(state->ps[no].bits_na_lam <= 130);
+        if (state->ps[no].bits_na_1 > bits) {
+            bits = state->ps[no].bits_na_1;
+        }
+        if (state->ps[no].bits_na_lam > bits) {
+            bits = state->ps[no].bits_na_lam;
+        }
+#else
+        /* build wnaf representation for na. */
+        state->ps[no].bits_na     = secp256k1_ecmult_wnaf(state->ps[no].wnaf_na,     256, &na[np],      WINDOW_A);
+        if (state->ps[no].bits_na > bits) {
+            bits = state->ps[no].bits_na;
+        }
+#endif
+        ++no;
+    }
+
+    /* Calculate odd multiples of a.
+     * All multiples are brought to the same Z 'denominator', which is stored
+     * in Z. Due to secp256k1' isomorphism we can do all operations pretending
+     * that the Z coordinate was 1, use affine addition formulae, and correct
+     * the Z coordinate of the result once at the end.
+     * The exception is the precomputed G table points, which are actually
+     * affine. Compared to the base used for other points, they have a Z ratio
+     * of 1/Z, so we can use secp256k1_gej_add_zinv_var, which uses the same
+     * isomorphism to efficiently add with a known Z inverse.
+     */
+    if (no > 0) {
+        /* Compute the odd multiples in Jacobian form. */
+        secp256k1_ecmult_odd_multiples_table(ECMULT_TABLE_SIZE(WINDOW_A), state->prej, state->zr, &a[state->ps[0].input_pos]);
+        for (np = 1; np < no; ++np) {
+            secp256k1_gej tmp = a[state->ps[np].input_pos];
+#ifdef VERIFY
+            secp256k1_fe_normalize_var(&(state->prej[(np - 1) * ECMULT_TABLE_SIZE(WINDOW_A) + ECMULT_TABLE_SIZE(WINDOW_A) - 1].z));
+#endif
+            secp256k1_gej_rescale(&tmp, &(state->prej[(np - 1) * ECMULT_TABLE_SIZE(WINDOW_A) + ECMULT_TABLE_SIZE(WINDOW_A) - 1].z));
+            secp256k1_ecmult_odd_multiples_table(ECMULT_TABLE_SIZE(WINDOW_A), state->prej + np * ECMULT_TABLE_SIZE(WINDOW_A), state->zr + np * ECMULT_TABLE_SIZE(WINDOW_A), &tmp);
+            secp256k1_fe_mul(state->zr + np * ECMULT_TABLE_SIZE(WINDOW_A), state->zr + np * ECMULT_TABLE_SIZE(WINDOW_A), &(a[state->ps[np].input_pos].z));
+        }
+        /* Bring them to the same Z denominator. */
+        secp256k1_ge_globalz_set_table_gej(ECMULT_TABLE_SIZE(WINDOW_A) * no, state->pre_a, &Z, state->prej, state->zr);
+    } else {
+        secp256k1_fe_set_int(&Z, 1);
+    }
+
+#ifdef USE_ENDOMORPHISM
+    for (np = 0; np < no; ++np) {
+        for (i = 0; i < ECMULT_TABLE_SIZE(WINDOW_A); i++) {
+            secp256k1_ge_mul_lambda(&state->pre_a_lam[np * ECMULT_TABLE_SIZE(WINDOW_A) + i], &state->pre_a[np * ECMULT_TABLE_SIZE(WINDOW_A) + i]);
+        }
+    }
+
+    if (ng) {
+        /* split ng into ng_1 and ng_128 (where gn = gn_1 + gn_128*2^128, and gn_1 and gn_128 are ~128 bit) */
+        secp256k1_scalar_split_128(&ng_1, &ng_128, ng);
+
+        /* Build wnaf representation for ng_1 and ng_128 */
+        bits_ng_1   = secp256k1_ecmult_wnaf(wnaf_ng_1,   129, &ng_1,   WINDOW_G);
+        bits_ng_128 = secp256k1_ecmult_wnaf(wnaf_ng_128, 129, &ng_128, WINDOW_G);
+        if (bits_ng_1 > bits) {
+            bits = bits_ng_1;
+        }
+        if (bits_ng_128 > bits) {
+            bits = bits_ng_128;
+        }
+    }
+#else
+    if (ng) {
+        bits_ng     = secp256k1_ecmult_wnaf(wnaf_ng,     256, ng,      WINDOW_G);
+        if (bits_ng > bits) {
+            bits = bits_ng;
+        }
+    }
+#endif
+
+    secp256k1_gej_set_infinity(r);
+
+    for (i = bits - 1; i >= 0; i--) {
+        int n;
+        secp256k1_gej_double_var(r, r, NULL);
+#ifdef USE_ENDOMORPHISM
+        for (np = 0; np < no; ++np) {
+            if (i < state->ps[np].bits_na_1 && (n = state->ps[np].wnaf_na_1[i])) {
+                ECMULT_TABLE_GET_GE(&tmpa, state->pre_a + np * ECMULT_TABLE_SIZE(WINDOW_A), n, WINDOW_A);
+                secp256k1_gej_add_ge_var(r, r, &tmpa, NULL);
+            }
+            if (i < state->ps[np].bits_na_lam && (n = state->ps[np].wnaf_na_lam[i])) {
+                ECMULT_TABLE_GET_GE(&tmpa, state->pre_a_lam + np * ECMULT_TABLE_SIZE(WINDOW_A), n, WINDOW_A);
+                secp256k1_gej_add_ge_var(r, r, &tmpa, NULL);
+            }
+        }
+        if (i < bits_ng_1 && (n = wnaf_ng_1[i])) {
+            ECMULT_TABLE_GET_GE_STORAGE(&tmpa, *ctx->pre_g, n, WINDOW_G);
+            secp256k1_gej_add_zinv_var(r, r, &tmpa, &Z);
+        }
+        if (i < bits_ng_128 && (n = wnaf_ng_128[i])) {
+            ECMULT_TABLE_GET_GE_STORAGE(&tmpa, *ctx->pre_g_128, n, WINDOW_G);
+            secp256k1_gej_add_zinv_var(r, r, &tmpa, &Z);
+        }
+#else
+        for (np = 0; np < no; ++np) {
+            if (i < state->ps[np].bits_na && (n = state->ps[np].wnaf_na[i])) {
+                ECMULT_TABLE_GET_GE(&tmpa, state->pre_a + np * ECMULT_TABLE_SIZE(WINDOW_A), n, WINDOW_A);
+                secp256k1_gej_add_ge_var(r, r, &tmpa, NULL);
+            }
+        }
+        if (i < bits_ng && (n = wnaf_ng[i])) {
+            ECMULT_TABLE_GET_GE_STORAGE(&tmpa, *ctx->pre_g, n, WINDOW_G);
+            secp256k1_gej_add_zinv_var(r, r, &tmpa, &Z);
+        }
+#endif
+    }
+
+    if (!r->infinity) {
+        secp256k1_fe_mul(&r->z, &r->z, &Z);
+    }
+}
+
+static void secp256k1_ecmult(const secp256k1_ecmult_context *ctx, secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_scalar *na, const secp256k1_scalar *ng) {
+    secp256k1_gej prej[ECMULT_TABLE_SIZE(WINDOW_A)];
+    secp256k1_fe zr[ECMULT_TABLE_SIZE(WINDOW_A)];
+    secp256k1_ge pre_a[ECMULT_TABLE_SIZE(WINDOW_A)];
+    struct secp256k1_strauss_point_state ps[1];
+#ifdef USE_ENDOMORPHISM
+    secp256k1_ge pre_a_lam[ECMULT_TABLE_SIZE(WINDOW_A)];
+#endif
+    struct secp256k1_strauss_state state;
+
+    state.prej = prej;
+    state.zr = zr;
+    state.pre_a = pre_a;
+#ifdef USE_ENDOMORPHISM
+    state.pre_a_lam = pre_a_lam;
+#endif
+    state.ps = ps;
+    secp256k1_ecmult_strauss_wnaf(ctx, &state, r, 1, a, na, ng);
+}
+
+static size_t secp256k1_strauss_scratch_size(size_t n_points) {
+#ifdef USE_ENDOMORPHISM
+    static const size_t point_size = (2 * sizeof(secp256k1_ge) + sizeof(secp256k1_gej) + sizeof(secp256k1_fe)) * ECMULT_TABLE_SIZE(WINDOW_A) + sizeof(struct secp256k1_strauss_point_state) + sizeof(secp256k1_gej) + sizeof(secp256k1_scalar);
+#else
+    static const size_t point_size = (sizeof(secp256k1_ge) + sizeof(secp256k1_gej) + sizeof(secp256k1_fe)) * ECMULT_TABLE_SIZE(WINDOW_A) + sizeof(struct secp256k1_strauss_point_state) + sizeof(secp256k1_gej) + sizeof(secp256k1_scalar);
+#endif
+    return n_points*point_size;
+}
+
+static int secp256k1_ecmult_strauss_batch(const secp256k1_ecmult_context *ctx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n_points, size_t cb_offset) {
+    secp256k1_gej* points;
+    secp256k1_scalar* scalars;
+    struct secp256k1_strauss_state state;
+    size_t i;
+
+    secp256k1_gej_set_infinity(r);
+    if (inp_g_sc == NULL && n_points == 0) {
+        return 1;
+    }
+
+    if (!secp256k1_scratch_resize(scratch, secp256k1_strauss_scratch_size(n_points), STRAUSS_SCRATCH_OBJECTS)) {
+        return 0;
+    }
+    secp256k1_scratch_reset(scratch);
+    points = (secp256k1_gej*)secp256k1_scratch_alloc(scratch, n_points * sizeof(secp256k1_gej));
+    scalars = (secp256k1_scalar*)secp256k1_scratch_alloc(scratch, n_points * sizeof(secp256k1_scalar));
+    state.prej = (secp256k1_gej*)secp256k1_scratch_alloc(scratch, n_points * ECMULT_TABLE_SIZE(WINDOW_A) * sizeof(secp256k1_gej));
+    state.zr = (secp256k1_fe*)secp256k1_scratch_alloc(scratch, n_points * ECMULT_TABLE_SIZE(WINDOW_A) * sizeof(secp256k1_fe));
+#ifdef USE_ENDOMORPHISM
+    state.pre_a = (secp256k1_ge*)secp256k1_scratch_alloc(scratch, n_points * 2 * ECMULT_TABLE_SIZE(WINDOW_A) * sizeof(secp256k1_ge));
+    state.pre_a_lam = state.pre_a + n_points * ECMULT_TABLE_SIZE(WINDOW_A);
+#else
+    state.pre_a = (secp256k1_ge*)secp256k1_scratch_alloc(scratch, n_points * ECMULT_TABLE_SIZE(WINDOW_A) * sizeof(secp256k1_ge));
+#endif
+    state.ps = (struct secp256k1_strauss_point_state*)secp256k1_scratch_alloc(scratch, n_points * sizeof(struct secp256k1_strauss_point_state));
+
+    for (i = 0; i < n_points; i++) {
+        secp256k1_ge point;
+        if (!cb(&scalars[i], &point, i+cb_offset, cbdata)) return 0;
+        secp256k1_gej_set_ge(&points[i], &point);
+    }
+    secp256k1_ecmult_strauss_wnaf(ctx, &state, r, n_points, points, scalars, inp_g_sc);
+    return 1;
+}
+
+/* Wrapper for secp256k1_ecmult_multi_func interface */
+static int secp256k1_ecmult_strauss_batch_single(const secp256k1_ecmult_context *actx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n) {
+    return secp256k1_ecmult_strauss_batch(actx, scratch, r, inp_g_sc, cb, cbdata, n, 0);
+}
+
+static size_t secp256k1_strauss_max_points(secp256k1_scratch *scratch) {
+    return secp256k1_scratch_max_allocation(scratch, STRAUSS_SCRATCH_OBJECTS) / secp256k1_strauss_scratch_size(1);
+}
+
+/** Convert a number to WNAF notation.
+ *  The number becomes represented by sum(2^{wi} * wnaf[i], i=0..WNAF_SIZE(w)+1) - return_val.
+ *  It has the following guarantees:
+ *  - each wnaf[i] is either 0 or an odd integer between -(1 << w) and (1 << w)
+ *  - the number of words set is always WNAF_SIZE(w)
+ *  - the returned skew is 0 without endomorphism, or 0 or 1 with endomorphism
+ */
+static int secp256k1_wnaf_fixed(int *wnaf, const secp256k1_scalar *s, int w) {
+    int sign = 0;
+    int skew = 0;
+    int pos = 1;
+#ifndef USE_ENDOMORPHISM
+    secp256k1_scalar neg_s;
+#endif
+    const secp256k1_scalar *work = s;
+
+    if (secp256k1_scalar_is_zero(s)) {
+        while (pos * w < WNAF_BITS) {
+            wnaf[pos] = 0;
+            ++pos;
+        }
+        return 0;
+    }
+
+    if (secp256k1_scalar_is_even(s)) {
+#ifdef USE_ENDOMORPHISM
+        skew = 1;
+#else
+        secp256k1_scalar_negate(&neg_s, s);
+        work = &neg_s;
+        sign = -1;
+#endif
+    }
+
+    wnaf[0] = (secp256k1_scalar_get_bits_var(work, 0, w) + skew + sign) ^ sign;
+
+    while (pos * w < WNAF_BITS) {
+        int now = w;
+        int val;
+        if (now + pos * w > WNAF_BITS) {
+            now = WNAF_BITS - pos * w;
+        }
+        val = secp256k1_scalar_get_bits_var(work, pos * w, now);
+        if ((val & 1) == 0) {
+            wnaf[pos - 1] -= ((1 << w) + sign) ^ sign;
+            wnaf[pos] = (val + 1 + sign) ^ sign;
+        } else {
+            wnaf[pos] = (val + sign) ^ sign;
+        }
+        ++pos;
+    }
+    VERIFY_CHECK(pos == WNAF_SIZE(w));
+
+    return skew;
+}
+
+struct secp256k1_pippenger_point_state {
+    int skew_na;
+    size_t input_pos;
+};
+
+struct secp256k1_pippenger_state {
+    int *wnaf_na;
+    struct secp256k1_pippenger_point_state* ps;
+};
+
+/*
+ * pippenger_wnaf computes the result of a multi-point multiplication as
+ * follows: The scalars are brought into wnaf with n_wnaf elements each. Then
+ * for every i < n_wnaf, first each point is added to a "bucket" corresponding
+ * to the point's wnaf[i]. Second, the buckets are added together such that
+ * r += 1*bucket[0] + 3*bucket[1] + 5*bucket[2] + ...
+ */
+static int secp256k1_ecmult_pippenger_wnaf(secp256k1_gej *buckets, int bucket_window, struct secp256k1_pippenger_state *state, secp256k1_gej *r, const secp256k1_scalar *sc, const secp256k1_ge *pt, size_t num) {
+    size_t n_wnaf = WNAF_SIZE(bucket_window+1);
+    size_t np;
+    size_t no = 0;
+    int i;
+    int j;
+
+    for (np = 0; np < num; ++np) {
+        if (secp256k1_scalar_is_zero(&sc[np]) || secp256k1_ge_is_infinity(&pt[np])) {
+            continue;
+        }
+        state->ps[no].input_pos = np;
+        state->ps[no].skew_na = secp256k1_wnaf_fixed(&state->wnaf_na[no*n_wnaf], &sc[np], bucket_window+1);
+        no++;
+    }
+    secp256k1_gej_set_infinity(r);
+
+    if (no == 0) {
+        return 1;
+    }
+
+    for (i = n_wnaf - 1; i >= 0; i--) {
+        secp256k1_gej running_sum;
+
+        for(j = 0; j < ECMULT_TABLE_SIZE(bucket_window+2); j++) {
+            secp256k1_gej_set_infinity(&buckets[j]);
+        }
+
+        for (np = 0; np < no; ++np) {
+            int n = state->wnaf_na[np*n_wnaf + i];
+            struct secp256k1_pippenger_point_state point_state = state->ps[np];
+            secp256k1_ge tmp;
+            int idx;
+
+#ifdef USE_ENDOMORPHISM
+            if (i == 0) {
+                /* correct for wnaf skew */
+                int skew = point_state.skew_na;
+                if (skew) {
+                    secp256k1_ge_neg(&tmp, &pt[point_state.input_pos]);
+                    secp256k1_gej_add_ge_var(&buckets[0], &buckets[0], &tmp, NULL);
+                }
+            }
+#endif
+            if (n > 0) {
+                idx = (n - 1)/2;
+                secp256k1_gej_add_ge_var(&buckets[idx], &buckets[idx], &pt[point_state.input_pos], NULL);
+            } else if (n < 0) {
+                idx = -(n + 1)/2;
+                secp256k1_ge_neg(&tmp, &pt[point_state.input_pos]);
+                secp256k1_gej_add_ge_var(&buckets[idx], &buckets[idx], &tmp, NULL);
+            }
+        }
+
+        for(j = 0; j < bucket_window; j++) {
+            secp256k1_gej_double_var(r, r, NULL);
+        }
+
+        secp256k1_gej_set_infinity(&running_sum);
+        /* Accumulate the sum: bucket[0] + 3*bucket[1] + 5*bucket[2] + 7*bucket[3] + ...
+         *                   = bucket[0] +   bucket[1] +   bucket[2] +   bucket[3] + ...
+         *                   +         2 *  (bucket[1] + 2*bucket[2] + 3*bucket[3] + ...)
+         * using an intermediate running sum:
+         * running_sum = bucket[0] +   bucket[1] +   bucket[2] + ...
+         *
+         * The doubling is done implicitly by deferring the final window doubling (of 'r').
+         */
+        for(j = ECMULT_TABLE_SIZE(bucket_window+2) - 1; j > 0; j--) {
+            secp256k1_gej_add_var(&running_sum, &running_sum, &buckets[j], NULL);
+            secp256k1_gej_add_var(r, r, &running_sum, NULL);
+        }
+
+        secp256k1_gej_add_var(&running_sum, &running_sum, &buckets[0], NULL);
+        secp256k1_gej_double_var(r, r, NULL);
+        secp256k1_gej_add_var(r, r, &running_sum, NULL);
+    }
+    return 1;
+}
+
+/**
+ * Returns optimal bucket_window (number of bits of a scalar represented by a
+ * set of buckets) for a given number of points.
+ */
+static int secp256k1_pippenger_bucket_window(size_t n) {
+#ifdef USE_ENDOMORPHISM
+    if (n <= 1) {
+        return 1;
+    } else if (n <= 4) {
+        return 2;
+    } else if (n <= 20) {
+        return 3;
+    } else if (n <= 57) {
+        return 4;
+    } else if (n <= 136) {
+        return 5;
+    } else if (n <= 235) {
+        return 6;
+    } else if (n <= 1260) {
+        return 7;
+    } else if (n <= 4420) {
+        return 9;
+    } else if (n <= 7880) {
+        return 10;
+    } else if (n <= 16050) {
+        return 11;
+    } else {
+        return PIPPENGER_MAX_BUCKET_WINDOW;
+    }
+#else
+    if (n <= 1) {
+        return 1;
+    } else if (n <= 11) {
+        return 2;
+    } else if (n <= 45) {
+        return 3;
+    } else if (n <= 100) {
+        return 4;
+    } else if (n <= 275) {
+        return 5;
+    } else if (n <= 625) {
+        return 6;
+    } else if (n <= 1850) {
+        return 7;
+    } else if (n <= 3400) {
+        return 8;
+    } else if (n <= 9630) {
+        return 9;
+    } else if (n <= 17900) {
+        return 10;
+    } else if (n <= 32800) {
+        return 11;
+    } else {
+        return PIPPENGER_MAX_BUCKET_WINDOW;
+    }
+#endif
+}
+
+/**
+ * Returns the maximum optimal number of points for a bucket_window.
+ */
+static size_t secp256k1_pippenger_bucket_window_inv(int bucket_window) {
+    switch(bucket_window) {
+#ifdef USE_ENDOMORPHISM
+        case 1: return 1;
+        case 2: return 4;
+        case 3: return 20;
+        case 4: return 57;
+        case 5: return 136;
+        case 6: return 235;
+        case 7: return 1260;
+        case 8: return 1260;
+        case 9: return 4420;
+        case 10: return 7880;
+        case 11: return 16050;
+        case PIPPENGER_MAX_BUCKET_WINDOW: return SIZE_MAX;
+#else
+        case 1: return 1;
+        case 2: return 11;
+        case 3: return 45;
+        case 4: return 100;
+        case 5: return 275;
+        case 6: return 625;
+        case 7: return 1850;
+        case 8: return 3400;
+        case 9: return 9630;
+        case 10: return 17900;
+        case 11: return 32800;
+        case PIPPENGER_MAX_BUCKET_WINDOW: return SIZE_MAX;
+#endif
+    }
+    return 0;
+}
+
+
+#ifdef USE_ENDOMORPHISM
+SECP256K1_INLINE static void secp256k1_ecmult_endo_split(secp256k1_scalar *s1, secp256k1_scalar *s2, secp256k1_ge *p1, secp256k1_ge *p2) {
+    secp256k1_scalar tmp = *s1;
+    secp256k1_scalar_split_lambda(s1, s2, &tmp);
+    secp256k1_ge_mul_lambda(p2, p1);
+
+    if (secp256k1_scalar_is_high(s1)) {
+        secp256k1_scalar_negate(s1, s1);
+        secp256k1_ge_neg(p1, p1);
+    }
+    if (secp256k1_scalar_is_high(s2)) {
+        secp256k1_scalar_negate(s2, s2);
+        secp256k1_ge_neg(p2, p2);
+    }
+}
+#endif
+
+/**
+ * Returns the scratch size required for a given number of points (excluding
+ * base point G) without considering alignment.
+ */
+static size_t secp256k1_pippenger_scratch_size(size_t n_points, int bucket_window) {
+#ifdef USE_ENDOMORPHISM
+    size_t entries = 2*n_points + 2;
+#else
+    size_t entries = n_points + 1;
+#endif
+    size_t entry_size = sizeof(secp256k1_ge) + sizeof(secp256k1_scalar) + sizeof(struct secp256k1_pippenger_point_state) + (WNAF_SIZE(bucket_window+1)+1)*sizeof(int);
+    return ((1<<bucket_window) * sizeof(secp256k1_gej) + sizeof(struct secp256k1_pippenger_state) + entries * entry_size);
+}
+
+static int secp256k1_ecmult_pippenger_batch(const secp256k1_ecmult_context *ctx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n_points, size_t cb_offset) {
+    /* Use 2(n+1) with the endomorphism, n+1 without, when calculating batch
+     * sizes. The reason for +1 is that we add the G scalar to the list of
+     * other scalars. */
+#ifdef USE_ENDOMORPHISM
+    size_t entries = 2*n_points + 2;
+#else
+    size_t entries = n_points + 1;
+#endif
+    secp256k1_ge *points;
+    secp256k1_scalar *scalars;
+    secp256k1_gej *buckets;
+    struct secp256k1_pippenger_state *state_space;
+    size_t idx = 0;
+    size_t point_idx = 0;
+    int i, j;
+    int bucket_window;
+
+    (void)ctx;
+    secp256k1_gej_set_infinity(r);
+    if (inp_g_sc == NULL && n_points == 0) {
+        return 1;
+    }
+
+    bucket_window = secp256k1_pippenger_bucket_window(n_points);
+    if (!secp256k1_scratch_resize(scratch, secp256k1_pippenger_scratch_size(n_points, bucket_window), PIPPENGER_SCRATCH_OBJECTS)) {
+        return 0;
+    }
+    secp256k1_scratch_reset(scratch);
+    points = (secp256k1_ge *) secp256k1_scratch_alloc(scratch, entries * sizeof(*points));
+    scalars = (secp256k1_scalar *) secp256k1_scratch_alloc(scratch, entries * sizeof(*scalars));
+    state_space = (struct secp256k1_pippenger_state *) secp256k1_scratch_alloc(scratch, sizeof(*state_space));
+    state_space->ps = (struct secp256k1_pippenger_point_state *) secp256k1_scratch_alloc(scratch, entries * sizeof(*state_space->ps));
+    state_space->wnaf_na = (int *) secp256k1_scratch_alloc(scratch, entries*(WNAF_SIZE(bucket_window+1)) * sizeof(int));
+    buckets = (secp256k1_gej *) secp256k1_scratch_alloc(scratch, (1<<bucket_window) * sizeof(*buckets));
+
+    if (inp_g_sc != NULL) {
+        scalars[0] = *inp_g_sc;
+        points[0] = secp256k1_ge_const_g;
+        idx++;
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ecmult_endo_split(&scalars[0], &scalars[1], &points[0], &points[1]);
+        idx++;
+#endif
+    }
+
+    while (point_idx < n_points) {
+        if (!cb(&scalars[idx], &points[idx], point_idx + cb_offset, cbdata)) {
+            return 0;
+        }
+        idx++;
+#ifdef USE_ENDOMORPHISM
+        secp256k1_ecmult_endo_split(&scalars[idx - 1], &scalars[idx], &points[idx - 1], &points[idx]);
+        idx++;
+#endif
+        point_idx++;
+    }
+
+    secp256k1_ecmult_pippenger_wnaf(buckets, bucket_window, state_space, r, scalars, points, idx);
+
+    /* Clear data */
+    for(i = 0; (size_t)i < idx; i++) {
+        secp256k1_scalar_clear(&scalars[i]);
+        state_space->ps[i].skew_na = 0;
+        for(j = 0; j < WNAF_SIZE(bucket_window+1); j++) {
+            state_space->wnaf_na[i * WNAF_SIZE(bucket_window+1) + j] = 0;
+        }
+    }
+    for(i = 0; i < 1<<bucket_window; i++) {
+        secp256k1_gej_clear(&buckets[i]);
+    }
+    return 1;
+}
+
+/* Wrapper for secp256k1_ecmult_multi_func interface */
+static int secp256k1_ecmult_pippenger_batch_single(const secp256k1_ecmult_context *actx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n) {
+    return secp256k1_ecmult_pippenger_batch(actx, scratch, r, inp_g_sc, cb, cbdata, n, 0);
+}
+
+/**
+ * Returns the maximum number of points in addition to G that can be used with
+ * a given scratch space. The function ensures that fewer points may also be
+ * used.
+ */
+static size_t secp256k1_pippenger_max_points(secp256k1_scratch *scratch) {
+    size_t max_alloc = secp256k1_scratch_max_allocation(scratch, PIPPENGER_SCRATCH_OBJECTS);
+    int bucket_window;
+    size_t res = 0;
+
+    for (bucket_window = 1; bucket_window <= PIPPENGER_MAX_BUCKET_WINDOW; bucket_window++) {
+        size_t n_points;
+        size_t max_points = secp256k1_pippenger_bucket_window_inv(bucket_window);
+        size_t space_for_points;
+        size_t space_overhead;
+        size_t entry_size = sizeof(secp256k1_ge) + sizeof(secp256k1_scalar) + sizeof(struct secp256k1_pippenger_point_state) + (WNAF_SIZE(bucket_window+1)+1)*sizeof(int);
+
+#ifdef USE_ENDOMORPHISM
+        entry_size = 2*entry_size;
+#endif
+        space_overhead = ((1<<bucket_window) * sizeof(secp256k1_gej) + entry_size + sizeof(struct secp256k1_pippenger_state));
+        if (space_overhead > max_alloc) {
+            break;
+        }
+        space_for_points = max_alloc - space_overhead;
+
+        n_points = space_for_points/entry_size;
+        n_points = n_points > max_points ? max_points : n_points;
+        if (n_points > res) {
+            res = n_points;
+        }
+        if (n_points < max_points) {
+            /* A larger bucket_window may support even more points. But if we
+             * would choose that then the caller couldn't safely use any number
+             * smaller than what this function returns */
+            break;
+        }
+    }
+    return res;
+}
+
+typedef int (*secp256k1_ecmult_multi_func)(const secp256k1_ecmult_context*, secp256k1_scratch*, secp256k1_gej*, const secp256k1_scalar*, secp256k1_ecmult_multi_callback cb, void*, size_t);
+static int secp256k1_ecmult_multi_var(const secp256k1_ecmult_context *ctx, secp256k1_scratch *scratch, secp256k1_gej *r, const secp256k1_scalar *inp_g_sc, secp256k1_ecmult_multi_callback cb, void *cbdata, size_t n) {
+    size_t i;
+
+    int (*f)(const secp256k1_ecmult_context*, secp256k1_scratch*, secp256k1_gej*, const secp256k1_scalar*, secp256k1_ecmult_multi_callback cb, void*, size_t, size_t);
+    size_t max_points;
+    size_t n_batches;
+    size_t n_batch_points;
+
+    secp256k1_gej_set_infinity(r);
+    if (inp_g_sc == NULL && n == 0) {
+        return 1;
+    } else if (n == 0) {
+        secp256k1_scalar szero;
+        secp256k1_scalar_set_int(&szero, 0);
+        secp256k1_ecmult(ctx, r, r, &szero, inp_g_sc);
+        return 1;
+    }
+
+    max_points = secp256k1_pippenger_max_points(scratch);
+    if (max_points == 0) {
+        return 0;
+    } else if (max_points > ECMULT_MAX_POINTS_PER_BATCH) {
+        max_points = ECMULT_MAX_POINTS_PER_BATCH;
+    }
+    n_batches = (n+max_points-1)/max_points;
+    n_batch_points = (n+n_batches-1)/n_batches;
+
+    if (n_batch_points >= ECMULT_PIPPENGER_THRESHOLD) {
+        f = secp256k1_ecmult_pippenger_batch;
+    } else {
+        max_points = secp256k1_strauss_max_points(scratch);
+        if (max_points == 0) {
+            return 0;
+        }
+        n_batches = (n+max_points-1)/max_points;
+        n_batch_points = (n+n_batches-1)/n_batches;
+        f = secp256k1_ecmult_strauss_batch;
+    }
+    for(i = 0; i < n_batches; i++) {
+        size_t nbp = n < n_batch_points ? n : n_batch_points;
+        size_t offset = n_batch_points*i;
+        secp256k1_gej tmp;
+        if (!f(ctx, scratch, &tmp, i == 0 ? inp_g_sc : NULL, cb, cbdata, nbp, offset)) {
+            return 0;
+        }
+        secp256k1_gej_add_var(r, r, &tmp, NULL);
+        n -= nbp;
+    }
+    return 1;
+}
+
+#endif /* SECP256K1_ECMULT_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_static_context.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_static_context.h
new file mode 100644
index 000000000..61d937345
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/ecmult_static_context.h
@@ -0,0 +1,1160 @@
+#ifndef _SECP256K1_ECMULT_STATIC_CONTEXT_
+#define _SECP256K1_ECMULT_STATIC_CONTEXT_
+#include "group.h"
+#define SC SECP256K1_GE_STORAGE_CONST
+static const secp256k1_ge_storage secp256k1_ecmult_static_context[64][16] = {
+{
+    SC(983487347u, 1861041900u, 2599115456u, 565528146u, 1451326239u, 148794576u, 4224640328u, 3120843701u, 2076989736u, 3184115747u, 3754320824u, 2656004457u, 2876577688u, 2388659905u, 3527541004u, 1170708298u),
+    SC(3830281845u, 3284871255u, 1309883393u, 2806991612u, 1558611192u, 1249416977u, 1614773327u, 1353445208u, 633124399u, 4264439010u, 426432620u, 167800352u, 2355417627u, 2991792291u, 3042397084u, 505150283u),
+    SC(1792710820u, 2165839471u, 3876070801u, 3603801374u, 2437636273u, 1231643248u, 860890267u, 4002236272u, 3258245037u, 4085545079u, 2695347418u, 288209541u, 484302592u, 139267079u, 14621978u, 2750167787u),
+    SC(11094760u, 1663454715u, 3104893589u, 1290390142u, 1334245677u, 2671416785u, 3982578986u, 2050971459u, 2136209393u, 1792200847u, 367473428u, 114820199u, 1096121039u, 425028623u, 3983611854u, 923011107u),
+    SC(3063072592u, 3527226996u, 3276923831u, 3785926779u, 346414977u, 2234429237u, 547163845u, 1847763663u, 2978762519u, 623753375u, 2207114031u, 3006533282u, 3147176505u, 1421052999u, 4188545436u, 1210097867u),
+    SC(1763690305u, 2162645845u, 1202943473u, 469109438u, 1159538654u, 390308918u, 1603161004u, 2906790921u, 2394291613u, 4089459264u, 1827402608u, 2166723935u, 3207526147u, 1197293526u, 436375990u, 1773481373u),
+    SC(1882939156u, 2815960179u, 295089455u, 2929502411u, 2990911492u, 2056857815u, 3502518067u, 957616604u, 1591168682u, 1240626880u, 1298264859u, 1839469436u, 3185927997u, 2386526557u, 4025121105u, 260593756u),
+    SC(699984967u, 3527536033u, 3843799838u, 958940236u, 927446270u, 2095887205u, 733758855u, 793790581u, 2288595512u, 2237855935u, 4158071588u, 103726164u, 1804839263u, 2006149890u, 3944535719u, 3558448075u),
+    SC(1145702317u, 3893958345u, 851308226u, 566580932u, 1803510929u, 244954233u, 754894895u, 1321302288u, 772295727u, 4004336128u, 2009158070u, 4026087258u, 1899732245u, 1392930957u, 3019192545u, 149625039u),
+    SC(3772604811u, 577564124u, 4116730494u, 548732504u, 241159976u, 965811878u, 3286803623u, 3781136673u, 2690883927u, 863484863u, 463101630u, 2948469162u, 1712070245u, 3742601912u, 2535479384u, 1015456764u),
+    SC(2610513434u, 780361970u, 4072278968u, 3165566617u, 362677842u, 1775830058u, 4195110448u, 2813784845u, 1072168452u, 1018450691u, 1028609376u, 2101464438u, 2419500187u, 2190549840u, 1837865365u, 625038589u),
+    SC(1347265449u, 3654928411u, 3255194520u, 1322421425u, 3049188507u, 1827004342u, 3467202132u, 4261348427u, 3419671838u, 2239837129u, 3441474020u, 268041876u, 4157379961u, 971431753u, 2053887746u, 2038404815u),
+    SC(3723233964u, 515696298u, 2908946645u, 1626400003u, 2191461318u, 1201029625u, 186243574u, 1212380923u, 858781105u, 4236445790u, 1936144063u, 1009147468u, 2407567966u, 1865959325u, 1701035060u, 241151649u),
+    SC(3696430315u, 3089900654u, 1103438577u, 3528924465u, 1259662835u, 2438429227u, 1692672370u, 2989843137u, 1446894995u, 2239587625u, 2340544036u, 434491102u, 128239031u, 2734594294u, 2667284742u, 1865591178u),
+    SC(1980028431u, 1099813170u, 2013628738u, 4214038867u, 3231891435u, 3896266769u, 2756820145u, 1490749299u, 951981230u, 3655451652u, 1676645053u, 3593230746u, 3010864552u, 405419875u, 1336073872u, 1398624425u),
+    SC(3414779716u, 2008156201u, 4125277506u, 2287126283u, 2446053551u, 212726297u, 2794923956u, 3421277562u, 1460719994u, 552209919u, 2551004934u, 953727248u, 3096710400u, 3712627263u, 3614955842u, 557715603u)
+},
+{
+    SC(461660907u, 483260338u, 3090624303u, 3468817529u, 2869411999u, 3408320195u, 157674611u, 1298485121u, 103769941u, 3030878493u, 1440637991u, 4223892787u, 3840844824u, 2730509202u, 2748389383u, 214732837u),
+    SC(4143598594u, 459898515u, 2922648667u, 1209678535u, 1176716252u, 1612841999u, 2202917330u, 13015901u, 1575346251u, 891263272u, 3091905261u, 3543244385u, 3935435865u, 2372913859u, 1075649255u, 201888830u),
+    SC(3481295448u, 3640243220u, 2859715852u, 3846556079u, 1065182531u, 2330293896u, 2178091110u, 3893510868u, 4099261975u, 2577582684u, 4207143791u, 589834100u, 2090766670u, 4242818989u, 2413240316u, 1338191979u),
+    SC(1222367653u, 2295459885u, 1856816550u, 918616911u, 3733449540u, 288527426u, 308654335u, 175301747u, 2585816357u, 1572985110u, 3820086017u, 3400646033u, 3928615806u, 2543586180u, 1619974000u, 1257448912u),
+    SC(3467862907u, 681146163u, 2909728989u, 83906098u, 2626131995u, 3872919971u, 2290108548u, 1697087700u, 1793941143u, 3236443826u, 1940064764u, 1563989881u, 527371209u, 610869743u, 1604941439u, 3670721525u),
+    SC(2302729378u, 1391194029u, 1641771531u, 3876177737u, 1929557473u, 2752989331u, 2519109900u, 1131448856u, 3786463166u, 506905989u, 2345013855u, 2144715811u, 1583628159u, 291930150u, 3243470493u, 4130365181u),
+    SC(2855519179u, 3147287790u, 1536116015u, 1784764672u, 959281397u, 3099717666u, 86403980u, 3409201632u, 3921301684u, 2101228153u, 575924517u, 1382150904u, 641478876u, 3860064926u, 1937521554u, 2358132463u),
+    SC(972265053u, 3025511526u, 2467192450u, 4011934802u, 4015820825u, 3179306985u, 1744647725u, 423238442u, 2406064939u, 901607195u, 3316491016u, 4128592049u, 1397491632u, 439641584u, 90500461u, 2834580417u),
+    SC(1730532518u, 2821193463u, 2700804628u, 2416923244u, 3795632308u, 2799866320u, 3434703577u, 3883111373u, 1777933228u, 2963254493u, 3042948878u, 1746288680u, 2832145340u, 544625602u, 3633879343u, 2300858165u),
+    SC(62331695u, 2228442612u, 3527845246u, 2989876118u, 3995298903u, 3601545798u, 4170931516u, 445717530u, 1981201926u, 94264130u, 2668647577u, 953251412u, 3322279962u, 3837653687u, 3116466555u, 3369796531u),
+    SC(2739333573u, 3637259489u, 443756582u, 825678124u, 2455706402u, 2994548791u, 3653546249u, 2584145078u, 1245698352u, 89066746u, 1738138166u, 2916153640u, 1850062717u, 3472193431u, 2110631011u, 1214009088u),
+    SC(2386327178u, 3993497770u, 1051345891u, 4137183237u, 3078790224u, 3598213568u, 3344610192u, 1517270932u, 869515922u, 2057215060u, 2792454282u, 4228826509u, 3425305972u, 2708629086u, 880185559u, 1356729037u),
+    SC(2989561710u, 3550122639u, 1990591383u, 2036612756u, 3588709655u, 595888062u, 4189293408u, 1955008963u, 987876526u, 542093629u, 1953520395u, 2315684331u, 2929815182u, 3270759899u, 393611756u, 1677885197u),
+    SC(2331762734u, 371120497u, 1141333410u, 3466824114u, 4113916626u, 3698793791u, 2483365276u, 4265751258u, 3804325409u, 4085909553u, 3531838853u, 2629626707u, 625187055u, 3045263564u, 198131065u, 3993694760u),
+    SC(27419592u, 3267954699u, 2966738458u, 3143461717u, 3869766944u, 2163162934u, 1886283869u, 2052225367u, 958768216u, 2006727717u, 2069130137u, 1939449196u, 3015752138u, 258766841u, 3290132621u, 4163970366u),
+    SC(903383785u, 2983456345u, 4269392462u, 3731664159u, 1837248343u, 1888413004u, 652691803u, 897487558u, 3732206419u, 3625013640u, 1917594162u, 967935585u, 1804564817u, 883883125u, 2389854768u, 2347234078u)
+},
+{
+    SC(1793692126u, 406948681u, 23075151u, 2805328754u, 3264854407u, 427926777u, 2859563730u, 198037267u, 2129133850u, 1089701106u, 3842694445u, 2533380467u, 663211132u, 2312829798u, 807127373u, 38506815u),
+    SC(571890638u, 3882751380u, 1536180709u, 3437159763u, 3953528399u, 516828575u, 3769463872u, 1449076325u, 4270798907u, 3135758980u, 3520630973u, 1452980147u, 3957715387u, 3054428574u, 2391664223u, 2297670550u),
+    SC(2724204046u, 2456139736u, 265045669u, 1367810338u, 1722635060u, 1306450931u, 2894913322u, 3094293390u, 3490680992u, 2550020195u, 3028635086u, 4200216295u, 1066664286u, 4170330175u, 777827015u, 183484181u),
+    SC(947228665u, 1559209921u, 3080864826u, 3123295835u, 2934045313u, 1590990229u, 2766960143u, 3113606941u, 1136432319u, 3758046297u, 2054046144u, 1377389889u, 3244301201u, 127071274u, 1752358610u, 2783507663u),
+    SC(1460807831u, 3649051054u, 2799484569u, 1231562901u, 3377754600u, 3577118892u, 1234337315u, 380370215u, 3272388869u, 3656237932u, 2653126291u, 786263023u, 1028996455u, 4274234235u, 4225822550u, 10734444u),
+    SC(2071087047u, 1934036755u, 611830132u, 2015415885u, 1373497691u, 3709112893u, 3810392851u, 1519037663u, 779113716u, 2738053543u, 2754096050u, 2121500804u, 982626833u, 1064427872u, 1627071029u, 1799421889u),
+    SC(490669665u, 331510235u, 927653097u, 4010558541u, 1341899186u, 2739641489u, 1436050289u, 1379364712u, 441190387u, 3816107121u, 4151493979u, 3530159022u, 2848669857u, 2894763699u, 1938279708u, 3206735972u),
+    SC(1164630680u, 735028522u, 1426163473u, 1764145219u, 2188722839u, 2599797011u, 2331123230u, 996298865u, 2803113036u, 1732133918u, 4135374745u, 1403496102u, 61305906u, 1982207767u, 35608603u, 680731708u),
+    SC(3097030574u, 2239944926u, 3004506636u, 3698971324u, 438440050u, 806226289u, 3299217652u, 2137747676u, 2376642592u, 2372355096u, 1444993877u, 4198291752u, 3194432604u, 579432496u, 3143260503u, 58153128u),
+    SC(3073570790u, 2457870973u, 3254087300u, 132589961u, 3090464363u, 4031655485u, 3397735349u, 3738272915u, 2438408586u, 1610016484u, 3607490511u, 1979839295u, 1993157220u, 1628966973u, 2566520843u, 2415504793u),
+    SC(2516700697u, 2521039798u, 2777488721u, 3196543385u, 3593950703u, 2445108602u, 4227515375u, 3361503440u, 3741757104u, 1367007706u, 4282009789u, 2127358709u, 2970274265u, 108953332u, 1376097231u, 3612352600u),
+    SC(2841122028u, 289695603u, 908429972u, 1449591303u, 3496532142u, 430811028u, 1377898285u, 198605765u, 702014643u, 1582973696u, 1654127041u, 4145703462u, 294032334u, 4235431914u, 3438393459u, 865474483u),
+    SC(3545445168u, 3333415739u, 2928811023u, 1435493501u, 3112072977u, 3466119300u, 61597844u, 839813414u, 3787328278u, 1928915478u, 3046796186u, 549615137u, 3862451403u, 1325262296u, 3520760105u, 1333228419u),
+    SC(1325790793u, 3907821545u, 4134901119u, 1951705246u, 3223387882u, 561480379u, 1136389443u, 2963679361u, 3722857515u, 626885912u, 3665060294u, 2975869036u, 1378007717u, 1212143055u, 3672021732u, 2520983812u),
+    SC(436660944u, 1593040065u, 2835874356u, 3054866405u, 1746716106u, 2901130226u, 3275156703u, 889550475u, 1667636846u, 2171317649u, 477876339u, 169193861u, 3301423024u, 2923695575u, 1084572294u, 981889567u),
+    SC(3803276281u, 4055280968u, 3904809427u, 186227966u, 932166956u, 2399165660u, 3851784532u, 3001852135u, 813014380u, 4116676373u, 2706810629u, 527442580u, 120296772u, 3128162880u, 662936789u, 1729392771u)
+},
+{
+    SC(1686440452u, 1988561476u, 754604000u, 1313277943u, 3972816537u, 316394247u, 994407191u, 1904170630u, 2086644946u, 2443632379u, 2709748921u, 1003213045u, 3157743406u, 1758245536u, 3227689301u, 1181052876u),
+    SC(1258105424u, 4154135555u, 2219123623u, 3901620566u, 4152326230u, 2255006844u, 2043811343u, 3401743053u, 1077175625u, 4217078864u, 23446180u, 3296093630u, 2983403379u, 483875022u, 1821322007u, 933769937u),
+    SC(4094896192u, 2631249021u, 2047644402u, 1580854103u, 3103587285u, 3577080832u, 2726417365u, 309664155u, 1801899606u, 2578001137u, 150353312u, 1950478529u, 895600852u, 3405805048u, 2316670682u, 3067768105u),
+    SC(443311827u, 441757202u, 1505167796u, 3339695156u, 4080303377u, 2032258566u, 4249816510u, 3524388084u, 3057881006u, 1951550910u, 755229308u, 2331249069u, 1739558582u, 2222328965u, 511821487u, 2764767310u),
+    SC(989753134u, 2338266356u, 549068233u, 4113024610u, 2746193091u, 2634969710u, 3079940655u, 3384912157u, 143838693u, 4047635856u, 4286586687u, 149695182u, 1777393012u, 52209639u, 2932952119u, 3267437714u),
+    SC(682610480u, 2717190045u, 3874701500u, 2657184992u, 2055845501u, 1316949440u, 1867841182u, 3514766617u, 3083609836u, 2586162565u, 866399081u, 1085717952u, 3259379257u, 575055971u, 3866877694u, 451222497u),
+    SC(328731030u, 2942825188u, 1841689481u, 3492191519u, 967390237u, 99172838u, 3036642267u, 3931425637u, 933459735u, 3523655044u, 2662830483u, 2533317360u, 1151283556u, 1285468956u, 15891850u, 3194406721u),
+    SC(3082245252u, 2305218459u, 2853219703u, 1279555698u, 3695999195u, 2225441691u, 2702374346u, 2002979755u, 3394310641u, 1438568303u, 441738339u, 2319547123u, 745721770u, 3663132780u, 3613740038u, 3163545587u),
+    SC(3109530474u, 209548946u, 1705898345u, 1227555051u, 1300903197u, 521706788u, 1046889791u, 392785355u, 1195852439u, 1128202903u, 589172095u, 3844020294u, 989062243u, 3765536158u, 3601935109u, 563198009u),
+    SC(1408383323u, 2941773350u, 4185382573u, 3662857379u, 4172908289u, 4118722458u, 1935569844u, 1296819381u, 439467796u, 917888253u, 1573015538u, 2875181025u, 22626495u, 313409715u, 121133518u, 1579603291u),
+    SC(838355261u, 2323744266u, 929233883u, 1533162328u, 2939669145u, 1021427197u, 2448693967u, 1568998094u, 455286333u, 2516902543u, 1708158744u, 278073872u, 978123683u, 2512836694u, 3972232382u, 1433020779u),
+    SC(2010810703u, 4018381427u, 571706262u, 1692351234u, 4256546562u, 1231266051u, 268479287u, 2820752911u, 2261632188u, 845795375u, 3555293251u, 4247559674u, 3383569817u, 4149228066u, 180667610u, 1402241180u),
+    SC(3525485702u, 3451430050u, 2349871300u, 60510511u, 4165534527u, 3431222792u, 4244473672u, 526926602u, 763199050u, 672899723u, 1978849638u, 489006191u, 1575850086u, 1948428588u, 201110001u, 2038136322u),
+    SC(3829603224u, 567257667u, 2324557421u, 3080821304u, 1922441927u, 1741539649u, 2023385976u, 3349327437u, 1997432110u, 3734074051u, 1330703636u, 3180299184u, 1913578229u, 141656008u, 2692604045u, 1602929664u),
+    SC(29051889u, 27392875u, 2013870801u, 1608859787u, 4192290684u, 944038467u, 2706126772u, 4086572363u, 3654238115u, 631287070u, 4277765317u, 2361271762u, 4170133585u, 2022489410u, 2834765713u, 1378478404u),
+    SC(2835113470u, 3839837803u, 3596950757u, 2129670392u, 1881028173u, 4057879348u, 2459142230u, 3736551989u, 3032996358u, 1333513239u, 3006303259u, 3885122327u, 4228039994u, 134788219u, 3631677646u, 450886807u)
+},
+{
+    SC(2450731413u, 2768047193u, 2114778718u, 2363611449u, 3811833768u, 1142236074u, 836975073u, 719658637u, 89564040u, 2055034782u, 2279505737u, 2354364196u, 748992674u, 2341838369u, 3471590741u, 3103440079u),
+    SC(464369172u, 1784969737u, 2303680721u, 1699015058u, 1839678160u, 53342253u, 3929309179u, 3713202491u, 1764215120u, 2190365769u, 3137266333u, 3919018972u, 3446276485u, 1027535494u, 3649392538u, 1979045036u),
+    SC(3689697965u, 1535268856u, 4095087266u, 1879342666u, 1901613989u, 4062220771u, 1231692686u, 3479254943u, 517178359u, 3704348661u, 3200159500u, 592930780u, 3995209641u, 2367381241u, 1790597847u, 2276745810u),
+    SC(1563410665u, 2779883331u, 320555798u, 143478861u, 1984047202u, 2486036480u, 1819096593u, 876845470u, 4160262809u, 1685665332u, 1096211683u, 3396846267u, 1079209808u, 1622135728u, 2746449213u, 2258485533u),
+    SC(1981422448u, 2212169687u, 873443773u, 3576733408u, 3923794933u, 1875069523u, 3053667173u, 4292418240u, 2192702144u, 1027092432u, 278807989u, 2315740043u, 485097259u, 4099751129u, 1350843241u, 1137138810u),
+    SC(3929635582u, 2647315129u, 1255145681u, 2059161179u, 1939751218u, 2574940312u, 1013734441u, 3958841903u, 615021475u, 1092396560u, 1516857705u, 4167743313u, 744612233u, 1609870616u, 1905505775u, 2106400820u),
+    SC(1036005687u, 2272703162u, 2208830030u, 2182996589u, 441615709u, 3591433922u, 3586649797u, 164179585u, 3077875769u, 1792522157u, 2657252843u, 657567108u, 656390324u, 1816007391u, 3075467586u, 3873231707u),
+    SC(1236896749u, 2895887291u, 1978987518u, 822801819u, 516389325u, 1102535042u, 1787993035u, 3557481093u, 3231661433u, 991180576u, 3686912074u, 1297456949u, 3327185778u, 308709174u, 495078044u, 2969592590u),
+    SC(2019907021u, 744703189u, 2139199843u, 518542186u, 3124680574u, 142934434u, 551498542u, 3021773546u, 4091561632u, 1051317147u, 825719313u, 3707224763u, 335483791u, 4028731434u, 1335000639u, 4102709448u),
+    SC(1093818871u, 985937516u, 327542691u, 2046117782u, 1264752065u, 697293694u, 1615263505u, 1156460629u, 2812684388u, 1192736815u, 3019618111u, 4209127823u, 2556369187u, 2112950523u, 637809851u, 2176824541u),
+    SC(1687299893u, 3728297084u, 490922479u, 3634470646u, 250826345u, 3692215527u, 3273717576u, 965983458u, 2226919381u, 1460789800u, 2122435754u, 2519058236u, 1620196106u, 4066817802u, 1130044433u, 3889340415u),
+    SC(852530522u, 3312783835u, 1596416107u, 1741549460u, 2684468674u, 3424816114u, 2501858342u, 1775689041u, 2140910620u, 3593295971u, 3269455071u, 2386348485u, 3506744308u, 1454965514u, 1429132807u, 1936823584u),
+    SC(606602909u, 3019871883u, 3512048756u, 3287518999u, 3877975051u, 3914786486u, 3870177904u, 1340649290u, 520571284u, 3028797996u, 2616337132u, 1103844529u, 3133726039u, 1357152000u, 1508799653u, 31330228u),
+    SC(2817743510u, 2877820134u, 3034826170u, 1694674814u, 3472934533u, 2992700940u, 940570741u, 734740020u, 2101869811u, 3976806699u, 3986671415u, 556491401u, 2336314226u, 3375597171u, 2706276162u, 2068498899u),
+    SC(2875346415u, 3996130283u, 2530370154u, 2292821435u, 1717542531u, 4166402291u, 2045046397u, 210928306u, 1305773764u, 891667924u, 1720475570u, 2097400197u, 3748242244u, 1645769622u, 3986372109u, 4259524466u),
+    SC(258680563u, 3407077353u, 3701760456u, 1531445568u, 3746171918u, 2983392727u, 1490964851u, 3947644742u, 2779475335u, 3867487462u, 2573576052u, 3434694262u, 2755711440u, 3366989652u, 566303708u, 3091229946u)
+},
+{
+    SC(2925506593u, 3911544000u, 1647760999u, 3077282783u, 810174083u, 3532746750u, 1218244633u, 1800164995u, 3882366571u, 1552758454u, 417617232u, 3581187042u, 1107218813u, 308444727u, 2996521844u, 3546298006u),
+    SC(2766498247u, 1567718891u, 906631353u, 1539374134u, 2937267715u, 3075423755u, 466239025u, 348294756u, 2802746156u, 3822638356u, 2215866298u, 2676073175u, 2327206803u, 3701444736u, 533673746u, 1949565232u),
+    SC(779912645u, 2120746348u, 3775586707u, 1719694388u, 3225985094u, 1124933767u, 2466028289u, 3688916232u, 2352972448u, 3100332066u, 3699049642u, 105143046u, 3528587757u, 3202351686u, 3275195870u, 2542878955u),
+    SC(4208701680u, 3032319563u, 1934783333u, 1683344422u, 1898255641u, 1818484420u, 1090856325u, 4203146066u, 3166734039u, 1425051511u, 411614967u, 1272168350u, 905464202u, 2860309946u, 2899721999u, 4016531256u),
+    SC(1252276677u, 705548877u, 3321309972u, 2587486609u, 1841091772u, 1176108340u, 2483104333u, 1124739854u, 1417860124u, 2145011089u, 1095816787u, 561231448u, 3047186502u, 2188442748u, 782343512u, 2073487869u),
+    SC(773625401u, 1399854511u, 2112273744u, 3798562401u, 2328245221u, 4053035765u, 884849756u, 2543299151u, 3064173848u, 3322400978u, 2493736578u, 4109781307u, 3356431908u, 2033183790u, 3916558464u, 937192909u),
+    SC(1676839026u, 1837563838u, 681907940u, 1979087218u, 3861274680u, 1004821519u, 3526269549u, 3587326189u, 4130121750u, 5876755u, 277168273u, 3347389376u, 1295078502u, 3055055655u, 988901279u, 1750695367u),
+    SC(1466696987u, 793586382u, 3395028606u, 688541023u, 227515247u, 433349930u, 1151320534u, 2638968365u, 2730052118u, 2419949779u, 4184196159u, 3075595332u, 1762597117u, 3208522231u, 3793454426u, 2205574333u),
+    SC(2271935805u, 2221340650u, 4006866556u, 3892925071u, 3300102857u, 4023132062u, 1966820825u, 193229358u, 3829742367u, 3288127030u, 2999566231u, 1746318860u, 611198282u, 1740582489u, 586692015u, 272371975u),
+    SC(1512874083u, 1683202061u, 3100471136u, 875884760u, 2252521753u, 3056609126u, 2397470151u, 3238829627u, 398340158u, 1086173909u, 2650682699u, 3851040891u, 267796754u, 1063916466u, 134772391u, 616879617u),
+    SC(1190901836u, 3498895828u, 121518848u, 4122627266u, 4044339275u, 3929319666u, 3725675569u, 2249645810u, 1648430039u, 805152867u, 604009597u, 428134903u, 3660078748u, 1495738811u, 2912743026u, 3529964664u),
+    SC(1098872981u, 3803982233u, 1184687675u, 1724685244u, 1166128174u, 3324080552u, 2889006549u, 591614595u, 442372335u, 2188313994u, 392144341u, 559497602u, 2786744839u, 1080958720u, 963196350u, 4153188088u),
+    SC(2439538370u, 4080798018u, 3371249236u, 2272355420u, 3780648680u, 116755088u, 1743646150u, 3071185844u, 3348389643u, 3506488228u, 3592742183u, 3935997343u, 3470563636u, 4177761627u, 2879753187u, 203653531u),
+    SC(3278048310u, 2898758456u, 2355004932u, 2165371155u, 909690763u, 4208028121u, 3529336571u, 120122699u, 1468577489u, 2088039937u, 3804192119u, 4005659309u, 496708233u, 114985314u, 4186471387u, 1516837088u),
+    SC(1694326758u, 3482448156u, 2533790413u, 3535432659u, 1293417127u, 2007819995u, 3512854075u, 2476797465u, 936262398u, 4149678787u, 807292055u, 1683402105u, 3767740082u, 682769936u, 2956180563u, 2800734304u),
+    SC(804843744u, 1565609957u, 1986774659u, 4163563545u, 1192892219u, 2967653559u, 1407927717u, 134508609u, 2584983666u, 3798685912u, 1759632157u, 1938927553u, 3974685712u, 2763800386u, 3702401831u, 3969543832u)
+},
+{
+    SC(2016238746u, 3648008750u, 3741265531u, 1468285316u, 3314132186u, 3225615603u, 2260838904u, 650230459u, 666608997u, 1079817106u, 1685466519u, 3417306450u, 465799968u, 1454367507u, 1432699603u, 4060146438u),
+    SC(1761873323u, 2175765323u, 123320402u, 1086415744u, 3425420197u, 3163463272u, 2096010147u, 892174421u, 3834451486u, 191088153u, 650609666u, 1384830375u, 430440180u, 1275312435u, 936713210u, 3964237847u),
+    SC(3490530311u, 4154571850u, 1473147571u, 1874492814u, 3394183939u, 690761407u, 1765847887u, 4254640890u, 3957252213u, 852293459u, 403059579u, 1419995731u, 373422976u, 1691953324u, 1513498303u, 3782064719u),
+    SC(2587537765u, 1727580331u, 2067598687u, 2050934719u, 1018600463u, 825517190u, 281367288u, 396667874u, 2125440864u, 2142555808u, 3739024155u, 471264185u, 2298783646u, 926505635u, 485317745u, 4237064052u),
+    SC(4177694527u, 1331122857u, 2632274962u, 2272030823u, 2711200568u, 493910969u, 64158788u, 2976239616u, 2805230971u, 1856476899u, 706343172u, 883417303u, 3085501222u, 2167885061u, 2608970459u, 1305891290u),
+    SC(3887930902u, 1612140391u, 329833229u, 737708613u, 660227298u, 2588285981u, 3429746116u, 4247477263u, 2536670475u, 1091054728u, 1521783433u, 4262529359u, 3261855757u, 453613765u, 484850910u, 3619344637u),
+    SC(3635973664u, 4002263582u, 683484955u, 1188525929u, 3024525647u, 1588813480u, 3496033065u, 109022234u, 2342061519u, 1416918501u, 2207158673u, 948640868u, 637445219u, 508491813u, 3897434662u, 680054967u),
+    SC(1039851594u, 403130855u, 3868498597u, 1611578944u, 2942424644u, 2874427101u, 1261647069u, 261871566u, 2520758170u, 2840740989u, 3799279215u, 381717039u, 3582347301u, 2025353438u, 2948438214u, 2918501540u),
+    SC(81851588u, 3029358979u, 3777821133u, 2109529880u, 3684139703u, 3572137489u, 2624799u, 2076188243u, 53500651u, 2606703535u, 3206313372u, 346558880u, 465806762u, 434266486u, 1902707603u, 4080110534u),
+    SC(3612241613u, 1917140707u, 4136616607u, 4041104182u, 2193790431u, 801466537u, 3599423303u, 3561003895u, 1189069231u, 8494816u, 4244955339u, 451969883u, 3908494655u, 517115239u, 1812731691u, 777430858u),
+    SC(3522137911u, 2027939004u, 2210696271u, 3920541975u, 875695915u, 2825269477u, 687289812u, 4252564584u, 1824925315u, 507608234u, 2614820601u, 2462525050u, 3886866857u, 668083682u, 2768243607u, 3293579201u),
+    SC(1682273922u, 1330912967u, 3636074852u, 840196898u, 1025234484u, 1557176067u, 2837118766u, 3109038869u, 594323342u, 3200796742u, 1959017554u, 1440926582u, 3021668826u, 3738492638u, 446292405u, 2414347832u),
+    SC(4116164451u, 4091036540u, 474505628u, 1269644927u, 3643568118u, 1673027873u, 1438360759u, 4022285580u, 4024623082u, 1654730750u, 1581385912u, 3853471495u, 335076979u, 2185560806u, 2494598452u, 3520671279u),
+    SC(4099595861u, 2215053464u, 488918654u, 2772869965u, 2247823716u, 1588093320u, 1138185172u, 732569291u, 247618738u, 1702163570u, 1772683376u, 1056938600u, 1997535786u, 2064838561u, 3705150691u, 1453615480u),
+    SC(3809909081u, 1962152573u, 3909100601u, 1479514000u, 1615313752u, 3569344372u, 997113509u, 3043376485u, 3480943705u, 4021042580u, 2284195092u, 2749518560u, 3037939132u, 3554704413u, 185068622u, 683070990u),
+    SC(3163624176u, 326387389u, 438403431u, 1924575191u, 1706136937u, 2432230714u, 4175139676u, 713582699u, 175432919u, 505729353u, 375905517u, 3179239595u, 2233296987u, 472507277u, 1822318909u, 3059447908u)
+},
+{
+    SC(3955300819u, 2390314746u, 8780989u, 1526705205u, 4147934248u, 1494146575u, 1667625450u, 2277923659u, 406493586u, 957460913u, 3449491434u, 912766689u, 1387230361u, 2368913075u, 3538729245u, 2943257094u),
+    SC(2095358020u, 3831852940u, 1752942227u, 477088929u, 2503091779u, 898077u, 2215106688u, 1298885808u, 352224250u, 3952364758u, 3669616566u, 664714721u, 1826685582u, 1576488055u, 2121138397u, 1442223205u),
+    SC(1378268686u, 187975558u, 3210161726u, 870689300u, 1860632239u, 902013623u, 571573600u, 25414363u, 3412397724u, 3841538145u, 215707661u, 324367139u, 2323478150u, 3794355190u, 1128115053u, 2519022352u),
+    SC(566244395u, 2591175241u, 2926679038u, 2852174582u, 200192886u, 521908517u, 2098042185u, 3563798587u, 1529741033u, 1248315044u, 233787221u, 2706044694u, 2870731528u, 3970719810u, 4167465378u, 525407392u),
+    SC(2196340159u, 4056996284u, 1702457669u, 2086317410u, 3933566271u, 3751624213u, 4023204768u, 677196918u, 2137509058u, 4037704026u, 2299370032u, 1748548051u, 3326874481u, 1974512389u, 1751264060u, 266112293u),
+    SC(1812114662u, 524787647u, 285577300u, 3638318945u, 3389691808u, 585441476u, 145370930u, 1149989778u, 1314386440u, 3471672106u, 908522311u, 4171434326u, 329350743u, 2954206373u, 856961382u, 2008618089u),
+    SC(2318825510u, 3826102862u, 687747522u, 4263777564u, 2387018418u, 1135189382u, 1414060091u, 217356911u, 2998889592u, 698204196u, 801530770u, 3479982231u, 1117806357u, 154519605u, 960816747u, 3149429798u),
+    SC(3250819610u, 351683992u, 296382659u, 4149667465u, 2183346760u, 1485561783u, 2218034265u, 420633334u, 1869679065u, 1205517989u, 3666184780u, 1975151679u, 371905540u, 367504198u, 1917294142u, 2403996454u),
+    SC(3958230362u, 3773825115u, 783748416u, 1243337893u, 4032003144u, 3908441244u, 201600922u, 2000451013u, 728826842u, 3533421010u, 3229478766u, 278198864u, 3933272000u, 1331731276u, 3202405750u, 1474627286u),
+    SC(3181836998u, 2581633616u, 3993055681u, 4020956268u, 2094932060u, 3551878275u, 393027783u, 2154269634u, 2283536956u, 2260289773u, 832949759u, 2403309662u, 3488387345u, 1652392255u, 393935478u, 2309058441u),
+    SC(4141036972u, 1727820200u, 832481848u, 1055621047u, 1091666560u, 1393833209u, 3406509646u, 2428157250u, 2974564551u, 2286298667u, 3776410458u, 815994971u, 1241023789u, 775596275u, 1035618310u, 3934253771u),
+    SC(206932164u, 4239023187u, 2046365950u, 2616857124u, 4246776524u, 4059028269u, 129664965u, 907402684u, 3859465657u, 4204192080u, 91453633u, 301171900u, 385561248u, 2689085222u, 1614465584u, 3977451005u),
+    SC(3683171878u, 3148577689u, 4042394721u, 1085044656u, 682611813u, 2857177748u, 2417075323u, 2983755657u, 3777418770u, 2448398967u, 3909780770u, 4000218621u, 4227580585u, 2425908645u, 1704039191u, 3712924954u),
+    SC(290465694u, 3921687099u, 2971845338u, 1854613741u, 1583022754u, 371222458u, 1744154613u, 3918664956u, 1960343256u, 1291903121u, 4010470137u, 1525668440u, 4091170130u, 1370665614u, 3468958243u, 1262617601u),
+    SC(469638518u, 1129475898u, 3766065538u, 1777952666u, 2589258222u, 3182239596u, 2626554219u, 1853296675u, 2912212627u, 2518041806u, 2743002885u, 3765128027u, 851537937u, 2059010589u, 1827964742u, 3630398912u),
+    SC(2458599023u, 2699477701u, 2305781427u, 2536499567u, 2118412162u, 1356010449u, 1426052710u, 725853717u, 1358092245u, 4196538471u, 66159936u, 4076320019u, 3065284443u, 2664736186u, 1943959552u, 939016920u)
+},
+{
+    SC(3159079334u, 690659487u, 1550245019u, 1719420482u, 1795694879u, 2846363486u, 15987067u, 569538014u, 1561199762u, 967336684u, 3110376818u, 1863433225u, 3468533545u, 3644881587u, 369296717u, 3652676359u),
+    SC(3207794512u, 2847938045u, 2415472979u, 1444858769u, 666387488u, 1660608279u, 1038886882u, 10876848u, 2468284561u, 2494495733u, 2622688628u, 2362399325u, 2213804831u, 3448783854u, 3958704532u, 3639349832u),
+    SC(54374990u, 186360229u, 3420619566u, 1356363720u, 2768151763u, 3862789233u, 4270651882u, 2681019589u, 2332931746u, 928338209u, 3968478928u, 3908570621u, 923281930u, 2285715383u, 3620920276u, 130031468u),
+    SC(4009596626u, 493238747u, 1786722937u, 653638870u, 1636723425u, 1884625267u, 2113708566u, 1448416211u, 3613674959u, 239497564u, 404863679u, 1521570751u, 2819432609u, 623319225u, 3073321373u, 565867032u),
+    SC(1220575379u, 4235426741u, 1889734996u, 43054857u, 879216917u, 3299856237u, 2922851906u, 1054251029u, 693641076u, 1704223409u, 961665328u, 2828086835u, 2727513652u, 1580557310u, 4169876178u, 682569510u),
+    SC(1757813477u, 22814395u, 3549822650u, 2254547303u, 372100012u, 1555116803u, 2587184145u, 3995169383u, 2645743307u, 188252331u, 3723854483u, 2138484090u, 1895504984u, 3538655836u, 1183003060u, 1439034601u),
+    SC(2578441833u, 3136721732u, 380864696u, 817462912u, 2257087586u, 2256998015u, 93155068u, 930999672u, 2793712092u, 2223512111u, 3157527446u, 1098951014u, 3490358734u, 1362531303u, 2421324125u, 1961922428u),
+    SC(1049179776u, 2969815936u, 3869567708u, 2883407597u, 1876243265u, 3498929528u, 2248008570u, 1231166427u, 3544374122u, 2839689583u, 1991744998u, 2798946627u, 736844268u, 1293771673u, 153373649u, 1931110485u),
+    SC(3785289356u, 1913060964u, 169967200u, 3348219956u, 3732729076u, 987877186u, 3063387163u, 3310757163u, 3480818987u, 1991307039u, 2882756981u, 1215305494u, 855630497u, 1471153868u, 1338946323u, 398364632u),
+    SC(1356154057u, 3013675057u, 3810909135u, 1796458190u, 2691409967u, 3963509663u, 2487357466u, 2764459334u, 2828737787u, 378542508u, 427318427u, 2412936991u, 393927878u, 3384382899u, 1135834101u, 3447900619u),
+    SC(3813669196u, 1922867812u, 483725924u, 518662823u, 3954558327u, 1908218112u, 2258643690u, 2093138355u, 1162728847u, 205977116u, 821018600u, 1237824238u, 2980682686u, 1821003630u, 3221633606u, 2717269894u),
+    SC(1353035942u, 2442753208u, 348196860u, 2355246066u, 2218279077u, 2203055542u, 1964199656u, 1329637142u, 1824193111u, 3965017045u, 795175573u, 1029253807u, 3915633667u, 1084707851u, 1682462202u, 2090124205u),
+    SC(190807548u, 1133131805u, 249542006u, 2858611426u, 304500253u, 2183315108u, 4145782890u, 2998333644u, 962888949u, 974441750u, 1484862994u, 801464190u, 2311388331u, 114769498u, 4260362972u, 1017092877u),
+    SC(1311406963u, 465174990u, 1760870095u, 883652788u, 1015674641u, 840236175u, 3124632038u, 2756294642u, 178804852u, 3164952754u, 241649187u, 1040890173u, 82588907u, 1771630815u, 1058353446u, 2473824375u),
+    SC(943051847u, 4107933890u, 535438460u, 2683519853u, 3177219980u, 3711205196u, 3390138615u, 2920849102u, 3747455519u, 4138118615u, 400899690u, 4278329560u, 2602463649u, 808685972u, 136036034u, 1078020636u),
+    SC(2185570356u, 3896907774u, 3620938057u, 1790823508u, 720763411u, 2404776615u, 3257162972u, 1221107462u, 3223154083u, 2528715719u, 688766234u, 1813423773u, 2324112952u, 83241050u, 4119437520u, 552112812u)
+},
+{
+    SC(3370489298u, 1718569235u, 523721575u, 2176389434u, 218587365u, 2490878487u, 2288222859u, 812943600u, 2821517993u, 3626217235u, 1545838667u, 3155352961u, 741681736u, 669093936u, 2382929309u, 2620482966u),
+    SC(40739723u, 469402467u, 1810137291u, 109375068u, 1888845715u, 2140810583u, 1053250454u, 3220064762u, 2539857789u, 4089587896u, 1364971662u, 2996699084u, 3939034030u, 2020251221u, 1606532641u, 3453095239u),
+    SC(1376139558u, 886121026u, 3003069127u, 3500718919u, 4223467610u, 3212808910u, 126355621u, 2065481301u, 218954382u, 1236555811u, 2283280895u, 4256918831u, 1550185311u, 896721211u, 4286247506u, 2515527710u),
+    SC(2942433244u, 2364220023u, 3675668782u, 3695614763u, 4041312428u, 2311531471u, 543507321u, 1902188023u, 1380686629u, 2455468346u, 2346421766u, 2211296276u, 3675221499u, 3890242164u, 3592353914u, 323566438u),
+    SC(971323999u, 4115912859u, 3703400072u, 2662062035u, 2355087034u, 610373016u, 2293984834u, 2456129286u, 2927901115u, 1832014620u, 1168920846u, 552716242u, 3101454502u, 1707155244u, 3450287619u, 2546358284u),
+    SC(3062358608u, 1394539264u, 4158727824u, 1704721957u, 1117692646u, 4057908715u, 1958466020u, 2309578289u, 271836599u, 2617957229u, 202314495u, 2948978715u, 1423414031u, 4128837100u, 1937488702u, 3301405882u),
+    SC(1276638700u, 885904232u, 3686149920u, 3283641475u, 619290126u, 2510808612u, 1691008630u, 573145513u, 506979295u, 3062936948u, 2703005699u, 4056634904u, 3460956977u, 3783023797u, 1215556973u, 3726733337u),
+    SC(3145485089u, 2008513183u, 2407056102u, 633050174u, 2634406893u, 2883313710u, 1233018283u, 3273507959u, 174012667u, 2126243450u, 2258342097u, 2857351925u, 3446764464u, 1187986524u, 3004835628u, 3228122242u),
+    SC(991481464u, 1720231754u, 1918287975u, 2752686681u, 1174123782u, 4227334584u, 1634945718u, 1074218184u, 3572504705u, 1199611126u, 1378243227u, 2901862427u, 2145083550u, 1055786253u, 3960418624u, 587771424u),
+    SC(3060872990u, 789280525u, 184089463u, 1784976524u, 344050594u, 2949751745u, 3173202246u, 3813443247u, 1247337895u, 4000924548u, 76989753u, 2093985529u, 265772293u, 3310477933u, 717631968u, 1024610284u),
+    SC(3399834097u, 2964304651u, 3593395714u, 2850196125u, 2344305533u, 3920139836u, 937580696u, 1116439644u, 4147778799u, 544787491u, 2461636418u, 2647550544u, 1451408824u, 3266700679u, 829974548u, 2625074193u),
+    SC(645329496u, 2808202504u, 1366740717u, 2841442794u, 1298546911u, 2730798019u, 3834987045u, 3258634143u, 4257492959u, 2976079952u, 1735944512u, 988426767u, 2395072762u, 3103996991u, 730963792u, 4206896923u),
+    SC(3457675112u, 4140282966u, 1286302693u, 575230857u, 2270112110u, 3056424235u, 1835144711u, 421529065u, 2499621064u, 1907217915u, 1365357672u, 2875249236u, 1193490885u, 644367230u, 2115448516u, 2507997379u),
+    SC(70240820u, 3745431832u, 1098747160u, 82118642u, 2446590634u, 851446619u, 2715739022u, 2142293045u, 2689000746u, 4219383621u, 3140617705u, 1457579904u, 2541485894u, 3932513084u, 3406615220u, 2746135210u),
+    SC(2576508439u, 3244150028u, 2516535555u, 3986514000u, 2903382402u, 2225326585u, 1780804949u, 1164188435u, 1682143109u, 2949153515u, 1249412173u, 349674695u, 3467452794u, 1021028584u, 1194554595u, 1296132950u),
+    SC(1028084134u, 2577983628u, 184499631u, 1037888434u, 1676727662u, 1831883333u, 1276555462u, 4161670547u, 372201005u, 844715673u, 24290758u, 1268964661u, 297554992u, 4061435345u, 719976096u, 1670144314u)
+},
+{
+    SC(1239892635u, 3772349433u, 1058531752u, 1409211242u, 2847698653u, 2391143499u, 2637108329u, 3000217976u, 4288568828u, 658925470u, 2552628125u, 1468771377u, 3230644908u, 2692030796u, 7587087u, 1951830015u),
+    SC(488413080u, 1055864530u, 1967623060u, 3973308786u, 2745059783u, 477755698u, 544732176u, 3786002606u, 1569550024u, 2935491988u, 1047898991u, 1749060996u, 1828274710u, 2943223535u, 3716062834u, 1253889972u),
+    SC(1626917485u, 492893476u, 2371366539u, 3928996000u, 3710769983u, 1237244931u, 1562679102u, 2930576193u, 2085522193u, 2968039733u, 3202113740u, 4250144171u, 3666251088u, 2016963274u, 293320478u, 3775462481u),
+    SC(3337977767u, 1831658883u, 1096680294u, 2436280860u, 119870062u, 1444445305u, 1467566544u, 2038307180u, 661842797u, 2493843529u, 3851219498u, 3941720925u, 1848373617u, 4051739727u, 1120765529u, 1101800264u),
+    SC(929493756u, 2211014659u, 3851484027u, 3468182176u, 147674626u, 3850162187u, 1517171722u, 907705770u, 3997080856u, 3666272567u, 659948161u, 2282159142u, 429200635u, 2563204390u, 1422415938u, 1688129608u),
+    SC(551422730u, 1797390513u, 2828310972u, 97463725u, 131839682u, 3917501017u, 566617767u, 700714239u, 3061891811u, 856175415u, 1072683059u, 1754819408u, 3533865753u, 2568134802u, 4226648923u, 32646755u),
+    SC(3538971706u, 2916601269u, 2891999350u, 3825811373u, 2355258376u, 2876141009u, 3940019347u, 1309282440u, 2567828520u, 1367177503u, 2910098023u, 1986452448u, 1802584940u, 1360144734u, 2877029236u, 3033303547u),
+    SC(3313753312u, 261894832u, 3637017242u, 3699232915u, 3508549542u, 3960876382u, 582644479u, 3199091169u, 3644395252u, 2675904765u, 2072396219u, 4071523208u, 3976776729u, 1025403411u, 2178466200u, 1107450603u),
+    SC(2163612584u, 2845646977u, 4033161886u, 2723908899u, 1902990762u, 3375716497u, 2588626243u, 513179480u, 3101622846u, 1458272618u, 3875706546u, 3028150894u, 3612001457u, 2583302957u, 3385091312u, 3719047138u),
+    SC(1256280924u, 3685139058u, 1853414115u, 3160743702u, 3455476559u, 2505590918u, 2308735646u, 3742507036u, 4016470170u, 330769483u, 3470077232u, 3383715347u, 1440115354u, 2667395648u, 1883060415u, 3332144245u),
+    SC(558087170u, 3027059128u, 1986900497u, 1642930671u, 5966195u, 3083778816u, 3199769457u, 1248728791u, 2110460619u, 327014118u, 2524517189u, 1776442925u, 1472982408u, 3459887088u, 1029172283u, 2232815594u),
+    SC(1544258748u, 3397993939u, 2721410152u, 2948125157u, 3562231734u, 3011402493u, 3266317933u, 527195819u, 369665170u, 3216603774u, 1952585925u, 258420856u, 3339671680u, 3733846143u, 2326118329u, 2310291176u),
+    SC(4140585488u, 4198875250u, 3415599245u, 3398679011u, 4155727512u, 331520374u, 785987151u, 146809315u, 2929041163u, 1558279570u, 1346822944u, 4167931729u, 2800498595u, 2809390575u, 3295157947u, 4121566122u),
+    SC(3571413466u, 1596401972u, 140853088u, 3137527478u, 204556611u, 4111255020u, 3835120334u, 3048525996u, 399176328u, 3005771198u, 780994070u, 3747160103u, 3136546207u, 508755537u, 2521091931u, 1715747893u),
+    SC(1156063870u, 393984449u, 1521183961u, 3649564442u, 183535572u, 3139859119u, 445469714u, 2815871833u, 1268459010u, 355340626u, 2465929503u, 750513297u, 1590602217u, 3983872541u, 97286792u, 110438349u),
+    SC(2549125874u, 1976691716u, 2532749644u, 279085303u, 633988261u, 3513450026u, 1057503157u, 1110164955u, 317735960u, 3241215082u, 3855084900u, 4137511567u, 3550729054u, 819799870u, 1929320159u, 2825290282u)
+},
+{
+    SC(2585638847u, 1394876113u, 3750575776u, 4144761638u, 1991524028u, 3165938218u, 158354186u, 812072970u, 3814951634u, 2507408645u, 1163603486u, 3566585210u, 1424854671u, 3326584505u, 3332079056u, 1901915986u),
+    SC(1520752595u, 1952396314u, 3263601295u, 3458083478u, 3797830135u, 509407552u, 3232598095u, 1205382790u, 2667815610u, 2560349365u, 2472625295u, 2883979179u, 554514567u, 2376619906u, 638138357u, 2568018129u),
+    SC(2442202610u, 2091297602u, 25025777u, 3622813695u, 3869161931u, 614884494u, 984078136u, 3345125623u, 3918959025u, 227030161u, 3885929851u, 1281751413u, 1612359075u, 2958486463u, 2884267132u, 3619290927u),
+    SC(3048700207u, 2570072469u, 1076153001u, 3767270422u, 1408579070u, 2076435276u, 2224129615u, 1962182553u, 1823335118u, 1499162388u, 1563913085u, 2068011578u, 1991334162u, 1665201834u, 1756239294u, 648108494u),
+    SC(2337582449u, 1819429591u, 3833487099u, 3870804287u, 2300831739u, 2232929806u, 1869816966u, 4084965807u, 4220168543u, 1248736546u, 924637940u, 73528534u, 2319796252u, 3657850751u, 2794932350u, 4220430348u),
+    SC(3028904021u, 2992718647u, 2354594543u, 3084902105u, 3127673085u, 783373559u, 3896264500u, 3984439851u, 820119108u, 4253719169u, 2623678017u, 3039126654u, 2922756242u, 2436956481u, 442364253u, 918876081u),
+    SC(1539558451u, 2306960255u, 1095386938u, 770368485u, 2906552323u, 3075682102u, 3534951832u, 2083903147u, 1308495764u, 2261904633u, 2112467113u, 1044610889u, 3222649255u, 1736090274u, 1954974285u, 1361850096u),
+    SC(587984395u, 1588261189u, 4052666242u, 512106258u, 651085942u, 2768947530u, 1250487652u, 1245674804u, 857176247u, 3594046498u, 647658046u, 2882585491u, 259918032u, 3698728358u, 632752990u, 351374374u),
+    SC(2404749839u, 3296323382u, 805352255u, 3954906457u, 3558496371u, 2470613864u, 2024150378u, 3564550335u, 2499521206u, 2051669779u, 607498894u, 3748811695u, 1128400961u, 3072401950u, 3042994760u, 811721793u),
+    SC(3595493043u, 1889077187u, 1981480426u, 4189336058u, 2081249554u, 2321560592u, 971543366u, 358725627u, 3595364674u, 3986924883u, 2193763710u, 4189195361u, 3121216309u, 1140981210u, 3226790033u, 353586077u),
+    SC(2871195936u, 2843651834u, 635723881u, 287569049u, 2067429609u, 2943584978u, 644639896u, 1264563774u, 670309272u, 2690274713u, 246950668u, 933865226u, 4053660195u, 1381269871u, 462688690u, 5420925u),
+    SC(977313734u, 4104230969u, 3334283655u, 1580178205u, 1578158646u, 1460773045u, 1728595474u, 3957344726u, 553676110u, 966612385u, 1786516334u, 2979157051u, 921122693u, 911238485u, 3922067113u, 1046213221u),
+    SC(91424183u, 123813459u, 1667146297u, 3387121372u, 438965888u, 4260725592u, 154972710u, 3237027664u, 3006360433u, 2505005588u, 2902337724u, 2660287100u, 1901200613u, 2646189902u, 2780155597u, 49560303u),
+    SC(3586622617u, 925349590u, 415005474u, 1260234539u, 30249250u, 2179523979u, 3475887768u, 3019952034u, 3517624902u, 4230850494u, 3734868171u, 742624613u, 822822789u, 3974379285u, 3711572581u, 3366701706u),
+    SC(329275906u, 1905371123u, 4004795330u, 2339811253u, 353091905u, 548998992u, 3687895576u, 356859438u, 2494263562u, 926298666u, 3983230019u, 2882391620u, 2824170047u, 2247742371u, 1881005652u, 1386887463u),
+    SC(1046492158u, 2680429213u, 1614272999u, 4010933686u, 2479992689u, 595409283u, 765550354u, 2852655093u, 1983575334u, 3910696497u, 2308266592u, 3012641543u, 2582478313u, 14949228u, 60656360u, 1955264759u)
+},
+{
+    SC(1355623958u, 2575138117u, 2562403739u, 1638722303u, 1523970956u, 2189861089u, 3498071469u, 1919711232u, 231840827u, 3230371223u, 143629793u, 1497495034u, 1677900731u, 1608282251u, 3485501508u, 3944969019u),
+    SC(1317209868u, 3823870608u, 3335344652u, 3702793515u, 2425890570u, 1442662397u, 4007605978u, 2976935239u, 1444558882u, 3449074340u, 523287240u, 1767769527u, 1776192231u, 1111610095u, 4035220013u, 3434023407u),
+    SC(1286632782u, 1751340143u, 184421370u, 3989392405u, 1838859918u, 3681550977u, 707040060u, 2695037953u, 1828105102u, 812532736u, 1115387936u, 1381188966u, 1389542552u, 621856846u, 1135930465u, 831833090u),
+    SC(2741542793u, 3565635943u, 455105161u, 2389444906u, 2966273581u, 4048751601u, 2569017914u, 1796095397u, 1515760827u, 3870103158u, 2737365395u, 818096507u, 2179280538u, 1254083919u, 2114706477u, 1413209953u),
+    SC(2036431795u, 3313380793u, 2996275588u, 625273343u, 1627738147u, 2163909313u, 2645773664u, 3066825866u, 3862562238u, 3189614065u, 3074707667u, 1611214266u, 689055345u, 1845962762u, 3616153367u, 98214289u),
+    SC(1783057147u, 1095836105u, 952581152u, 665189523u, 4159236737u, 3621720388u, 2768968806u, 1541462219u, 1550070665u, 2946487171u, 3084327270u, 3528580128u, 3683323170u, 2326350340u, 681502936u, 611874814u),
+    SC(2075965546u, 3954443814u, 3457426695u, 3100575745u, 795895906u, 2051458923u, 4220432661u, 3191956430u, 2978441632u, 1935083482u, 1260223004u, 1989210512u, 708452144u, 1742032782u, 412060225u, 942058976u),
+    SC(1554952802u, 1148928548u, 435577880u, 1218016814u, 774531999u, 4171943086u, 2728379380u, 1755428421u, 3096769247u, 551470356u, 663936617u, 2259245103u, 3605128160u, 4254582248u, 2543346251u, 2641240630u),
+    SC(2834055303u, 3779347324u, 986655417u, 1060344853u, 1961336735u, 3444096071u, 3402507696u, 1296975131u, 4013745799u, 318316127u, 3012349080u, 1543913977u, 3581569730u, 3073345556u, 1048961320u, 3338742347u),
+    SC(1917475623u, 1573453706u, 3775608035u, 1560651154u, 3305702627u, 840251936u, 2021694407u, 1567223161u, 1217097878u, 4101089784u, 1480235880u, 823763473u, 1860062290u, 3212933927u, 305432786u, 2664137512u),
+    SC(488290329u, 2159084342u, 1977681447u, 3072933047u, 2133970307u, 2904163387u, 2929381044u, 2852811875u, 3486789427u, 3312981159u, 2897952520u, 3716688458u, 3312599340u, 2231560239u, 2736260178u, 2100166993u),
+    SC(2561748569u, 2171003952u, 3930314290u, 4171544961u, 4084487200u, 1829909478u, 4190664042u, 1205662930u, 1332053018u, 3102835265u, 2758716514u, 3094681405u, 890009818u, 1835725787u, 3657145276u, 2012429206u),
+    SC(1490727773u, 2663703693u, 1786667419u, 3911642156u, 1173781475u, 1032437218u, 949369190u, 3379245680u, 3855657643u, 102309733u, 3862169655u, 1953708469u, 2899532678u, 2185103023u, 2246792392u, 2140300644u),
+    SC(1105179994u, 3403119551u, 2151897995u, 2133026531u, 4095632628u, 1958582421u, 3756551819u, 1353448323u, 343568827u, 940163873u, 3647008605u, 2675342302u, 2020863909u, 3314608025u, 3678853306u, 2350764749u),
+    SC(3610890660u, 7527132u, 3948519712u, 999155044u, 1566318108u, 1592356541u, 1395933920u, 3725362820u, 1628394109u, 2361449910u, 3407340106u, 1370203307u, 1521539242u, 166450716u, 1562824595u, 815891091u),
+    SC(4169640806u, 3985781662u, 2412370154u, 452406588u, 105016225u, 176939651u, 3796204183u, 875428687u, 2497589429u, 82221910u, 4277856341u, 1375558239u, 286683641u, 3316069361u, 519521869u, 2295715438u)
+},
+{
+    SC(1272080061u, 1249052793u, 3406223580u, 3180222548u, 3305857569u, 3627944464u, 989639337u, 2790050407u, 2758101533u, 2203734512u, 1518825984u, 392742217u, 2425492197u, 2028188113u, 3750975833u, 2472872035u),
+    SC(23055961u, 3145183377u, 2430976923u, 2926141735u, 1297155725u, 3931229778u, 1820665319u, 2985180446u, 3042883880u, 2460902302u, 3663963302u, 4048537328u, 3995357361u, 2497655514u, 2584741032u, 1771542440u),
+    SC(3555045486u, 1984442910u, 1340694232u, 3778110580u, 1134128670u, 754930307u, 645413801u, 419876731u, 718672506u, 2655370853u, 650960778u, 1175245889u, 3468383881u, 2671574337u, 44753822u, 3359158981u),
+    SC(289419990u, 2387037467u, 2851881154u, 4063189789u, 1829943773u, 2629576813u, 942097665u, 562844855u, 2647906183u, 117874787u, 202211775u, 3519990636u, 3082138694u, 1836881245u, 583992800u, 2183831281u),
+    SC(2721107251u, 1807232970u, 3202569269u, 3708638735u, 3532027994u, 4114767065u, 2764680156u, 135914892u, 1473879964u, 2935607101u, 4201045944u, 3202280567u, 3793176244u, 41830505u, 969791663u, 1519485648u),
+    SC(1497249350u, 1416277963u, 4236912956u, 1827689230u, 1595876921u, 792380080u, 2973128767u, 43523726u, 365213078u, 1703541227u, 1608568996u, 2447861933u, 4236202627u, 2270952660u, 996772411u, 1327926083u),
+    SC(930257564u, 986864131u, 3788206015u, 4282936823u, 3575152799u, 1711906087u, 3523467955u, 1026809541u, 3754676659u, 126901401u, 34761162u, 674497989u, 546239979u, 3916171265u, 4169565745u, 1773808675u),
+    SC(1188611875u, 4038625723u, 846346399u, 3124471166u, 3540873247u, 133640400u, 3354116939u, 2182269853u, 3158440321u, 538434017u, 508437111u, 2461460484u, 1662547818u, 3578959375u, 209001526u, 3335522863u),
+    SC(4264155336u, 4248354463u, 3273048757u, 2876562537u, 4290560912u, 509206354u, 1722430555u, 1796475043u, 864985283u, 4161684480u, 1401260098u, 2472895218u, 2342429930u, 827590760u, 300446032u, 2313806596u),
+    SC(2581459341u, 3429172659u, 2024065972u, 4099664542u, 1148350145u, 3444652410u, 3577141975u, 2981349935u, 4203645620u, 3053918552u, 3258443245u, 1577847138u, 1635931506u, 873577721u, 2391948063u, 3880308298u),
+    SC(348781524u, 168814463u, 525438717u, 333282992u, 3413546488u, 563982782u, 3571937262u, 2168075485u, 2567967190u, 4135534212u, 2773230423u, 2560090101u, 4070935767u, 1086323696u, 2826348049u, 1398744384u),
+    SC(1019826995u, 663251023u, 3152709102u, 4103744231u, 1372971676u, 1214523997u, 1159949230u, 2703418845u, 786011241u, 2156179212u, 1156040729u, 3454726929u, 1928366760u, 4000343119u, 4288863167u, 3214674902u),
+    SC(2681260382u, 4128008241u, 2510236484u, 1511367526u, 1684226652u, 979685907u, 2954161581u, 3173181201u, 2348267479u, 1347783270u, 1149362033u, 739573388u, 2484197607u, 335176176u, 4239049161u, 739872951u),
+    SC(2990421330u, 2634202447u, 3179573376u, 2783566953u, 2521510477u, 3781882024u, 2239710944u, 2912891640u, 4089020966u, 4152247187u, 3694477470u, 1764138981u, 2507816564u, 3857045441u, 3960587447u, 1062920229u),
+    SC(2607237939u, 3082469982u, 2290705462u, 3066564076u, 3196897175u, 4248068159u, 2751492888u, 1096521131u, 1350638971u, 3209282660u, 3725272910u, 717966828u, 1468400702u, 1807609199u, 332456241u, 3283231722u),
+    SC(752680913u, 2889161941u, 555836002u, 2587892579u, 793746532u, 2681266768u, 719050347u, 3803221u, 1422540107u, 1615046554u, 1724888503u, 923959013u, 3231965435u, 2753642578u, 1839210672u, 3344430910u)
+},
+{
+    SC(35118683u, 172484830u, 3416100291u, 3700412376u, 540823883u, 3117923166u, 4211300427u, 2853939967u, 3346783680u, 988896867u, 2435731911u, 431849862u, 1744411117u, 2614624696u, 297543835u, 4045956333u),
+    SC(2040009399u, 3617093372u, 1922089948u, 419196583u, 488784755u, 779735420u, 2537006207u, 704283906u, 1092151363u, 2578829348u, 2820670194u, 2121866485u, 3135057501u, 2561548080u, 1838738028u, 3520705790u),
+    SC(2347233873u, 2021920507u, 3747005552u, 3302704092u, 1421533666u, 2091592699u, 3349570591u, 3813605549u, 115030445u, 3350012162u, 2428670067u, 3833734570u, 1834087037u, 3648785167u, 3795974654u, 230561124u),
+    SC(3166315679u, 1499753232u, 1332394568u, 512254231u, 3188709397u, 2787249743u, 4120940214u, 2887173650u, 3906489413u, 2295240998u, 2578634494u, 1588397589u, 1261609842u, 547227344u, 3285763119u, 2699176838u),
+    SC(2920964533u, 3740093834u, 2438698186u, 1924062654u, 745692322u, 2251363856u, 1198363872u, 1945834517u, 3791006786u, 4021475876u, 1202959856u, 137650558u, 3764418806u, 2028729507u, 3549185474u, 4085572018u),
+    SC(2715838951u, 1959655040u, 1103474341u, 961883214u, 3220165814u, 946461598u, 3310562057u, 3895921046u, 3423737504u, 3466676673u, 4053794032u, 4003999722u, 704282430u, 186242539u, 1929875533u, 2743489242u),
+    SC(3863164996u, 1689760206u, 3183192577u, 2929742795u, 2741898431u, 3788088914u, 2356234821u, 7039846u, 36640443u, 397902308u, 1207730645u, 450227359u, 3243815017u, 2084858847u, 1390053102u, 1800322698u),
+    SC(2899288970u, 284742850u, 4164169257u, 657423444u, 1943078242u, 2187671316u, 2338824812u, 1463135135u, 2886625321u, 272841068u, 3193451269u, 275059886u, 893727404u, 1588413844u, 3713690958u, 858582046u),
+    SC(220208151u, 2716463025u, 2076296789u, 1220608226u, 1158026410u, 3025895717u, 2670689841u, 80726308u, 1182245224u, 514737744u, 1549626516u, 2794996864u, 1140029757u, 2873715616u, 2877687374u, 2336796195u),
+    SC(1712499527u, 3009254442u, 159655935u, 3126441867u, 4265886590u, 3094626983u, 2035167860u, 2311303989u, 3444838362u, 2596170866u, 3801673179u, 1837914686u, 3231006463u, 1247923284u, 584065013u, 4147287941u),
+    SC(900839097u, 216650153u, 2150488455u, 1952211291u, 2276027011u, 3518121564u, 3433005808u, 477320989u, 4007917006u, 2860081630u, 3686269191u, 921073036u, 3922496269u, 1487331039u, 3974930220u, 2054391386u),
+    SC(3348685354u, 1508268709u, 1715972206u, 4188610176u, 2563479521u, 2178972493u, 3288192040u, 3754144178u, 1173914019u, 454089507u, 3398639886u, 574196980u, 135948897u, 105476021u, 2877469782u, 2140775314u),
+    SC(60661201u, 2505799644u, 1330476086u, 2641855913u, 3370908611u, 3545887069u, 2369313011u, 278373074u, 1677987717u, 2174519857u, 2497481396u, 1568231376u, 3671812134u, 1893623337u, 1526376990u, 3328774765u),
+    SC(2836826686u, 3566150450u, 1220364883u, 3711427451u, 3528155780u, 2723292785u, 3326692341u, 2222164977u, 1858144237u, 1869912598u, 665154087u, 1299959695u, 2415334423u, 2100885199u, 1677986979u, 848478053u),
+    SC(2293836559u, 1740853836u, 1031472293u, 3209927466u, 2722427870u, 1686533972u, 3134525842u, 43165427u, 4133377528u, 4179858803u, 3614537390u, 3380004165u, 2699323023u, 2351902646u, 3408173486u, 2494501357u),
+    SC(1820258417u, 3371479244u, 1743152481u, 953496909u, 4267482844u, 97428203u, 2755286865u, 830318058u, 1082737155u, 2096588114u, 869939293u, 1138867599u, 3414628151u, 3300388932u, 2755674787u, 886356844u)
+},
+{
+    SC(1981590337u, 957784565u, 3778147127u, 3909235993u, 1637480329u, 2280601867u, 1059949562u, 2968107974u, 4043469535u, 4159249472u, 895867525u, 402468881u, 3186079639u, 86430659u, 4027560590u, 4067278225u),
+    SC(174847206u, 2629171882u, 2333280466u, 3666750170u, 1365991192u, 1932613341u, 769674425u, 2870677148u, 3091982589u, 717533940u, 691292429u, 746447527u, 2346750954u, 2424023836u, 2489851473u, 1000862947u),
+    SC(1294470925u, 420276534u, 18534679u, 2910625938u, 3592407247u, 3676292946u, 91786365u, 2630448437u, 4060747756u, 3372072880u, 766751258u, 2899531047u, 631745164u, 3523898915u, 3168717447u, 2801541394u),
+    SC(4228902076u, 3340600279u, 3364406353u, 4167190351u, 39030410u, 2148305555u, 4106423272u, 4019775241u, 1048613489u, 896239533u, 2278643848u, 649090509u, 1858593869u, 1017004108u, 2725922618u, 2362479567u),
+    SC(3279186701u, 4095625861u, 3191586341u, 3252046177u, 4161721618u, 2329134038u, 751155705u, 2989611709u, 942304573u, 3648059604u, 2883823407u, 1492175829u, 54393633u, 3106238944u, 429976962u, 1435978615u),
+    SC(3849622377u, 2984399872u, 690474125u, 61954906u, 3671421106u, 3429544548u, 2830056933u, 4242121816u, 952897126u, 3854066003u, 462125754u, 3261473627u, 4248077119u, 2601130223u, 2596495819u, 1081964366u),
+    SC(3544595842u, 126020837u, 2577264196u, 3433073867u, 496013073u, 2132398305u, 2482253446u, 1347711182u, 3954364337u, 261394336u, 1107608476u, 3443266300u, 104305688u, 870955527u, 3446753045u, 646876293u),
+    SC(164137956u, 1354687087u, 347069906u, 2162313159u, 2097666782u, 2177194309u, 1083298213u, 1791764705u, 445921337u, 2034078155u, 2254058003u, 1297019339u, 2457505957u, 3923390662u, 3364713163u, 2092921u),
+    SC(2010686846u, 2180989257u, 2265174665u, 208481647u, 547071646u, 2570387552u, 227431381u, 3946252713u, 1802054573u, 2876468168u, 3435214380u, 619729504u, 96719536u, 601795828u, 1679578869u, 3266813859u),
+    SC(1689091897u, 2850488954u, 85895902u, 2363909390u, 557966933u, 189022184u, 4135255025u, 2090271113u, 2804992462u, 2897353835u, 3129164865u, 2671868525u, 1204434986u, 2421048110u, 1069687644u, 573230363u),
+    SC(1864118934u, 1742326766u, 130305247u, 3848358018u, 448383585u, 389136808u, 676464280u, 133776905u, 3973153497u, 15653017u, 4189644276u, 1910866015u, 4017185152u, 3100723612u, 137322886u, 3499754296u),
+    SC(2165760230u, 1978556390u, 4038887110u, 3280144759u, 2755863878u, 1292009146u, 4196675347u, 2883653205u, 2360229279u, 2940095236u, 4183119698u, 122598923u, 483221264u, 2336117478u, 1200036442u, 1470973u),
+    SC(22625049u, 2110942382u, 3865539390u, 3568657648u, 4280364838u, 467068956u, 1638706151u, 934686603u, 1016938107u, 1378881668u, 2052861738u, 969631954u, 3114829317u, 2704079673u, 4202235721u, 1896331078u),
+    SC(1272877817u, 322275610u, 2048255u, 3828419764u, 283292018u, 656555904u, 1730883898u, 407673382u, 3259565233u, 3319282763u, 829721223u, 1466466546u, 121051626u, 1142159685u, 3894622225u, 1384264827u),
+    SC(3763136398u, 3055118026u, 3433748869u, 930030556u, 2135841826u, 2075894041u, 2845381068u, 3086878324u, 257833966u, 160279206u, 524657374u, 1855318297u, 1760771791u, 1248968332u, 2414205221u, 2464430473u),
+    SC(3809273981u, 900900763u, 2895572448u, 3283497701u, 1349213062u, 580961411u, 3299214221u, 3628519825u, 3643683404u, 3319374656u, 3868217535u, 427844533u, 3841842588u, 2749654710u, 2681210929u, 1051800659u)
+},
+{
+    SC(1622151271u, 634353693u, 3884689189u, 1079019159u, 1060108012u, 22091029u, 115446660u, 534633082u, 1649201031u, 4042006969u, 137296836u, 1833810040u, 1562442638u, 3756418044u, 1181092791u, 160208619u),
+    SC(1041667920u, 3037209402u, 1477404634u, 1440610569u, 2797465015u, 2054982250u, 3391499235u, 3605494419u, 3639198696u, 1933432209u, 1915711520u, 2741088986u, 3869566747u, 1879175626u, 717801628u, 458685614u),
+    SC(2768417957u, 2138940313u, 1896672548u, 1414723957u, 827016389u, 745281061u, 1045174332u, 3577682097u, 2169383377u, 1730416479u, 712654956u, 3155052928u, 1776219501u, 3353461099u, 711436547u, 1497369655u),
+    SC(1896697766u, 3621973902u, 926548253u, 4069206549u, 2297004301u, 3251063401u, 993943014u, 1270589313u, 3281589988u, 588955836u, 2429665887u, 1734915238u, 3409902793u, 2578722241u, 654727507u, 3216225031u),
+    SC(2536890957u, 2554531636u, 2109372546u, 2649000077u, 358086224u, 3391808161u, 1211714614u, 2605265326u, 2606629887u, 206756474u, 1092207840u, 3362434504u, 3945886373u, 4232252600u, 2886868947u, 3532954370u),
+    SC(65718672u, 4071991225u, 2060698395u, 2198173427u, 3957878549u, 4022831630u, 3461473682u, 419893418u, 779469249u, 2019627177u, 2019172804u, 3609556656u, 2681069216u, 2978123659u, 1249817695u, 2366599297u),
+    SC(2811735153u, 3049657771u, 1390752797u, 1411409994u, 2127695318u, 3083850245u, 787626821u, 1929564189u, 855492837u, 4008216334u, 1809444437u, 2182869717u, 813270534u, 2247412174u, 1161082081u, 1381922858u),
+    SC(3920648469u, 503487540u, 2083562080u, 327383264u, 2785608988u, 867359286u, 1036950980u, 431152821u, 1419040671u, 2665230771u, 2455357484u, 351717207u, 3187759581u, 3348793239u, 2511298896u, 1213040259u),
+    SC(2396309679u, 670711827u, 2849604206u, 3201137057u, 818618388u, 2531623890u, 3805810347u, 1463443182u, 79508933u, 3480790940u, 3579218280u, 263259195u, 3368747551u, 3044188079u, 1352272344u, 3090026690u),
+    SC(337838342u, 789695791u, 185502398u, 1517725636u, 783544345u, 2877621235u, 2946546356u, 1215973672u, 1208860651u, 725001171u, 1289736233u, 3756237869u, 1654092362u, 364807179u, 4279861158u, 4016003402u),
+    SC(1113567525u, 3780565260u, 836674522u, 1827009520u, 756906197u, 2663480421u, 3902552087u, 3507352398u, 774509259u, 224530498u, 2361577079u, 3744385228u, 3961162378u, 2586454589u, 3040342450u, 332039963u),
+    SC(3041171145u, 1474749273u, 2282851768u, 649990155u, 2952549483u, 1360702019u, 1809905451u, 544396952u, 68636355u, 2878101257u, 1478326650u, 2199663643u, 320705780u, 628185476u, 2087425498u, 3828181698u),
+    SC(3988280964u, 459019854u, 4007245269u, 1946776277u, 125932076u, 3922945473u, 608655237u, 759981570u, 1458494773u, 3686363491u, 3746534866u, 3692063331u, 290340676u, 486223220u, 3313127929u, 2280570810u),
+    SC(233319658u, 3886064320u, 853251650u, 1236563554u, 538386922u, 1967845333u, 3003439052u, 2872751142u, 150287328u, 2176354561u, 3956114759u, 3858039u, 2003618785u, 4212993191u, 2956509701u, 3196752221u),
+    SC(2121593903u, 3906201458u, 1137774967u, 3978600103u, 780659717u, 3484790562u, 769856015u, 36405780u, 695767695u, 3397748350u, 3377872749u, 1577340836u, 783581424u, 3804923626u, 2896998870u, 1723843622u),
+    SC(2572703671u, 2154230449u, 1195305676u, 4208655231u, 922600921u, 448134411u, 986012643u, 2442352758u, 1662902878u, 1367546113u, 2863017129u, 59878996u, 2111442975u, 648834983u, 865532037u, 1000323350u)
+},
+{
+    SC(2802315204u, 2299944053u, 2128407100u, 3463617348u, 2448441666u, 1070000794u, 1884246751u, 210372176u, 4075251068u, 1818330260u, 3223083664u, 3496698459u, 3376508259u, 4156094473u, 3718580079u, 1962552466u),
+    SC(3866141502u, 1978128229u, 2646349807u, 2688968712u, 1012393569u, 2539553175u, 2230158790u, 2206981245u, 3747509223u, 1243575365u, 3510697084u, 4007723917u, 859148499u, 1713821117u, 199178654u, 2644187203u),
+    SC(1964672019u, 297703434u, 1518880848u, 3373273121u, 959853764u, 2251122694u, 723413077u, 800337307u, 648287930u, 2947400245u, 1113383775u, 3610122168u, 1829970570u, 2892296971u, 1554744636u, 494969279u),
+    SC(4031050415u, 1835549397u, 2490029791u, 1131956513u, 1204048760u, 1914510905u, 3436953651u, 3943499769u, 1759802551u, 3820069122u, 4025269834u, 2717988015u, 2671631612u, 1159803272u, 1951365142u, 4085381442u),
+    SC(606110736u, 4064038873u, 70240913u, 2494945854u, 3729188113u, 2063877878u, 3912150605u, 3215847250u, 2977890044u, 3389766053u, 356841724u, 356991784u, 2228722660u, 3145515298u, 2594559598u, 1158432841u),
+    SC(1794017518u, 25183950u, 1671020817u, 785574353u, 95301808u, 1715172822u, 2718673424u, 1470113919u, 1142251437u, 2499778479u, 4281783303u, 1325560741u, 2913926884u, 3804531669u, 3139007483u, 1406557472u),
+    SC(2970751291u, 2450850294u, 545967636u, 1959629374u, 3303894193u, 455065073u, 41447235u, 1831795469u, 3594460859u, 4077235761u, 722461030u, 598330044u, 192707446u, 509790368u, 1051867275u, 1446366645u),
+    SC(1959543921u, 1887295052u, 3154544834u, 487969766u, 2252004301u, 996805128u, 2018864848u, 597352487u, 1136669046u, 533675042u, 981364938u, 2653382923u, 1408807893u, 2742559841u, 1833041360u, 1912794731u),
+    SC(2721713526u, 3549551325u, 601974093u, 2790584575u, 3951999363u, 4215366345u, 2845142034u, 4218934731u, 1726020765u, 823952138u, 3809833u, 4233069287u, 1129914456u, 1399496316u, 1915356031u, 4169077603u),
+    SC(3926695685u, 1849292395u, 1522137139u, 1552827989u, 4109112844u, 2060253220u, 2853920191u, 801241282u, 3422535773u, 1693187125u, 2113050221u, 2708536698u, 2777027446u, 4174902187u, 1811957361u, 3772547370u),
+    SC(3930825929u, 747327770u, 2505687587u, 2880650279u, 583976081u, 3834434841u, 1957901663u, 82062519u, 1246607062u, 4096185443u, 1298601955u, 3551964017u, 2293924654u, 2316870880u, 1326950040u, 3135743003u),
+    SC(2476396705u, 2790106263u, 443544224u, 2802435205u, 819417773u, 177556618u, 4130535785u, 2505448107u, 2591437865u, 1610510350u, 3815578981u, 4114533339u, 2461835810u, 3856846001u, 1439644255u, 3343979676u),
+    SC(4065627430u, 2927818196u, 950831561u, 4171626868u, 1177734694u, 150634338u, 2487656862u, 796691698u, 2119716392u, 2975402883u, 833495592u, 2179672277u, 346833760u, 3054174076u, 3573945862u, 3318693908u),
+    SC(2752867821u, 4203551149u, 1685153083u, 1110714758u, 1962211454u, 2837810663u, 1792364454u, 4089022191u, 3967274249u, 192406218u, 3350506767u, 1577386058u, 1497165592u, 1817646171u, 1066733732u, 617241273u),
+    SC(307712584u, 3903562077u, 681601120u, 3047177738u, 2486055863u, 3842609448u, 3660507009u, 2553494609u, 3174736607u, 3482954246u, 1496988826u, 1025695462u, 3184242644u, 1095387068u, 949053977u, 2083266597u),
+    SC(3022399010u, 1538609936u, 2420072227u, 990220729u, 2914167049u, 3768364162u, 1346299210u, 1681335666u, 2574961060u, 4053930867u, 303191498u, 2606902764u, 726562386u, 2306023171u, 939416980u, 608183941u)
+},
+{
+    SC(1862109024u, 2933191225u, 198801920u, 104305860u, 4011109577u, 4122560610u, 1283427153u, 1072910968u, 1957473321u, 1766609671u, 2854361911u, 4075423370u, 2724854995u, 3336067759u, 2831739585u, 400030103u),
+    SC(3665137971u, 362515859u, 3613170351u, 1634568159u, 2407386812u, 2769867978u, 3661728638u, 966943982u, 2329232814u, 928287686u, 386060431u, 2380767940u, 993235698u, 994357638u, 4262826729u, 789587319u),
+    SC(700222805u, 4205189715u, 1681820282u, 2408317852u, 3145763515u, 149703318u, 2996102375u, 2778856747u, 1243021847u, 118692771u, 660320701u, 2037909966u, 3471407521u, 3539034550u, 2338530850u, 798101514u),
+    SC(202761792u, 3072251152u, 936980226u, 2112028598u, 55725596u, 545941282u, 2866544613u, 2541609642u, 2986914411u, 250525398u, 494419489u, 904338436u, 448237071u, 2519815520u, 3547503723u, 3479815920u),
+    SC(2591263445u, 2313710919u, 2225850186u, 2907469855u, 1923973028u, 2439332754u, 1359667863u, 1147453888u, 591668157u, 1802961428u, 2115337573u, 3814501239u, 1652114003u, 3286770823u, 2320492326u, 1627762005u),
+    SC(915583786u, 1541647557u, 857793588u, 1120457139u, 593298997u, 1235522530u, 3835902793u, 4029633796u, 2892088014u, 950803214u, 2067553664u, 3466102617u, 417988445u, 1721721291u, 2995105031u, 1833135847u),
+    SC(3713015457u, 984220366u, 1636921821u, 69668826u, 2853588756u, 3372417728u, 1514016965u, 3165630303u, 549067200u, 2237752955u, 3528219045u, 2819816242u, 2536477233u, 430232621u, 1219272797u, 2682238494u),
+    SC(4158909478u, 628504302u, 1961569314u, 3701318609u, 1298978065u, 2797817112u, 2778611026u, 2986972418u, 2728592083u, 1350107926u, 261737783u, 1726357156u, 2342206098u, 3937750792u, 3688276065u, 1598643893u),
+    SC(673033353u, 989709407u, 1304069795u, 4233856570u, 603282839u, 3834722266u, 3349356388u, 2690783748u, 318351191u, 3370905692u, 2347975280u, 2009518842u, 2234183321u, 2940030960u, 2623873751u, 1542240694u),
+    SC(2380479990u, 2443937714u, 165899369u, 1753008008u, 3688956092u, 2346743686u, 143829732u, 3830274100u, 446444093u, 1705814492u, 2316415254u, 1337109896u, 3093454689u, 1928322219u, 2296006624u, 2093435857u),
+    SC(4072133379u, 1665275533u, 1975626640u, 3338948757u, 3639875020u, 2527617364u, 2537708733u, 3825629008u, 3956434656u, 2047924528u, 2149850378u, 563001677u, 1364815414u, 2503665164u, 637530147u, 630327427u),
+    SC(2169035971u, 3667715128u, 133026623u, 1213164483u, 1858042667u, 1566345391u, 3257221880u, 1553218197u, 1494901497u, 2543246705u, 3407410762u, 149097838u, 2595763051u, 3921913476u, 3975713216u, 1013875562u),
+    SC(4285039888u, 3972750160u, 2508056116u, 3828502305u, 1554885499u, 2478771653u, 3465835374u, 2839338634u, 936668484u, 3860842840u, 1796057260u, 539213045u, 1979230663u, 2637220243u, 3822691920u, 124051918u),
+    SC(4008482152u, 442930842u, 3844390262u, 1477377511u, 2570068482u, 380269897u, 3550124210u, 1507268577u, 1690622835u, 1216029693u, 2876552462u, 1409060125u, 862828291u, 1145788484u, 2966975851u, 3091998876u),
+    SC(992351977u, 3038251247u, 1125019979u, 3468273479u, 2933515034u, 2848650947u, 3581678949u, 3449520008u, 3870604714u, 2854135121u, 1257402460u, 1206940695u, 2996845551u, 725641056u, 3899090423u, 600507448u),
+    SC(1594814264u, 3363681343u, 1687711901u, 1220822433u, 2890970125u, 4169329849u, 1095390946u, 3969022672u, 2174219653u, 1940964660u, 1237339498u, 2965031440u, 1016584643u, 2590104317u, 4235803743u, 3748725935u)
+},
+{
+    SC(770670183u, 2030489407u, 913827766u, 28354808u, 2556411291u, 589717159u, 413516142u, 20574376u, 1695189435u, 3750527782u, 3546610407u, 1435363367u, 2770958348u, 2608593137u, 3331479090u, 2086258508u),
+    SC(386282669u, 3729286075u, 814752142u, 1413230862u, 2616133966u, 2483044279u, 1602859126u, 1971292416u, 3070813417u, 3451205972u, 735409142u, 4007950155u, 2905395594u, 2869625175u, 3709680291u, 2952203732u),
+    SC(3404816958u, 563114856u, 2100979818u, 2101934521u, 2503989815u, 1063833326u, 1723163772u, 3130704072u, 2515274210u, 1396315966u, 393457735u, 2691705207u, 828877164u, 3349330754u, 122605524u, 2602269000u),
+    SC(3709941627u, 592327138u, 2051205206u, 810649302u, 871212350u, 1541388603u, 4163983787u, 2631105522u, 665062813u, 2612020092u, 3229205070u, 3819479307u, 3310127863u, 1843015221u, 2875318880u, 3723951791u),
+    SC(1567440489u, 946197176u, 1275093448u, 4236630568u, 3990268727u, 196525149u, 15396621u, 1859637416u, 3138749279u, 3859238173u, 3227404352u, 2720346799u, 3006927153u, 2147957966u, 397899810u, 870180302u),
+    SC(1039540230u, 838590221u, 2330450212u, 923346890u, 4067788704u, 3619481496u, 3864357516u, 1659963629u, 3299501842u, 1079788777u, 949881347u, 2502746723u, 3228809289u, 247884983u, 3118597092u, 302086001u),
+    SC(3566621623u, 1671359399u, 3923258138u, 1638982085u, 325268348u, 4006635798u, 1207442469u, 3002539627u, 4047574291u, 2011583803u, 1713508996u, 1060703309u, 4012225302u, 3776068377u, 2784459927u, 3025510009u),
+    SC(4215947449u, 1997878089u, 1026649407u, 646510252u, 850804277u, 1871694871u, 3390738440u, 3114862405u, 3567086852u, 195428920u, 1556755650u, 1851670178u, 2207687769u, 3388294264u, 4058594964u, 4248126948u),
+    SC(45480372u, 1361999478u, 2195192123u, 956464540u, 1294436548u, 3045580134u, 2390633033u, 757048237u, 1350268583u, 862465366u, 1780970485u, 3285033794u, 559081924u, 163710122u, 3170983363u, 2626972150u),
+    SC(90053239u, 741607095u, 3003181022u, 3546281037u, 1996206866u, 2019149839u, 2216417072u, 1170259974u, 4159879668u, 130215053u, 2605146665u, 3967236653u, 1930867601u, 2409157952u, 3775975830u, 1489883331u),
+    SC(40478381u, 3873592210u, 35609037u, 272986081u, 3051595606u, 504620408u, 1019656134u, 250693036u, 942133950u, 156032543u, 3738710122u, 1712961843u, 2888111563u, 1171258741u, 645705716u, 511104714u),
+    SC(239657447u, 2278853730u, 2391081998u, 746810345u, 3484552464u, 1369592268u, 2655434121u, 1213868536u, 2934523673u, 3058111393u, 4281279490u, 3966376385u, 1307651904u, 1645528218u, 3652190772u, 1126527756u),
+    SC(123809694u, 110218531u, 117547539u, 2035819815u, 3596140063u, 1382818318u, 3664758070u, 3019339789u, 2719299822u, 3892472009u, 2876096109u, 412140786u, 2578091481u, 2196346764u, 3068803053u, 1395690512u),
+    SC(880155357u, 791542602u, 112062960u, 2175792069u, 531560395u, 3155859615u, 1042526138u, 680268271u, 1355330482u, 2485441305u, 148200464u, 964096786u, 3215229166u, 2660485876u, 3076499838u, 353883041u),
+    SC(2388114644u, 1552848777u, 1649071283u, 2325568488u, 3165393822u, 2695611152u, 2713875122u, 898903657u, 2377088931u, 1138573339u, 3366910425u, 3238180215u, 676550680u, 1043832292u, 1583145576u, 3925456200u),
+    SC(3116588854u, 731097341u, 35427079u, 152855963u, 655343116u, 2522648040u, 3048497137u, 3838372571u, 777022751u, 2851975543u, 235569549u, 3020787559u, 727642795u, 120522014u, 2406411931u, 4235508200u)
+},
+{
+    SC(2533741935u, 4150033708u, 3133949860u, 2798619408u, 806119564u, 266064305u, 1385120185u, 1697466874u, 3309272849u, 2305765083u, 4237655511u, 751372374u, 3319766406u, 1139025033u, 1880631363u, 2216696728u),
+    SC(531691765u, 3457214584u, 2884896024u, 292273176u, 250051106u, 4144042126u, 176967583u, 4132839552u, 2406879878u, 872979134u, 3029052987u, 2283805120u, 2613859206u, 553294045u, 1245122721u, 3840523078u),
+    SC(1249934121u, 993078438u, 2897493833u, 1681305911u, 57100476u, 365202891u, 2111004277u, 4247410280u, 1628827737u, 3793711703u, 3364391257u, 3510640052u, 3346661510u, 885793286u, 3903378618u, 356572920u),
+    SC(680178688u, 1413780236u, 356581993u, 2539116542u, 3091268161u, 952393142u, 3601213640u, 3759147734u, 3201912600u, 2029303323u, 3233109971u, 3469579370u, 4191225303u, 2727922547u, 4241219026u, 1108397896u),
+    SC(581424072u, 2231376178u, 2556335427u, 507971440u, 4133814232u, 3831053002u, 2090051536u, 2682264467u, 1696017056u, 2590078109u, 3496563305u, 1242917226u, 2491190071u, 2058502209u, 3614091208u, 50680464u),
+    SC(1148224059u, 3153210519u, 1979896166u, 3699990000u, 2774705970u, 4177914488u, 1097495713u, 3943642621u, 28438271u, 1936652546u, 2951976972u, 917798112u, 3345031007u, 3414386063u, 2086388059u, 3336786964u),
+    SC(3207879285u, 3245056275u, 2753912038u, 3444068917u, 3619101580u, 301796681u, 469710494u, 37792426u, 2324375961u, 3765435021u, 2308122387u, 186365381u, 1748483921u, 2929955002u, 2507797221u, 1450081310u),
+    SC(2628113752u, 657975440u, 4188527535u, 3642824575u, 1167948061u, 570005820u, 1209373950u, 3114955026u, 2156903999u, 3426648275u, 258877187u, 4116394669u, 3424577769u, 1876755024u, 3610721045u, 137959590u),
+    SC(1295746957u, 2893879416u, 2731249393u, 43796623u, 1509060380u, 3580712054u, 2063633991u, 246915731u, 245935590u, 2758600953u, 1174591025u, 3759438209u, 874703696u, 3900497366u, 2032803558u, 741576512u),
+    SC(737124188u, 2899307081u, 1769647158u, 617077642u, 1659909664u, 278863054u, 4232490889u, 625515113u, 3013249184u, 3621100329u, 3078044036u, 1407642415u, 2069197169u, 551433765u, 2836890938u, 3978268035u),
+    SC(1956698332u, 1096426127u, 1006277939u, 3889489220u, 4030026180u, 3579514159u, 4250029335u, 2203857202u, 3553085216u, 3293255490u, 1237506477u, 1050435484u, 3944172449u, 3169627003u, 1477888937u, 2421667267u),
+    SC(867315816u, 669003983u, 4033294932u, 3994270030u, 1836283861u, 4220295811u, 3981502955u, 1254544883u, 2953929766u, 3399467612u, 2767815501u, 1837724890u, 359769422u, 525366934u, 2275330754u, 1596174485u),
+    SC(2757381304u, 618201396u, 1587888624u, 1754675322u, 309402992u, 1862772816u, 1766295424u, 776578164u, 3139660404u, 2518031939u, 4144540600u, 2162413735u, 2788510259u, 3413511116u, 1497090248u, 130610227u),
+    SC(4221771265u, 792248867u, 928054053u, 140258355u, 1340321712u, 917602285u, 1586319677u, 1429062327u, 3604542914u, 1952132240u, 3586261493u, 1380920077u, 1224870626u, 1321897505u, 3109874655u, 2938496454u),
+    SC(2321281375u, 3760646295u, 420407446u, 4154009512u, 2825227525u, 4188075686u, 2041350513u, 1285713851u, 1670924786u, 1104780793u, 3524777730u, 1315724274u, 2655303597u, 1675669649u, 3173211461u, 1286635196u),
+    SC(1138423224u, 1326909178u, 3451890502u, 3840823688u, 3093921534u, 4140902218u, 2007985143u, 2980979703u, 3539657192u, 1914000311u, 3861983402u, 1995841174u, 2739822780u, 4269529997u, 1752802206u, 3674790048u)
+},
+{
+    SC(1529327297u, 3326406825u, 3128910982u, 2593525414u, 42156971u, 3661621938u, 1244490461u, 1967679138u, 1025455708u, 720268318u, 2871990393u, 1117479541u, 1562094725u, 697888549u, 2324777980u, 3391621955u),
+    SC(1194208642u, 570517940u, 3796480395u, 3996975496u, 1891180536u, 2012913508u, 2586036803u, 2779419249u, 2424448764u, 654631266u, 3378681847u, 1794600320u, 850887774u, 2610529382u, 3440406071u, 442629809u),
+    SC(3922776395u, 1021134129u, 4161953411u, 3695042522u, 416696694u, 3141869998u, 2208946602u, 2248782897u, 3791212714u, 2183092330u, 2442693998u, 3821686193u, 359924765u, 1313892u, 732537261u, 3441185514u),
+    SC(3832647873u, 4126820624u, 1633739521u, 1776853127u, 1990846870u, 2931750872u, 723350088u, 2100866125u, 1353427778u, 3735236517u, 2936890827u, 1037652209u, 3538242522u, 1205440750u, 2681851721u, 3428134171u),
+    SC(3715940368u, 3100195993u, 139205042u, 933899119u, 508675941u, 2073279390u, 3838896736u, 762162827u, 2670162920u, 363468845u, 4142816880u, 2331633868u, 1859516459u, 2571514805u, 1415575689u, 3310370398u),
+    SC(1850103477u, 2861511197u, 2158258814u, 1914352173u, 4112609179u, 1613408074u, 2229142795u, 2743410061u, 386541358u, 4131835227u, 238820765u, 350328321u, 796595210u, 325800094u, 1477199872u, 130087432u),
+    SC(3503083399u, 2168288449u, 3773780757u, 707691176u, 2640783803u, 600372304u, 3521490788u, 1266639681u, 3049849833u, 3696342843u, 1559948576u, 3113774976u, 2979720549u, 3508429388u, 1393959701u, 716360542u),
+    SC(2281167118u, 2404489970u, 874916137u, 3296730075u, 4266077966u, 1052198560u, 3487426822u, 379036992u, 918125804u, 3064034925u, 3007906638u, 2843799763u, 13395259u, 1525101299u, 3917909303u, 323214095u),
+    SC(4272733253u, 1134926458u, 1071872991u, 1594198106u, 2743911342u, 1759781849u, 3909986783u, 357998405u, 4054491364u, 588230484u, 3248723140u, 4206364217u, 407716541u, 1660843258u, 3535395038u, 735131513u),
+    SC(3679104282u, 2103136756u, 3192389130u, 3635496721u, 3762160259u, 813057806u, 1922167568u, 196643685u, 1370854030u, 2657803320u, 3197001343u, 2838705898u, 1256322653u, 3731470140u, 1658864516u, 4241135314u),
+    SC(4138122573u, 1064712956u, 1914688217u, 3980579663u, 234064841u, 1340868250u, 2408246134u, 2334390091u, 3574856083u, 4185747404u, 2592066932u, 72932352u, 1132443153u, 3084950430u, 2850577555u, 531426487u),
+    SC(2552518597u, 1814188589u, 3771797408u, 1688271073u, 1392417060u, 1864411028u, 2178912172u, 2411760311u, 772279774u, 2791980611u, 2940533230u, 3149501999u, 370215731u, 2968115262u, 942881455u, 2310941126u),
+    SC(751991992u, 3546574605u, 2773077774u, 2498170045u, 3288367839u, 3030402134u, 1196921751u, 3823185297u, 3245569995u, 3802879953u, 493640893u, 3321821285u, 1141758187u, 3411864659u, 306737884u, 2761165281u),
+    SC(1865741334u, 706283811u, 2318095713u, 1419794148u, 2504644337u, 1922210484u, 263491957u, 3084520625u, 705689999u, 2554474009u, 3818190952u, 2133768662u, 3690402460u, 3381523320u, 831084441u, 1146769937u),
+    SC(831531101u, 3633896804u, 1996958159u, 636851001u, 4007892767u, 380666960u, 2826737942u, 4021398986u, 1411635481u, 515161969u, 4199924051u, 371116192u, 1868116156u, 397223417u, 972171737u, 2331326509u),
+    SC(974457928u, 3569708670u, 2643527780u, 699675161u, 2627045402u, 3565281489u, 1504374419u, 2979851122u, 688725044u, 4064400308u, 4156347928u, 4119156622u, 2098702491u, 2615488234u, 1090654007u, 3790938610u)
+},
+{
+    SC(1397828129u, 1248172308u, 2194412927u, 3657598991u, 2085616102u, 1202270518u, 3253032741u, 2632389423u, 1019922267u, 332153082u, 1521672215u, 2163564334u, 3102124007u, 582149809u, 329417494u, 188520915u),
+    SC(2484409087u, 165527253u, 332794704u, 523511269u, 3524328119u, 4077596669u, 3681267981u, 2969751460u, 3456338723u, 628364217u, 4089156990u, 1135761223u, 1241363911u, 2843043452u, 1927162020u, 1187988850u),
+    SC(3424784620u, 4001207648u, 1967060425u, 33527184u, 588161341u, 2216089406u, 1194534688u, 3972415390u, 3430941953u, 3671974564u, 355464831u, 2638417624u, 987848314u, 3854256447u, 2513703271u, 847178398u),
+    SC(944122325u, 1095537200u, 1611102749u, 3845108718u, 3985128242u, 1188491807u, 3783427529u, 722821803u, 2594736624u, 4038805042u, 2146959275u, 3199724336u, 3631416672u, 3989329185u, 1113423723u, 925573746u),
+    SC(536468163u, 2790961065u, 141113925u, 985919057u, 2438788330u, 374449238u, 2980068000u, 621714839u, 2454037345u, 2810385667u, 3189321079u, 794373297u, 4178743943u, 2630861151u, 1229894711u, 2665151675u),
+    SC(71889345u, 3684655732u, 3834974630u, 40555081u, 3804280840u, 423207811u, 1620826812u, 3717508581u, 1813258849u, 713714932u, 491517868u, 2389605511u, 767769458u, 2826892693u, 3923819122u, 3331321015u),
+    SC(3333750894u, 150650636u, 3555142699u, 1161199649u, 3068475424u, 1509735584u, 1033908609u, 3073273527u, 3313105177u, 3410735718u, 2770838598u, 2161939200u, 1654309303u, 1247727621u, 4123284974u, 3218452135u),
+    SC(4107359918u, 3667881557u, 4099213325u, 905728122u, 3167924799u, 3731720507u, 1537227227u, 659110227u, 2101733778u, 2731849932u, 1103266972u, 887588276u, 2413509058u, 3876926094u, 2675347623u, 834362982u),
+    SC(3178393694u, 2636806389u, 1832500758u, 186297941u, 3662837586u, 3282938029u, 1064394039u, 2117567716u, 95811670u, 1968831533u, 3070787872u, 2658254448u, 3676980228u, 3909574788u, 2135784404u, 3803100103u),
+    SC(2624310917u, 420491519u, 3322620679u, 3357048697u, 614451586u, 1196461215u, 41516451u, 3256616699u, 3715883496u, 2257787428u, 2455669147u, 880443853u, 2246776764u, 3074399406u, 278369115u, 1177356599u),
+    SC(439711555u, 2231299488u, 1079942678u, 677737570u, 563039018u, 2032266501u, 3704274118u, 1877323449u, 2386821791u, 2066266240u, 2520835526u, 1611863315u, 3800297318u, 2553770190u, 1751820038u, 2175904420u),
+    SC(3515911639u, 4055231138u, 2717511782u, 6831543u, 3016647759u, 2007513585u, 1217171617u, 3815960975u, 2720128636u, 364849140u, 4285658094u, 4211508323u, 127732138u, 997100418u, 3152669382u, 146802488u),
+    SC(3082714386u, 513166810u, 2182067081u, 798923178u, 921230382u, 1956178560u, 883901335u, 4290259857u, 2290170782u, 3274942148u, 2025203706u, 2950735447u, 3706997198u, 979032741u, 1714061744u, 1756952042u),
+    SC(1785121933u, 665679939u, 3927612276u, 926826810u, 456860581u, 4247102861u, 1802871345u, 3111467239u, 2947918463u, 4090223916u, 2765919892u, 3848356305u, 2236940933u, 2379663516u, 2033761836u, 170415812u),
+    SC(723418419u, 3083992977u, 2885930256u, 4084559514u, 3550295439u, 795067132u, 3902666387u, 98659646u, 3559229619u, 3518103022u, 3093345450u, 3504265473u, 3135355783u, 1746911831u, 3896748938u, 1982334610u),
+    SC(4151598450u, 129451956u, 3923175367u, 306344029u, 336516292u, 3560777935u, 2695409605u, 934056748u, 4131395595u, 112767211u, 3377236273u, 797539933u, 516899453u, 2089210576u, 1999558205u, 4107023428u)
+},
+{
+    SC(87353816u, 3198238907u, 1232123158u, 3291424375u, 3695263554u, 2608617182u, 3798070797u, 3966302680u, 3847946128u, 278442153u, 3929504461u, 3056452729u, 3658519828u, 643043450u, 684101279u, 121314490u),
+    SC(4041434108u, 1283940781u, 3208791522u, 2974918612u, 861706326u, 3183082284u, 508820598u, 682206875u, 1177134745u, 1065833400u, 1830916342u, 1348337823u, 1877305145u, 2647094535u, 2714586296u, 2450197741u),
+    SC(2726369020u, 1580548584u, 150986819u, 369792970u, 2983651480u, 3064179956u, 3511715342u, 1538695618u, 3829066845u, 578378703u, 2038030944u, 3732775932u, 1174552062u, 2377418012u, 375009203u, 1203897576u),
+    SC(3480144388u, 847968760u, 3831609064u, 2454845771u, 827762235u, 3561019074u, 3068061128u, 2125290281u, 500142325u, 2613926927u, 908976630u, 461018064u, 1790330457u, 2138554260u, 3099515250u, 2668195629u),
+    SC(1153226571u, 752634643u, 4102962367u, 2953166708u, 3172028384u, 1546019245u, 73810680u, 2123706323u, 2289283451u, 1736737040u, 4246735980u, 196740994u, 886758605u, 1893565373u, 3405498929u, 3744937024u),
+    SC(768993978u, 3888906052u, 3538251248u, 352204151u, 4022234611u, 1471705290u, 4243963811u, 2027117811u, 1763868778u, 1322271979u, 3608278288u, 3888498758u, 3465093513u, 3125049811u, 2129222282u, 295188310u),
+    SC(2552844131u, 1588346847u, 4175462227u, 3528353039u, 48525488u, 1810438463u, 342094266u, 3279671133u, 111165134u, 1329165912u, 4063411685u, 1911765579u, 2818934337u, 3808545183u, 3789526924u, 1948478023u),
+    SC(3331030119u, 905985030u, 3533623355u, 799989600u, 1593247216u, 4044824934u, 3057376453u, 1132187407u, 2788031862u, 3252641138u, 1745792893u, 1362467427u, 2194538589u, 4207162080u, 1731158987u, 3426969514u),
+    SC(282742454u, 1925220542u, 3537150606u, 1044967349u, 4104410814u, 3036747834u, 2170951116u, 4063975818u, 2876870249u, 40785387u, 3225638952u, 2818597718u, 1556539976u, 2301588618u, 2800555653u, 916700871u),
+    SC(607531008u, 2820787318u, 1270007122u, 63140951u, 2489460286u, 3749254552u, 3480926448u, 2300022433u, 3335552281u, 3577740253u, 4083676266u, 1879037356u, 3793973091u, 653990091u, 981292091u, 2669230849u),
+    SC(1168110979u, 889306226u, 331429321u, 3194220363u, 4271486769u, 2440942709u, 3008822642u, 561011853u, 2621371879u, 1149493671u, 1110535664u, 2670803472u, 394628735u, 4014155619u, 3742604108u, 1418371877u),
+    SC(1139004104u, 1152838795u, 3053437035u, 3533998804u, 965296070u, 2842987726u, 3847937142u, 3591812355u, 1659887171u, 3058851485u, 1843832825u, 2284970388u, 153709291u, 2147381595u, 1241923942u, 3246474482u),
+    SC(2372841964u, 95150550u, 785345036u, 3777509922u, 3777338585u, 1256811659u, 530593057u, 2218391448u, 163045439u, 4110451435u, 940149273u, 3289892018u, 1950559815u, 2046468986u, 785769535u, 229305669u),
+    SC(4222560409u, 1251917359u, 3419952330u, 3518946758u, 2125025139u, 840904710u, 2104865575u, 3206919775u, 407519472u, 2004634252u, 1712650404u, 3590313236u, 840286442u, 2628712493u, 3254945248u, 1148702071u),
+    SC(3313735124u, 1648160975u, 2356873919u, 1752134136u, 1812666743u, 1155388994u, 2048656880u, 513774477u, 495906662u, 2103152333u, 2943961999u, 735251223u, 2523783965u, 2210023145u, 1945848363u, 2437613245u),
+    SC(1086803487u, 4028294733u, 2247710942u, 1830793111u, 1634316303u, 2935377055u, 600165818u, 1578619540u, 2988076738u, 457218665u, 4176910460u, 454493682u, 1199052867u, 1940805269u, 347367761u, 1212452462u)
+},
+{
+    SC(3715433378u, 171840999u, 971741983u, 2238541363u, 3192426674u, 4094492328u, 467620204u, 194258737u, 3399274574u, 3279461044u, 1351137305u, 2503870624u, 193649547u, 2998335432u, 1712991547u, 2208648311u),
+    SC(2715750837u, 1950207216u, 2432412079u, 3161034889u, 3163700758u, 2527560734u, 1574123740u, 2830017576u, 1235654592u, 1173758764u, 3503805913u, 3353556737u, 1972267538u, 2593804497u, 4050894516u, 1536909338u),
+    SC(4252707359u, 3437282014u, 3776749445u, 203710275u, 463138159u, 2772620289u, 1182212975u, 1132575015u, 2008846240u, 1446588540u, 1178588185u, 2810502365u, 3189501211u, 3192046357u, 3703545124u, 2781338651u),
+    SC(127281203u, 3251296097u, 4229877600u, 1655402395u, 2971465573u, 744237737u, 3839563968u, 1414447733u, 2055975912u, 547297398u, 3544526703u, 1086573241u, 4145442250u, 370020177u, 2948813570u, 1970539713u),
+    SC(3163465607u, 792227545u, 605650287u, 3454430637u, 4436412u, 957261079u, 2917570432u, 3199157324u, 317922439u, 2607400867u, 3201779931u, 1812841573u, 973872378u, 3838606231u, 3221928943u, 461831659u),
+    SC(246719913u, 1498935408u, 1945961723u, 1327338499u, 2917210822u, 1660082997u, 597934446u, 1244971072u, 662537876u, 3851981101u, 2064803568u, 1228771649u, 4273868614u, 3144280868u, 3367923741u, 2660003700u),
+    SC(958115915u, 3015255252u, 3159655209u, 1681296573u, 2092702329u, 3275820278u, 1666603934u, 3861667140u, 2501203189u, 4234907638u, 1084271161u, 60369385u, 1104875606u, 3495688315u, 3738262066u, 4032927728u),
+    SC(1265262733u, 3131514218u, 237040963u, 4104455196u, 2691347880u, 3487609649u, 1785135800u, 1176579745u, 4089650722u, 3141152552u, 3206481300u, 1333364227u, 276607745u, 113027050u, 176916027u, 1602590030u),
+    SC(2774594376u, 3129694750u, 2287032514u, 2766750820u, 29083039u, 1069500497u, 840365222u, 3485333678u, 2555809577u, 3972967703u, 629036427u, 3011729266u, 1526288233u, 1119437732u, 917067812u, 194168105u),
+    SC(592881983u, 3318575349u, 4127058062u, 1732571107u, 3503756272u, 837953701u, 482225210u, 1269788935u, 1504556881u, 1896976655u, 165783184u, 328929494u, 4077662490u, 1253488686u, 3518656631u, 977900779u),
+    SC(4160682596u, 2908983358u, 1718640008u, 3588190607u, 1505225185u, 4179103009u, 1685793395u, 115536342u, 817223934u, 1402206707u, 3062750872u, 450873212u, 3409531894u, 2142975045u, 1392180850u, 3108320562u),
+    SC(1943394512u, 2513880371u, 1620134863u, 1529322591u, 4060169700u, 3770293993u, 1183592156u, 3047089385u, 1457468150u, 3671110754u, 1216162597u, 2044466392u, 888112901u, 3589252991u, 523705271u, 1679814981u),
+    SC(2715251449u, 70744868u, 3381212136u, 1205646623u, 2056792384u, 3523601635u, 3273403565u, 2609964048u, 1635414738u, 3927671477u, 2002719738u, 17329846u, 673666863u, 4128776449u, 1023303890u, 2113317599u),
+    SC(678583802u, 2909193903u, 1603800869u, 1698604501u, 292539447u, 3194048567u, 1222053939u, 4292027072u, 1744031112u, 463670025u, 1002183205u, 880963334u, 2427537891u, 2521706813u, 3815796576u, 836594698u),
+    SC(945238598u, 3719965767u, 2849528520u, 3282124488u, 1093917226u, 3479450861u, 2561471910u, 139299258u, 3917471374u, 1798050709u, 2851226278u, 2410252745u, 1571541746u, 2877491529u, 1276119582u, 4206041035u),
+    SC(3869162698u, 1114491339u, 1196187395u, 1533960773u, 3407411925u, 765004505u, 1831463563u, 3761422880u, 841664315u, 226257499u, 2314441323u, 2186776430u, 2801566686u, 2703073796u, 3780881787u, 1370189991u)
+},
+{
+    SC(3356584800u, 529363654u, 613773845u, 1186481398u, 3211505163u, 123165303u, 4059481794u, 1428486699u, 3074915494u, 3726640351u, 881339493u, 977699355u, 1396125459u, 3984731327u, 1086458841u, 3721516733u),
+    SC(3675076449u, 3333909775u, 1262445603u, 3668028655u, 433069981u, 3324184640u, 206500128u, 2656010471u, 782457265u, 4053687660u, 3895856132u, 315252919u, 2755213770u, 922519354u, 2055252100u, 2429801305u),
+    SC(2756940336u, 2847978751u, 1709353190u, 1195969566u, 1965491900u, 3974470294u, 4065860779u, 457378802u, 2625680435u, 4168918960u, 912437805u, 1940496017u, 2831564708u, 2681452721u, 2977785501u, 178951684u),
+    SC(2809970073u, 2149172818u, 128792792u, 4173216994u, 3752778392u, 3547909179u, 2139546257u, 363162335u, 1029632619u, 226065897u, 1871318430u, 3511308809u, 4293432909u, 733440206u, 3154916386u, 2246758263u),
+    SC(731502074u, 2752951666u, 3348551978u, 3130709972u, 1526861742u, 2511266125u, 4044638365u, 215744304u, 1267320586u, 1960868675u, 3421832152u, 2257930073u, 2620941002u, 851383950u, 547951559u, 1340068454u),
+    SC(2684856551u, 174120198u, 1829892583u, 1225976594u, 2442169561u, 2751359631u, 1396256832u, 4190566994u, 616089248u, 1633732935u, 1633964885u, 3929429044u, 842800539u, 676918864u, 1428572539u, 219449459u),
+    SC(133428457u, 620472331u, 1882141266u, 1679319159u, 679060192u, 3481716513u, 213482586u, 3423863792u, 4201383258u, 1319777873u, 927348830u, 208213775u, 4087467606u, 3653264448u, 3835415188u, 3916570843u),
+    SC(1895413499u, 3284443662u, 1774671761u, 36215094u, 1302729892u, 3712548907u, 689399756u, 809699792u, 1542256887u, 1010909539u, 1793915800u, 371041697u, 3719334021u, 1415418990u, 3304256413u, 1722896741u),
+    SC(4292037144u, 3413799593u, 431584770u, 554753321u, 1212891070u, 139387849u, 4633456u, 4145076332u, 2956733683u, 2226540590u, 257006677u, 3020881975u, 3400787219u, 587473979u, 260993303u, 3410840543u),
+    SC(4018910540u, 3254488333u, 2078930374u, 2245837925u, 2632570996u, 3139405325u, 1623001428u, 3612462970u, 2032232089u, 519993838u, 198517548u, 1752888302u, 2236384752u, 3428944014u, 3264747145u, 2955960571u),
+    SC(3519760330u, 3333709979u, 1048481536u, 1985059447u, 2643412116u, 3131942587u, 1137942580u, 1547604917u, 2831143240u, 2752062158u, 438973315u, 216212421u, 839130203u, 4170782680u, 1103599719u, 3606044489u),
+    SC(3979124118u, 943995448u, 2583700510u, 3458129573u, 1268799005u, 2693058918u, 2421470342u, 2310844252u, 4161944025u, 2910466020u, 1520150746u, 2594375360u, 1025693596u, 3356457299u, 1405172368u, 3357345029u),
+    SC(3608628529u, 1093067289u, 2172624909u, 336171229u, 1137437622u, 2177129887u, 3319848621u, 3625148145u, 940129946u, 3128586787u, 111536296u, 1792339610u, 2781599252u, 3659875306u, 872551800u, 2302213340u),
+    SC(1104919194u, 189973497u, 2565652941u, 2930155667u, 3463454839u, 2388313768u, 2445171637u, 16202936u, 1593006897u, 2191020511u, 2084184836u, 1467463398u, 2313657914u, 2691464051u, 4089268188u, 4294499481u),
+    SC(4188734592u, 3528391612u, 40836399u, 4036867171u, 4090825107u, 2939803682u, 140442162u, 2546416492u, 1084596508u, 3326586985u, 72576332u, 3780421002u, 3675044591u, 2008171921u, 3141075467u, 4288443118u),
+    SC(3852374110u, 4271371075u, 2076634991u, 3101716180u, 518739558u, 3284103928u, 1607286758u, 3505817896u, 42970787u, 1339303318u, 3280473330u, 1956150319u, 790791234u, 1449585627u, 3814185461u, 3901254732u)
+},
+{
+    SC(3892284764u, 2210224198u, 97085365u, 934022966u, 3120556498u, 264721182u, 4011343025u, 1936310374u, 2593930315u, 3833725723u, 4141640186u, 2218699022u, 3726005369u, 649732123u, 1594208266u, 3687592104u),
+    SC(2459115622u, 155132544u, 2344650987u, 2337329027u, 2478875455u, 1363777389u, 666384305u, 779524970u, 131624810u, 1099629813u, 755087667u, 1116544707u, 3462583113u, 1765615231u, 1221263451u, 345614861u),
+    SC(283432140u, 3102718597u, 937211953u, 3334135604u, 2242058317u, 3044145753u, 1441000856u, 2163904099u, 654999768u, 3976748269u, 4108102772u, 1209693616u, 3022484925u, 2592361118u, 3806239715u, 2457345174u),
+    SC(1983572202u, 34789206u, 3963513429u, 2661898079u, 3999779459u, 2657216026u, 2570146353u, 810465768u, 1310539449u, 3517224567u, 1830164911u, 2328664885u, 3323158486u, 200812613u, 1588943475u, 1631047872u),
+    SC(1996456687u, 665652044u, 360516388u, 3634015955u, 3932508085u, 3762889476u, 2869080596u, 2179691892u, 1880327422u, 3850327759u, 1653803674u, 236673399u, 2154944705u, 3229042401u, 2981554507u, 485288416u),
+    SC(264936494u, 3091907543u, 2050111855u, 2694936127u, 1954787063u, 722933256u, 3813405263u, 739130277u, 2256053561u, 3585156690u, 2029190911u, 3133350308u, 3458910883u, 3499638057u, 41852560u, 491183838u),
+    SC(2808085465u, 1288453772u, 2477084166u, 3837131567u, 1141955368u, 3112183866u, 1372456734u, 2203526963u, 2954171016u, 3969349716u, 2868857569u, 414601865u, 4013256181u, 468368341u, 1996835394u, 3658768313u),
+    SC(394302887u, 1097097404u, 3291468368u, 1194224926u, 1035172467u, 1541144594u, 3844885672u, 3479557309u, 3116596876u, 2815221788u, 2598284757u, 360029902u, 1618439794u, 2569763994u, 3258655905u, 2917038348u),
+    SC(2305403224u, 515881048u, 3401955316u, 2294640138u, 2523482065u, 2913659188u, 1840514079u, 1334322081u, 1545396585u, 4197671987u, 447162882u, 3846426473u, 2663235502u, 750784192u, 4164775689u, 2390294077u),
+    SC(2816642384u, 3952759529u, 3784236377u, 1797857230u, 1881467157u, 3886776601u, 754213935u, 2085935272u, 3814437883u, 3598631313u, 3014087408u, 1480756254u, 2838244491u, 132661795u, 909841870u, 675503551u),
+    SC(2053456581u, 627096201u, 3974668317u, 245144267u, 3845450294u, 1209560693u, 1003623636u, 3431474873u, 3952764341u, 3855863791u, 1357940588u, 3374805012u, 2942824193u, 2988435703u, 329942625u, 4139666589u),
+    SC(73006928u, 4068145413u, 2752900485u, 643186737u, 2386201439u, 296363448u, 2965535934u, 2202307569u, 1300692310u, 3766694667u, 2421404412u, 2295288621u, 1987219755u, 3682346025u, 885571108u, 1086202535u),
+    SC(3800801259u, 1729576293u, 2024334221u, 266315944u, 3877353536u, 2983817286u, 1164606138u, 2981999790u, 2626097845u, 3537364374u, 3559786635u, 2149380619u, 2137897542u, 2218263339u, 206251476u, 3754285811u),
+    SC(1009857555u, 1650586423u, 3853695002u, 1715580147u, 1146669099u, 1380681899u, 2219018152u, 1791877891u, 3247738482u, 1042579957u, 4035547117u, 2619207487u, 2408116465u, 3045899420u, 1771645449u, 1340019342u),
+    SC(2004305920u, 978372350u, 1705342765u, 503429310u, 3635208103u, 3659317811u, 3957481997u, 297103567u, 2521968324u, 599616959u, 1167498361u, 357125999u, 3158983160u, 3114128384u, 3086595483u, 2336612985u),
+    SC(4103187540u, 1182325894u, 97419735u, 1615223731u, 2031918136u, 2818146326u, 1038685355u, 1330155299u, 2657284062u, 4126074186u, 2871281156u, 2738191090u, 1922990674u, 2689532011u, 4040564095u, 99693623u)
+},
+{
+    SC(3639643416u, 3974502485u, 1527161781u, 180938703u, 2788643910u, 3418867931u, 2912046968u, 1776807950u, 1185488163u, 2433308651u, 3682797092u, 1938004308u, 753534320u, 795320477u, 3620835863u, 105275502u),
+    SC(2971894151u, 635573958u, 1662864280u, 3637757763u, 1966418418u, 2382544768u, 3521712538u, 4180511568u, 1216311665u, 1622710591u, 2836323703u, 1065095206u, 3046512769u, 2304432132u, 1370910091u, 3540050165u),
+    SC(3003078502u, 1266710982u, 63268125u, 3769826631u, 2161222028u, 1624738852u, 2999285769u, 2485757266u, 3350017650u, 1836975640u, 3947916645u, 3226839039u, 3416803572u, 2607406281u, 3224012241u, 1574498192u),
+    SC(2417128114u, 3148595382u, 316383238u, 491687931u, 3782721648u, 71265990u, 725842943u, 2574280796u, 2910592942u, 1266732336u, 3293910730u, 3812834954u, 758280869u, 2044998492u, 585388705u, 2220041893u),
+    SC(492257517u, 927280821u, 3326474467u, 3418658462u, 175063450u, 4228793954u, 2332128647u, 2793872080u, 3349562222u, 3060602442u, 1750735766u, 864506271u, 3021446456u, 1089650280u, 684313887u, 2273360774u),
+    SC(569437869u, 3392548160u, 448456633u, 786222873u, 1891470348u, 56622530u, 1988234620u, 1200550357u, 3540465428u, 1566012807u, 3682627310u, 3118219502u, 421481320u, 474517348u, 4276632114u, 3506654966u),
+    SC(200012878u, 1289466640u, 383837247u, 2978212823u, 641013196u, 1218428129u, 2429292619u, 1428313217u, 4155302101u, 1036892035u, 3775206351u, 778853475u, 3322870631u, 4195074838u, 3725481759u, 3550082329u),
+    SC(126839072u, 3914304851u, 1035784989u, 2867617428u, 1989254908u, 3724484330u, 1316610484u, 1040102649u, 1452719164u, 210631948u, 1224888518u, 1113840153u, 910511278u, 2297844676u, 797967535u, 283877762u),
+    SC(1244500121u, 2493482314u, 3779000024u, 2685901143u, 2759844693u, 2465008309u, 2989069530u, 1046572576u, 3374497605u, 2414541412u, 1726159904u, 3650454710u, 2872643374u, 1536622747u, 1381290537u, 3538573283u),
+    SC(1982773073u, 895953548u, 653968243u, 2944168854u, 1891156211u, 862699673u, 178384938u, 2122337777u, 3992617936u, 1827424625u, 1827918311u, 4247768891u, 2116109311u, 2389157370u, 3259962586u, 3018719650u),
+    SC(16401953u, 2306633926u, 2338480543u, 3225473112u, 3429377887u, 2444554167u, 3036218027u, 811186210u, 2350667613u, 3590742085u, 2594672781u, 575072326u, 272468093u, 997542396u, 3031146350u, 3776453205u),
+    SC(1784787552u, 1031272746u, 3302965053u, 805306745u, 3874552409u, 2790720051u, 483200429u, 1779723984u, 1097599486u, 1897611475u, 2456960784u, 1754250527u, 3808506348u, 3902842183u, 2596972722u, 2928554842u),
+    SC(2323692909u, 829274841u, 1103316386u, 1866432209u, 1938371795u, 4027514213u, 3989131198u, 2637747342u, 2193562562u, 1183535102u, 290853894u, 707762868u, 1909722738u, 2733745164u, 2354524179u, 94921256u),
+    SC(390966983u, 2005348047u, 1183001210u, 3460046175u, 1194344520u, 3385791048u, 306982602u, 876126480u, 3192052847u, 3055117485u, 1493712024u, 239443620u, 3677526258u, 3935077241u, 3195438491u, 2508943164u),
+    SC(3776157658u, 1760005001u, 3371368706u, 4151959572u, 4117952947u, 2782084300u, 3075220020u, 3130861900u, 3220322643u, 4251107806u, 2765944679u, 2454606920u, 3864173523u, 2241965276u, 1056706189u, 2253371852u),
+    SC(10455103u, 669421195u, 538798805u, 681593482u, 4243109638u, 2765550308u, 1560790187u, 2332940655u, 157674749u, 358872640u, 2549359913u, 811329072u, 318369228u, 2192271276u, 2616093049u, 3105543667u)
+},
+{
+    SC(3392929934u, 3483303263u, 1976307765u, 4193102460u, 1186037029u, 2559946979u, 3008510830u, 4008303279u, 2792795817u, 3991995u, 311426100u, 3736693519u, 1914150184u, 2000710916u, 1829538652u, 896726226u),
+    SC(1506989834u, 781231698u, 1423994091u, 932436763u, 2811140941u, 235158077u, 3312925598u, 1277169313u, 2161654787u, 95045550u, 2507009285u, 3400899479u, 1327874861u, 2641030305u, 845165129u, 3067306163u),
+    SC(81377829u, 4112377516u, 996390415u, 1466127523u, 1087938057u, 1370439327u, 2374941315u, 3221315808u, 35184362u, 4155013651u, 4157224703u, 3036174627u, 820839223u, 644204168u, 3814924360u, 2548030643u),
+    SC(1091124676u, 3446444543u, 108918031u, 285417020u, 1457053816u, 2518578419u, 3204558864u, 1447981867u, 3090612039u, 774503865u, 3344583272u, 2737274269u, 3562442510u, 1127429989u, 2804182977u, 1775681652u),
+    SC(2318905039u, 2047942274u, 566069924u, 123115342u, 2915025724u, 2614503051u, 611479778u, 1680640702u, 111791999u, 3565934367u, 3623017458u, 358904698u, 718271833u, 2594429479u, 2455462208u, 1049889789u),
+    SC(2072590390u, 2994175732u, 776612573u, 3305897523u, 938985307u, 4037860099u, 405398386u, 312125617u, 834030222u, 4269222652u, 3952042783u, 188369721u, 969558599u, 2241466312u, 1494637662u, 3640394545u),
+    SC(793329188u, 1680204464u, 4194525713u, 1397937237u, 2203558613u, 193170132u, 590149348u, 3837254789u, 2629901211u, 1547324833u, 4256276761u, 178627910u, 1204782838u, 3049171442u, 2847310157u, 1633221731u),
+    SC(1445130399u, 3305816299u, 706740166u, 1986021205u, 2637844550u, 1419078314u, 1678054887u, 2432697110u, 870544859u, 890225672u, 4294515721u, 4251895411u, 1276311012u, 1177847908u, 2958585231u, 4245816799u),
+    SC(4225912221u, 703507803u, 1922376483u, 3748563847u, 841832204u, 937238929u, 1762562329u, 2321245641u, 3396851205u, 4196168123u, 2898493537u, 4105193320u, 3913075709u, 3714213782u, 3736794417u, 1813506206u),
+    SC(473058800u, 1281200026u, 2096535567u, 1916392924u, 2499055699u, 1592813861u, 1665248526u, 1352252079u, 2539722497u, 3800235497u, 2456011531u, 2486813252u, 2969323588u, 2786889819u, 264256920u, 4162650714u),
+    SC(4093970658u, 1112717313u, 4105391438u, 692152127u, 3191447576u, 765356874u, 3774754898u, 3659714922u, 1417146611u, 4116649329u, 2382824064u, 4091923584u, 2943998996u, 2572469258u, 2350556732u, 4055180934u),
+    SC(4241530692u, 3958450744u, 2400383404u, 466315350u, 35062538u, 2419973666u, 1574066566u, 718969713u, 2103427683u, 1844215170u, 377438369u, 3472936858u, 4219642124u, 2727593550u, 2415179286u, 530554266u),
+    SC(1717990860u, 490767589u, 4104938990u, 1912533482u, 1727757083u, 4081637760u, 2971627803u, 4227474711u, 2482396781u, 1077462396u, 1040490667u, 188422725u, 1078987146u, 1905877850u, 3465315863u, 3779881072u),
+    SC(2343360099u, 2602377036u, 540592495u, 3215700530u, 2276091252u, 330543342u, 1521140429u, 3101043196u, 1353643940u, 4257187260u, 3766970644u, 3977679607u, 2139641066u, 2691703488u, 1191064988u, 3899819176u),
+    SC(4020334744u, 3662481612u, 4168714619u, 3391835711u, 3785299560u, 71469795u, 2493742903u, 3412561168u, 3292204549u, 1481564183u, 2157273751u, 477496008u, 931448839u, 2827709521u, 2133135454u, 3513095854u),
+    SC(1821292885u, 77067071u, 2713776553u, 2767520127u, 1059460035u, 985220275u, 2884538737u, 221640066u, 2657382407u, 232264137u, 3155923068u, 3788271780u, 2919723565u, 1308585734u, 3615447351u, 9588952u)
+},
+{
+    SC(2320406161u, 892569437u, 3092616448u, 1707673477u, 2810327980u, 4012118332u, 4142748730u, 3869507620u, 92116036u, 2366184953u, 1613655167u, 3287845172u, 3562699894u, 416962379u, 1296831910u, 1764080884u),
+    SC(220529260u, 249394787u, 707093586u, 3327680194u, 3905189366u, 612327964u, 3292761054u, 3030686883u, 1334491337u, 3207860077u, 3280619568u, 1041320647u, 2483468975u, 1479881667u, 3211575507u, 3039423798u),
+    SC(2075210586u, 859890386u, 3979249840u, 1571749934u, 1787834945u, 3779262932u, 3834468444u, 2848979155u, 3949299214u, 3265482052u, 521566179u, 4090178483u, 2634506734u, 537774764u, 1760986104u, 1885781444u),
+    SC(2157623553u, 1245488719u, 2108443037u, 4226304849u, 1701247415u, 4110744868u, 1746909616u, 3191493799u, 846028927u, 3826268145u, 3155840342u, 1303740777u, 3325552898u, 2580884535u, 3592783405u, 4209959030u),
+    SC(535271984u, 3867256577u, 2621667187u, 479852461u, 3031868718u, 681291605u, 3866870888u, 975222367u, 189285295u, 2489945122u, 4002580885u, 1631683077u, 2806354223u, 990581176u, 3013857114u, 805874285u),
+    SC(4221232460u, 3061114345u, 3434676469u, 1406782470u, 155821803u, 124504941u, 3888697140u, 2788501814u, 1026476732u, 2216503728u, 3089015914u, 2063998098u, 272392246u, 1587339314u, 677528523u, 2432699241u),
+    SC(3643892943u, 4282202220u, 2100563362u, 826776443u, 1365722925u, 2702305724u, 679208928u, 3149950187u, 1446692720u, 2990196076u, 3121167752u, 25041546u, 1204401671u, 3950457476u, 478874733u, 4191001246u),
+    SC(1002796340u, 395169719u, 3087599283u, 10336612u, 2123927609u, 504611529u, 4163730275u, 706425703u, 1588733263u, 4149509341u, 1952228143u, 3819719132u, 766367752u, 1435203845u, 1906598194u, 3492363785u),
+    SC(1774340829u, 3089482890u, 2870005976u, 919794943u, 2035504962u, 4034646005u, 3486869666u, 3458779364u, 2688966610u, 4246698276u, 241215855u, 1193302498u, 1307583268u, 129792487u, 301354381u, 2759318534u),
+    SC(1993945167u, 2379081822u, 2587040362u, 3154537819u, 1926143939u, 2749781524u, 935556830u, 4138641196u, 1781637476u, 2939621229u, 45782825u, 4247420511u, 1775642409u, 3169645376u, 1224651656u, 1411268824u),
+    SC(4099217380u, 332485632u, 702660355u, 2932600301u, 2644542769u, 1705216342u, 2043283695u, 2373746705u, 2092217219u, 1660104946u, 3159676245u, 3674605841u, 226100099u, 3987250021u, 2436672589u, 1083744721u),
+    SC(775618835u, 2173251804u, 4192653515u, 3582997173u, 3769245096u, 484007740u, 503088416u, 1360222738u, 586791868u, 3760447547u, 3490651251u, 3534666198u, 2531156474u, 1207301882u, 832959081u, 3020069982u),
+    SC(298341207u, 1349761730u, 1369831393u, 1101983922u, 2409775356u, 3892600618u, 3875266737u, 3482966490u, 4002034047u, 2018792567u, 1932407387u, 1184232926u, 3015567427u, 301694942u, 437132459u, 3636206614u),
+    SC(4090425889u, 2348669465u, 2575850637u, 3995997864u, 3040420324u, 1615191584u, 2490849366u, 2670494936u, 2841563080u, 3763919842u, 3580970157u, 3864708123u, 187158351u, 2199194387u, 4160227448u, 2176418944u),
+    SC(3040328915u, 1001466289u, 3676795030u, 2946692141u, 3593888463u, 2224708622u, 4148397123u, 4253879884u, 1993280384u, 1176406404u, 3148404923u, 4180061590u, 1786680964u, 4036906941u, 1164279397u, 3562714780u),
+    SC(1286200509u, 4232891464u, 1656861418u, 3412215448u, 1086562483u, 2512121988u, 2650588176u, 3097245464u, 3192968944u, 2220731064u, 3414522916u, 4204353060u, 3690514744u, 3688465060u, 2246470987u, 498255717u)
+},
+{
+    SC(1167035839u, 2632944828u, 1562396359u, 1120559767u, 244303722u, 181546963u, 2941229710u, 561240151u, 1460096143u, 346254175u, 110249239u, 1849542582u, 1293066381u, 147850597u, 3876457633u, 1458739232u),
+    SC(3571928080u, 2436259038u, 1291130511u, 4109706148u, 535321895u, 223400632u, 1981907545u, 281269666u, 3986674262u, 1137333737u, 1403128295u, 1607985509u, 1996916063u, 3564990547u, 3398899933u, 2822030993u),
+    SC(4187142002u, 2183119934u, 1635192887u, 2899344980u, 2532710469u, 3583070294u, 1537984623u, 296183513u, 2324170481u, 3475303187u, 3887648540u, 634736823u, 1254765115u, 3808584578u, 3772430219u, 561684376u),
+    SC(513372587u, 1759503751u, 4262413842u, 2894839952u, 1546497784u, 1634597484u, 3075497476u, 1112503488u, 1318854936u, 1645523550u, 1808408161u, 1471049890u, 1607196116u, 1989192912u, 3845591311u, 3230210229u),
+    SC(4281800629u, 256065360u, 161761292u, 2162610453u, 3289868207u, 803664088u, 1737988317u, 3468667062u, 1313091619u, 3871261661u, 4163576187u, 3519070773u, 663580583u, 2181685257u, 1282501745u, 373224564u),
+    SC(1305532007u, 4040631353u, 3016994284u, 364840424u, 312087064u, 2832713285u, 813363164u, 1634515727u, 2857968226u, 2482770921u, 2702964276u, 1457003903u, 4233117491u, 978467573u, 454990490u, 2451215822u),
+    SC(3309788844u, 1373644165u, 2568421202u, 4021050421u, 3214613315u, 3179866441u, 2282215282u, 4192353052u, 766132975u, 1427735093u, 3905164154u, 3510365574u, 3650419996u, 1208798186u, 2311177541u, 3425106727u),
+    SC(1485656607u, 1872571460u, 3807266779u, 3227427836u, 1367154025u, 2087101352u, 2787930808u, 1683647111u, 611621831u, 1033465938u, 1055561737u, 1718623444u, 3674681330u, 3643294293u, 3841507882u, 2950124804u),
+    SC(3583452191u, 43558840u, 2702416786u, 2831018419u, 4179535508u, 3293628424u, 3781032090u, 4272940814u, 1561835153u, 3434531879u, 2033417772u, 143682419u, 2206689113u, 2885101743u, 3330838914u, 3213033967u),
+    SC(1563269339u, 3268845808u, 481878529u, 1366255066u, 188999428u, 2024859095u, 3740130866u, 1902201859u, 3294724532u, 3498902869u, 2063801661u, 3851840419u, 1697955856u, 1216829830u, 2472036433u, 2158918739u),
+    SC(3706632627u, 1854832685u, 4075722340u, 3009760070u, 1947919686u, 1613829674u, 3359356634u, 160149010u, 3211678034u, 1403957074u, 2395316449u, 232911190u, 3595342115u, 593590477u, 4003146812u, 1042747586u),
+    SC(3566751331u, 1293366329u, 237055278u, 781035984u, 3490518265u, 471671502u, 3279573882u, 4088428685u, 3341570902u, 1660948465u, 2602036180u, 3189056267u, 1448251311u, 3378653995u, 367559448u, 1247557023u),
+    SC(332188181u, 124235367u, 2908363616u, 57405667u, 3860321591u, 2915594808u, 3193053797u, 3103490367u, 2893876952u, 791722516u, 2759950240u, 2647310599u, 1060814304u, 1104815755u, 3283917665u, 954167246u),
+    SC(3633439037u, 1737408037u, 3240746577u, 2032524778u, 210349431u, 1157873376u, 3552462955u, 3068823u, 2593869163u, 1645741574u, 2624282012u, 1595174943u, 3150496822u, 2635369792u, 3670346328u, 1317499755u),
+    SC(3066163224u, 734815666u, 3189326611u, 2603442644u, 551273493u, 3201260612u, 896218759u, 1203901890u, 3082479753u, 4206490018u, 1615910957u, 3112412856u, 3354260034u, 1776181406u, 227950091u, 2452682654u),
+    SC(2235295503u, 3336503999u, 656069002u, 1855251063u, 1400966644u, 100804460u, 3316705750u, 794158471u, 3220130150u, 1524496317u, 4024763824u, 915138624u, 1872936127u, 829155670u, 1406327784u, 3285915916u)
+},
+{
+    SC(3539989726u, 2664422354u, 3717852078u, 3493347675u, 431408204u, 2534904428u, 166307432u, 1071633271u, 2817060747u, 2307358268u, 3433391820u, 2071844151u, 219511979u, 303896099u, 3062367591u, 2892429963u),
+    SC(4169968731u, 2129799654u, 437437237u, 369342547u, 1225909990u, 105177072u, 378686654u, 1403688950u, 3897807924u, 3252342965u, 1215424641u, 560413328u, 1897408132u, 317929004u, 3828647679u, 1630564758u),
+    SC(2120346993u, 1574861569u, 4055542703u, 3156063114u, 2155135979u, 3395705935u, 3607950162u, 1649229112u, 1891339524u, 2871189526u, 475543260u, 4035849276u, 919486311u, 4103998043u, 2581732188u, 3337457769u),
+    SC(2650342494u, 2112594502u, 300482146u, 4214370423u, 3712572735u, 2394678491u, 944484075u, 2859174140u, 1298074617u, 4123981874u, 2931863188u, 4060402101u, 408241016u, 1141274074u, 2343754010u, 2412599648u),
+    SC(1561545950u, 3513590208u, 46110254u, 2131948246u, 1318148204u, 2154872738u, 1632214749u, 3758828119u, 3082206346u, 1424038120u, 2361241545u, 845137641u, 307971779u, 1724404993u, 861282060u, 1237934782u),
+    SC(2774909901u, 771645224u, 1285073837u, 2193431137u, 1992145786u, 1323638656u, 695741715u, 2225025760u, 1506694954u, 4281622541u, 648809495u, 1264275594u, 2179049970u, 2134563430u, 1143161913u, 1676304803u),
+    SC(146493114u, 1026262009u, 3602767471u, 2183478058u, 1903997235u, 4037497130u, 232766761u, 3333583275u, 4037065903u, 338762279u, 3658077565u, 3465013868u, 2987748329u, 1503145496u, 1553131083u, 2250198737u),
+    SC(2341715858u, 2700579248u, 3859696179u, 2395756825u, 1875611477u, 3083700335u, 3413235310u, 1368601544u, 2011324934u, 2489277894u, 3393073269u, 1479863073u, 1546719681u, 1270920228u, 832404816u, 4096637834u),
+    SC(3098090164u, 3937526885u, 3922595589u, 3117243593u, 3619511456u, 687964457u, 2049777986u, 2737216841u, 904576627u, 2497431372u, 3782524472u, 2176150332u, 3538905622u, 1249874595u, 386091287u, 597337724u),
+    SC(653517061u, 2613638042u, 3043803086u, 3430911227u, 3939946327u, 3394071887u, 1634025406u, 422896314u, 2056719107u, 2825344479u, 4064697313u, 3122017483u, 3752686726u, 3984230999u, 2989927946u, 36279219u),
+    SC(2977387875u, 1756856293u, 2305658602u, 3898809838u, 2022534013u, 3053356239u, 1719149320u, 1006974664u, 3980567886u, 911250528u, 3970581037u, 4208855094u, 2375475175u, 3461024498u, 4207299460u, 172606632u),
+    SC(2123341088u, 2610619360u, 3636249805u, 2405928311u, 194895330u, 4166746397u, 1666551241u, 3089845290u, 830253287u, 1769367456u, 492844122u, 2898915009u, 1465071417u, 1748645392u, 3136192983u, 3149049830u),
+    SC(182090295u, 2773063932u, 2875617227u, 2014878906u, 4034576690u, 3504190878u, 648632813u, 578906269u, 3395653562u, 3622802446u, 1642118462u, 1105217635u, 3484288771u, 4187487776u, 3066363798u, 3248936252u),
+    SC(154149828u, 3967951687u, 1435057545u, 77065166u, 3232269485u, 3912916706u, 592527655u, 4277917673u, 3417904405u, 3905839920u, 1437307359u, 2532079592u, 1386597940u, 4043192840u, 828125384u, 1712244674u),
+    SC(4144828863u, 1262971610u, 2738002832u, 3848745747u, 554156666u, 3660926287u, 1405749523u, 293551868u, 956195932u, 2061195588u, 3476646641u, 1003448777u, 4182963546u, 1462193925u, 2827901865u, 1370898532u),
+    SC(287054389u, 4206061741u, 3909899140u, 2957058664u, 2712205523u, 1231432323u, 1252507865u, 2198483068u, 3163354130u, 595880373u, 2050058791u, 535083586u, 4093274722u, 251534866u, 1425149793u, 2349787856u)
+},
+{
+    SC(3015000623u, 325176924u, 3212623969u, 1014540936u, 2686878702u, 3453922035u, 257234635u, 689320672u, 395365200u, 3425465866u, 3351439740u, 3293249321u, 2261203941u, 1504215424u, 2365812346u, 2486464854u),
+    SC(2802351214u, 1019547153u, 1581443183u, 2237644987u, 2316167912u, 1277137594u, 922833639u, 1775757119u, 2259030628u, 3320484395u, 3474839377u, 3039388985u, 3157017009u, 701728799u, 45087422u, 1375130067u),
+    SC(1408178651u, 332882372u, 2572930650u, 1429622838u, 3740348959u, 3769865143u, 1102404486u, 2395773863u, 2055053046u, 1642858333u, 434575788u, 1458579645u, 1077283311u, 3435370625u, 412513198u, 1108997u),
+    SC(166351317u, 1290556120u, 1492697218u, 3828755332u, 1787027698u, 2627329842u, 818520792u, 3844511768u, 1093689215u, 2840813230u, 4268955351u, 1793367442u, 1197897289u, 1467402002u, 558600125u, 4039642298u),
+    SC(2618143148u, 4195387407u, 3571081448u, 176847982u, 3021045559u, 2151239299u, 4216918791u, 349987936u, 1438071630u, 2148079477u, 510134808u, 1844452199u, 3473619148u, 3775643892u, 3701006526u, 2069649956u),
+    SC(2536827719u, 256373429u, 82685205u, 2031847695u, 1685669223u, 3749398630u, 3100433967u, 2559626296u, 2614261735u, 2095898325u, 2650411530u, 4139725354u, 2433652522u, 1465137472u, 3074463995u, 2942034210u),
+    SC(950856594u, 2511634642u, 447889167u, 3271534101u, 3998181635u, 850059409u, 1500318444u, 2845728509u, 2319192144u, 1285732158u, 3307511706u, 1860111207u, 106597122u, 1317987028u, 3909997475u, 2833499319u),
+    SC(197466102u, 106471666u, 3969627291u, 425148315u, 2088018812u, 3287551129u, 2083642145u, 386904296u, 2967132086u, 417456225u, 2418726206u, 2685222098u, 3920069151u, 388803267u, 1008714223u, 4223482981u),
+    SC(1730602173u, 1587573223u, 1136504786u, 801576255u, 1239639300u, 3897044404u, 2640640405u, 3098571739u, 2095045418u, 1782771792u, 2216047065u, 2006450887u, 1019963460u, 450135304u, 1704523436u, 4178916267u),
+    SC(3045516080u, 2837283309u, 3652809443u, 3617799274u, 2953845221u, 1870697859u, 1987277049u, 671334013u, 2347392220u, 1637733040u, 408564290u, 531095235u, 1714215546u, 2668823252u, 4291679007u, 1499030154u),
+    SC(1785804164u, 3771923969u, 1688952513u, 4078905240u, 4219818381u, 2140263698u, 3560443409u, 1027592498u, 981877075u, 1273450409u, 1808708945u, 366130160u, 1509712333u, 1419790056u, 3592515372u, 1023304152u),
+    SC(689558936u, 2052202277u, 1573780309u, 1046114431u, 1768897198u, 1193436549u, 613072153u, 961650488u, 3203433527u, 2587127126u, 2088764244u, 3898254742u, 1779313411u, 2448405043u, 2102013432u, 2635393468u),
+    SC(2025692259u, 905848568u, 1759010770u, 1792571870u, 4118995060u, 266283808u, 4139640706u, 3438115348u, 2780184652u, 3445643695u, 656585512u, 181166262u, 2272629776u, 370943424u, 1751557846u, 2309122167u),
+    SC(267180733u, 424783777u, 1080203254u, 2661909603u, 1424050736u, 3737445342u, 2397112235u, 1140319020u, 3540605726u, 1560404816u, 714090654u, 3305695922u, 4001926073u, 4235374954u, 2250613806u, 603974704u),
+    SC(244840167u, 1554020100u, 3702066775u, 2862773506u, 3785435454u, 3651035430u, 218349583u, 1404753202u, 3766478445u, 2586133471u, 1533117238u, 4149938439u, 2210912076u, 3594357012u, 575816505u, 525962129u),
+    SC(4146528898u, 2136081288u, 1410528199u, 2682243562u, 3659634297u, 3884779676u, 1276188622u, 3650143718u, 2534539131u, 69352587u, 4188728680u, 4144009400u, 528573366u, 1948891771u, 2778384350u, 3961787045u)
+},
+{
+    SC(771871546u, 3238832643u, 2874232693u, 1176661863u, 1772130049u, 1442937700u, 2722327092u, 1148976574u, 4122834849u, 744616687u, 1621674295u, 3475628518u, 2284524224u, 1048213347u, 4058663310u, 153122870u),
+    SC(2125145888u, 3034373129u, 148397811u, 141146887u, 2520820550u, 761993323u, 2298029094u, 2891332110u, 2829144983u, 2531560926u, 2167918181u, 3311166313u, 1986747894u, 2110826144u, 1833688282u, 2697250572u),
+    SC(3869871954u, 4004844136u, 2445592287u, 191554676u, 1824322074u, 1934754654u, 1806989779u, 631655906u, 1640478312u, 3779394326u, 3878618879u, 1897296401u, 116845712u, 1282189569u, 1638341398u, 253193742u),
+    SC(869049848u, 3185853214u, 1086566153u, 574813225u, 768296876u, 2336838903u, 1037196762u, 3581040974u, 1545806877u, 1185761684u, 533220394u, 2594450382u, 518321105u, 3416686830u, 2271268151u, 3918676320u),
+    SC(3856331543u, 2684505765u, 649861433u, 2052378851u, 4281491040u, 1056350427u, 1268888422u, 3791019043u, 2372988231u, 1754646015u, 3964172838u, 3080977165u, 1940074122u, 2762476976u, 3389041795u, 1131517310u),
+    SC(1630655860u, 1949945516u, 3883647184u, 3029959080u, 1311781856u, 408642488u, 2800393690u, 3410356207u, 115351401u, 3420630797u, 2709679468u, 2872316445u, 1790203899u, 1997501520u, 3278242062u, 551284298u),
+    SC(2323279372u, 1575922229u, 4047150033u, 1372010426u, 3148623809u, 2453870821u, 2339486538u, 2280451262u, 2466099576u, 2994948921u, 132102763u, 1776872552u, 3906687848u, 1416385780u, 2716658831u, 3839935313u),
+    SC(1482060017u, 4064599659u, 4201421603u, 1862488009u, 1206323034u, 1506270647u, 4148487892u, 2940354206u, 221477839u, 2184047858u, 1052602625u, 1800724448u, 2376949890u, 1248004043u, 4042069004u, 1001474649u),
+    SC(1973975072u, 2109156381u, 895285550u, 2806725496u, 4257596779u, 2294716595u, 2126073388u, 4029509053u, 2287557214u, 3863235224u, 910675328u, 3403565516u, 2460443864u, 4145068647u, 1675629270u, 2972605807u),
+    SC(3067953236u, 2487048107u, 1053067642u, 2406833819u, 1120120518u, 2019615106u, 2151977185u, 2444444329u, 3698388134u, 2675794597u, 2346696087u, 3691916163u, 416413840u, 2548582733u, 2519917531u, 3323365251u),
+    SC(4258867839u, 1450083676u, 3423817219u, 2338254228u, 956448310u, 2038800503u, 2270893323u, 23474499u, 4001071451u, 434241187u, 4225947271u, 3009484949u, 1212186223u, 3021170789u, 3408787844u, 4241328442u),
+    SC(544425045u, 2335106449u, 1970249987u, 676962447u, 2451092807u, 3397085111u, 644609608u, 622894566u, 3012162452u, 742316904u, 1183695331u, 1942632009u, 3993963459u, 2025380463u, 2934502595u, 2424729664u),
+    SC(489227787u, 2064607364u, 749046162u, 1223089239u, 4103152782u, 944881113u, 2156101348u, 2809656549u, 2750173639u, 2290439348u, 455194332u, 3662094961u, 2388553957u, 2373693996u, 3087294434u, 714908241u),
+    SC(844100070u, 1293873339u, 240400805u, 2741251793u, 4185619158u, 3756747900u, 2600026127u, 4095003808u, 2551250677u, 1982555415u, 1538344606u, 2598805396u, 1759235723u, 1251966u, 1750681115u, 626531732u),
+    SC(3996016258u, 3876613311u, 1191787057u, 3901742282u, 1577096572u, 270596184u, 3165567618u, 4061944625u, 3613068329u, 3912630805u, 2056061785u, 2568706449u, 2343664228u, 1807908509u, 1314728487u, 1028342757u),
+    SC(2729604648u, 2866824008u, 1921075953u, 959207538u, 460881358u, 1786258799u, 989199155u, 1140694999u, 3534517067u, 1671080238u, 1077292982u, 69981150u, 2456995550u, 2177711190u, 3355630373u, 505438766u)
+},
+{
+    SC(2470971363u, 1622646280u, 3521284388u, 611900249u, 53592433u, 1667691553u, 3986964859u, 3228144262u, 4160240678u, 1357358974u, 796266088u, 2135382104u, 2999113584u, 425466269u, 866665252u, 3795780335u),
+    SC(1943673032u, 163567132u, 2998325065u, 4151760187u, 4286963295u, 2037110896u, 4023804057u, 2843670454u, 4267379728u, 470850548u, 1360194572u, 542908383u, 117354082u, 3909600634u, 3301531838u, 585104523u),
+    SC(421763950u, 3621776882u, 1804759030u, 1922063749u, 28357531u, 2718763721u, 3528327041u, 2594458380u, 1745913977u, 1705774731u, 3785007083u, 1889010688u, 4275556992u, 2808027536u, 1706627542u, 967259307u),
+    SC(3761989171u, 2069950976u, 953323220u, 30139149u, 3360357391u, 466334029u, 1085748790u, 717259079u, 3822910993u, 1348849055u, 4159668773u, 3924702853u, 4257335520u, 1714446370u, 3394938265u, 2541598048u),
+    SC(2132231371u, 3951042779u, 332537683u, 2179456991u, 3112576172u, 2873883577u, 502046554u, 4014018248u, 4272356370u, 2124475345u, 3140973257u, 1234959848u, 3468807232u, 3812306463u, 2768101189u, 3493652974u),
+    SC(2983624056u, 158967077u, 546553405u, 3473936990u, 3742593866u, 3986716933u, 2905591308u, 285301696u, 2640868047u, 3062221467u, 70156428u, 150492378u, 3977001273u, 1087159682u, 1233481348u, 3391921638u),
+    SC(3432795737u, 4256529583u, 3151717298u, 4190687875u, 1563633254u, 158068428u, 685294219u, 733826550u, 2829744078u, 4225504275u, 2375584227u, 1429440840u, 2192098666u, 1015042413u, 840775854u, 41702830u),
+    SC(3231767315u, 1865273494u, 1093659663u, 1873962287u, 1664376931u, 1435837948u, 31100007u, 316783664u, 996300708u, 334486049u, 1648124912u, 3615910102u, 2480590997u, 2253624363u, 548978494u, 3975730498u),
+    SC(1923874249u, 3947343158u, 2264687656u, 1121555015u, 3593673308u, 289357572u, 3048054908u, 3707221766u, 2043411687u, 1708537123u, 3350208529u, 2939237811u, 2793137666u, 3370678100u, 1405378414u, 2235087472u),
+    SC(139882711u, 1304366355u, 1276034712u, 2139658031u, 2197726287u, 3663457902u, 2357615523u, 1611719773u, 2323318078u, 260257531u, 2850134214u, 3099029628u, 553263652u, 173876122u, 2118167747u, 1771928540u),
+    SC(566458485u, 3545725305u, 2257836680u, 2245189792u, 1605297549u, 245844769u, 2016071772u, 1896412522u, 821618527u, 1870442187u, 3958912319u, 4032980189u, 2069248247u, 4226059888u, 3345680132u, 1791157180u),
+    SC(4148097755u, 2486537082u, 4003164230u, 2318687306u, 2491702264u, 229564758u, 4126839602u, 211561653u, 3452304873u, 2572510204u, 1630441069u, 3167885411u, 4175966562u, 1295680948u, 161732432u, 107333173u),
+    SC(1923252062u, 311708286u, 1678166990u, 3717252154u, 3161198614u, 1069601573u, 4091259962u, 359278439u, 3768419820u, 2520693990u, 650972975u, 383288062u, 1217231824u, 2559091429u, 4278580592u, 2250271391u),
+    SC(510621576u, 1629846927u, 3397488683u, 961386517u, 653633283u, 1754007094u, 2769834941u, 2247122605u, 2701964981u, 3912616774u, 3406969249u, 63999109u, 3141040146u, 2619453260u, 1468121925u, 4171492447u),
+    SC(3961993547u, 1155134029u, 1496861029u, 1279080034u, 2846121209u, 3483514199u, 2468398271u, 505281559u, 3532558643u, 2311328115u, 2310583909u, 3085705085u, 2999958380u, 2683778623u, 32663880u, 1366954658u),
+    SC(3799286526u, 1580228485u, 2766986278u, 586308614u, 2894037718u, 587959438u, 1301020570u, 2323176208u, 3827747523u, 2955860540u, 455053544u, 124753776u, 703403555u, 1658788582u, 3867772588u, 3276199889u)
+},
+{
+    SC(2899222640u, 2858879423u, 4023946212u, 3203519621u, 2698675175u, 2895781552u, 3987224702u, 3120457323u, 2482773149u, 4275634169u, 1626305806u, 2497520450u, 1604357181u, 2396667630u, 133501825u, 425754851u),
+    SC(373198437u, 4218322088u, 1482670194u, 928038760u, 4272261342u, 1584479871u, 2503531505u, 354736840u, 303523947u, 2146627908u, 2295709985u, 233918502u, 3061152653u, 3878359811u, 3090216214u, 1263334344u),
+    SC(2076294749u, 898460940u, 2754527139u, 2099281956u, 3551675677u, 4195211229u, 3603181913u, 1984445192u, 1121699734u, 573102875u, 2187911072u, 656800898u, 1477748883u, 3685470532u, 3965328576u, 4253954499u),
+    SC(1876288412u, 2267864341u, 434083874u, 1779401913u, 2781669786u, 3073195348u, 669142308u, 3636028767u, 127310509u, 372075961u, 2537369503u, 2705808591u, 971889633u, 2718294671u, 1415139024u, 276903675u),
+    SC(3596445084u, 2918342013u, 1827011883u, 3900260359u, 1783558754u, 1921301616u, 3293933601u, 1111091218u, 3238604202u, 967515902u, 1208493040u, 1614341552u, 903992012u, 480937886u, 28823639u, 2379076161u),
+    SC(1968094521u, 1600813704u, 2958098796u, 909224758u, 1752381729u, 3115930502u, 3643078327u, 2863416031u, 2510423171u, 2162796973u, 1796627662u, 3678673773u, 239312629u, 2457874359u, 3809753210u, 2494718541u),
+    SC(1731463174u, 4265769542u, 194787641u, 1036371942u, 1745836602u, 660344840u, 1082796561u, 3963871960u, 4001246025u, 3118794916u, 3886266100u, 1928084049u, 3032262555u, 2306541818u, 3921311698u, 2426451176u),
+    SC(4018285402u, 658949239u, 1329629679u, 2738829796u, 776877685u, 1774949833u, 2797031752u, 3236392582u, 2542061420u, 1832249084u, 183211998u, 1840198657u, 1314474881u, 3361925365u, 3440999944u, 974653576u),
+    SC(1671164742u, 4271520021u, 1517391404u, 3289979834u, 1233503784u, 3050636514u, 3728319521u, 2919957525u, 3518724155u, 1272537958u, 3303667759u, 3864284110u, 234069183u, 1495943844u, 1989482539u, 3056780355u),
+    SC(1575547612u, 2187321001u, 2701011625u, 2761636008u, 1864623673u, 3995428494u, 1950725639u, 3749309698u, 2711714857u, 3743669273u, 3222519898u, 621366782u, 2554696188u, 176315043u, 1467854493u, 1806812435u),
+    SC(1182422499u, 3354985654u, 814715964u, 4226927046u, 3360200226u, 2503195953u, 1526762508u, 3747376732u, 1505823655u, 3718914053u, 2708056196u, 1868291203u, 1664951819u, 1982491563u, 751360443u, 1075645602u),
+    SC(101076600u, 386741863u, 2955045918u, 1653351871u, 1070602553u, 321875967u, 3200546966u, 2632915072u, 225765461u, 1759013254u, 4169466720u, 3880757831u, 1769634729u, 2642211393u, 4245887731u, 3909815727u),
+    SC(2379322656u, 1554830911u, 1971754317u, 1058862290u, 623917994u, 2775317172u, 3261049248u, 1667374591u, 3883068608u, 3752131736u, 2607464936u, 1251402973u, 4056909038u, 937468613u, 309280197u, 1804321090u),
+    SC(395093976u, 2154850233u, 624748058u, 3473623511u, 530005996u, 1656467301u, 451942772u, 3238178099u, 691726480u, 2563588439u, 3675387583u, 3294893253u, 1205949092u, 3844564019u, 114533547u, 4193437592u),
+    SC(1241354591u, 1121646490u, 1686974686u, 3373490541u, 1189649937u, 2948191343u, 2978671156u, 3827318062u, 3377194192u, 3805066092u, 3271994064u, 2484020181u, 549626522u, 1166583694u, 3299399570u, 764854172u),
+    SC(2808929206u, 427994673u, 2338143204u, 3942895356u, 2304289727u, 1468778908u, 1350679341u, 3972686632u, 2399853022u, 2097821409u, 3799931826u, 2500883276u, 1352425312u, 3372587055u, 596007302u, 2017539287u)
+},
+{
+    SC(172527491u, 737404283u, 1378219848u, 1967891125u, 3449182151u, 391223470u, 304889116u, 3996348146u, 1311927616u, 1686958697u, 766780722u, 1429807050u, 1546340567u, 1151984543u, 3172111324u, 2189332513u),
+    SC(3269764283u, 1288133244u, 1314904801u, 996741356u, 1884733412u, 1544206289u, 558284137u, 1518251699u, 1924323147u, 1635892959u, 1275016917u, 3776324356u, 1705865502u, 202621081u, 499067715u, 3311904259u),
+    SC(2660619816u, 3307703068u, 1451637465u, 3851776926u, 2364760323u, 1977782632u, 1515607226u, 1445106389u, 2327693248u, 2319920969u, 1115274896u, 1834441597u, 402374626u, 1205432354u, 1396686295u, 491780324u),
+    SC(1996097434u, 731516361u, 974312078u, 3421366629u, 3812294134u, 3978884039u, 3352635742u, 1797690428u, 13489496u, 1642706934u, 3128398168u, 106641350u, 4016459895u, 2470770670u, 115922099u, 2925890710u),
+    SC(2686884812u, 2748914055u, 1937433663u, 756783569u, 413219250u, 1566264233u, 3400883298u, 1726270584u, 1877719428u, 1988282262u, 4210071735u, 1623567192u, 186026227u, 1235988261u, 878101455u, 3591361377u),
+    SC(4053231115u, 4124107153u, 3534184341u, 1110486344u, 81952807u, 4125498697u, 1693462482u, 2990125452u, 3439709895u, 1055710168u, 4246237022u, 1943085528u, 719511299u, 700284484u, 1082914808u, 1529874921u),
+    SC(1481485493u, 1935423659u, 913226612u, 2395711383u, 1541429099u, 2771316424u, 3338417471u, 399999946u, 26796724u, 1562275554u, 2290450886u, 1574607684u, 2722372873u, 1229315759u, 1998792801u, 1299123352u),
+    SC(3949810665u, 1328858449u, 2680298883u, 4060684833u, 1165923991u, 2656262528u, 835037267u, 1633040358u, 3109606689u, 3612027263u, 1850965274u, 2501035455u, 1956880692u, 2989837601u, 2991272131u, 514909703u),
+    SC(3542886422u, 2995653583u, 3564619313u, 2091503271u, 1371789218u, 2765269616u, 3068810600u, 1666719265u, 2118314133u, 3335278251u, 3361418207u, 807286765u, 899334530u, 3994904643u, 2747385847u, 3528707340u),
+    SC(3132681349u, 3533155425u, 2330764867u, 3555018576u, 1500828005u, 1243623897u, 1071818853u, 2130356426u, 4099162373u, 1333917673u, 445413180u, 915835391u, 3998951530u, 3932499234u, 2014496944u, 1476384528u),
+    SC(2104877156u, 1430391164u, 3607724722u, 2456386351u, 3275987562u, 653382938u, 360082336u, 281545563u, 2556998173u, 802173963u, 1898654040u, 2873697709u, 3526274706u, 30023701u, 1532464389u, 335648001u),
+    SC(1216717657u, 3420164715u, 1026103527u, 2814363815u, 3399248527u, 2265457834u, 4230549954u, 3191596424u, 2096767009u, 197782440u, 661821193u, 3129199915u, 3603027595u, 571989255u, 3350141303u, 902722054u),
+    SC(86788496u, 2319129483u, 1051755765u, 871757145u, 3910221139u, 2373267495u, 991927221u, 3506242540u, 2918237538u, 555183593u, 3050652275u, 2550066259u, 1935622924u, 1141386013u, 1915989302u, 1193809339u),
+    SC(2961067645u, 912271025u, 3829956364u, 976054309u, 2426360429u, 3756714048u, 860863671u, 2976390123u, 651422564u, 3348472580u, 4062622529u, 3566918328u, 1262646615u, 526922344u, 336090107u, 3690353753u),
+    SC(1104160934u, 638409761u, 4090697585u, 3951520784u, 412890746u, 3037968225u, 623962484u, 1861465265u, 4172453316u, 2731726287u, 468253494u, 2636411583u, 2233875405u, 976659501u, 1885152597u, 441456529u),
+    SC(228814647u, 3127034711u, 536841111u, 970423620u, 335496573u, 1496573821u, 3839638808u, 2076574157u, 3960354230u, 1830746438u, 2136594363u, 1397484405u, 335074021u, 421124372u, 4043995000u, 1296743377u)
+},
+{
+    SC(2759056966u, 2773771898u, 915395955u, 378399267u, 1065424189u, 3786627878u, 2430240867u, 1910948145u, 1268823138u, 2460932406u, 2049702377u, 3729301642u, 2270156417u, 2935515669u, 1488232015u, 333167852u),
+    SC(3963231590u, 2717344665u, 3330507643u, 2069094492u, 1576271806u, 844971343u, 3725773593u, 3293220801u, 1933125411u, 1106657228u, 3650404527u, 3511000962u, 3309805512u, 23235466u, 884265026u, 3867812812u),
+    SC(2380535986u, 2007649740u, 291610222u, 4151143005u, 2330231880u, 3336494284u, 4079710776u, 3045731925u, 300175272u, 1753290057u, 2323446107u, 2448133203u, 1897525100u, 62520621u, 938748110u, 2483424933u),
+    SC(3941565796u, 4020457560u, 536627435u, 849338423u, 1622694903u, 2253013822u, 1890968103u, 2458058141u, 2431563444u, 3273994144u, 2920282564u, 2871620844u, 315460419u, 2331615405u, 105614140u, 3825521500u),
+    SC(1770365960u, 436268948u, 2889892729u, 3688514673u, 3952720709u, 1774783907u, 605504449u, 2947048934u, 38294098u, 846447109u, 2199988078u, 482652009u, 58745901u, 1043251865u, 1692020085u, 2977904741u),
+    SC(3749156389u, 3930496686u, 342096417u, 2961755248u, 1791611872u, 2622150301u, 1430397623u, 2049694734u, 1457522946u, 1307567328u, 1594457791u, 2920040322u, 2838823131u, 3221083429u, 2327375059u, 307491364u),
+    SC(439175999u, 704562179u, 1530705937u, 343762620u, 1895613568u, 82869187u, 23704978u, 3831637605u, 1611450850u, 923617677u, 3571146990u, 2520538539u, 2376639038u, 2377370369u, 3624250410u, 3615349574u),
+    SC(764309941u, 395778606u, 890380761u, 1156064327u, 244397938u, 560614464u, 4033284221u, 1090955901u, 3643294611u, 2912576497u, 772374999u, 2861631454u, 564730390u, 3124994653u, 646536012u, 3616789797u),
+    SC(3040822479u, 2767342245u, 2776280569u, 3485527708u, 3592541314u, 980436690u, 2153312390u, 215781809u, 2169043418u, 2501125521u, 3698439429u, 3999324854u, 2793459908u, 501030861u, 3583683133u, 3712651293u),
+    SC(4078810936u, 708788696u, 3557269243u, 3488736225u, 3893932756u, 4164798985u, 1241795187u, 3595203666u, 2393791384u, 3416169943u, 714289829u, 1522223608u, 2613922570u, 3640037692u, 3871460094u, 693107847u),
+    SC(2095442944u, 4280954881u, 166522183u, 982064125u, 4072843681u, 2413289870u, 966372633u, 3054322365u, 3306439070u, 657208192u, 175957468u, 411297739u, 771116169u, 1596617487u, 3454202820u, 2489020407u),
+    SC(1474971529u, 4158663721u, 2047384831u, 2598838221u, 256974012u, 2456523417u, 631366020u, 3323296862u, 3331748634u, 1360209248u, 3346726166u, 365777010u, 1290850614u, 2085594058u, 2979720197u, 2832663037u),
+    SC(1555709774u, 2326491405u, 2273744879u, 2585453209u, 2182701308u, 3405285511u, 2624534747u, 1273093088u, 862771016u, 2571185727u, 2627816705u, 753650915u, 1122934423u, 1670176575u, 3747348599u, 2369664950u),
+    SC(90900628u, 2102730721u, 781890942u, 2802660398u, 1018645876u, 4115262915u, 4149550831u, 3399458752u, 3886843346u, 2763694604u, 1310436099u, 1905281291u, 3814148817u, 4190880658u, 4069475791u, 3679310561u),
+    SC(2090876031u, 2877257381u, 2723690078u, 1430728835u, 1519931567u, 1820574481u, 3028789440u, 1269332520u, 487867652u, 423473929u, 386546855u, 57358783u, 1188070806u, 1428826466u, 1782333616u, 177182180u),
+    SC(1560550296u, 3093603077u, 293048812u, 568213435u, 3420818052u, 2217333393u, 3134601365u, 71485947u, 1184987600u, 3737951852u, 162939585u, 1604396734u, 102336303u, 398862141u, 820178097u, 490472018u)
+},
+{
+    SC(1198357412u, 890731121u, 697460724u, 351217501u, 1219769569u, 940317437u, 2678867462u, 4175440864u, 2131908090u, 1470497863u, 3243074932u, 494367929u, 1767796005u, 457609517u, 3543955443u, 4149669314u),
+    SC(3330984275u, 2556191310u, 3686726368u, 344917147u, 3386773283u, 2065247867u, 3908122913u, 3695674005u, 2012204991u, 2693522884u, 103992040u, 209624682u, 1376640025u, 3686868767u, 2902487256u, 913177313u),
+    SC(51667624u, 2920015049u, 3017253519u, 1071812123u, 2571723173u, 2160964558u, 1290623835u, 537361271u, 825729747u, 1392761590u, 1142623949u, 609149740u, 478665972u, 658807909u, 3553467330u, 1636424506u),
+    SC(3616504574u, 1808500084u, 668829693u, 946464586u, 1979729368u, 406956181u, 4175922839u, 412791377u, 2386664246u, 1192624407u, 2943858119u, 2548487829u, 1705793661u, 3457595727u, 202485393u, 1924721832u),
+    SC(2189382710u, 4186169698u, 1109472631u, 1983920883u, 3607145598u, 92147950u, 1402492489u, 429006982u, 2674194346u, 4283195956u, 1593180543u, 3760708566u, 643378372u, 4031840072u, 3394015175u, 1558737750u),
+    SC(1805700700u, 1754525187u, 1654624487u, 2216136944u, 68436239u, 2233918826u, 2968997668u, 4123197178u, 634669625u, 2517670383u, 3007433093u, 3522650191u, 696793327u, 1110232330u, 152147442u, 726198231u),
+    SC(742639492u, 3149716575u, 880320409u, 4630949u, 1505653181u, 1071542118u, 3069898832u, 2578767084u, 1314905164u, 2213468220u, 3680194608u, 2445142726u, 2802637025u, 3977804516u, 1184600151u, 419058566u),
+    SC(1336605659u, 403108152u, 2724587657u, 3679190711u, 2874389193u, 1647236788u, 3333657299u, 528273159u, 3515102004u, 947876802u, 3658623910u, 174276546u, 653934448u, 3828171172u, 1444811038u, 2933240663u),
+    SC(339431464u, 3233735983u, 2646677300u, 43177515u, 392637796u, 1436471495u, 1239428896u, 2348305406u, 2289915967u, 3084305790u, 3250948245u, 178888356u, 2146779246u, 4234024427u, 1032696742u, 3905672369u),
+    SC(961540617u, 2841143833u, 962675692u, 4171962245u, 2791421965u, 2368576296u, 3328980779u, 2916707843u, 1558316022u, 134331787u, 2460382133u, 1215270659u, 146717643u, 3198704598u, 2091590890u, 2460305557u),
+    SC(1042706599u, 2034894580u, 690504458u, 2345543782u, 4005260856u, 2432547988u, 112379796u, 3543073874u, 835904670u, 2590827554u, 918469413u, 3408148837u, 1789043194u, 1729294718u, 1834822488u, 2928788408u),
+    SC(3301658713u, 837504950u, 1727706187u, 1845900341u, 896114239u, 2352826711u, 3111232113u, 2017659422u, 2679415011u, 2370224692u, 3953323203u, 2250773775u, 1103871456u, 1933857783u, 3328123972u, 3307902309u),
+    SC(1767706194u, 3006067357u, 35851140u, 3240494485u, 2221989856u, 1899667734u, 6385932u, 2363969169u, 4105037265u, 1831329288u, 2027489194u, 884350865u, 1094001278u, 159320441u, 4110377537u, 68569781u),
+    SC(1525490260u, 665735034u, 2452169880u, 171203360u, 1236274187u, 676156893u, 1374080130u, 357190845u, 1839504596u, 1514713169u, 4060710869u, 1096636593u, 2588809028u, 3627704311u, 1809407212u, 476953361u),
+    SC(957000182u, 26105440u, 3440739633u, 2098069989u, 1584380370u, 2860012851u, 1732766592u, 212521659u, 3179187407u, 887560394u, 2490695882u, 2732057577u, 1018218231u, 3635922188u, 2062474881u, 2513446682u),
+    SC(1107263183u, 578424674u, 37103195u, 466969755u, 2523291988u, 291121216u, 3279675483u, 2003600853u, 4199013737u, 2715326244u, 4169142308u, 3686083459u, 3512922856u, 3093381668u, 1195683747u, 1393205701u)
+},
+{
+    SC(1331866444u, 3086683411u, 308412705u, 2554456370u, 2967351597u, 1733087234u, 827692265u, 2178921377u, 289799640u, 3318834771u, 2836568844u, 972864473u, 1500041772u, 4280362943u, 2447939655u, 904037199u),
+    SC(2575383612u, 3753748540u, 2811819999u, 1587868018u, 1038431720u, 790984055u, 3731301644u, 1846621966u, 951964491u, 415041564u, 2200992348u, 4272384400u, 296027191u, 4287888493u, 2854418940u, 3573682726u),
+    SC(1970740379u, 2607713160u, 3470587124u, 930264002u, 1173824281u, 122965335u, 3335069900u, 326806848u, 3632692886u, 129472919u, 3226625539u, 2728837633u, 416887061u, 1130551300u, 356705234u, 1369994655u),
+    SC(4223755401u, 2079062379u, 3389104769u, 4073338565u, 3689225172u, 440818499u, 856809827u, 381405275u, 127244068u, 376610605u, 2598268701u, 2534766433u, 2820385475u, 4294123141u, 330930335u, 318185845u),
+    SC(761419527u, 3536226585u, 2328998689u, 3591334816u, 1578134205u, 1103093801u, 3418753973u, 3588283844u, 1530820786u, 2684864777u, 924992522u, 3557568163u, 1869705595u, 3313643247u, 841618349u, 1632346896u),
+    SC(3475240082u, 1688964704u, 2950217939u, 2829510968u, 4218043142u, 1723444205u, 599182149u, 3585292920u, 1201476124u, 1461631424u, 3796636907u, 3015591958u, 325310290u, 4221903599u, 2685464188u, 843835594u),
+    SC(3270571096u, 3849271420u, 2838244847u, 4029431364u, 3703574760u, 3266810236u, 1964057057u, 1045028730u, 3535646880u, 4117469088u, 268273252u, 28527135u, 616206627u, 3498685014u, 1783632491u, 2430589238u),
+    SC(1270864764u, 2335784868u, 3187652054u, 3487500065u, 3514696661u, 4279511860u, 2691960889u, 1283768022u, 3239440117u, 3088430000u, 3270700109u, 2562105500u, 920167200u, 797042551u, 4008345612u, 1713652205u),
+    SC(1233553764u, 2449552413u, 3139739949u, 2886523083u, 3648218127u, 435238208u, 231513377u, 3598351734u, 1003225207u, 1550611030u, 4262337852u, 2819804714u, 3244463273u, 2073740987u, 855086785u, 975917304u),
+    SC(2715954175u, 3495328708u, 4029028922u, 3684471179u, 2815956881u, 3599669751u, 4163140273u, 33191313u, 2635890672u, 3683103094u, 1579697202u, 287936530u, 2496546027u, 832886459u, 1241267398u, 3564329642u),
+    SC(718666875u, 1628061148u, 3834972005u, 11037458u, 3790987439u, 2312775807u, 3375415349u, 3089087440u, 2679862136u, 918687461u, 3176925215u, 1435039099u, 1342114588u, 1906963252u, 3488735014u, 1611160706u),
+    SC(4216184459u, 1084561028u, 249927207u, 3584932419u, 1355984265u, 990857900u, 1870305536u, 582023708u, 1966962179u, 1733088207u, 1190083164u, 3785297292u, 1004947745u, 1784159416u, 1841702516u, 180335137u),
+    SC(4084089742u, 2441136551u, 426220168u, 1375299216u, 1841338030u, 1250354698u, 2728864721u, 2959990011u, 1071025467u, 1691914484u, 2858760972u, 1516700275u, 2771651049u, 607063247u, 4219381388u, 3373946171u),
+    SC(2146554811u, 2380633398u, 431356428u, 2501496525u, 4195490782u, 4281443977u, 1707183170u, 3515016439u, 43334925u, 2064458077u, 4149827026u, 2544422546u, 1259302114u, 1919625668u, 729425798u, 2757346641u),
+    SC(2475010648u, 501654469u, 1262984133u, 2284058265u, 3864896735u, 3216144340u, 3043718887u, 3290359029u, 2513504704u, 1583873907u, 787550022u, 889877880u, 4155285556u, 2519357244u, 1887123831u, 2544852082u),
+    SC(1329107374u, 3899397847u, 1931705980u, 3537599611u, 2074239136u, 1267070685u, 2447524924u, 3173107761u, 2842541385u, 924561908u, 2664553616u, 395476463u, 813764142u, 3107511895u, 179660379u, 2380654703u)
+},
+{
+    SC(286197159u, 1217476806u, 1373931377u, 3573925838u, 1757245025u, 108852419u, 959661087u, 2721509987u, 123823405u, 395119964u, 4128806145u, 3492638840u, 789641269u, 663309689u, 1335091190u, 3909761814u),
+    SC(2458775681u, 3448095605u, 3846079069u, 1243939168u, 2712179703u, 2514528696u, 1400411181u, 3792085496u, 528921884u, 1230512228u, 4062090867u, 931590129u, 3669288723u, 1764179131u, 2650488188u, 764612514u),
+    SC(3981461254u, 1881876860u, 3861653384u, 1419940889u, 3890280301u, 225359362u, 3772709602u, 2406778923u, 1744011295u, 836946168u, 1547583643u, 2969842237u, 3997288340u, 2150480638u, 3129156617u, 1325216902u),
+    SC(3592470591u, 3671101194u, 2792523734u, 2070472959u, 1473838345u, 785123121u, 2721504084u, 2212009910u, 4070989896u, 1696639999u, 2859248441u, 3104578877u, 2309769016u, 4267049236u, 2484173427u, 1626540609u),
+    SC(4267160019u, 2981312649u, 344263087u, 698599319u, 1002907346u, 93565259u, 286808078u, 1804582990u, 3599771325u, 2181306538u, 1961279765u, 187428107u, 223299791u, 4043449191u, 587626985u, 2106033479u),
+    SC(501761768u, 2386293097u, 1180388710u, 1812775472u, 918601490u, 3009070794u, 1574279477u, 1505824867u, 3643095372u, 3370828988u, 832869144u, 404837899u, 3152252263u, 3925885097u, 69867335u, 3741018586u),
+    SC(2051920526u, 1020215512u, 2058830843u, 1611771091u, 2552120098u, 75944844u, 1802229404u, 915313553u, 2313215016u, 1745739579u, 443475191u, 2998247588u, 3289885130u, 1289464560u, 2961919458u, 3798282256u),
+    SC(1496487624u, 2215532014u, 4148657376u, 3923080315u, 216179279u, 3856996518u, 2014567019u, 880786726u, 2125033974u, 58008256u, 4039109547u, 402585883u, 2182540617u, 437175766u, 1441865826u, 1665450276u),
+    SC(3078919323u, 1109978808u, 3102316446u, 4252174800u, 1046362670u, 3864571927u, 2260100326u, 3682270765u, 2139319322u, 1066628173u, 240059747u, 1164853046u, 1454716611u, 512654137u, 1544275853u, 2556727566u),
+    SC(580428655u, 115762757u, 1593355348u, 2740341778u, 1504897999u, 975028678u, 2401832824u, 4197869940u, 3667767462u, 644880229u, 691878327u, 369150353u, 4026243769u, 737605979u, 2791271214u, 2620684209u),
+    SC(624678531u, 4114750403u, 1274989179u, 1531504358u, 3520816024u, 2554021149u, 1865577096u, 1362433716u, 1638936249u, 3016959317u, 2526207810u, 3033412199u, 695904139u, 2060012285u, 3230414132u, 860289224u),
+    SC(3442642063u, 1520946900u, 218826564u, 968761561u, 4098434233u, 3360677602u, 2204368028u, 486310067u, 2601372374u, 1399175099u, 2183933043u, 806379489u, 2424203087u, 2668736829u, 1664637882u, 3005713727u),
+    SC(700899790u, 1066183324u, 3546718434u, 998702102u, 2557230354u, 2084117292u, 2934243163u, 1545771642u, 3688392810u, 3908656537u, 3447657276u, 840000010u, 2955752477u, 44371204u, 3799655472u, 3734995825u),
+    SC(3265506533u, 942399325u, 173917125u, 161041810u, 2297418901u, 849604788u, 2703870825u, 2810175425u, 3617296913u, 1432689375u, 3133875354u, 1118654553u, 2616257301u, 495686053u, 4127407123u, 1943733376u),
+    SC(2005668850u, 485568946u, 2260461782u, 2622034876u, 2693998905u, 2811925574u, 2831747304u, 3217266392u, 2520502878u, 1176196783u, 2567958416u, 1525744035u, 2841811417u, 1157609637u, 3871707993u, 2765099676u),
+    SC(207989197u, 368293876u, 3237374184u, 1394768686u, 1254103141u, 935691540u, 375090092u, 2481205522u, 2920254212u, 492683984u, 2055637221u, 4291235240u, 3889542314u, 2465899605u, 1694380507u, 757371549u)
+},
+{
+    SC(136266275u, 1782161742u, 3530966629u, 586004249u, 4076565170u, 3312577895u, 876489815u, 1337331291u, 888213221u, 1813863938u, 1374206604u, 2668794769u, 1377764865u, 784024905u, 1937217146u, 3627318859u),
+    SC(3161427495u, 2344678392u, 1808682441u, 2396619894u, 3034006140u, 1044331129u, 4102609084u, 1058091322u, 1515502621u, 1258860285u, 1406233340u, 127619173u, 3057107171u, 225762630u, 1651671815u, 4285298193u),
+    SC(630785468u, 1344100570u, 1929331818u, 828088181u, 2313124884u, 1302120759u, 3180735860u, 313275450u, 1008942268u, 2707820177u, 4248947940u, 1732478629u, 3645496831u, 611830707u, 1937638387u, 61731419u),
+    SC(1347537282u, 2857000226u, 227299159u, 1108544547u, 1181072563u, 1291715943u, 3752803919u, 2688390945u, 2484326219u, 1350060758u, 452823659u, 2363636452u, 2152205190u, 1812507720u, 607624535u, 2319475408u),
+    SC(3222638329u, 3875752446u, 758301165u, 51152840u, 2430504171u, 1189996379u, 44948392u, 232960619u, 3026371583u, 2974537914u, 3244781723u, 3702394182u, 2835938901u, 663347918u, 3320069474u, 3071978352u),
+    SC(1947047272u, 3022037725u, 949698504u, 1728470528u, 283847009u, 1458268020u, 360012619u, 1579646653u, 4005878207u, 1765381301u, 20903539u, 2558445559u, 757888638u, 2604781527u, 2240457927u, 3990518442u),
+    SC(4281545336u, 1208697934u, 2578865021u, 2456188396u, 1796646478u, 3757714293u, 2622755030u, 1606025966u, 30472258u, 3850691354u, 1208779266u, 405050222u, 3807844323u, 3748806955u, 358470323u, 4212845387u),
+    SC(2041619043u, 3711576883u, 835794591u, 2392116351u, 2862318436u, 689502669u, 2866163103u, 2052898811u, 576580608u, 1144506306u, 542475550u, 474572979u, 4137279429u, 2221684538u, 331268239u, 1556318477u),
+    SC(705880713u, 2092991958u, 815360595u, 3449491044u, 1305192012u, 2057063005u, 3299868133u, 1114733861u, 730760330u, 1129737257u, 4233249504u, 1217580888u, 452658791u, 2612091783u, 1764043106u, 1669202162u),
+    SC(3689992902u, 700129090u, 282055655u, 756126609u, 382876308u, 4262209576u, 2436932760u, 484247369u, 1415138625u, 2340918814u, 3058199817u, 4145497883u, 334812059u, 461523021u, 2221122791u, 2995497332u),
+    SC(706669295u, 3007808000u, 3728730665u, 3241577762u, 3126001367u, 292940936u, 1126531898u, 3913205978u, 304146054u, 2548053118u, 3490807704u, 3465095661u, 3938930443u, 804039554u, 297557674u, 1669808877u),
+    SC(2395818908u, 3199065200u, 4060875213u, 1731284266u, 1022607637u, 1154299144u, 3879751917u, 384430926u, 86892497u, 2036004815u, 2668116514u, 901861508u, 2277490553u, 1312485879u, 562264334u, 170374972u),
+    SC(2192479620u, 3046309306u, 143307916u, 3468295982u, 3110013374u, 699221760u, 273412494u, 3153322038u, 2886126025u, 1296005576u, 2326933823u, 3713038344u, 919578907u, 258326637u, 1991591857u, 604405680u),
+    SC(3283196708u, 902217854u, 1295144146u, 503984315u, 566424671u, 1755595238u, 2455519229u, 120267530u, 1004363245u, 1611271287u, 1013059281u, 3646183010u, 183890924u, 188417891u, 1612883046u, 2255154239u),
+    SC(1231171449u, 2524105034u, 653815517u, 585754026u, 3098352226u, 866901449u, 4223318963u, 1071806142u, 3239364285u, 4077877700u, 423690458u, 2222266564u, 4117269051u, 1893556406u, 3304547745u, 215164118u),
+    SC(3229321461u, 3443938850u, 803179772u, 3340311630u, 2749197592u, 565049216u, 1674980657u, 45735981u, 3858875409u, 2208179057u, 2167864606u, 3853383863u, 3320158569u, 901453102u, 2505912317u, 1486241881u)
+},
+{
+    SC(768143995u, 3015559849u, 803917440u, 4076216623u, 2181646206u, 1394504907u, 4103550766u, 2586780259u, 2146132903u, 2528467950u, 4288774330u, 4277434230u, 4233079764u, 751685015u, 1689565875u, 271910800u),
+    SC(2894970956u, 471567486u, 2880252031u, 2717262342u, 4077383193u, 1268797362u, 4257261832u, 2560701319u, 2691453933u, 1607372210u, 2771176414u, 58794458u, 4272438220u, 2521311077u, 642919262u, 3613569198u),
+    SC(549667688u, 1635817891u, 3597742712u, 2133548191u, 983618585u, 1077056145u, 1016537981u, 3024916594u, 3788763915u, 2354027825u, 234019788u, 1129974745u, 3836449602u, 132091652u, 2429034711u, 3714188356u),
+    SC(3752023309u, 1237246457u, 810507218u, 1575719630u, 2984629402u, 1312110059u, 1532351529u, 3778270553u, 500991970u, 3016414634u, 2451804626u, 3116044735u, 2749076428u, 609078974u, 343845623u, 1628221103u),
+    SC(1079050562u, 537097107u, 2113045556u, 1216978919u, 795109794u, 494396817u, 3615304214u, 3016596136u, 1485503229u, 2246940765u, 2872639209u, 812577075u, 3970992077u, 816616346u, 4279493103u, 2696304890u),
+    SC(302016674u, 1709668681u, 88411267u, 3337357281u, 3061995584u, 3396993199u, 1858891069u, 2509301562u, 3807375387u, 3567949934u, 3737724046u, 4137514111u, 1709156749u, 1400722499u, 3253197246u, 830289695u),
+    SC(86642997u, 2517748533u, 1802616926u, 3224858276u, 667521935u, 294768443u, 3699185630u, 2619978653u, 1654256627u, 789295435u, 4056501046u, 2298266369u, 3425028365u, 3740463800u, 2064449616u, 423401599u),
+    SC(587205175u, 208206623u, 1253389730u, 3674422134u, 284316357u, 2112208954u, 1196434050u, 302049830u, 985808817u, 4037289748u, 2191325460u, 4289570719u, 592322138u, 3671063901u, 886295122u, 2540475213u),
+    SC(2164961127u, 4048157441u, 2790139366u, 1435011700u, 4142835891u, 3320410016u, 2681849481u, 1047872443u, 2885564134u, 874029678u, 2048520878u, 2934385850u, 1097367713u, 1997417466u, 2045706034u, 898129538u),
+    SC(3451958921u, 95403444u, 4056502814u, 671939501u, 2069116441u, 3101129770u, 553516228u, 1712496197u, 2639919391u, 3157824758u, 2182076931u, 2920510603u, 91421090u, 3496854290u, 1333938225u, 2005754623u),
+    SC(469295760u, 426796598u, 3855795018u, 970866434u, 856973549u, 2439780350u, 2385957015u, 2589908140u, 3781058972u, 4109407963u, 32316753u, 3931244779u, 68560366u, 1699148814u, 843806029u, 3772908229u),
+    SC(3846833357u, 4119412096u, 438094070u, 2645426661u, 884548695u, 2876447138u, 80918210u, 2029354870u, 135282137u, 3030947473u, 2960763605u, 1898348122u, 4127316996u, 2240743006u, 2934791826u, 887094286u),
+    SC(1897883656u, 1406242187u, 2434671426u, 2734794757u, 2714201131u, 3046668149u, 257451999u, 3794951424u, 152449195u, 3454838096u, 2737741298u, 821046884u, 2554260361u, 962889686u, 1262263641u, 2203109889u),
+    SC(1985684731u, 222483668u, 2849949193u, 1221492625u, 2084499056u, 1235444595u, 2655267198u, 1020186662u, 1447071023u, 3629752849u, 651251319u, 2167418603u, 2268535831u, 2985934672u, 2652239173u, 3259021212u),
+    SC(3062826974u, 1796450254u, 1939504794u, 476729966u, 3521076442u, 3086668105u, 234121934u, 986487065u, 1570879569u, 2820662853u, 1206879400u, 4271520206u, 4242315964u, 2749978648u, 3007865079u, 4114755771u),
+    SC(3649818358u, 3409857055u, 1537210569u, 2398557069u, 3130583052u, 536941530u, 3880813719u, 1419070102u, 1164730147u, 2533104753u, 2046210979u, 2821557175u, 2327264610u, 1639358616u, 2001893732u, 1524105344u)
+},
+{
+    SC(294473811u, 4198428764u, 2165111046u, 977342291u, 950658751u, 1362860671u, 1381568815u, 4165654500u, 2742156443u, 3373802792u, 668387394u, 853861450u, 2637359866u, 2230427693u, 2824878545u, 103849618u),
+    SC(3462974251u, 3960356708u, 3970663027u, 1911703734u, 2602955995u, 2496279357u, 210580885u, 3874806640u, 2822070051u, 4063068709u, 2061277285u, 1429537360u, 2349584518u, 2910686068u, 3963567776u, 3972103816u),
+    SC(2016723458u, 2541590237u, 3532225472u, 3001659539u, 112442257u, 922189826u, 2246032020u, 3487464820u, 1658786807u, 2276379919u, 1596562072u, 457926499u, 2193005220u, 2575074329u, 529788645u, 1519231207u),
+    SC(1572936313u, 886315817u, 1530415140u, 2311860166u, 3941188424u, 45807153u, 2483174955u, 1469805839u, 3162970586u, 2454510043u, 2417743140u, 2783896043u, 4229304966u, 1351489836u, 284407686u, 4050060666u),
+    SC(1089549454u, 2684562245u, 1059803961u, 224950790u, 58262787u, 3033299806u, 927475933u, 1400133226u, 3082832878u, 1490904482u, 3040968407u, 593844137u, 1569781919u, 798746464u, 1083127814u, 1590280691u),
+    SC(1538536818u, 1828650047u, 3754703497u, 985555578u, 1002045074u, 767791702u, 915104522u, 465342914u, 1114045622u, 3426575950u, 1922317875u, 1070157234u, 3077282627u, 509171365u, 1607316331u, 668038565u),
+    SC(3323765415u, 1224391265u, 2469548057u, 3722781348u, 3031269370u, 4289586349u, 2226931390u, 957179955u, 2298143215u, 388542993u, 1780793152u, 2112973240u, 1502081645u, 1973971844u, 934878133u, 1618693887u),
+    SC(3954817210u, 3380652139u, 2572526672u, 1228436929u, 465848053u, 3939966705u, 2398020514u, 2900599831u, 2007674400u, 2727714272u, 2337519533u, 1681172994u, 4089802218u, 142069883u, 4261364192u, 2856729470u),
+    SC(4248537414u, 694781904u, 571619480u, 3221145068u, 2970038253u, 3370542615u, 2832314379u, 1807587465u, 1411648700u, 1964173012u, 121911610u, 1134463822u, 2574507072u, 885427058u, 3741638072u, 3097389771u),
+    SC(2158675312u, 116080836u, 3333803512u, 3797833536u, 984464391u, 4149942538u, 1145746749u, 1195624987u, 426540232u, 1021913877u, 3121679962u, 3390873776u, 3273678689u, 3851165262u, 4274383191u, 1915176720u),
+    SC(1158541955u, 1843489443u, 998849897u, 969171492u, 1791167915u, 2484857096u, 1119081920u, 1901041264u, 2534183757u, 1529097558u, 2956376281u, 1260291681u, 1159207651u, 3441978306u, 2518693280u, 4253362775u),
+    SC(1690661001u, 2213259738u, 3615956917u, 105152953u, 308358176u, 1328282355u, 1666389191u, 1019854259u, 2059193948u, 4244545599u, 1952864052u, 329670934u, 3592985517u, 571024701u, 1172799188u, 3135874872u),
+    SC(1184018396u, 889004172u, 1920099477u, 1964506637u, 189152569u, 1805931691u, 3250067608u, 3446883320u, 1471577127u, 2315956523u, 1588897116u, 2470229082u, 3602241877u, 554726955u, 1644067322u, 87402371u),
+    SC(1360270758u, 326216664u, 3362619326u, 1255989535u, 4140691901u, 856602972u, 2084629207u, 3858539838u, 78510889u, 2277092409u, 3136284616u, 1772786459u, 3229606238u, 94732571u, 2598206327u, 492226777u),
+    SC(1257123658u, 2873597433u, 3001150814u, 421725801u, 236310867u, 582305583u, 3367057659u, 2102668336u, 153914902u, 4226436363u, 290094468u, 690656835u, 1748591179u, 3668885459u, 165028339u, 2139821087u),
+    SC(2349582063u, 631395785u, 941018791u, 1503410647u, 181331585u, 2473834542u, 2528647747u, 3710284323u, 2364124560u, 3901998444u, 3224972026u, 605068436u, 546878913u, 356944705u, 3829683853u, 160452346u)
+},
+{
+    SC(1451965994u, 766802222u, 1324674662u, 350355960u, 2823290314u, 951779387u, 2914020724u, 508533147u, 1932833685u, 1640746212u, 1238908653u, 542788672u, 3642566481u, 2475403216u, 1859773861u, 3791645308u),
+    SC(216282074u, 1906267522u, 1852437064u, 1010678235u, 3729121535u, 4197231849u, 4150055440u, 1128246703u, 3264673345u, 1375783733u, 3415088931u, 34309836u, 2603881793u, 3106237815u, 2950890176u, 505684202u),
+    SC(3927516830u, 2488673756u, 327917152u, 614182630u, 2355346359u, 730432873u, 88446505u, 4240960753u, 4121410433u, 1398090547u, 2262743232u, 651724036u, 4138228417u, 3106475766u, 4179362424u, 750466827u),
+    SC(434692713u, 3111300976u, 3323560909u, 3413395188u, 601658363u, 2967722170u, 1070605430u, 74966422u, 813799229u, 4061279746u, 1996953298u, 1765274397u, 4035137864u, 2359104373u, 3535793255u, 618634298u),
+    SC(1231617791u, 3545122377u, 2628213180u, 2391855988u, 3734909337u, 2705206020u, 681643510u, 368801430u, 691450613u, 2224147576u, 951972679u, 2767063862u, 3676868191u, 158497152u, 2165075628u, 2832330233u),
+    SC(3529008459u, 1174295398u, 55914117u, 2816083797u, 205887723u, 1756010196u, 1648915894u, 1477354329u, 86311333u, 3889682737u, 1098085375u, 3464880379u, 1139759451u, 542536350u, 186494667u, 2442759451u),
+    SC(3094023174u, 1995851063u, 4191388160u, 1722723757u, 1329293492u, 727282912u, 2669776257u, 2772951118u, 1386276034u, 3089621174u, 2303649396u, 2292749559u, 1467806712u, 266878652u, 2651863592u, 1006978704u),
+    SC(2450691869u, 3012269556u, 3887712993u, 4048656504u, 2160727935u, 1940770088u, 174916584u, 3472792113u, 2648524840u, 990354037u, 1957678544u, 3888925732u, 1168435347u, 3720532709u, 3528212798u, 2624020545u),
+    SC(69863181u, 2459013627u, 4217968964u, 2735851825u, 1081344097u, 737361378u, 2157825722u, 2900791120u, 1412000158u, 1206005337u, 3067055303u, 230632577u, 601427243u, 2760861753u, 3679310020u, 2091861010u),
+    SC(2304197829u, 1531316041u, 2716383108u, 434697890u, 508817514u, 2929310544u, 3751532879u, 3785491984u, 2716598214u, 3666495867u, 3150261948u, 1306653078u, 2283636929u, 2492138954u, 1527136744u, 3312103429u),
+    SC(3387483809u, 1095455990u, 3248396980u, 3181117152u, 2258888938u, 2053848664u, 2160875912u, 553275695u, 1752757914u, 1504034431u, 1046528434u, 1855690339u, 2425857774u, 2142030048u, 237252438u, 3919745098u),
+    SC(3690358562u, 221287988u, 2268047572u, 3655202989u, 756646724u, 68846869u, 1965143185u, 513684595u, 404949341u, 3706987369u, 15990563u, 3409604325u, 658214808u, 2112012281u, 1742449680u, 1802932879u),
+    SC(2972942716u, 4184192946u, 4124576773u, 3089123761u, 1179063207u, 2093485395u, 512951348u, 59239037u, 3674464770u, 787225894u, 1288484371u, 1987692265u, 3767465580u, 4044585132u, 2916653148u, 2297816723u),
+    SC(3784876742u, 1057734114u, 4078669159u, 2003536621u, 3146165592u, 3800656487u, 297129408u, 4248472894u, 3906942491u, 4017607636u, 1285879766u, 3310681130u, 2653159866u, 2524355569u, 84128323u, 2374174391u),
+    SC(1598027967u, 344901367u, 413901309u, 2414916476u, 417612014u, 1371467558u, 1499802638u, 967537237u, 1571117481u, 1088564682u, 3141693657u, 833402800u, 723113978u, 882224086u, 3586817872u, 3592950853u),
+    SC(513582137u, 3376206006u, 3649593908u, 274710963u, 395026609u, 3340190413u, 1543782101u, 90195397u, 4157807658u, 412153222u, 558068169u, 2001737608u, 3474337160u, 1679447360u, 12885220u, 843004632u)
+},
+{
+    SC(2083716311u, 321936583u, 1157386229u, 758210093u, 3570268096u, 833886820u, 3681471481u, 4249803963u, 2130717687u, 3101800692u, 172642091u, 421697598u, 4220526099u, 1506535732u, 2318522651u, 2076732404u),
+    SC(3635330426u, 3675180635u, 4282523718u, 1750526474u, 1682343466u, 1292539119u, 2893227939u, 2897346987u, 1855384826u, 3916002889u, 4211021149u, 3439442996u, 241993264u, 1634586947u, 29890244u, 2635163863u),
+    SC(2111268073u, 1081371355u, 3873218083u, 4044562588u, 2141674529u, 2107952064u, 3689043955u, 3423481956u, 2548188353u, 2697516682u, 4235866514u, 2985306600u, 3687062917u, 2383095614u, 206503719u, 2548448480u),
+    SC(961167287u, 839569057u, 3482959339u, 4268254472u, 364097642u, 1343091094u, 3226753483u, 2159507482u, 3968394805u, 2518014496u, 3451298154u, 38127252u, 267735247u, 3484363065u, 957363479u, 1698662790u),
+    SC(2744437828u, 3863759709u, 3010153901u, 3500431594u, 2624982656u, 875272695u, 1378345519u, 1791692262u, 3726226549u, 2682325366u, 3925052276u, 389591343u, 3869112658u, 650251545u, 6263093u, 860194434u),
+    SC(309822299u, 841707800u, 2661553828u, 3383039256u, 238699224u, 1100968507u, 3534897900u, 4177846894u, 3463859410u, 1435499569u, 2006933774u, 3007046995u, 2819231184u, 288756524u, 1854189890u, 3858081977u),
+    SC(2088052675u, 3396090720u, 416722812u, 2597822221u, 1176386826u, 3290882216u, 1002529034u, 2156491632u, 4202546863u, 1988253003u, 164033721u, 941800849u, 1186836065u, 2298291750u, 1863561032u, 1437279190u),
+    SC(2858016010u, 775169843u, 2706497878u, 2821546952u, 2660836656u, 2077717717u, 3498848893u, 658545289u, 4048269927u, 418273988u, 1144587321u, 3094511386u, 4122354470u, 4225741678u, 603926280u, 979427875u),
+    SC(1933550557u, 635706492u, 1314164193u, 391588743u, 834468642u, 1475393570u, 467867971u, 1271027212u, 2540684860u, 3801872764u, 1235100171u, 2159823063u, 532708943u, 665828867u, 4215955726u, 3885758496u),
+    SC(3602864699u, 4002116109u, 644187852u, 1895585048u, 2776091504u, 72205071u, 554242761u, 4049640413u, 3149249833u, 688714164u, 687706448u, 3680924185u, 2274039047u, 303853541u, 2977107717u, 1196398757u),
+    SC(3014099531u, 1302405838u, 17960870u, 4110705157u, 3801652109u, 2085339416u, 223612049u, 2870889264u, 3353629397u, 3527061798u, 674241336u, 3525864585u, 2278818471u, 2069831593u, 2885891701u, 1329881521u),
+    SC(943450806u, 3704544104u, 3603194299u, 3757910007u, 502151885u, 765197432u, 4190577627u, 771063523u, 2436865367u, 678307964u, 1498061278u, 4120830837u, 3369466394u, 3399332765u, 1670894068u, 2891073104u),
+    SC(501595739u, 1876059299u, 4182005344u, 160804770u, 962098784u, 2636270989u, 1828906496u, 1316975808u, 4088133273u, 2943366134u, 216957582u, 1003216568u, 4242258589u, 3505873185u, 2810125978u, 3429220861u),
+    SC(2021386647u, 4046435053u, 1951135097u, 3941871277u, 2261999657u, 3808836272u, 2028063026u, 3659044589u, 3595750274u, 34514326u, 1889867282u, 1898224864u, 1659225476u, 3153868894u, 1647148554u, 1185039302u),
+    SC(4119269244u, 1304843028u, 2354051818u, 2031439365u, 533555049u, 1418960734u, 214120313u, 4187370667u, 4256529561u, 2635160409u, 1836564249u, 3828261559u, 3235640513u, 181194540u, 4018312346u, 680914749u),
+    SC(1914329770u, 3317667974u, 1413160514u, 2952053282u, 3332782151u, 3751637695u, 2146129829u, 167804454u, 2499496888u, 4213150810u, 223599992u, 2197202825u, 2869811316u, 2635473358u, 952082661u, 1532017334u)
+},
+{
+    SC(701959589u, 2450082966u, 3801334037u, 1119476651u, 3004037339u, 2895659371u, 1706080091u, 3016377454u, 2829429308u, 3274085782u, 3716849048u, 2275653490u, 4020356712u, 1066046591u, 4286629474u, 835127193u),
+    SC(897324213u, 739161909u, 1962309113u, 3449528554u, 2634765108u, 226285020u, 2832650161u, 324642926u, 2242711487u, 162722959u, 2264531309u, 2307017293u, 4006636248u, 1035416591u, 2557266093u, 3957962218u),
+    SC(1912896448u, 699621778u, 2975109255u, 1580597872u, 2818493758u, 515803157u, 1642586345u, 785148275u, 2098287545u, 1424779842u, 1039209855u, 4238164284u, 4173562747u, 3569896384u, 1089361492u, 1858690350u),
+    SC(2757340308u, 2538321018u, 2388474793u, 379482919u, 882562385u, 3129659692u, 4216198588u, 3565768337u, 1772023241u, 2931080253u, 3451485646u, 748689895u, 562737327u, 663797632u, 3315310934u, 2629536884u),
+    SC(242169331u, 1243063456u, 175561111u, 2950276224u, 3213816292u, 692329775u, 3181354285u, 3015261169u, 1744760252u, 3733849950u, 4219512025u, 693702734u, 2844842003u, 722286940u, 2391355922u, 3564773447u),
+    SC(2291286292u, 966238959u, 506903622u, 2122264528u, 1392182009u, 3447321781u, 3873294792u, 1373792940u, 991667700u, 2332723711u, 2764968211u, 2471301595u, 649629323u, 783169152u, 1459916213u, 3846736182u),
+    SC(2664330880u, 1149932862u, 1416201114u, 318583284u, 4140857901u, 1128356267u, 1095497693u, 1624736741u, 761312690u, 241788645u, 2036924781u, 1946525101u, 3225208750u, 4156033061u, 2590150721u, 3771407135u),
+    SC(2862143077u, 233168744u, 2659004990u, 155440145u, 3918377979u, 1360152661u, 627903232u, 1469886352u, 2876841580u, 3955906097u, 580277652u, 3039511497u, 1597126708u, 1404269416u, 42059925u, 2098341602u),
+    SC(812381463u, 3272442363u, 496180006u, 1236237424u, 2267310113u, 2237850197u, 1113026387u, 716498059u, 3503382440u, 328287114u, 1410789607u, 477863076u, 1362085890u, 3569642059u, 2006757845u, 675415451u),
+    SC(747557402u, 4212477852u, 3286869720u, 3708058361u, 3240421074u, 1188732842u, 916816078u, 2444327052u, 2111479336u, 1745064524u, 3637408011u, 3599633029u, 4230973048u, 1160089497u, 1136388910u, 4138160782u),
+    SC(1255139572u, 1856599651u, 1458352865u, 3271906169u, 3410637086u, 2119040671u, 1680850868u, 413922813u, 2782309328u, 3561735700u, 3723648708u, 609378416u, 268989415u, 3293584485u, 3271843364u, 1954072630u),
+    SC(4155626312u, 931793228u, 1049414704u, 1037617746u, 265265177u, 616902615u, 844384832u, 3477591939u, 3106685802u, 2357099686u, 1845236259u, 3355104451u, 3327830357u, 3100545339u, 1162051156u, 2646331847u),
+    SC(514329180u, 948073745u, 1774920952u, 105860125u, 2811186644u, 1695131452u, 940976033u, 2019732362u, 309099076u, 1607914408u, 4118428245u, 1337868060u, 3952860679u, 2578427283u, 265792106u, 295755030u),
+    SC(3882528435u, 2629929072u, 1617404150u, 1421619579u, 2309432083u, 724299897u, 2666040048u, 1096383838u, 1836447402u, 426930713u, 3934220119u, 3232225281u, 1000075862u, 3631628825u, 3529619355u, 1219322120u),
+    SC(3335633324u, 4194223138u, 3901817518u, 1335914529u, 3871871049u, 3709757137u, 3499113177u, 235348888u, 781652835u, 1102256292u, 3754223033u, 833068853u, 4178470716u, 1807198743u, 2733399861u, 3740356601u),
+    SC(228568838u, 3126580587u, 4000897922u, 1303869372u, 3850020302u, 1548458239u, 2356371812u, 3570971356u, 2544858219u, 4220062752u, 2062616152u, 953792592u, 764216612u, 2052428514u, 2314665964u, 2792116584u)
+},
+{
+    SC(2022030201u, 622422758u, 4099630680u, 255591669u, 2746707126u, 492890866u, 1170945474u, 626140794u, 2553916130u, 3034177025u, 437361978u, 3530139681u, 3716731527u, 788732176u, 2733886498u, 780490151u),
+    SC(4207089618u, 3411945447u, 1960753704u, 3552759657u, 1130668432u, 848791484u, 3810908171u, 353148861u, 3312275539u, 2963747704u, 2966813687u, 2483733320u, 2880725255u, 463405312u, 3340834122u, 1292390014u),
+    SC(2664721153u, 4108676217u, 2604619822u, 775242570u, 636236518u, 2873717047u, 1857718302u, 2091477716u, 1586310695u, 2528697445u, 2256487867u, 2787362203u, 2741360704u, 496928924u, 601271512u, 3586110309u),
+    SC(1791685197u, 4242641311u, 3369628733u, 2052809939u, 806398185u, 3412279529u, 1946210627u, 1398934260u, 3077042954u, 2276630414u, 814388665u, 1749609309u, 3367688729u, 1959714965u, 2411157301u, 2263996211u),
+    SC(439326213u, 4256425445u, 876987216u, 1314194194u, 3010100734u, 1576065730u, 598365157u, 3705087566u, 3427486218u, 1877721147u, 358249820u, 410263983u, 1386735339u, 573015435u, 3312164843u, 1274000474u),
+    SC(1340417963u, 1112802360u, 10328826u, 706586684u, 2526013892u, 4135069035u, 3566832565u, 2945858092u, 107866747u, 2114273476u, 1970904771u, 965191541u, 1793617219u, 1453495760u, 4269949644u, 41605060u),
+    SC(123137558u, 4245690796u, 820317976u, 1443287541u, 4203849632u, 2954045926u, 714382464u, 3076066234u, 1293485113u, 2554869888u, 1663243834u, 1823619723u, 3832632037u, 2772671780u, 1362964704u, 558960720u),
+    SC(104412626u, 1897841881u, 4081037590u, 3456756312u, 3025873323u, 2036419348u, 663042483u, 1254379139u, 1882881825u, 3296543036u, 153313200u, 916960321u, 2276001640u, 759388499u, 1134495268u, 1699779658u),
+    SC(4218137867u, 889442133u, 2322944798u, 2659784159u, 2592614267u, 3345396604u, 3647495000u, 2837331949u, 75759322u, 2350992064u, 2461684340u, 2333444962u, 60872001u, 106935728u, 2095087192u, 2026584532u),
+    SC(818402121u, 2851948581u, 2197490142u, 4158011576u, 1665124994u, 3116095068u, 4019154383u, 478938546u, 1455910301u, 1844755722u, 2818772446u, 2743310120u, 1907022363u, 1639658700u, 517605614u, 2705809838u),
+    SC(335193145u, 4147885949u, 3527556636u, 2575925391u, 2530836608u, 2938195122u, 3771589905u, 2663025172u, 4017017665u, 2146447634u, 3974365403u, 2994000421u, 3198356067u, 3382731724u, 2593683495u, 3554902256u),
+    SC(1108422413u, 1982378939u, 2047758090u, 246779179u, 2568353687u, 279750626u, 1730233650u, 784289836u, 2712478714u, 3614283837u, 1824826964u, 2514128237u, 3308726345u, 3623735281u, 887459898u, 3896777957u),
+    SC(3527405352u, 290146745u, 125808293u, 735109902u, 1788801307u, 3306408847u, 822599754u, 3798637803u, 1514985656u, 2967186195u, 716984495u, 3386310843u, 3156794500u, 1007814159u, 1629566196u, 4265651874u),
+    SC(1178327293u, 565847309u, 518944000u, 3901419432u, 941693255u, 4276272755u, 3595637504u, 1831384538u, 553054976u, 3799273120u, 516961220u, 3048859574u, 1887176404u, 3648800625u, 2905989893u, 2971331974u),
+    SC(561598562u, 3812086269u, 2571795641u, 1946669885u, 4094345694u, 1247304730u, 725275648u, 2382611624u, 3912910386u, 3657806663u, 2347179560u, 3311073478u, 3031523768u, 2672297551u, 829774364u, 4138790294u),
+    SC(3908534093u, 41076189u, 4026661177u, 1264946070u, 3582612650u, 3167460834u, 3305185564u, 1828271691u, 1883569901u, 567401887u, 2154847219u, 3599749472u, 834678216u, 1517326104u, 465030801u, 2253777505u)
+},
+{
+    SC(69398569u, 525452511u, 2938319650u, 1880483009u, 3967907249u, 2829806383u, 1621746321u, 1916983616u, 1370370736u, 248894365u, 3788903479u, 221658457u, 404383926u, 1308961733u, 2635279776u, 2619294254u),
+    SC(4116760418u, 3197079795u, 2972456007u, 1278881079u, 1399016013u, 267334468u, 3129907813u, 468505870u, 1237093446u, 3810554944u, 1980244001u, 1830827024u, 4255330344u, 3556724451u, 2936427778u, 3969278111u),
+    SC(3989128687u, 604159041u, 3302470711u, 1703086807u, 4153485525u, 2444501021u, 449535888u, 2817157702u, 3967126593u, 3774839729u, 4230523164u, 1130105305u, 2419296875u, 560268503u, 173246097u, 1794638932u),
+    SC(1735434103u, 3810847770u, 4216841726u, 1126260487u, 1019034952u, 4140633019u, 3223272164u, 440162565u, 3864068825u, 3275406276u, 2196958479u, 4212485308u, 539037402u, 431338309u, 4061221107u, 4289896057u),
+    SC(1802752446u, 2780168117u, 1133399256u, 2599868866u, 3158418134u, 2848371717u, 2893014484u, 1878597835u, 139427334u, 1841937895u, 2016179766u, 2330806831u, 3849381146u, 2224326221u, 2296824272u, 3983748073u),
+    SC(1520559143u, 1690628296u, 1614953069u, 1422707415u, 257987514u, 3063997315u, 2652769123u, 3445956897u, 843436720u, 4264023440u, 365609354u, 2250088148u, 2769492081u, 59746990u, 1275187671u, 1973406172u),
+    SC(2823162534u, 2631304853u, 2485683334u, 33106529u, 243176015u, 492943806u, 489814307u, 4023911334u, 4139752347u, 4133120235u, 2455727203u, 1293330101u, 1838339727u, 4219498628u, 2131345625u, 3646653738u),
+    SC(4198202713u, 3167956639u, 2765023077u, 3652537372u, 1708707687u, 2324231909u, 1009881825u, 1679047879u, 2515346176u, 794145218u, 554048969u, 3173445869u, 2193645289u, 1271864237u, 1006139617u, 1072905092u),
+    SC(4273823033u, 1749314885u, 4263358248u, 538495360u, 4104454924u, 1997598205u, 3080563305u, 3238994582u, 3099819109u, 3162260128u, 1706963773u, 405274298u, 1894479347u, 1596497438u, 1094591269u, 1522128209u),
+    SC(2640931764u, 1304425992u, 2939922746u, 3918107623u, 1248692482u, 1121191585u, 2062140937u, 1807331998u, 3643560968u, 3236720945u, 2667270358u, 411521120u, 3664086365u, 2334989504u, 2668098536u, 3236026237u),
+    SC(2404161740u, 567514400u, 3895963765u, 1201374790u, 674719322u, 2894222365u, 467511362u, 3395036514u, 1038550674u, 2948454520u, 1518702565u, 1362236790u, 157238862u, 3475771959u, 1415257606u, 2714484334u),
+    SC(1831986705u, 588754101u, 4075551797u, 2767613701u, 2944855428u, 1912813036u, 1398542170u, 3440695634u, 2367865816u, 842155635u, 2602621363u, 2143763320u, 4256143529u, 1826541687u, 1851134007u, 2997377819u),
+    SC(3699972731u, 227995919u, 3067674252u, 477404832u, 847958753u, 893077929u, 2153170373u, 3057114881u, 1197132301u, 3330088847u, 2465660906u, 549749504u, 722435391u, 4124201578u, 3419977887u, 636305133u),
+    SC(3346980455u, 338882355u, 1940861469u, 2106574528u, 4065634984u, 939438415u, 880899904u, 173329243u, 3962520186u, 3417951565u, 2532850810u, 1158609417u, 1846710650u, 305050726u, 600225342u, 3684765712u),
+    SC(1932816778u, 3409537322u, 2445361402u, 1740774412u, 3661005378u, 2854030637u, 1914937560u, 1558250179u, 3808763123u, 1298026979u, 2417248681u, 899022004u, 847010236u, 506303181u, 1296472514u, 648957572u),
+    SC(600303058u, 722185115u, 3110060002u, 3818809602u, 1551617161u, 4208042174u, 526230670u, 1957951010u, 3160030963u, 3295123990u, 3121214191u, 1337066151u, 2200271451u, 1066776105u, 1163805043u, 2606444927u)
+},
+{
+    SC(1137648243u, 3815904636u, 35128896u, 1498158156u, 2482392993u, 1978830034u, 1585381051u, 335710867u, 529205549u, 1286325760u, 863511412u, 283835652u, 936788847u, 101075250u, 116973165u, 2483395918u),
+    SC(2210369250u, 711585268u, 1961210974u, 1353321439u, 1215935705u, 1641330999u, 11213011u, 2020212318u, 695107713u, 3413272123u, 1378074688u, 2790029989u, 658491086u, 1881545465u, 3409839898u, 2042086316u),
+    SC(1723393102u, 3373492622u, 3599711002u, 3748987970u, 1143620470u, 2663282777u, 2229588531u, 2674289435u, 2963045423u, 2234232397u, 4178299567u, 2791622546u, 4001934471u, 757990509u, 2858420658u, 605204372u),
+    SC(4272330873u, 3840847353u, 659917277u, 1664684318u, 1563018625u, 821178295u, 3329580379u, 794312951u, 2169136998u, 1706378889u, 3017987093u, 1159314572u, 2524368718u, 2444830959u, 898030098u, 68613446u),
+    SC(3172236096u, 1547478676u, 3467968131u, 1603626860u, 1411948645u, 2916654969u, 2891471305u, 2110051838u, 1733578576u, 2788816800u, 1613389791u, 759324595u, 3991538909u, 4073480091u, 3323038139u, 2043658072u),
+    SC(3011536148u, 2207224783u, 101813390u, 4149858178u, 961260436u, 3760245299u, 2099300570u, 3143747485u, 3209436103u, 902146054u, 3598885374u, 597299239u, 1369786353u, 2099087354u, 1506359374u, 1017249349u),
+    SC(3137350455u, 1622014086u, 2828880803u, 599881832u, 2213606365u, 4248974065u, 675350384u, 1446749674u, 1254778294u, 1745968946u, 409433048u, 1103126998u, 2370471436u, 1143685003u, 3341252280u, 1003299547u),
+    SC(2019014241u, 1108099665u, 1035538349u, 2878848993u, 2585673617u, 1565675366u, 2261830657u, 117854892u, 1965053814u, 2351841804u, 4065720752u, 3747135308u, 959541091u, 1629950401u, 4236240320u, 189693687u),
+    SC(3443026785u, 3216851941u, 278623472u, 1568038608u, 1548544711u, 2243949731u, 3359141033u, 1425753427u, 2934907774u, 2301245979u, 2216178210u, 153063705u, 1690071616u, 791861830u, 1201756636u, 1249732113u),
+    SC(2497506925u, 3815453805u, 1308318422u, 1061717857u, 710358190u, 3797004413u, 1870767051u, 2099598345u, 845543228u, 2941187056u, 1083282999u, 1311194087u, 3227025541u, 423673289u, 2634724972u, 3297305091u),
+    SC(1394185841u, 1653557808u, 2313575976u, 1732811292u, 2133445032u, 171245194u, 3242484287u, 2667183179u, 1165233778u, 997752293u, 501180123u, 2529762237u, 429212016u, 1660866777u, 1766992150u, 2066419882u),
+    SC(945381459u, 1085161105u, 3490034658u, 983140246u, 425352282u, 2175943302u, 1166850024u, 3968884285u, 1417959566u, 3386676357u, 3168826489u, 2984241621u, 3305143707u, 246924146u, 4113453679u, 123892017u),
+    SC(1498291154u, 979168666u, 2565114847u, 3722708999u, 3116533535u, 2044826765u, 118913881u, 2684275795u, 30932180u, 3147559151u, 3769605849u, 2376328043u, 753602217u, 3789763983u, 1247346722u, 4123341034u),
+    SC(3203969599u, 2514533821u, 1007395325u, 2063305304u, 520326691u, 3823758018u, 3095693832u, 1864628246u, 2586004821u, 4190638257u, 2952735262u, 2977139992u, 1124651421u, 295756268u, 3428261546u, 3110485030u),
+    SC(1663042556u, 4114384947u, 1430450710u, 3825340149u, 1051862436u, 3194752601u, 3106848742u, 1383208530u, 3142397378u, 4065704146u, 1545077688u, 2297695627u, 3152458457u, 4134880529u, 2187655177u, 3419805764u),
+    SC(3081663242u, 3880428040u, 2670880433u, 1398290076u, 1232125961u, 3862005121u, 1297357575u, 3334998678u, 1135063881u, 1723120988u, 2716095891u, 1113861429u, 3955845594u, 88397004u, 1699846421u, 887623013u)
+},
+{
+    SC(2668669863u, 1518051232u, 591131964u, 3625564717u, 2443152079u, 2589878039u, 747840157u, 1417298109u, 2236109461u, 625624150u, 2276484522u, 3671203634u, 3004642785u, 2519941048u, 286358016u, 3502187361u),
+    SC(1979235571u, 2198968296u, 3104128030u, 1368659294u, 3672213117u, 1391937809u, 2759329883u, 1389958836u, 2420411428u, 890766213u, 2707043165u, 2738550562u, 3382941095u, 378763942u, 3093409509u, 2964936317u),
+    SC(738589056u, 2116353374u, 2279888429u, 1705963022u, 828292114u, 896734726u, 2179570630u, 199574728u, 977051187u, 779668316u, 2330529056u, 3992755888u, 1000402439u, 2191612089u, 357145081u, 1441305104u),
+    SC(3372185571u, 1990378702u, 1181109789u, 3007260699u, 2430812419u, 1342872134u, 2198044770u, 1122343273u, 492870646u, 795688582u, 3226537448u, 1245881435u, 1071312339u, 1997541910u, 3829149062u, 1964864598u),
+    SC(3005241683u, 2859584860u, 2297396821u, 999606499u, 3964655188u, 3075624064u, 1368424820u, 847579236u, 744318941u, 1201524211u, 1104903258u, 3771742070u, 4093550286u, 53333408u, 659192149u, 3026115299u),
+    SC(3415227510u, 2060701016u, 1724277801u, 2661091313u, 215175235u, 1719160017u, 2940192603u, 1942243742u, 2398510742u, 4053370504u, 720436957u, 3760614784u, 2014232625u, 4199009336u, 2658914393u, 246186938u),
+    SC(446126854u, 165933106u, 2141828870u, 892600041u, 4146883601u, 2127439849u, 3431174989u, 2697318886u, 754216027u, 2671089369u, 1463409379u, 2826265846u, 334206028u, 1562078629u, 62819702u, 350080249u),
+    SC(3607678201u, 1305808009u, 3724583207u, 482185919u, 703873206u, 1075587326u, 1772056430u, 1356871295u, 4212601732u, 3762698616u, 2707284202u, 752961239u, 3089561250u, 1634547883u, 2919906767u, 31529502u),
+    SC(299389109u, 1252069111u, 2304374236u, 1252642323u, 2415535563u, 271885157u, 592252779u, 1178960198u, 53568246u, 3149254195u, 2937703855u, 1474069228u, 1764301842u, 954790502u, 4245417136u, 3132108431u),
+    SC(2094400513u, 3190829985u, 2239253067u, 2918833540u, 4106202305u, 2502268912u, 1731261142u, 2453877410u, 1861934729u, 934615026u, 3785479199u, 3605446967u, 3582056355u, 3042887218u, 1961855879u, 496882544u),
+    SC(3179454680u, 881405516u, 158640787u, 2790186672u, 162147899u, 376983910u, 3379568747u, 1408037207u, 1411174731u, 535638557u, 1510230718u, 2856041085u, 1958999115u, 3678347246u, 2958940834u, 520309445u),
+    SC(1870118851u, 1980314816u, 3987573623u, 4117586697u, 396136405u, 3149345244u, 70002589u, 2314836548u, 1713919226u, 3789182954u, 2123295507u, 3015665476u, 4069315088u, 3980795614u, 2021907367u, 4155874670u),
+    SC(4078777812u, 3708497519u, 1529048728u, 3747007128u, 2780224299u, 2728976580u, 3953400499u, 550363476u, 3812495996u, 3116459113u, 2211909765u, 3967732138u, 315888386u, 4202077281u, 1437542127u, 2815522910u),
+    SC(3236576167u, 3189780679u, 2030714184u, 2121402515u, 772212369u, 2193424420u, 1417920098u, 2031545011u, 4110769775u, 697022136u, 1206489717u, 1691036150u, 88940849u, 535864250u, 547921653u, 2569798466u),
+    SC(598120112u, 3876471191u, 3533286352u, 3003233155u, 1039593763u, 2148663879u, 2659932582u, 279051507u, 988977723u, 3458445518u, 2950275676u, 4048574808u, 3093122873u, 831143981u, 214208408u, 3935649503u),
+    SC(2893621405u, 3242329790u, 1948255717u, 4083664057u, 3803596193u, 740414223u, 4293576836u, 3875047642u, 667197150u, 2081112783u, 2447275650u, 242164299u, 706345359u, 1928593492u, 1774391838u, 3660333945u)
+},
+{
+    SC(3009793609u, 3525092161u, 3245586135u, 574145899u, 4034974232u, 2828949446u, 3457574134u, 1546193476u, 3883480541u, 1976722737u, 3557056370u, 994794948u, 106991499u, 1626704265u, 3534503938u, 3271872260u),
+    SC(2939511082u, 3508735083u, 975571643u, 1775005849u, 4144127005u, 706007446u, 420750190u, 1296964164u, 3061654480u, 2268588398u, 258119220u, 1152421762u, 2183948554u, 3016917902u, 1186604447u, 3147111215u),
+    SC(405897674u, 923178082u, 1575208079u, 3088321769u, 2214762612u, 3893926734u, 3167279390u, 3951912989u, 2709000001u, 2390687969u, 3858727239u, 866338457u, 2045181240u, 3217044625u, 2328560686u, 1861539550u),
+    SC(1277015638u, 1098202702u, 1559301990u, 2587773702u, 236499920u, 458659357u, 2353007333u, 2611100088u, 3428309717u, 2008274629u, 3647015407u, 268886847u, 2626192792u, 3341061984u, 1515395072u, 3708589435u),
+    SC(4042661445u, 3420460388u, 402520550u, 3677541300u, 2230979515u, 1273170666u, 2514471146u, 827498216u, 1259202696u, 3072082970u, 475301020u, 2118811945u, 3612811582u, 1387362670u, 2779447975u, 2265478999u),
+    SC(2229583001u, 1885758268u, 2744744533u, 2751282929u, 3032060674u, 1949605811u, 1570835257u, 793354274u, 1683039266u, 449593771u, 109462780u, 1941150268u, 1808732776u, 139050949u, 2225765509u, 1246293964u),
+    SC(2802845617u, 3765730171u, 462111640u, 590276976u, 2549490668u, 1227143343u, 384473299u, 1872236586u, 2432932105u, 2621627369u, 29218585u, 3541815309u, 3762320683u, 3470760231u, 2011203130u, 2527437401u),
+    SC(796052351u, 4037990088u, 4017471553u, 1320960316u, 561010825u, 3728618461u, 3540350568u, 1334322515u, 2252671868u, 3217596003u, 3122272084u, 3124892250u, 146022162u, 3584383023u, 2911266650u, 2958817688u),
+    SC(161418820u, 3776882969u, 4050624816u, 1522984750u, 3239766493u, 3767349571u, 782872272u, 4177710199u, 1140123311u, 211837022u, 1955996644u, 402816745u, 3326870942u, 1443720320u, 1645866695u, 3832886909u),
+    SC(452931871u, 3201459109u, 3989748495u, 3779670060u, 3234605835u, 2462489907u, 3541849378u, 3952908948u, 2234764749u, 2534999097u, 1221823414u, 2220662906u, 2593424893u, 3688122472u, 2131104831u, 243658822u),
+    SC(1244527825u, 1331697159u, 1126644730u, 922926684u, 1475975786u, 704282514u, 1718439968u, 1878820141u, 2509443841u, 2182928123u, 1663057853u, 2828328506u, 1475048880u, 791101245u, 3209045799u, 807262644u),
+    SC(1506123994u, 75559732u, 2487617790u, 2776679170u, 2522687136u, 3704896305u, 945074946u, 2943008309u, 1088584510u, 2469322363u, 1078526500u, 2073262975u, 691596720u, 2702927487u, 380178128u, 704842212u),
+    SC(1460389583u, 4274587105u, 1447626425u, 3957246995u, 1621878179u, 1643627976u, 4030517934u, 1056559397u, 1438644008u, 32976965u, 2197709285u, 3567855255u, 2001746745u, 2603748421u, 3462117821u, 903804357u),
+    SC(3179129705u, 2297226467u, 1646197352u, 950157362u, 2929140164u, 4242027992u, 1652798968u, 4193267428u, 3343133888u, 2499845914u, 423061238u, 3494957413u, 3637365392u, 784231823u, 595573026u, 2713123590u),
+    SC(2810225213u, 3951319549u, 1905650326u, 3909017486u, 2335763951u, 3772810842u, 2983632261u, 489145948u, 4173940274u, 2703192453u, 2654763363u, 4064871590u, 1399005653u, 257836626u, 831912020u, 895345820u),
+    SC(4037755568u, 3145789767u, 2141184942u, 4120133888u, 346636610u, 3895536529u, 2259736314u, 1057113066u, 595225270u, 3051392771u, 2813693848u, 3877775276u, 1832280309u, 1138362004u, 3061980317u, 858203300u)
+},
+{
+    SC(941124125u, 1620226392u, 1431256941u, 3336438938u, 540497787u, 766040889u, 373284400u, 2979905322u, 177008709u, 2625544842u, 1096614388u, 1196846420u, 4186360501u, 3945210662u, 1143943919u, 3412870088u),
+    SC(2868459499u, 3255324438u, 807131982u, 2853200483u, 3487859623u, 3501857558u, 3107820062u, 2163227213u, 2115527726u, 2346720657u, 2251713340u, 3377131273u, 3223650794u, 3766790266u, 177525458u, 4167009497u),
+    SC(311132793u, 3961991670u, 3475828441u, 4275227465u, 4114440759u, 287999228u, 3329759386u, 2384037498u, 4228771259u, 844254234u, 256179964u, 1796107218u, 3127243322u, 1425447302u, 1385509204u, 1101567113u),
+    SC(2084416542u, 1837746358u, 3915669193u, 60671540u, 2731498203u, 842785439u, 103116859u, 3404407266u, 2713222963u, 3049100113u, 368142082u, 2923502225u, 3018451818u, 2169399182u, 3017634865u, 1845463402u),
+    SC(1620925474u, 3368534446u, 555437218u, 4144603563u, 1969376145u, 213474605u, 1856420595u, 3939242692u, 1705488978u, 252956811u, 1258322279u, 1776729832u, 3988114536u, 3572272198u, 1383845751u, 1398527932u),
+    SC(1762997475u, 799707654u, 1609033889u, 2324053368u, 2951656833u, 2545022095u, 1325992886u, 2638191889u, 737853621u, 891297811u, 1613139572u, 594983169u, 2686965496u, 4040759974u, 1496585540u, 294269531u),
+    SC(3866323582u, 3807637640u, 654389167u, 993860478u, 3985490230u, 874636344u, 2342980699u, 1928023737u, 1520117329u, 644165140u, 150615609u, 199275733u, 463804864u, 310744654u, 2057873049u, 1169977839u),
+    SC(239011286u, 715635161u, 1855226016u, 2750348850u, 4059485278u, 800137564u, 3998891997u, 4048007508u, 1194893107u, 3761772527u, 273800027u, 653240081u, 1187997500u, 310579555u, 786511222u, 3092283411u),
+    SC(3036944959u, 3482022954u, 3739636749u, 3919006909u, 4266819119u, 1212326408u, 103856594u, 597427799u, 1319114089u, 4260737761u, 1982976744u, 741084092u, 689793522u, 4260038527u, 1319231386u, 1661185367u),
+    SC(3846585080u, 1572901113u, 2683774833u, 3251385733u, 3753876990u, 849242549u, 4245340911u, 1064393430u, 3309340124u, 2842098330u, 2556268102u, 2033409485u, 757257328u, 2031055308u, 487255243u, 3197919149u),
+    SC(273355511u, 2413549351u, 710350577u, 1361281890u, 2485522754u, 1210096318u, 3839671116u, 3619357718u, 3954210633u, 312725146u, 3792397974u, 3833954588u, 1779821907u, 2701218449u, 2422680647u, 3829673069u),
+    SC(379167192u, 3494512635u, 855436470u, 2928216366u, 4239059924u, 4254878455u, 3617218283u, 739826290u, 3488721213u, 1288540569u, 2623691196u, 4237777587u, 1234356449u, 2367467024u, 185343202u, 2198868227u),
+    SC(333398980u, 1306721698u, 1267933489u, 3888643170u, 2305763143u, 1886386521u, 2247721544u, 1287414137u, 497238456u, 1934421131u, 1960709128u, 2688614248u, 3637710577u, 3756130276u, 1929365309u, 2796038772u),
+    SC(772805737u, 461244658u, 3551164236u, 4177074918u, 3920537361u, 4259237061u, 3625379235u, 3715444221u, 3444473673u, 2576271136u, 2750230085u, 2167864295u, 2571239709u, 3663560660u, 743894391u, 703945624u),
+    SC(2955504442u, 4192737708u, 2813336533u, 2037901957u, 1563142269u, 620241136u, 3249364868u, 1805455553u, 422364625u, 3061329310u, 3824436397u, 1640020182u, 2540832302u, 2063844885u, 2982901072u, 2809011473u),
+    SC(4188085081u, 1849071252u, 4251112483u, 1368274267u, 2811635355u, 3535120523u, 478922770u, 1090405967u, 2358353504u, 2249592823u, 2367480425u, 1158857070u, 1979230110u, 3661225756u, 2903524693u, 1830110173u)
+},
+{
+    SC(3638948794u, 3243385178u, 2365114888u, 1084927340u, 2097158816u, 336310452u, 231393062u, 580838002u, 3851653288u, 568877195u, 3846156888u, 2754011062u, 3396743120u, 2639744892u, 1431686029u, 1903473537u),
+    SC(3268926613u, 1818698216u, 1862252109u, 1578913474u, 4289804840u, 1885759995u, 2888888373u, 2636129891u, 2360477693u, 1672434489u, 4188472821u, 2046052045u, 437371108u, 3454488779u, 2151384078u, 1514762405u),
+    SC(3140765176u, 3623124217u, 3204258419u, 1994235030u, 4141313973u, 3067394014u, 3891883464u, 3387486245u, 3254639322u, 1970078634u, 2106725210u, 2833086525u, 1670513208u, 472865524u, 2121280699u, 2548725819u),
+    SC(309446023u, 3610145983u, 678094472u, 3223511337u, 4188624231u, 2675209562u, 619208065u, 1214683627u, 307823706u, 3407147709u, 2103429213u, 3636822787u, 2441204583u, 1675916090u, 1444359140u, 2979809856u),
+    SC(1982287011u, 2286805587u, 3436767742u, 3002584758u, 477850697u, 439716674u, 3863581947u, 2155905635u, 220608999u, 1402913678u, 2974580099u, 1207717136u, 3265452095u, 2174870701u, 464004734u, 3218951674u),
+    SC(2374025586u, 3926883961u, 3555874460u, 1238670328u, 856489843u, 4258163476u, 977941661u, 3889087192u, 2262660846u, 1677408901u, 2922467369u, 1043137100u, 4279650771u, 3357788771u, 1512036754u, 2539641395u),
+    SC(1142842756u, 272648505u, 914080820u, 4056304706u, 1529598235u, 1542384711u, 898735874u, 77881967u, 1035144846u, 702992091u, 2075420139u, 2454875215u, 1266516833u, 2974932401u, 3666315911u, 2262316403u),
+    SC(282628724u, 2966722803u, 3533567779u, 2474391608u, 1236598744u, 3094620093u, 2714845907u, 369896328u, 366951725u, 2971547133u, 2753808137u, 618960857u, 2006195012u, 551749950u, 1402811398u, 3808228405u),
+    SC(962649761u, 2486282608u, 1808066694u, 2361174774u, 234593415u, 400975056u, 83848885u, 1091105486u, 1020816894u, 1838575736u, 2668167699u, 73800319u, 2028242253u, 2121917721u, 1921251529u, 2828854963u),
+    SC(2717497535u, 366873177u, 336873963u, 978494261u, 2877822089u, 2054875183u, 2521644031u, 4057807064u, 3713415744u, 3955164880u, 2229410320u, 3755022307u, 3363858805u, 1398106956u, 800395520u, 1799982442u),
+    SC(399227430u, 164572050u, 2101616757u, 962629850u, 1654784623u, 3459989194u, 2240801569u, 1986371042u, 1911756881u, 2723553175u, 2964071573u, 3609789600u, 3185432638u, 2208423303u, 2967147750u, 4279453877u),
+    SC(282950688u, 2418348758u, 1686423600u, 1392917024u, 3343336708u, 976718153u, 671781049u, 4166009090u, 371505957u, 2474457927u, 1126253569u, 3355537407u, 4151375790u, 2105071839u, 941370857u, 331122028u),
+    SC(2127306191u, 1587304141u, 1137651997u, 1529991785u, 1356564935u, 726775332u, 1952136309u, 4003891353u, 61741949u, 780292838u, 1136081573u, 1836882786u, 528077243u, 30578492u, 465809744u, 2709331701u),
+    SC(4118645416u, 3394012023u, 348789448u, 3808052591u, 1284813572u, 265335400u, 545565522u, 929596026u, 744207086u, 3837069751u, 130735480u, 1107476780u, 910486599u, 2623115273u, 1478462314u, 2130033795u),
+    SC(1955617954u, 1897311939u, 3110934223u, 4221780767u, 1556888759u, 3849614629u, 306928433u, 3178221670u, 2099698284u, 308858727u, 2221495536u, 1221057715u, 974275765u, 2399830054u, 3285960273u, 1758193777u),
+    SC(1309372774u, 3725783295u, 3135972452u, 3122681380u, 3898315320u, 1245625291u, 3684458552u, 2498694383u, 145248803u, 3480764710u, 874108791u, 2482726617u, 434324108u, 1522025692u, 3554266182u, 2125028368u)
+},
+{
+    SC(4095464112u, 3774124339u, 1954448156u, 2941024780u, 584234335u, 483707475u, 286644251u, 3027719344u, 2257880535u, 651454587u, 3313147574u, 3910046631u, 3169039651u, 2576160449u, 696031594u, 3062648739u),
+    SC(3459141530u, 1009969738u, 35229281u, 2373814441u, 355537356u, 4228991558u, 213496956u, 1669603654u, 1552983955u, 3304370832u, 604896268u, 499179421u, 2737968344u, 807678026u, 3567168353u, 2353882345u),
+    SC(2454671851u, 2184874449u, 831795291u, 1169825676u, 1084590471u, 1942690394u, 2762211706u, 3042637679u, 2365319338u, 3552008694u, 348752618u, 993280940u, 1178602031u, 1559708076u, 3354759347u, 972286478u),
+    SC(2677560697u, 4247966509u, 151962163u, 3310844434u, 2986095882u, 3914030856u, 3436387520u, 860446559u, 4289606749u, 2343453766u, 3218454181u, 293342071u, 1238022655u, 3938175190u, 1394478132u, 4256084776u),
+    SC(3033685698u, 1795086146u, 719843849u, 255984080u, 2447365525u, 874035973u, 313642533u, 1163634918u, 2316564524u, 1195940716u, 1914843207u, 3907025376u, 23457264u, 1278433300u, 3111232984u, 668125878u),
+    SC(2135745017u, 2899432034u, 1819124473u, 2109840859u, 3124696519u, 2070710502u, 990727745u, 2752134271u, 1963223245u, 866344359u, 606159585u, 3867224292u, 3038840373u, 3295910586u, 2433460716u, 3384811471u),
+    SC(1744070416u, 383286836u, 3000319326u, 3310329765u, 4062980155u, 2749127191u, 1895582230u, 439084228u, 1884304792u, 326674045u, 377650590u, 3363592478u, 2947641322u, 1784390018u, 1332541121u, 4203919218u),
+    SC(472957101u, 1135650637u, 4212757570u, 185931877u, 2096733734u, 4238795506u, 481917546u, 1405180051u, 925427330u, 1923351053u, 2204480714u, 3944038373u, 372144582u, 3395978522u, 3795034464u, 1074487901u),
+    SC(227727393u, 2219043153u, 2909459085u, 3082645761u, 1970114976u, 3426610084u, 35253812u, 3123666967u, 4231900027u, 2888054525u, 2744804820u, 1500359618u, 191232240u, 3239664209u, 1569663960u, 1330983134u),
+    SC(996304063u, 2759713926u, 1022152104u, 4268512678u, 2870837640u, 3507597858u, 1252922637u, 3276898019u, 3824649934u, 1524401760u, 2559990337u, 1660220688u, 2350855385u, 609332995u, 2406016501u, 2406242521u),
+    SC(3333888266u, 3838886221u, 3016467419u, 3341790649u, 3667104212u, 783789160u, 1310400762u, 3633793516u, 4105695306u, 2973076533u, 455893547u, 2864660063u, 3696934279u, 2872882056u, 2264350097u, 539812697u),
+    SC(3263458726u, 2820785414u, 3760367911u, 628854049u, 1473785327u, 426717862u, 2025377226u, 3498407835u, 3577945153u, 1319190911u, 1062047947u, 3346460201u, 2590672215u, 2723591074u, 1487439866u, 4217021014u),
+    SC(2076058913u, 33130418u, 1949000294u, 3536165044u, 31327487u, 1891010986u, 2347335564u, 1669503944u, 3753248202u, 881959988u, 3846164684u, 3636142472u, 208517894u, 3407391141u, 3485893709u, 1074365179u),
+    SC(2175348532u, 3463201667u, 168136052u, 2889266255u, 4105885613u, 3068947090u, 2279310533u, 2649966235u, 828612565u, 2017635648u, 1260407590u, 1970316631u, 2447304459u, 2893112079u, 2425504835u, 1197046834u),
+    SC(2653983058u, 1419924288u, 2320709126u, 3640188854u, 2683911962u, 2643927342u, 3261193464u, 3929873787u, 2878724355u, 3436083049u, 3424148509u, 1311037973u, 3116391362u, 2037892948u, 454042580u, 970415398u),
+    SC(16199673u, 2464180001u, 89776423u, 672570852u, 2291071982u, 3899998968u, 4262439281u, 412856039u, 3677249728u, 1182323568u, 3472045521u, 3554674668u, 819725249u, 4078699211u, 2037243914u, 4166444096u)
+},
+{
+    SC(1740919499u, 3877396933u, 2326751436u, 2985697421u, 1447445291u, 2255966095u, 1611141497u, 1834170313u, 3589822942u, 2703601378u, 299681739u, 3037417379u, 4014970727u, 2126073701u, 3064037855u, 2610138122u),
+    SC(2959647136u, 3814991611u, 764778261u, 1677371416u, 497556143u, 1000564042u, 4065791500u, 1027030318u, 2636763418u, 2469599275u, 839050056u, 4115114412u, 3982189672u, 2204140838u, 1747652790u, 3786215179u),
+    SC(3812425833u, 3703652912u, 1980699604u, 1506061914u, 2330998846u, 3874717363u, 20614012u, 1484655664u, 2896690261u, 1196646483u, 159078055u, 1300317512u, 2570981831u, 1267318554u, 3037645632u, 3117135345u),
+    SC(2012483448u, 279997059u, 1908492604u, 1638405820u, 284407565u, 1607271004u, 1423855670u, 3949669604u, 1635878907u, 4045715556u, 3600475894u, 3387647818u, 3950223476u, 3109131487u, 2524676171u, 3329048150u),
+    SC(3505120665u, 1999377488u, 158974979u, 636438923u, 1767149410u, 2424026197u, 532320013u, 3350230775u, 3506414357u, 999737675u, 3415715721u, 797201045u, 3439137094u, 3636888232u, 1001867404u, 1070514934u),
+    SC(803341976u, 972240723u, 2174569332u, 4037031657u, 720363583u, 1532359940u, 222173943u, 3948724459u, 669414977u, 446802288u, 4195328223u, 2316597014u, 3039478974u, 1217500351u, 1058613984u, 3974805650u),
+    SC(2497689022u, 832535973u, 4012390289u, 3862385792u, 473134599u, 855172718u, 3160709443u, 2946049581u, 1340978834u, 1282260619u, 3672935594u, 1114896253u, 1194768191u, 2151967837u, 3557909289u, 83919397u),
+    SC(2685697085u, 4183307820u, 393931333u, 2425217781u, 2950365274u, 2300063381u, 3990090983u, 1961757942u, 3357278228u, 2993935030u, 779960569u, 3652282828u, 1743505267u, 3193034940u, 2134245237u, 4042181132u),
+    SC(2449311128u, 4037657778u, 318968012u, 1098807866u, 3241626396u, 745989749u, 4126255071u, 850508142u, 4075976689u, 357235455u, 2000916706u, 3900438139u, 2804084317u, 3036848582u, 604252796u, 2006800965u),
+    SC(101955641u, 2732365617u, 2730133770u, 3908553062u, 2872853047u, 264325893u, 2086018926u, 546076667u, 582367640u, 2242336949u, 2223649162u, 1521240572u, 178342991u, 3408523296u, 2216853754u, 1636770650u),
+    SC(1697876449u, 998213608u, 2367869150u, 3635535434u, 3029347602u, 2697162358u, 300760335u, 3790588806u, 3127970813u, 157171921u, 2766714052u, 3441353031u, 3760111386u, 1962222723u, 1338315915u, 1705537099u),
+    SC(2069540711u, 3174156395u, 3834082852u, 2243125169u, 1332693007u, 1773075089u, 820191370u, 262117783u, 184405617u, 469065021u, 1286610377u, 946922506u, 2233109630u, 2803987975u, 489850357u, 3341265389u),
+    SC(3152895344u, 3190413328u, 1371373852u, 2133030998u, 2097773989u, 3484604561u, 3233580762u, 2103971308u, 580626917u, 3723142348u, 1233964596u, 2884246809u, 1451113068u, 2274332609u, 834566918u, 4166322862u),
+    SC(474309298u, 31198476u, 474732582u, 1614612386u, 2339718649u, 702598622u, 2007092771u, 1563921691u, 3096928870u, 2036801390u, 3171632090u, 2666464957u, 2581592302u, 84487705u, 4066440296u, 250703600u),
+    SC(2850943751u, 3355276358u, 3608928556u, 645558581u, 1754003398u, 2401097307u, 4007141515u, 2306720640u, 2585847442u, 2486681168u, 916961025u, 2906286711u, 2183350629u, 3403456959u, 1234360906u, 608407455u),
+    SC(3919397u, 2910764499u, 1130649170u, 2504839137u, 475960727u, 4198145923u, 3575554927u, 727034596u, 3487299979u, 2134210036u, 1295494166u, 1094003986u, 3153584442u, 1125501956u, 1050325095u, 3018071122u)
+},
+{
+    SC(1456510740u, 215912204u, 253318863u, 2775298218u, 3073705928u, 3154352632u, 3237812190u, 434409115u, 3593346865u, 3020727994u, 1910411353u, 2325723409u, 1818165255u, 3742118891u, 4111316616u, 4010457359u),
+    SC(2413332453u, 1353953544u, 4051432026u, 303594340u, 1259813651u, 366336945u, 3380747343u, 2634392445u, 2066562619u, 120707135u, 1398541407u, 502464084u, 2984999938u, 3829298149u, 1120989122u, 3373752257u),
+    SC(1681071159u, 120984332u, 2029459879u, 1382039080u, 3634662556u, 54408822u, 48099449u, 1179080842u, 2669759950u, 3169946602u, 1520730683u, 3878549631u, 1666070500u, 1804495215u, 1101808889u, 1988315741u),
+    SC(1810699040u, 1982264875u, 1311915666u, 268159494u, 1265118580u, 1494821999u, 2740360551u, 3403457379u, 2370002476u, 3663200326u, 1969174367u, 2988878975u, 2261867571u, 1896957751u, 4228495601u, 268030737u),
+    SC(3788031612u, 1459331879u, 4195039120u, 148760443u, 2710036304u, 3803193725u, 2316636996u, 1290739855u, 2078515077u, 1158390637u, 187516666u, 1165781180u, 3871854912u, 2887741280u, 3432370474u, 3017515415u),
+    SC(2660400581u, 1115514969u, 819611304u, 2438542525u, 1149450061u, 641570348u, 4195260176u, 114239580u, 3415942550u, 2418164759u, 3596450733u, 4170880111u, 3742333800u, 707266970u, 294392938u, 1502400257u),
+    SC(4244209414u, 4144723933u, 1206802017u, 3395049043u, 1534528858u, 212213384u, 273948964u, 2465871688u, 98513287u, 526054552u, 101003852u, 2178852720u, 1739213138u, 2000068838u, 3443316390u, 2907641948u),
+    SC(4170329393u, 2397160575u, 698736458u, 1726629095u, 2059726015u, 608224441u, 940962377u, 3160021800u, 2474105021u, 1418624931u, 3220142189u, 3165061177u, 609263259u, 3526248509u, 2451110984u, 882122082u),
+    SC(1803413035u, 2626850042u, 3923382679u, 2501640460u, 887077755u, 2970691407u, 3982443858u, 546345352u, 545064661u, 1905866916u, 4137411501u, 4293519422u, 399697152u, 2101209662u, 4081268472u, 3745325674u),
+    SC(3913855272u, 3324082002u, 2401043817u, 1769760109u, 2460560183u, 875956117u, 1942607787u, 1641754800u, 1964565342u, 442388011u, 1687580604u, 293988342u, 3046598358u, 2835075967u, 920490836u, 349604594u),
+    SC(2643665013u, 1607952309u, 2279132309u, 992705865u, 1231530495u, 2682680275u, 2340070945u, 1036310446u, 2160469638u, 3849593659u, 569936175u, 133751759u, 1309000826u, 3681058360u, 1289881501u, 385711414u),
+    SC(1190130845u, 2798968177u, 277741425u, 3875973536u, 2502592372u, 251555512u, 1825737360u, 462006518u, 2334535950u, 3997809264u, 2012251623u, 3408888487u, 2549759312u, 3379458376u, 2301581275u, 4171117892u),
+    SC(1923456093u, 1653002750u, 3279649712u, 4281661052u, 1248011568u, 933375742u, 2109342469u, 751470571u, 2742486580u, 2572871261u, 3296809419u, 4075155428u, 3182626853u, 3435860599u, 3916597057u, 245531435u),
+    SC(514908612u, 2222061780u, 506774061u, 381342968u, 789366883u, 3683832850u, 9270407u, 528428861u, 590313143u, 483933274u, 1128871308u, 2791400346u, 3033966006u, 2397900561u, 174539653u, 2363998101u),
+    SC(3558289816u, 1015432688u, 3960686128u, 2087286003u, 446928557u, 4028273076u, 3055038539u, 885707705u, 942001648u, 3175434773u, 3929872598u, 2961036794u, 1122092143u, 2142675404u, 4054255588u, 1958229328u),
+    SC(2852327378u, 1383667573u, 3763466478u, 3195889922u, 2107642962u, 1739908882u, 157313327u, 492435243u, 4236498733u, 1510923342u, 3227437908u, 1896980749u, 154410481u, 2958311799u, 3270353062u, 1889012642u)
+},
+{
+    SC(822693957u, 1703644293u, 3960229340u, 2092754577u, 3495958557u, 4288710741u, 4092815138u, 1275224613u, 2592916775u, 472063207u, 2931222331u, 2597044591u, 1261640449u, 1272207288u, 2040245568u, 1417421068u),
+    SC(57865933u, 2591783175u, 1332940705u, 2361514832u, 2842982424u, 2581566511u, 1328343723u, 3898369656u, 2090549923u, 2179715082u, 2370481583u, 775215786u, 3850307123u, 2489521783u, 3999750482u, 1014134079u),
+    SC(2011629934u, 1914036612u, 3406392133u, 1425412057u, 1338374071u, 683386303u, 3190457777u, 428137206u, 1251032257u, 3672462899u, 2593185313u, 1953316437u, 2123216916u, 3258622817u, 3197533388u, 3442579011u),
+    SC(265734183u, 884987600u, 2786263189u, 3536027957u, 3885575220u, 1854265340u, 3853595664u, 1987453181u, 2744740518u, 512197390u, 114481815u, 96285071u, 3293497789u, 4015333892u, 4092376929u, 3025411574u),
+    SC(612519829u, 3198151239u, 3191059512u, 226844204u, 3503855660u, 764021515u, 3628841562u, 3951882416u, 3622158804u, 3603368155u, 2780109382u, 822859403u, 25907739u, 3882220368u, 3789068172u, 1684074913u),
+    SC(3520260226u, 1656105499u, 1676578448u, 838040958u, 3130046810u, 995588852u, 3233766730u, 2629592527u, 3096399775u, 1659682138u, 1365617549u, 2450677843u, 1725372848u, 2623357383u, 1402837393u, 1993344168u),
+    SC(2434333993u, 2901722469u, 518468307u, 3322336116u, 3303354477u, 2422295273u, 3584734361u, 1255342255u, 2224600785u, 3752112711u, 3720624102u, 3425652159u, 3563799906u, 957522630u, 501907560u, 3362627156u),
+    SC(3271809032u, 2402529419u, 3935184016u, 3639910664u, 659985988u, 2584831332u, 1091987512u, 224789177u, 2944016703u, 3591574599u, 1273021052u, 967556634u, 1019501719u, 1864898605u, 3453844870u, 4011599553u),
+    SC(1326048883u, 3477092042u, 1799777609u, 296885426u, 1109310872u, 255028335u, 163456938u, 2108662143u, 3501831646u, 225777648u, 4099069764u, 3428610561u, 4069711767u, 3876386370u, 1215899260u, 369937558u),
+    SC(3466874302u, 1921411468u, 3753149186u, 3739960133u, 1909238781u, 2219053499u, 4040572016u, 1651280893u, 754573870u, 383500798u, 2400558032u, 922698902u, 2125517085u, 2541623325u, 2827334144u, 2773618829u),
+    SC(2040368526u, 2190975469u, 1347589661u, 1684817146u, 2021572959u, 1656810013u, 330975936u, 994237514u, 2596719101u, 3800849855u, 600269956u, 1857741551u, 3033366103u, 1496147464u, 2628189942u, 4210116847u),
+    SC(3076719908u, 2490548320u, 377911263u, 2002478742u, 2549252529u, 839159951u, 230337140u, 3095221595u, 1528132928u, 2083899038u, 2503451113u, 272698731u, 2624407067u, 161482016u, 4135914440u, 2519252428u),
+    SC(2556876861u, 2107629748u, 2377697213u, 1433609947u, 3343742332u, 3505415093u, 2690575000u, 2017949066u, 4133794057u, 4184820210u, 2960078982u, 1333558937u, 3733636790u, 3960011078u, 945143131u, 3343864106u),
+    SC(1801254589u, 1449097227u, 181948563u, 1034221031u, 1779862110u, 3141289560u, 3383585093u, 2578193674u, 554670851u, 2530857925u, 4076682145u, 2827602863u, 4244507626u, 2938597885u, 3223414171u, 2204001183u),
+    SC(291814305u, 2937237569u, 1434020428u, 3585179044u, 3677832974u, 2016114805u, 3981784693u, 538800869u, 2673738915u, 999373833u, 1457987857u, 3180983013u, 501300267u, 4103517997u, 997980659u, 1113009463u),
+    SC(3993610129u, 1037741502u, 330412440u, 2749687355u, 1555232145u, 1196959672u, 530284980u, 340384986u, 2298150586u, 3185141181u, 26985524u, 2219307959u, 2447245692u, 1065988754u, 1248620406u, 2208024308u)
+},
+{
+    SC(3660855132u, 3816892380u, 3431508003u, 1440179111u, 768988979u, 3652895254u, 2084463131u, 3991218655u, 323118457u, 3675476946u, 2157306354u, 2684850253u, 1543808805u, 744627428u, 1091926767u, 3538062578u),
+    SC(2810298495u, 3411171710u, 4062828084u, 3003344135u, 3264709694u, 1048068132u, 3549102117u, 1927032841u, 3841604555u, 1360558064u, 2204714588u, 1197341693u, 3768005385u, 2899352192u, 2849083812u, 3793398404u),
+    SC(3631867959u, 3146872034u, 420513606u, 2446059169u, 2652499910u, 429155541u, 748397809u, 3543114527u, 235482177u, 894763888u, 1086818023u, 3285579564u, 1810274445u, 1142434275u, 140188668u, 4059040723u),
+    SC(2682453748u, 1595694625u, 17869409u, 4001607469u, 759206176u, 3336900820u, 3693692341u, 2473365492u, 2714988574u, 637563477u, 4105755464u, 3161387095u, 2814461644u, 4283494186u, 3858290792u, 1516784203u),
+    SC(4062605051u, 1956634460u, 3701616314u, 2342355265u, 1267526896u, 464674235u, 2247549950u, 3633206724u, 296547100u, 2905295542u, 4077085273u, 2746567644u, 1803616500u, 918536622u, 2709233803u, 2413530101u),
+    SC(1383097263u, 1316928613u, 759541292u, 3793001510u, 257497874u, 3658838865u, 3213596633u, 3650670599u, 63812226u, 1947202098u, 3651967368u, 2399936732u, 2521262969u, 322630211u, 4004516883u, 1422335688u),
+    SC(2852550033u, 3224936812u, 733055828u, 3325391168u, 1930707186u, 731324754u, 3498518219u, 4117056191u, 2179511600u, 2761523161u, 4282458808u, 3042559735u, 2438675720u, 2532100345u, 3706723018u, 4059342362u),
+    SC(2048163474u, 1848349034u, 3258863528u, 3644103333u, 1151231486u, 3308192205u, 2814277731u, 4197063636u, 3510455851u, 1315219655u, 2185965649u, 3799505477u, 4254363720u, 3128925961u, 1852465545u, 4138612075u),
+    SC(960983998u, 3301464188u, 2737893955u, 1522861436u, 4164105020u, 1184099683u, 64022400u, 2368856028u, 326418376u, 2065332946u, 2081529277u, 3466798514u, 208026276u, 417986090u, 3587033208u, 2294843214u),
+    SC(2712989146u, 349068332u, 3978782854u, 1513755929u, 4281030368u, 4041238337u, 1631550267u, 936378809u, 3831648862u, 1780262732u, 3189639539u, 328937247u, 722753719u, 3671027558u, 215485348u, 294998383u),
+    SC(170533035u, 3100330628u, 2519007245u, 2729143680u, 1780483799u, 1771308699u, 777046078u, 1252661309u, 944830935u, 3219243484u, 2959537667u, 145170296u, 892161275u, 1151850054u, 2176346749u, 598783080u),
+    SC(3596882604u, 51304713u, 1277701547u, 3288737023u, 2143659411u, 1229626338u, 2504854740u, 2518260221u, 2909459409u, 3820898741u, 1076396276u, 3330086214u, 2070741501u, 1675949151u, 4169029889u, 2072266145u),
+    SC(3395707749u, 1912264784u, 839246291u, 1812660322u, 2590197689u, 3115125394u, 280633483u, 1476186344u, 2182942190u, 4022517575u, 1314348304u, 2211853573u, 1730367526u, 3842875309u, 1411362967u, 749836026u),
+    SC(822183119u, 2084092802u, 2957672615u, 1548122281u, 2555590320u, 4127903458u, 704941703u, 3216796016u, 1310798669u, 1681974379u, 2704001393u, 836064664u, 2498528840u, 2878347924u, 3344415063u, 1714110968u),
+    SC(3763417450u, 1647484613u, 2916400914u, 1340277384u, 3671023234u, 2962715012u, 2086976330u, 2356641838u, 861453503u, 2497852292u, 3384683911u, 2044029625u, 3423593678u, 602612346u, 1947876325u, 1071593133u),
+    SC(502143537u, 3800930061u, 289630048u, 2019675509u, 690814111u, 1395759030u, 2095320716u, 1658529388u, 2140950369u, 4113871752u, 2130755443u, 1184235968u, 2624156111u, 1053548247u, 1666584094u, 3436241707u)
+},
+{
+    SC(2819478132u, 2629026829u, 2945562911u, 1854605392u, 41922071u, 2531530491u, 2316774439u, 3550381961u, 1180787169u, 3914439365u, 3786421842u, 3441223373u, 494782102u, 2858003292u, 1448968751u, 2940369046u),
+    SC(1228705098u, 2320747717u, 1742025124u, 3358828738u, 1857762103u, 2669617968u, 2684123743u, 2427291148u, 3948024171u, 3841263454u, 3817968782u, 3617000488u, 3457510946u, 3443415072u, 3976288418u, 291039859u),
+    SC(1118114309u, 1364783097u, 3986370035u, 1058514953u, 3723130907u, 2966082807u, 1592373613u, 4029958112u, 1261460522u, 159904028u, 385928252u, 2962822321u, 213058425u, 39305506u, 3400567258u, 2953928339u),
+    SC(4004285350u, 3275325131u, 2912133301u, 482119944u, 699333459u, 1353300830u, 498723416u, 2738735797u, 3773472794u, 1167510524u, 1995708610u, 1872986795u, 1771998886u, 460328822u, 2566240531u, 3665251184u),
+    SC(870908870u, 249845288u, 3674648542u, 3670939624u, 3213883826u, 2765218754u, 3292181727u, 1765634472u, 2846619223u, 156162860u, 2158300764u, 3792761756u, 4248292998u, 1588571137u, 1696144875u, 2915693433u),
+    SC(1257645965u, 743351844u, 3299328612u, 1606739395u, 2242479072u, 526126122u, 3132670209u, 2327012389u, 1257540758u, 1688790030u, 864103666u, 1782879705u, 2344074317u, 878043196u, 569218289u, 3875319913u),
+    SC(676712446u, 2310487862u, 3297058723u, 154140360u, 1534807165u, 2207878247u, 4002312458u, 1195155314u, 3973562995u, 203866583u, 1307033594u, 1808951889u, 3485439766u, 2123920858u, 3400721970u, 628518531u),
+    SC(453432196u, 3506137302u, 962794710u, 2800823697u, 944975983u, 445662356u, 620440622u, 225699982u, 1038708892u, 3484553780u, 4174808994u, 3862318255u, 1961625058u, 2183421173u, 2682639230u, 3890472885u),
+    SC(3472048934u, 1436162338u, 4281682055u, 1419885595u, 1926695253u, 861477946u, 2586543901u, 2286266784u, 2854911092u, 1779735787u, 2994125983u, 2248840912u, 677288518u, 3593153557u, 3383199489u, 2094768467u),
+    SC(971218259u, 3653638590u, 3374334294u, 479058129u, 1331477004u, 2497262229u, 892109896u, 3651901580u, 1455849852u, 2738531309u, 14202660u, 1968080740u, 1927308794u, 897128363u, 3654300057u, 1275380700u),
+    SC(684658124u, 660984744u, 2929312783u, 1473333980u, 1562502960u, 656352357u, 338449257u, 2159155320u, 2425193686u, 930413364u, 2001285554u, 307432757u, 2238003500u, 1858295105u, 481986971u, 1067622012u),
+    SC(943383548u, 127299943u, 2909652237u, 1257655712u, 4123282405u, 78394323u, 1736026340u, 2126927829u, 296638455u, 1861436609u, 641299684u, 636649068u, 3331138991u, 1014270261u, 257248847u, 1556179874u),
+    SC(2668740334u, 4261010365u, 3376970497u, 2258271000u, 3369826513u, 906131732u, 12531263u, 2501581679u, 861444520u, 2059219969u, 3536488433u, 3392343056u, 3231250347u, 3425501702u, 4204845226u, 3883035310u),
+    SC(875006280u, 3061145215u, 799684212u, 4150716124u, 1344915012u, 1442298502u, 887378800u, 2722425542u, 4141895498u, 4068116328u, 601774281u, 3538746538u, 1671758462u, 3066546971u, 1116345758u, 554718074u),
+    SC(1149406575u, 702696847u, 505403366u, 331269161u, 664926760u, 2151357672u, 2890104906u, 3156886545u, 1199701084u, 1614409973u, 4222014462u, 1336462493u, 3214687968u, 1279434993u, 2285235388u, 2975474024u),
+    SC(2419658919u, 481424988u, 2207220911u, 2736159805u, 4086711147u, 477511738u, 1428567116u, 3971000648u, 429362137u, 3495313342u, 3653961670u, 4170077754u, 2057308114u, 1445981917u, 97057494u, 3847612010u)
+},
+{
+    SC(3017729014u, 3423125690u, 1534829496u, 1346803271u, 888659105u, 1661894766u, 4165031912u, 697485157u, 3575889724u, 1795181757u, 1507549874u, 1480154979u, 3565672142u, 830054113u, 1507719534u, 3652903656u),
+    SC(4123340423u, 2168639254u, 3491407759u, 395600125u, 2056091205u, 1233197217u, 2716612715u, 3263564356u, 2257286689u, 2753339767u, 2228663460u, 3584404544u, 3972978154u, 3637886739u, 3854541466u, 1603898424u),
+    SC(641806023u, 3776877383u, 3574980110u, 2564901152u, 1378226343u, 738790225u, 4030459977u, 2255719927u, 295765315u, 60094770u, 422069111u, 439158593u, 3956842123u, 1242303994u, 150522972u, 3682386439u),
+    SC(2385589330u, 2076597417u, 605447848u, 3200763641u, 3106877254u, 3374069827u, 3828392492u, 1315607291u, 3211667999u, 305089333u, 179172787u, 3225149656u, 1080822644u, 3286534940u, 2231515542u, 2699760148u),
+    SC(3983719183u, 1208009460u, 767048521u, 326825213u, 1087716958u, 3599826498u, 3107818740u, 2785268698u, 1304576537u, 1847155836u, 3250405674u, 2694326935u, 2163030471u, 3253944705u, 1698753082u, 3845065767u),
+    SC(2823293375u, 2790862099u, 1207038844u, 3886043838u, 3567640686u, 3799791258u, 1638354726u, 1428653770u, 2075289233u, 1582582790u, 213364421u, 2858522524u, 2809903954u, 1742449197u, 324107072u, 1051562955u),
+    SC(2291926834u, 1805734123u, 3420689573u, 1003089617u, 476535216u, 1334543097u, 2045923069u, 2990972415u, 1822043289u, 2128934150u, 3541372378u, 1912558832u, 2295908612u, 1500502429u, 3539272060u, 2641558214u),
+    SC(3069594753u, 3051481608u, 2339450545u, 2054924228u, 4282917353u, 65440790u, 2134400604u, 3588265957u, 2569563771u, 741034486u, 740973978u, 93172292u, 1583303041u, 2980574219u, 2969067524u, 1088571815u),
+    SC(78721532u, 1566330912u, 1219109269u, 3229207312u, 2345730495u, 3209647323u, 2033975193u, 1009666575u, 2794060854u, 4218956981u, 3379703631u, 2400336569u, 100401885u, 3519721431u, 4007729122u, 3851183625u),
+    SC(2344993313u, 2454241381u, 3071516966u, 4207668067u, 250885582u, 1733938903u, 1658948056u, 2192440210u, 1717829063u, 849763004u, 2334162093u, 3715296533u, 1757279167u, 3270001477u, 2677428083u, 4197601814u),
+    SC(2911676146u, 4069956071u, 3299890629u, 3133371278u, 3551760603u, 558967408u, 205243474u, 237180706u, 4227661901u, 390685951u, 658498389u, 225847327u, 3028263358u, 3941067795u, 1850521034u, 1584413524u),
+    SC(304549398u, 3089811378u, 549382137u, 2353383127u, 2278640956u, 781853185u, 1734676013u, 3311472816u, 957105351u, 1291924767u, 2025324585u, 3897237789u, 80455313u, 302089802u, 3496158310u, 4000611245u),
+    SC(1221283087u, 3865703766u, 1551786763u, 3208862988u, 2964616465u, 1429406173u, 2847895093u, 3047143885u, 3187847794u, 3875229246u, 2044093786u, 2855772466u, 2252977997u, 1253496627u, 1824313803u, 3492626272u),
+    SC(1435191953u, 2954553263u, 3689501374u, 3761866706u, 3160683386u, 2172174457u, 4033800334u, 2293562561u, 500568896u, 2877151546u, 112648553u, 2760351679u, 1976713840u, 2960166087u, 1364536484u, 4127293522u),
+    SC(2942286091u, 3570696800u, 2680748212u, 879905933u, 371824626u, 2796545677u, 2544287558u, 1654320774u, 3724452395u, 1875952433u, 1755420330u, 700510406u, 2122483560u, 357724466u, 2579725929u, 4152935597u),
+    SC(732269412u, 3045632405u, 947036931u, 2403831527u, 2919479301u, 2947112020u, 1653738112u, 2316444303u, 3103978479u, 2856978461u, 308282125u, 1154683958u, 2086296447u, 1288456128u, 528614237u, 2945631134u)
+},
+{
+    SC(3751554592u, 1759634227u, 4138518211u, 3130599659u, 3881948336u, 669688286u, 3672211577u, 695226401u, 1226786139u, 1855160209u, 905875552u, 2831529665u, 1625185017u, 3130043300u, 3227522138u, 3659203373u),
+    SC(399372699u, 529779700u, 1206056828u, 1867177702u, 196488961u, 2148657353u, 2522788662u, 2308787051u, 1566407979u, 857878238u, 2852634973u, 2131204123u, 2812808340u, 3651465982u, 1947448513u, 3757182587u),
+    SC(3732610632u, 1025396308u, 60450219u, 3075208965u, 2460440177u, 301478800u, 2020185415u, 2910424285u, 1627945543u, 473410099u, 4114096970u, 2440686062u, 3031404169u, 2099206907u, 1232790956u, 2248800462u),
+    SC(2343232878u, 1198836246u, 1270188071u, 2305538045u, 1841160260u, 1049160535u, 2935147928u, 3818293360u, 2128394208u, 692132409u, 3183837651u, 981952986u, 3501941431u, 1239605342u, 1265208179u, 225920797u),
+    SC(1958540456u, 418545838u, 1645667403u, 4203505141u, 81660142u, 351421726u, 2877676470u, 871152679u, 2804776066u, 431108218u, 927442607u, 3782508732u, 318483929u, 4079394971u, 1143889788u, 4195920424u),
+    SC(2351179626u, 1598459225u, 3579449038u, 4292231882u, 2911534527u, 3174868713u, 2883217980u, 1046921244u, 3074833211u, 117299980u, 3425406982u, 2813303717u, 879305153u, 3439142119u, 1270010014u, 2633468950u),
+    SC(3394012837u, 1133386629u, 2931266329u, 2512080059u, 3268046571u, 585832644u, 1151303760u, 4164956195u, 1787214290u, 3523549326u, 4139598868u, 530139359u, 2107355242u, 1401770006u, 4264627539u, 3014221080u),
+    SC(1988836761u, 3474599222u, 2535855552u, 3118306895u, 1953046625u, 30632894u, 8987922u, 1482010220u, 1585584845u, 441041520u, 3045700482u, 362734762u, 3723600227u, 1056985402u, 2472480517u, 3558297033u),
+    SC(4137318322u, 915055827u, 1432589840u, 3550795442u, 1919127293u, 1256417138u, 946345068u, 1353195020u, 2948635882u, 3916808200u, 3223857138u, 2259986522u, 636089773u, 2116476405u, 266813303u, 3992924481u),
+    SC(1294364269u, 2282087282u, 719947200u, 1065389577u, 67185303u, 600695627u, 3423704882u, 507439949u, 1464333499u, 954935833u, 1949391476u, 2146234814u, 640934838u, 2477152026u, 3767255766u, 2397668523u),
+    SC(1825548026u, 2780595753u, 282065873u, 3347141416u, 3152283414u, 1656153711u, 1047376382u, 3616949007u, 464657631u, 3299783240u, 1162505878u, 3862534742u, 3899846651u, 3980167606u, 2513773976u, 1803555687u),
+    SC(734708953u, 181663675u, 2018505992u, 1055015000u, 2266993350u, 3679506170u, 1032089726u, 2239152753u, 3271229362u, 257492591u, 519168390u, 890304984u, 594386284u, 933877218u, 2646719799u, 439652468u),
+    SC(1253204385u, 2215899770u, 848155650u, 1305331452u, 1831981169u, 4101626048u, 253253616u, 718148001u, 3846087699u, 2362703617u, 564971301u, 878503956u, 2792594154u, 3831500219u, 630060686u, 2654848235u),
+    SC(2082956373u, 965635733u, 1172460454u, 3057130868u, 485386699u, 558270142u, 2819896785u, 247008390u, 1884023798u, 3291747866u, 1725636793u, 1552257124u, 171155452u, 894504521u, 3157754944u, 4135144713u),
+    SC(3013624247u, 3479051648u, 3976465681u, 139584997u, 690715168u, 2972053528u, 2543659091u, 81834710u, 261064551u, 1476481099u, 2550215537u, 1381589752u, 3557508349u, 3578290922u, 1272133161u, 3008228265u),
+    SC(3507369103u, 1077600519u, 1522596015u, 3088783267u, 2852999673u, 751358577u, 733140212u, 3467225217u, 100497019u, 50410977u, 68742811u, 3090618848u, 1603912616u, 2272476179u, 1767751118u, 3249696448u)
+},
+{
+    SC(2950670644u, 1870384244u, 3964091927u, 4110714448u, 298132763u, 3177974896u, 3260855649u, 1258311080u, 2976836646u, 3581267654u, 3094482836u, 80535005u, 2024129606u, 168620678u, 4254285674u, 2577025593u),
+    SC(1515179601u, 3578614970u, 3088354879u, 797813018u, 1355130048u, 1083957563u, 119796717u, 2021253602u, 1525138732u, 4127381203u, 3062851977u, 4142386071u, 1213064952u, 3609844670u, 1484215992u, 3431673114u),
+    SC(1401099367u, 3953214819u, 830584870u, 2207781603u, 918659453u, 4293181358u, 4072336467u, 4282551694u, 262435288u, 1941569548u, 147995405u, 1811389750u, 4118444114u, 1252574507u, 578798636u, 1074483177u),
+    SC(2872591360u, 1058667772u, 16799222u, 688522560u, 3475129040u, 3433794124u, 1076991040u, 1425059515u, 2939587530u, 236447274u, 3960100164u, 1298525395u, 2761371754u, 4025787449u, 2464666072u, 3981743594u),
+    SC(3976786453u, 1358319886u, 3905641993u, 1405765539u, 2585003073u, 3447572652u, 741448872u, 3444688769u, 971292808u, 1486657617u, 3079335839u, 862424956u, 248802634u, 1703726921u, 2982469234u, 2682500687u),
+    SC(4273605693u, 2467118193u, 3538801384u, 3862847335u, 1065478730u, 1602785515u, 1071410798u, 2624755760u, 2768741032u, 2700950902u, 558848464u, 3400938789u, 1410632048u, 2094050860u, 1686695852u, 2101955993u),
+    SC(4124709913u, 3191744141u, 3038636619u, 2944952304u, 2687117769u, 1502766822u, 14738299u, 223780235u, 32298390u, 1195949618u, 1154476371u, 1873391152u, 273358443u, 2362272244u, 509120994u, 606974408u),
+    SC(3937286725u, 1520668653u, 941545039u, 3056942351u, 574018151u, 2549472282u, 82289937u, 374652507u, 619831005u, 2134744303u, 1462663193u, 2963006112u, 3726585674u, 1797461239u, 1470634776u, 3441417480u),
+    SC(2845288945u, 3925574221u, 1989126288u, 3105801567u, 210047271u, 1545005898u, 2572648420u, 2278643173u, 2633053858u, 3288168184u, 3566345146u, 165026071u, 191806458u, 4116335861u, 1768316231u, 3169297484u),
+    SC(253765755u, 2509241970u, 1926513613u, 3735004917u, 4188741775u, 2806800711u, 281300019u, 3635185u, 3462483807u, 2277745510u, 1708651892u, 1413928970u, 56262931u, 531946794u, 2864634184u, 3118504241u),
+    SC(4194010611u, 4232988065u, 1802432341u, 3448133339u, 3732370320u, 253801846u, 2726367450u, 3905836819u, 1373544282u, 2066678017u, 3439519431u, 3381452691u, 2754663978u, 535580478u, 2512241599u, 2720083475u),
+    SC(3589933363u, 4047249230u, 2311777188u, 270484672u, 1108190662u, 2080251561u, 1724842405u, 4014518744u, 1593608472u, 2342434397u, 4205240553u, 2166622191u, 3528923u, 1996089122u, 4284726332u, 989608730u),
+    SC(2475269743u, 4230552139u, 3917936952u, 3098769598u, 3209444661u, 4188126675u, 3974782724u, 3639917274u, 2711234947u, 1439392508u, 1127433801u, 478802541u, 4223040451u, 2268034322u, 2452212595u, 3508939070u),
+    SC(2413851784u, 190519100u, 3576747926u, 2710481928u, 2148944938u, 3984096005u, 2427227598u, 1001464024u, 2191178977u, 1139441673u, 3841324161u, 308061908u, 3976150834u, 1467800561u, 3226772030u, 1743883019u),
+    SC(281260179u, 1415659644u, 915707047u, 1662956706u, 911938094u, 3456789397u, 2082200558u, 947098788u, 4036848108u, 2455542339u, 1466205449u, 4158358953u, 586549709u, 850657486u, 61343079u, 2292663847u),
+    SC(3487862268u, 4116082621u, 1969417576u, 1466595601u, 3136251120u, 3697533272u, 438943523u, 1041892750u, 1141661777u, 435333448u, 3031876514u, 2121342186u, 209290199u, 256519609u, 1400190683u, 4260080502u)
+},
+{
+    SC(1406628534u, 2978091511u, 343468499u, 973866526u, 757277528u, 1142388839u, 2945536141u, 3759469101u, 3001571847u, 2170606364u, 1017327004u, 3120716036u, 468321128u, 3656061918u, 2331571461u, 1930702552u),
+    SC(3117811324u, 4230396490u, 526101390u, 3589443580u, 12282838u, 3055128772u, 453582536u, 750425919u, 87216299u, 1999749165u, 2446098001u, 1907762611u, 183870981u, 3643605669u, 4232900175u, 2946539195u),
+    SC(3903405291u, 1034986659u, 2587588236u, 1880077572u, 1696686560u, 1243434386u, 3746745675u, 2212912696u, 2031851135u, 575946730u, 2663616094u, 2706019532u, 2635197066u, 1942621203u, 3760379195u, 4173271368u),
+    SC(2892050679u, 1105289247u, 1519565685u, 2426902952u, 65580444u, 3373395323u, 2112756687u, 3658806066u, 2548718870u, 3586646888u, 3350821933u, 1921239811u, 4061525916u, 3520594550u, 1872307168u, 3464547908u),
+    SC(2889143489u, 489507550u, 788811400u, 1800916293u, 3249681744u, 1400920516u, 3917828215u, 1093821500u, 1905385813u, 2931012984u, 1800788801u, 1697549042u, 3133274419u, 3606456099u, 2156683634u, 3205410986u),
+    SC(2814687995u, 4053305746u, 484530004u, 410862009u, 246830045u, 3164065541u, 3723774424u, 3388961612u, 3438413619u, 3662326637u, 2178649434u, 3555798301u, 164350275u, 2341607004u, 3896269562u, 1591806179u),
+    SC(3226183767u, 3881369008u, 700458770u, 376569395u, 2607908019u, 1353553198u, 2636334721u, 1140283021u, 2632309194u, 1710844790u, 3031461719u, 4081969123u, 3326745889u, 4034909949u, 3950856167u, 3153389256u),
+    SC(2184243175u, 2166726232u, 3921103433u, 872887260u, 623636347u, 95935618u, 2766774027u, 697875047u, 164043041u, 993154257u, 4114304816u, 3500729957u, 409872172u, 3504722710u, 2806324915u, 717798207u),
+    SC(1913401183u, 1684394893u, 957780895u, 2366199383u, 3846687839u, 2225031745u, 50628017u, 764720583u, 2251658783u, 1601491318u, 3836612294u, 3836982164u, 1834686310u, 4239983357u, 2677791106u, 718595268u),
+    SC(641418698u, 3008658673u, 1590313857u, 1025261614u, 1545641278u, 883067087u, 405447843u, 251932751u, 890679795u, 1380695500u, 4259157180u, 4219905082u, 665298826u, 4240175069u, 1720908833u, 2268480568u),
+    SC(1323007329u, 2757671761u, 531677728u, 1863777888u, 1512057206u, 2416428007u, 297355401u, 2843988168u, 3028483811u, 4269951770u, 844221740u, 1060678479u, 2913804270u, 3550002834u, 1490208797u, 2041637686u),
+    SC(4098631786u, 3088674341u, 2277647863u, 546429701u, 239595915u, 96051385u, 2043858235u, 356783975u, 3081379864u, 1495630942u, 1713035648u, 2797737429u, 4252005067u, 1174473008u, 182861961u, 1284115192u),
+    SC(1497340893u, 2990980382u, 435071738u, 25048206u, 1369038540u, 2388914024u, 3985375113u, 3187649864u, 1375850783u, 2762762203u, 3714513839u, 1546363407u, 2343675571u, 416152492u, 1797618344u, 3540898582u),
+    SC(2184924310u, 2347360549u, 640504537u, 1253044800u, 1440674061u, 1666425671u, 3827600864u, 2022304946u, 2918906490u, 263308814u, 3892002350u, 1942380643u, 1520343008u, 1245225248u, 3081248535u, 2098883649u),
+    SC(2377054091u, 3295547231u, 2240796492u, 1757295037u, 62158041u, 1809272299u, 4005194159u, 1592984938u, 366675588u, 3144502911u, 2973082795u, 4105706826u, 2851896979u, 3262002710u, 3082369242u, 634669574u),
+    SC(729159370u, 3948971047u, 1511320403u, 3061460707u, 3090283349u, 1868816562u, 3759558902u, 3868199437u, 2438888892u, 1660478281u, 2415784493u, 3546303863u, 3144683831u, 3066258755u, 2228021651u, 3294706852u)
+}
+};
+#undef SC
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.ml b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.ml
new file mode 100644
index 000000000..b21422eb2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.ml
@@ -0,0 +1,458 @@
+module Context = struct
+  type t
+
+  external create : int -> t = "caml_secp256k1_context_create"
+  external clone : t -> t = "caml_secp256k1_context_clone"
+  external randomize : t -> Bigstring.t -> bool = "caml_secp256k1_context_randomize" [@@noalloc]
+
+  let create ?(sign=true) ?(verify=true) () =
+    let flags = 1 lor
+                (if sign then 0x100 else 0) lor
+                (if verify then 0x200 else 0) in
+    create flags
+
+  let randomize ctx buf =
+    if Bigstring.length buf < 32 then
+      invalid_arg "Context.randomize: input must be at least 32 bytes long" ;
+    randomize ctx buf
+end
+
+module Key = struct
+  type secret
+  type public
+  type _ t =
+    | Sk : Bigstring.t -> secret t
+    | Pk : Bigstring.t -> public t
+
+  let buffer : type a. a t -> Bigstring.t = function
+    | Sk sk -> sk
+    | Pk pk -> pk
+
+  let secret_bytes = 32
+  let public_bytes = 64
+  let compressed_pk_bytes = 33
+  let uncompressed_pk_bytes = 65
+
+  let bytes : type a. a t -> int = function
+    | Sk _ -> secret_bytes
+    | Pk _ -> public_bytes
+
+  let serialized_bytes :
+    type a. ?compressed:bool -> a t -> int =
+    fun ?(compressed=true) -> function
+      | Sk _ -> secret_bytes
+      | Pk _ -> if compressed then public_bytes + 1 else secret_bytes + 1
+
+  let equal : type a. a t -> a t -> bool = fun a b ->
+    match a, b with
+    | Sk a, Sk b -> Bigstring.equal a b
+    | Pk a, Pk b -> Bigstring.equal a b
+
+  let copy : type a. a t -> a t = function
+    | Sk sk -> Sk (Bigstring.copy sk)
+    | Pk pk -> Pk (Bigstring.copy pk)
+
+  external sk_negate_inplace : Context.t -> Bigstring.t -> unit =
+    "caml_secp256k1_ec_privkey_negate" [@@noalloc]
+  external sk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_privkey_tweak_add" [@@noalloc]
+  external sk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_privkey_tweak_mul" [@@noalloc]
+  external pk_negate_inplace : Context.t -> Bigstring.t -> unit =
+    "caml_secp256k1_ec_pubkey_negate" [@@noalloc]
+  external pk_add_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_pubkey_tweak_add" [@@noalloc]
+  external pk_mul_tweak_inplace : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_pubkey_tweak_mul" [@@noalloc]
+  external pk_combine : Context.t -> Bigstring.t -> Bigstring.t list -> bool =
+    "caml_secp256k1_ec_pubkey_combine" [@@noalloc]
+
+  let negate_inplace :
+    type a. Context.t -> a t -> unit = fun ctx -> function
+    | Sk k -> sk_negate_inplace ctx k
+    | Pk k -> pk_negate_inplace ctx k
+
+  let negate ctx k =
+    let k' = copy k in
+    negate_inplace ctx k' ;
+    k'
+
+  let op_tweak :
+    type a. string -> (Context.t -> Bigstring.t -> Bigstring.t -> bool) ->
+    Context.t -> a t -> Bigstring.t -> Bigstring.t =
+    fun name f ctx k buf ->
+      let buflen = Bigstring.length buf in
+      if buflen < 32 then
+        invalid_arg (Printf.sprintf "Key.%s: " name) ;
+      let k' = buffer (copy k) in
+      if not (f ctx k' buf) then
+        failwith (Printf.sprintf "Key.%s: operation failed" name) ;
+      k'
+
+  let add_tweak :
+    type a. Context.t -> a t -> Bigstring.t -> a t =
+    fun ctx k buf ->
+      match k with
+      | Sk _ -> Sk (op_tweak "add_tweak" sk_add_tweak_inplace ctx k buf)
+      | Pk _ -> Pk (op_tweak "add_tweak" pk_add_tweak_inplace ctx k buf)
+
+  let mul_tweak :
+    type a. Context.t -> a t -> Bigstring.t -> a t =
+    fun ctx k buf ->
+      match k with
+      | Sk _ -> Sk (op_tweak "mul_tweak" sk_mul_tweak_inplace ctx k buf)
+      | Pk _ -> Pk (op_tweak "mul_tweak" pk_mul_tweak_inplace ctx k buf)
+
+  external pk_parse : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_pubkey_parse" [@@noalloc]
+  external pk_serialize : Context.t -> Bigstring.t -> Bigstring.t -> int =
+    "caml_secp256k1_ec_pubkey_serialize" [@@noalloc]
+  external pk_create : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_pubkey_create" [@@noalloc]
+
+  let neuterize :
+    type a. Context.t -> a t -> public t option = fun ctx -> function
+    | Pk pk -> Some (Pk pk)
+    | Sk sk ->
+        let pk = Bigstring.create public_bytes in
+        if pk_create ctx pk sk then Some (Pk pk) else None
+
+  let neuterize_exn ctx k =
+    match neuterize ctx k with
+    | None -> invalid_arg "Key.neuterize_exn: invalid secret key"
+    | Some pk -> pk
+
+  let list_map_filter_opt ~f l =
+    ListLabels.fold_left ~init:[] ~f:begin fun a e ->
+      match f e with
+      | None -> a
+      | Some r -> r :: a
+    end l
+
+  let combine ctx pks =
+    let nb_pks = List.length pks in
+    if nb_pks = 0 || nb_pks > 1024 then None
+    else
+      let pk = Bigstring.create public_bytes in
+      let pks = list_map_filter_opt ~f:begin fun k ->
+          match neuterize ctx k with
+          | None -> None
+          | Some (Pk k) -> Some k
+        end pks in
+      if pk_combine ctx pk pks then Some (Pk pk)
+      else None
+
+  let combine_exn ctx pks =
+    match combine ctx pks with
+    | None -> invalid_arg "Key.combine_exn: sum of pks is invalid"
+    | Some pk -> pk
+
+  external verify_sk : Context.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ec_seckey_verify" [@@noalloc]
+
+  let read_sk_exn ctx buf =
+    let buflen = Bigstring.length buf in
+    if buflen < secret_bytes then
+      invalid_arg (Printf.sprintf "Key.read_sk: invalid buffer size %d" buflen) ;
+    match verify_sk ctx buf with
+    | true -> Sk Bigstring.(copy (sub buf 0 secret_bytes))
+    | false -> invalid_arg "Key.read_sk: secret key is invalid"
+
+  let read_sk ctx buf =
+    try Ok (read_sk_exn ctx buf) with
+    | Invalid_argument msg -> Error msg
+
+  let read_pk_exn ctx buf =
+    let buflen = Bigstring.length buf in
+    if buflen < compressed_pk_bytes then
+      invalid_arg (Printf.sprintf "Key.read_pk: invalid buffer size %d" buflen) ;
+    let outbuf = Bigstring.create public_bytes in
+    if pk_parse ctx outbuf buf then
+      Pk outbuf
+    else
+      invalid_arg "Key.read_pk_exn: public key is invalid"
+
+  let read_pk ctx buf =
+    try Ok (read_pk_exn ctx buf) with
+    | Invalid_argument msg -> Error msg
+
+  let write :
+    type a. ?compress:bool -> Context.t -> ?pos:int -> Bigstring.t -> a t -> int =
+    fun ?(compress=true) ctx ?(pos=0) buf -> function
+      | Sk sk ->
+          let buflen = Bigstring.length buf in
+          if pos < 0 || pos > buflen - secret_bytes then
+            invalid_arg "Key.write (secret): pos < 0 or pos + 32 > buflen" ;
+          Bigstring.blit sk 0 buf pos secret_bytes ;
+          secret_bytes
+      | Pk pk ->
+          let buflen = Bigstring.length buf in
+          if pos < 0
+          || (compress && pos > buflen - compressed_pk_bytes)
+          || (not compress && pos > buflen - uncompressed_pk_bytes) then
+            invalid_arg (Printf.sprintf "Key.write (public): pos=%d, buflen=%d" pos buflen) ;
+          let len = if compress then 33 else 65 in
+          let buf = Bigstring.sub buf pos len in
+          pk_serialize ctx buf pk
+
+  let to_bytes :
+    type a. ?compress:bool -> Context.t -> a t -> Bigstring.t =
+    fun ?(compress=true) ctx -> function
+      | Sk _ as sk ->
+          let buf = Bigstring.create secret_bytes in
+          let _ = write ~compress ctx buf sk in
+          buf
+      | Pk _ as pk ->
+          let buf =
+            Bigstring.create (1 + (if compress then secret_bytes else public_bytes)) in
+          let _ = write ~compress ctx buf pk in
+          buf
+end
+
+module Sign = struct
+  type plain
+  type recoverable
+  type _ t =
+    | P : Bigstring.t -> plain t
+    | R : Bigstring.t -> recoverable t
+
+  let buffer : type a. a t -> Bigstring.t = function
+    | P plain -> plain
+    | R recoverable -> recoverable
+
+  let plain_bytes = 64
+  let recoverable_bytes = 65
+  let msg_bytes = 32
+
+  let equal : type a. a t -> a t -> bool = fun a b ->
+    match a, b with
+    | P a, P b -> Bigstring.equal a b
+    | R a, R b -> Bigstring.equal a b
+
+  external parse_compact : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_signature_parse_compact" [@@noalloc]
+  external parse_der : Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_signature_parse_der" [@@noalloc]
+  external serialize_compact : Context.t -> Bigstring.t -> Bigstring.t -> unit =
+    "caml_secp256k1_ecdsa_signature_serialize_compact" [@@noalloc]
+  external serialize_der : Context.t -> Bigstring.t -> Bigstring.t -> int =
+    "caml_secp256k1_ecdsa_signature_serialize_der" [@@noalloc]
+  external parse_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int -> bool =
+    "caml_secp256k1_ecdsa_recoverable_signature_parse_compact" [@@noalloc]
+  external serialize_recoverable : Context.t -> Bigstring.t -> Bigstring.t -> int =
+    "caml_secp256k1_ecdsa_recoverable_signature_serialize_compact" [@@noalloc]
+
+  let read_exn ctx buf =
+    let buflen = Bigstring.length buf in
+    if buflen < plain_bytes then
+      invalid_arg (Printf.sprintf "Sign.read: invalid buffer size %d" buflen) ;
+    let signature = Bigstring.create plain_bytes in
+    if parse_compact ctx signature buf then
+      P signature
+    else
+      invalid_arg "Sign.read: signature could not be parsed"
+
+  let read ctx buf =
+    try Ok (read_exn ctx buf) with
+      Invalid_argument msg -> Error msg
+
+  let read_der_exn ctx buf =
+    let signature = Bigstring.create plain_bytes in
+    if parse_der ctx signature buf then
+      P signature
+    else
+      invalid_arg "Sign.read_der: signature could not be parsed"
+
+  let read_der ctx buf =
+    try Ok (read_der_exn ctx buf) with
+      Invalid_argument msg -> Error msg
+
+  let read_recoverable_exn ctx buf =
+    let buflen = Bigstring.length buf in
+    if buflen < recoverable_bytes then
+      invalid_arg (Printf.sprintf "Sign.read_recoverable: invalid buffer size %d" buflen) ;
+    let signature = Bigstring.create recoverable_bytes in
+    let recid = int_of_char (Bigstring.get buf 64) in
+    if parse_recoverable ctx signature buf recid then
+      R signature
+    else
+      invalid_arg "Sign.read_recoverable: signature could not be parsed"
+
+  let read_recoverable ctx buf =
+    try Ok (read_recoverable_exn ctx buf) with
+    | Invalid_argument msg -> Error msg
+
+  let write_exn :
+    type a. ?der:bool -> Context.t -> Bigstring.t -> a t -> int =
+    fun ?(der=false) ctx buf -> function
+      | P signature ->
+          let buflen = Bigstring.length buf in
+          if not der then begin
+            if buflen < plain_bytes then
+              invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
+            serialize_compact ctx buf signature ;
+            plain_bytes
+          end
+          else begin
+            match serialize_der ctx buf signature with
+            | 0 -> invalid_arg "Sign.write_exn: buffer too small to \
+                                contain a DER signature"
+            | len -> len
+          end
+      | R signature ->
+          let buflen = Bigstring.length buf in
+          if buflen < recoverable_bytes then
+            invalid_arg (Printf.sprintf "Sign.write: buffer length too small (%d)" buflen) ;
+          let recid = serialize_recoverable ctx buf signature in
+          Bigstring.set buf 64 (char_of_int recid) ;
+          recoverable_bytes
+
+  let write ?der ctx buf signature =
+    try Ok (write_exn ?der ctx buf signature) with
+      Invalid_argument msg -> Error msg
+
+  let to_bytes :
+    type a. ?der:bool -> Context.t -> a t -> Bigstring.t =
+    fun ?(der=false) ctx -> function
+      | P _ as signature ->
+          if der then begin
+            let buf = Bigstring.create 72 in
+            let nb_written = write_exn ~der ctx buf signature in
+            Bigstring.sub buf 0 nb_written
+          end
+          else
+            let buf = Bigstring.create plain_bytes in
+            let _nb_written = write_exn ~der ctx buf signature in
+            buf
+      | R _ as signature ->
+          let buf = Bigstring.create recoverable_bytes in
+          let _nb_written = write_exn ctx buf signature in
+          buf
+
+  external normalize :
+    Context.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_signature_normalize" [@@noalloc]
+
+  let normalize ctx (P signature) =
+    let normalized_sig = Bigstring.create plain_bytes in
+    if normalize ctx normalized_sig signature then
+      Some (P normalized_sig) else None
+
+  (* [sign ctx signature msg sk] *)
+  external sign :
+    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_sign" [@@noalloc]
+
+  (* [verify ctx pk msg signature] *)
+  external verify :
+    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_verify" [@@noalloc]
+
+  let check_msglen msg =
+    let msglen = Bigstring.length msg in
+    if msglen < msg_bytes
+    then invalid_arg
+        (Printf.sprintf "message is too small (%d < %d)" msglen msg_bytes)
+
+  let sign_exn ctx buf ~sk ~msg =
+    check_msglen msg ;
+    let buflen = Bigstring.length buf in
+    if buflen < plain_bytes then
+      invalid_arg (Printf.sprintf "Sign.write_sign: buffer length too \
+                                   small (%d)" buflen) ;
+    match sign ctx buf (Key.buffer sk) msg with
+    | true -> ()
+    | false -> invalid_arg "Sign.write_sign: the nonce generation \
+                            function failed, or the private key was \
+                            invalid"
+
+  let write_sign_exn ctx buf ~sk ~msg =
+    let signature = Bigstring.create plain_bytes in
+    sign_exn ctx signature ~sk ~msg ;
+    write_exn ctx buf (P signature)
+
+  let write_sign ctx buf ~sk ~msg =
+    try Ok (write_sign_exn ctx ~sk ~msg buf)
+    with Invalid_argument msg -> Error msg
+
+  let sign_exn ctx ~sk msg =
+    let signature = Bigstring.create plain_bytes in
+    sign_exn ctx signature ~sk ~msg ;
+    P signature
+
+  let sign ctx ~sk msg =
+    try Ok (sign_exn ctx ~sk msg)
+    with Invalid_argument msg -> Error msg
+
+  external sign_recoverable :
+    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_sign_recoverable" [@@noalloc]
+
+  let write_sign_recoverable_exn ctx ~sk ~msg buf =
+    check_msglen msg ;
+    let buflen = Bigstring.length buf in
+    if buflen < recoverable_bytes then
+      invalid_arg (Printf.sprintf "Sign.write_sign_recoverable: buffer \
+                                   length too small (%d)" buflen) ;
+    if sign_recoverable ctx buf (Key.buffer sk) msg then
+      recoverable_bytes
+    else invalid_arg "Sign.write_sign_recoverable_exn: the nonce \
+                      generation function failed, or the private key \
+                      was invalid"
+
+  let write_sign_recoverable ctx ~sk ~msg buf =
+    try Ok (write_sign_recoverable_exn ctx ~sk ~msg buf)
+    with Invalid_argument msg -> Error msg
+
+  let sign_recoverable ctx ~sk msg =
+    let signature = Bigstring.create recoverable_bytes in
+    match write_sign_recoverable ctx ~sk ~msg signature with
+    | Error error -> Error error
+    | Ok _nb_written -> Ok (R signature)
+
+  let sign_recoverable_exn ctx ~sk msg =
+    match sign_recoverable ctx ~sk msg with
+    | Error msg -> invalid_arg msg
+    | Ok signature -> signature
+
+  external to_plain : Context.t -> Bigstring.t -> Bigstring.t -> unit =
+    "caml_secp256k1_ecdsa_recoverable_signature_convert" [@@noalloc]
+
+  let to_plain : type a. Context.t -> a t -> plain t = fun ctx -> function
+    | P _ as signature -> signature
+    | R recoverable ->
+        let plain = Bigstring.create plain_bytes in
+        to_plain ctx plain recoverable ;
+        P plain
+
+  let verify_plain_exn ctx ~pk msg signature =
+    check_msglen msg ;
+    let siglen = Bigstring.length signature in
+    if siglen < plain_bytes then
+      invalid_arg (Printf.sprintf "verify: signature too short (%d < %d)"
+                     siglen plain_bytes) ;
+    verify ctx (Key.buffer pk) msg signature
+
+  let verify_exn ctx ~pk ~msg ~signature =
+    let P signature = to_plain ctx signature in
+    verify_plain_exn ctx ~pk msg signature
+
+  let verify ctx ~pk ~msg ~signature =
+    try Ok (verify_exn ctx ~pk ~msg ~signature) with
+    | Invalid_argument msg -> Error msg
+
+  external recover :
+    Context.t -> Bigstring.t -> Bigstring.t -> Bigstring.t -> bool =
+    "caml_secp256k1_ecdsa_recover" [@@noalloc]
+
+  let recover_exn ctx ~signature:(R signature) msg =
+    check_msglen msg ;
+    let pk = Bigstring.create Key.public_bytes in
+    if recover ctx pk signature msg then Key.Pk pk
+    else
+      invalid_arg "Sign.recover: pk could not be recovered"
+
+  let recover ctx ~signature msg =
+    try Ok (recover_exn ctx ~signature msg) with
+      Invalid_argument msg -> Error msg
+end
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.mli b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.mli
new file mode 100644
index 000000000..41ba1eafc
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/external.mli
@@ -0,0 +1,206 @@
+module Context : sig
+  type t
+  (** Opaque data structure that holds context information
+      (precomputed tables etc.).
+
+      Do not create a new context object for each operation, as
+      construction is far slower than all other API calls (~100 times
+      slower than an ECDSA verification).
+
+      A constructed context can safely be used from multiple threads
+      simultaneously, but API call that take a non-const pointer to a
+      context need exclusive access to it. In particular this is the
+      case for secp256k1_context_destroy and
+      secp256k1_context_randomize.
+
+      Regarding randomization, either do it once at creation time (in
+      which case you do not need any locking for the other calls), or
+      use a read-write lock. *)
+
+  val create : ?sign:bool -> ?verify:bool -> unit -> t
+  (** [create ?sign ?bool ()] is a freshly allocated [t]. *)
+
+  val clone : t -> t
+  (** [clone t] is a copy of [t]. *)
+
+  val randomize : t -> Bigstring.t -> bool
+  (** While secp256k1 code is written to be constant-time no matter
+      what secret values are, it's possible that a future compiler may
+      output code which isn't, and also that the CPU may not emit the
+      same radio frequencies or draw the same amount power for all
+      values.
+
+      This function provides a seed which is combined into the
+      blinding value: that blinding value is added before each
+      multiplication (and removed afterwards) so that it does not
+      affect function results, but shields against attacks which rely
+      on any input-dependent behaviour.
+
+      You should call this after secp256k1_context_create or
+      secp256k1_context_clone, and may call this repeatedly
+      afterwards. *)
+
+end
+
+module Key : sig
+  type secret
+  type public
+  type _ t
+
+  val buffer : _ t -> Bigstring.t
+  (** [buffer k] is the underlying buffer of [k]. DO NOT MODIFY. *)
+
+  val secret_bytes : int
+  (** Length of a secret key in memory: 32 bytes *)
+
+  val public_bytes : int
+  (** Length of a public key in memory: 64 bytes *)
+
+  val compressed_pk_bytes : int
+  (** Length of the compressed serialization of a public key: 33 bytes *)
+
+  val uncompressed_pk_bytes : int
+  (** Length of the uncompressed serialization of a public key: 65 bytes *)
+
+  val bytes : _ t -> int
+  (** [bytes k] is the length of [k] in memory (the length of the
+      underlying [Bigstring.t]). *)
+
+  val serialized_bytes : ?compressed:bool -> _ t -> int
+  (** [serialized_bytes ?compressed k] is the length of the
+      serialization (compressed) of [k].*)
+
+  val equal : 'a t -> 'a t -> bool
+  val copy : 'a t -> 'a t
+
+  (** {2 Aritmetic operations } *)
+
+  val negate : Context.t -> 'a t -> 'a t
+  val add_tweak : Context.t -> 'a t -> Bigstring.t -> 'a t
+  val mul_tweak : Context.t -> 'a t -> Bigstring.t -> 'a t
+  val neuterize : Context.t -> _ t -> public t option
+  val neuterize_exn : Context.t -> _ t -> public t
+  val combine : Context.t -> _ t list -> public t option
+  val combine_exn : Context.t -> _ t list -> public t
+
+  (** {2 Input/Output} *)
+
+  val read_sk : Context.t -> Bigstring.t -> (secret t, string) result
+  val read_sk_exn : Context.t -> Bigstring.t -> secret t
+  val read_pk : Context.t -> Bigstring.t -> (public t, string) result
+  val read_pk_exn : Context.t -> Bigstring.t -> public t
+  val write : ?compress:bool -> Context.t -> ?pos:int -> Bigstring.t -> _ t -> int
+  val to_bytes : ?compress:bool -> Context.t -> _ t -> Bigstring.t
+end
+
+module Sign : sig
+
+  (** {2 Signature} *)
+
+  type plain
+  type recoverable
+  type _ t
+
+  val buffer : _ t -> Bigstring.t
+  (** [buffer signature] is the underlying buffer of [signature]. DO
+      NOT MODIFY. *)
+
+  val plain_bytes : int
+  (** 64 bytes *)
+
+  val recoverable_bytes : int
+  (** 65 bytes *)
+
+  val msg_bytes : int
+  (** 32 bytes *)
+
+  val equal : 'a t -> 'a t -> bool
+  val to_plain : Context.t -> _ t -> plain t
+
+  (** {3 Input/Output} *)
+
+  val read : Context.t -> Bigstring.t -> (plain t, string) result
+  val read_exn : Context.t -> Bigstring.t -> plain t
+  val read_der : Context.t -> Bigstring.t -> (plain t, string) result
+  val read_der_exn : Context.t -> Bigstring.t -> plain t
+
+  val read_recoverable :
+    Context.t -> Bigstring.t -> (recoverable t, string) result
+  (** [read_recoverable_exn ctx buf] reads a recoverable signature in
+      [buf] if everything goes well or return an error otherwise. *)
+
+  val read_recoverable_exn : Context.t -> Bigstring.t -> recoverable t
+  (** [read_recoverable_exn ctx buf] reads a recoverable signature in
+      [buf].
+
+      @raises [Invalid_argument] if [buf] is less than 65 bytes long
+      or [buf] does not contain a valid recoverable signature. *)
+
+  val write_exn : ?der:bool -> Context.t -> Bigstring.t -> _ t -> int
+
+  val write : ?der:bool -> Context.t -> Bigstring.t -> _ t -> (int, string) result
+
+  val to_bytes : ?der:bool -> Context.t -> _ t -> Bigstring.t
+  (** [to_bytes ?der ctx signature] writes the serialization of
+      [signature] in a freshly allocated [Bigstring.t], which is then
+      returned. *)
+
+  (** {3 Sign} *)
+
+  val normalize :
+    Context.t -> plain t -> plain t option
+  (** [normalize ctx sig] is the normalized lower-S form of [Some
+      normalized_sig] if [sig] was not already in this form, or [None]
+      otherwise. *)
+
+  (** {4 Creation} *)
+
+  val sign : Context.t -> sk:Key.secret Key.t -> Bigstring.t -> (plain
+                                                                   t, string) result
+
+  val sign_exn : Context.t -> sk:Key.secret Key.t -> Bigstring.t ->
+    plain t
+
+  val sign_recoverable : Context.t -> sk:Key.secret Key.t ->
+    Bigstring.t -> (recoverable t, string) result
+
+  val sign_recoverable_exn : Context.t -> sk:Key.secret Key.t ->
+    Bigstring.t -> recoverable t
+
+  (** {4 Direct write} *)
+
+  val write_sign : Context.t -> Bigstring.t -> sk:Key.secret Key.t ->
+    msg:Bigstring.t -> (int, string) result (** [write_sign ctx buf ~sk
+                                                ~msg] writes signs [msg] with [sk] and writes the signature to
+                                                [buf] at [?pos]. It returns the number of bytes written (64) on
+                                                success, or ar error message otherwise. *)
+
+  val write_sign_exn : Context.t -> Bigstring.t -> sk:Key.secret Key.t
+    -> msg:Bigstring.t -> int (** [write_sign_exn ctx buf ~sk ~msg]
+                                  writes signs [msg] with [sk] and writes the signature to [buf] at
+                                  [?pos]. It returns the number of bytes written (64).
+
+                                  @raise Invalid_argument if [buf] is not long enough to contain
+                                  a signature or signing has failed. *)
+
+  val write_sign_recoverable : Context.t -> sk:Key.secret Key.t ->
+    msg:Bigstring.t -> Bigstring.t -> (int, string) result
+
+  val write_sign_recoverable_exn : Context.t -> sk:Key.secret Key.t ->
+    msg:Bigstring.t -> Bigstring.t -> int
+
+  (** {4 Verification} *)
+
+  val verify_exn : Context.t -> pk:Key.public Key.t -> msg:Bigstring.t
+    -> signature:_ t -> bool
+
+  val verify : Context.t -> pk:Key.public Key.t -> msg:Bigstring.t ->
+    signature:_ t -> (bool, string) result
+
+  (** {4 Recovery} *)
+
+  val recover_exn : Context.t -> signature:recoverable t ->
+    Bigstring.t -> Key.public Key.t
+
+  val recover : Context.t -> signature:recoverable t -> Bigstring.t ->
+    (Key.public Key.t, string) result end
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field.h
new file mode 100644
index 000000000..bb6692ad5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field.h
@@ -0,0 +1,132 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_H
+#define SECP256K1_FIELD_H
+
+/** Field element module.
+ *
+ *  Field elements can be represented in several ways, but code accessing
+ *  it (and implementations) need to take certain properties into account:
+ *  - Each field element can be normalized or not.
+ *  - Each field element has a magnitude, which represents how far away
+ *    its representation is away from normalization. Normalized elements
+ *    always have a magnitude of 1, but a magnitude of 1 doesn't imply
+ *    normality.
+ */
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#if defined(USE_FIELD_10X26)
+#include "field_10x26.h"
+#elif defined(USE_FIELD_5X52)
+#include "field_5x52.h"
+#else
+#error "Please select field implementation"
+#endif
+
+#include "util.h"
+
+/** Normalize a field element. */
+static void secp256k1_fe_normalize(secp256k1_fe *r);
+
+/** Weakly normalize a field element: reduce it magnitude to 1, but don't fully normalize. */
+static void secp256k1_fe_normalize_weak(secp256k1_fe *r);
+
+/** Normalize a field element, without constant-time guarantee. */
+static void secp256k1_fe_normalize_var(secp256k1_fe *r);
+
+/** Verify whether a field element represents zero i.e. would normalize to a zero value. The field
+ *  implementation may optionally normalize the input, but this should not be relied upon. */
+static int secp256k1_fe_normalizes_to_zero(secp256k1_fe *r);
+
+/** Verify whether a field element represents zero i.e. would normalize to a zero value. The field
+ *  implementation may optionally normalize the input, but this should not be relied upon. */
+static int secp256k1_fe_normalizes_to_zero_var(secp256k1_fe *r);
+
+/** Set a field element equal to a small integer. Resulting field element is normalized. */
+static void secp256k1_fe_set_int(secp256k1_fe *r, int a);
+
+/** Sets a field element equal to zero, initializing all fields. */
+static void secp256k1_fe_clear(secp256k1_fe *a);
+
+/** Verify whether a field element is zero. Requires the input to be normalized. */
+static int secp256k1_fe_is_zero(const secp256k1_fe *a);
+
+/** Check the "oddness" of a field element. Requires the input to be normalized. */
+static int secp256k1_fe_is_odd(const secp256k1_fe *a);
+
+/** Compare two field elements. Requires magnitude-1 inputs. */
+static int secp256k1_fe_equal(const secp256k1_fe *a, const secp256k1_fe *b);
+
+/** Same as secp256k1_fe_equal, but may be variable time. */
+static int secp256k1_fe_equal_var(const secp256k1_fe *a, const secp256k1_fe *b);
+
+/** Compare two field elements. Requires both inputs to be normalized */
+static int secp256k1_fe_cmp_var(const secp256k1_fe *a, const secp256k1_fe *b);
+
+/** Set a field element equal to 32-byte big endian value. If successful, the resulting field element is normalized. */
+static int secp256k1_fe_set_b32(secp256k1_fe *r, const unsigned char *a);
+
+/** Convert a field element to a 32-byte big endian value. Requires the input to be normalized */
+static void secp256k1_fe_get_b32(unsigned char *r, const secp256k1_fe *a);
+
+/** Set a field element equal to the additive inverse of another. Takes a maximum magnitude of the input
+ *  as an argument. The magnitude of the output is one higher. */
+static void secp256k1_fe_negate(secp256k1_fe *r, const secp256k1_fe *a, int m);
+
+/** Multiplies the passed field element with a small integer constant. Multiplies the magnitude by that
+ *  small integer. */
+static void secp256k1_fe_mul_int(secp256k1_fe *r, int a);
+
+/** Adds a field element to another. The result has the sum of the inputs' magnitudes as magnitude. */
+static void secp256k1_fe_add(secp256k1_fe *r, const secp256k1_fe *a);
+
+/** Sets a field element to be the product of two others. Requires the inputs' magnitudes to be at most 8.
+ *  The output magnitude is 1 (but not guaranteed to be normalized). */
+static void secp256k1_fe_mul(secp256k1_fe *r, const secp256k1_fe *a, const secp256k1_fe * SECP256K1_RESTRICT b);
+
+/** Sets a field element to be the square of another. Requires the input's magnitude to be at most 8.
+ *  The output magnitude is 1 (but not guaranteed to be normalized). */
+static void secp256k1_fe_sqr(secp256k1_fe *r, const secp256k1_fe *a);
+
+/** If a has a square root, it is computed in r and 1 is returned. If a does not
+ *  have a square root, the root of its negation is computed and 0 is returned.
+ *  The input's magnitude can be at most 8. The output magnitude is 1 (but not
+ *  guaranteed to be normalized). The result in r will always be a square
+ *  itself. */
+static int secp256k1_fe_sqrt(secp256k1_fe *r, const secp256k1_fe *a);
+
+/** Checks whether a field element is a quadratic residue. */
+static int secp256k1_fe_is_quad_var(const secp256k1_fe *a);
+
+/** Sets a field element to be the (modular) inverse of another. Requires the input's magnitude to be
+ *  at most 8. The output magnitude is 1 (but not guaranteed to be normalized). */
+static void secp256k1_fe_inv(secp256k1_fe *r, const secp256k1_fe *a);
+
+/** Potentially faster version of secp256k1_fe_inv, without constant-time guarantee. */
+static void secp256k1_fe_inv_var(secp256k1_fe *r, const secp256k1_fe *a);
+
+/** Calculate the (modular) inverses of a batch of field elements. Requires the inputs' magnitudes to be
+ *  at most 8. The output magnitudes are 1 (but not guaranteed to be normalized). The inputs and
+ *  outputs must not overlap in memory. */
+static void secp256k1_fe_inv_all_var(secp256k1_fe *r, const secp256k1_fe *a, size_t len);
+
+/** Convert a field element to the storage type. */
+static void secp256k1_fe_to_storage(secp256k1_fe_storage *r, const secp256k1_fe *a);
+
+/** Convert a field element back from the storage type. */
+static void secp256k1_fe_from_storage(secp256k1_fe *r, const secp256k1_fe_storage *a);
+
+/** If flag is true, set *r equal to *a; otherwise leave it. Constant-time. */
+static void secp256k1_fe_storage_cmov(secp256k1_fe_storage *r, const secp256k1_fe_storage *a, int flag);
+
+/** If flag is true, set *r equal to *a; otherwise leave it. Constant-time. */
+static void secp256k1_fe_cmov(secp256k1_fe *r, const secp256k1_fe *a, int flag);
+
+#endif /* SECP256K1_FIELD_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26.h
new file mode 100644
index 000000000..727c5267f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26.h
@@ -0,0 +1,48 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_REPR_H
+#define SECP256K1_FIELD_REPR_H
+
+#include <stdint.h>
+
+typedef struct {
+    /* X = sum(i=0..9, elem[i]*2^26) mod n */
+    uint32_t n[10];
+#ifdef VERIFY
+    int magnitude;
+    int normalized;
+#endif
+} secp256k1_fe;
+
+/* Unpacks a constant into a overlapping multi-limbed FE element. */
+#define SECP256K1_FE_CONST_INNER(d7, d6, d5, d4, d3, d2, d1, d0) { \
+    (d0) & 0x3FFFFFFUL, \
+    (((uint32_t)d0) >> 26) | (((uint32_t)(d1) & 0xFFFFFUL) << 6), \
+    (((uint32_t)d1) >> 20) | (((uint32_t)(d2) & 0x3FFFUL) << 12), \
+    (((uint32_t)d2) >> 14) | (((uint32_t)(d3) & 0xFFUL) << 18), \
+    (((uint32_t)d3) >> 8) | (((uint32_t)(d4) & 0x3UL) << 24), \
+    (((uint32_t)d4) >> 2) & 0x3FFFFFFUL, \
+    (((uint32_t)d4) >> 28) | (((uint32_t)(d5) & 0x3FFFFFUL) << 4), \
+    (((uint32_t)d5) >> 22) | (((uint32_t)(d6) & 0xFFFFUL) << 10), \
+    (((uint32_t)d6) >> 16) | (((uint32_t)(d7) & 0x3FFUL) << 16), \
+    (((uint32_t)d7) >> 10) \
+}
+
+#ifdef VERIFY
+#define SECP256K1_FE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {SECP256K1_FE_CONST_INNER((d7), (d6), (d5), (d4), (d3), (d2), (d1), (d0)), 1, 1}
+#else
+#define SECP256K1_FE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {SECP256K1_FE_CONST_INNER((d7), (d6), (d5), (d4), (d3), (d2), (d1), (d0))}
+#endif
+
+typedef struct {
+    uint32_t n[8];
+} secp256k1_fe_storage;
+
+#define SECP256K1_FE_STORAGE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {{ (d0), (d1), (d2), (d3), (d4), (d5), (d6), (d7) }}
+#define SECP256K1_FE_STORAGE_CONST_GET(d) d.n[7], d.n[6], d.n[5], d.n[4],d.n[3], d.n[2], d.n[1], d.n[0]
+
+#endif /* SECP256K1_FIELD_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26_impl.h
new file mode 100644
index 000000000..94f8132fc
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_10x26_impl.h
@@ -0,0 +1,1161 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_REPR_IMPL_H
+#define SECP256K1_FIELD_REPR_IMPL_H
+
+#include "util.h"
+#include "num.h"
+#include "field.h"
+
+#ifdef VERIFY
+static void secp256k1_fe_verify(const secp256k1_fe *a) {
+    const uint32_t *d = a->n;
+    int m = a->normalized ? 1 : 2 * a->magnitude, r = 1;
+    r &= (d[0] <= 0x3FFFFFFUL * m);
+    r &= (d[1] <= 0x3FFFFFFUL * m);
+    r &= (d[2] <= 0x3FFFFFFUL * m);
+    r &= (d[3] <= 0x3FFFFFFUL * m);
+    r &= (d[4] <= 0x3FFFFFFUL * m);
+    r &= (d[5] <= 0x3FFFFFFUL * m);
+    r &= (d[6] <= 0x3FFFFFFUL * m);
+    r &= (d[7] <= 0x3FFFFFFUL * m);
+    r &= (d[8] <= 0x3FFFFFFUL * m);
+    r &= (d[9] <= 0x03FFFFFUL * m);
+    r &= (a->magnitude >= 0);
+    r &= (a->magnitude <= 32);
+    if (a->normalized) {
+        r &= (a->magnitude <= 1);
+        if (r && (d[9] == 0x03FFFFFUL)) {
+            uint32_t mid = d[8] & d[7] & d[6] & d[5] & d[4] & d[3] & d[2];
+            if (mid == 0x3FFFFFFUL) {
+                r &= ((d[1] + 0x40UL + ((d[0] + 0x3D1UL) >> 26)) <= 0x3FFFFFFUL);
+            }
+        }
+    }
+    VERIFY_CHECK(r == 1);
+}
+#endif
+
+static void secp256k1_fe_normalize(secp256k1_fe *r) {
+    uint32_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4],
+             t5 = r->n[5], t6 = r->n[6], t7 = r->n[7], t8 = r->n[8], t9 = r->n[9];
+
+    /* Reduce t9 at the start so there will be at most a single carry from the first pass */
+    uint32_t m;
+    uint32_t x = t9 >> 22; t9 &= 0x03FFFFFUL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x3D1UL; t1 += (x << 6);
+    t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL;
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL; m = t2;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL; m &= t3;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL; m &= t4;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL; m &= t5;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL; m &= t6;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL; m &= t7;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL; m &= t8;
+
+    /* ... except for a possible carry at bit 22 of t9 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t9 >> 23 == 0);
+
+    /* At most a single final reduction is needed; check if the value is >= the field characteristic */
+    x = (t9 >> 22) | ((t9 == 0x03FFFFFUL) & (m == 0x3FFFFFFUL)
+        & ((t1 + 0x40UL + ((t0 + 0x3D1UL) >> 26)) > 0x3FFFFFFUL));
+
+    /* Apply the final reduction (for constant-time behaviour, we do it always) */
+    t0 += x * 0x3D1UL; t1 += (x << 6);
+    t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL;
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL;
+
+    /* If t9 didn't carry to bit 22 already, then it should have after any final reduction */
+    VERIFY_CHECK(t9 >> 22 == x);
+
+    /* Mask off the possible multiple of 2^256 from the final reduction */
+    t9 &= 0x03FFFFFUL;
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+    r->n[5] = t5; r->n[6] = t6; r->n[7] = t7; r->n[8] = t8; r->n[9] = t9;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_normalize_weak(secp256k1_fe *r) {
+    uint32_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4],
+             t5 = r->n[5], t6 = r->n[6], t7 = r->n[7], t8 = r->n[8], t9 = r->n[9];
+
+    /* Reduce t9 at the start so there will be at most a single carry from the first pass */
+    uint32_t x = t9 >> 22; t9 &= 0x03FFFFFUL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x3D1UL; t1 += (x << 6);
+    t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL;
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL;
+
+    /* ... except for a possible carry at bit 22 of t9 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t9 >> 23 == 0);
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+    r->n[5] = t5; r->n[6] = t6; r->n[7] = t7; r->n[8] = t8; r->n[9] = t9;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_normalize_var(secp256k1_fe *r) {
+    uint32_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4],
+             t5 = r->n[5], t6 = r->n[6], t7 = r->n[7], t8 = r->n[8], t9 = r->n[9];
+
+    /* Reduce t9 at the start so there will be at most a single carry from the first pass */
+    uint32_t m;
+    uint32_t x = t9 >> 22; t9 &= 0x03FFFFFUL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x3D1UL; t1 += (x << 6);
+    t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL;
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL; m = t2;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL; m &= t3;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL; m &= t4;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL; m &= t5;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL; m &= t6;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL; m &= t7;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL; m &= t8;
+
+    /* ... except for a possible carry at bit 22 of t9 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t9 >> 23 == 0);
+
+    /* At most a single final reduction is needed; check if the value is >= the field characteristic */
+    x = (t9 >> 22) | ((t9 == 0x03FFFFFUL) & (m == 0x3FFFFFFUL)
+        & ((t1 + 0x40UL + ((t0 + 0x3D1UL) >> 26)) > 0x3FFFFFFUL));
+
+    if (x) {
+        t0 += 0x3D1UL; t1 += (x << 6);
+        t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL;
+        t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL;
+        t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL;
+        t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL;
+        t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL;
+        t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL;
+        t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL;
+        t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL;
+        t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL;
+
+        /* If t9 didn't carry to bit 22 already, then it should have after any final reduction */
+        VERIFY_CHECK(t9 >> 22 == x);
+
+        /* Mask off the possible multiple of 2^256 from the final reduction */
+        t9 &= 0x03FFFFFUL;
+    }
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+    r->n[5] = t5; r->n[6] = t6; r->n[7] = t7; r->n[8] = t8; r->n[9] = t9;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static int secp256k1_fe_normalizes_to_zero(secp256k1_fe *r) {
+    uint32_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4],
+             t5 = r->n[5], t6 = r->n[6], t7 = r->n[7], t8 = r->n[8], t9 = r->n[9];
+
+    /* z0 tracks a possible raw value of 0, z1 tracks a possible raw value of P */
+    uint32_t z0, z1;
+
+    /* Reduce t9 at the start so there will be at most a single carry from the first pass */
+    uint32_t x = t9 >> 22; t9 &= 0x03FFFFFUL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x3D1UL; t1 += (x << 6);
+    t1 += (t0 >> 26); t0 &= 0x3FFFFFFUL; z0  = t0; z1  = t0 ^ 0x3D0UL;
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL; z0 |= t1; z1 &= t1 ^ 0x40UL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL; z0 |= t2; z1 &= t2;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL; z0 |= t3; z1 &= t3;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL; z0 |= t4; z1 &= t4;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL; z0 |= t5; z1 &= t5;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL; z0 |= t6; z1 &= t6;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL; z0 |= t7; z1 &= t7;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL; z0 |= t8; z1 &= t8;
+                                         z0 |= t9; z1 &= t9 ^ 0x3C00000UL;
+
+    /* ... except for a possible carry at bit 22 of t9 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t9 >> 23 == 0);
+
+    return (z0 == 0) | (z1 == 0x3FFFFFFUL);
+}
+
+static int secp256k1_fe_normalizes_to_zero_var(secp256k1_fe *r) {
+    uint32_t t0, t1, t2, t3, t4, t5, t6, t7, t8, t9;
+    uint32_t z0, z1;
+    uint32_t x;
+
+    t0 = r->n[0];
+    t9 = r->n[9];
+
+    /* Reduce t9 at the start so there will be at most a single carry from the first pass */
+    x = t9 >> 22;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x3D1UL;
+
+    /* z0 tracks a possible raw value of 0, z1 tracks a possible raw value of P */
+    z0 = t0 & 0x3FFFFFFUL;
+    z1 = z0 ^ 0x3D0UL;
+
+    /* Fast return path should catch the majority of cases */
+    if ((z0 != 0UL) & (z1 != 0x3FFFFFFUL)) {
+        return 0;
+    }
+
+    t1 = r->n[1];
+    t2 = r->n[2];
+    t3 = r->n[3];
+    t4 = r->n[4];
+    t5 = r->n[5];
+    t6 = r->n[6];
+    t7 = r->n[7];
+    t8 = r->n[8];
+
+    t9 &= 0x03FFFFFUL;
+    t1 += (x << 6);
+
+    t1 += (t0 >> 26);
+    t2 += (t1 >> 26); t1 &= 0x3FFFFFFUL; z0 |= t1; z1 &= t1 ^ 0x40UL;
+    t3 += (t2 >> 26); t2 &= 0x3FFFFFFUL; z0 |= t2; z1 &= t2;
+    t4 += (t3 >> 26); t3 &= 0x3FFFFFFUL; z0 |= t3; z1 &= t3;
+    t5 += (t4 >> 26); t4 &= 0x3FFFFFFUL; z0 |= t4; z1 &= t4;
+    t6 += (t5 >> 26); t5 &= 0x3FFFFFFUL; z0 |= t5; z1 &= t5;
+    t7 += (t6 >> 26); t6 &= 0x3FFFFFFUL; z0 |= t6; z1 &= t6;
+    t8 += (t7 >> 26); t7 &= 0x3FFFFFFUL; z0 |= t7; z1 &= t7;
+    t9 += (t8 >> 26); t8 &= 0x3FFFFFFUL; z0 |= t8; z1 &= t8;
+                                         z0 |= t9; z1 &= t9 ^ 0x3C00000UL;
+
+    /* ... except for a possible carry at bit 22 of t9 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t9 >> 23 == 0);
+
+    return (z0 == 0) | (z1 == 0x3FFFFFFUL);
+}
+
+SECP256K1_INLINE static void secp256k1_fe_set_int(secp256k1_fe *r, int a) {
+    r->n[0] = a;
+    r->n[1] = r->n[2] = r->n[3] = r->n[4] = r->n[5] = r->n[6] = r->n[7] = r->n[8] = r->n[9] = 0;
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static int secp256k1_fe_is_zero(const secp256k1_fe *a) {
+    const uint32_t *t = a->n;
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    return (t[0] | t[1] | t[2] | t[3] | t[4] | t[5] | t[6] | t[7] | t[8] | t[9]) == 0;
+}
+
+SECP256K1_INLINE static int secp256k1_fe_is_odd(const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    return a->n[0] & 1;
+}
+
+SECP256K1_INLINE static void secp256k1_fe_clear(secp256k1_fe *a) {
+    int i;
+#ifdef VERIFY
+    a->magnitude = 0;
+    a->normalized = 1;
+#endif
+    for (i=0; i<10; i++) {
+        a->n[i] = 0;
+    }
+}
+
+static int secp256k1_fe_cmp_var(const secp256k1_fe *a, const secp256k1_fe *b) {
+    int i;
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    VERIFY_CHECK(b->normalized);
+    secp256k1_fe_verify(a);
+    secp256k1_fe_verify(b);
+#endif
+    for (i = 9; i >= 0; i--) {
+        if (a->n[i] > b->n[i]) {
+            return 1;
+        }
+        if (a->n[i] < b->n[i]) {
+            return -1;
+        }
+    }
+    return 0;
+}
+
+static int secp256k1_fe_set_b32(secp256k1_fe *r, const unsigned char *a) {
+    r->n[0] = (uint32_t)a[31] | ((uint32_t)a[30] << 8) | ((uint32_t)a[29] << 16) | ((uint32_t)(a[28] & 0x3) << 24);
+    r->n[1] = (uint32_t)((a[28] >> 2) & 0x3f) | ((uint32_t)a[27] << 6) | ((uint32_t)a[26] << 14) | ((uint32_t)(a[25] & 0xf) << 22);
+    r->n[2] = (uint32_t)((a[25] >> 4) & 0xf) | ((uint32_t)a[24] << 4) | ((uint32_t)a[23] << 12) | ((uint32_t)(a[22] & 0x3f) << 20);
+    r->n[3] = (uint32_t)((a[22] >> 6) & 0x3) | ((uint32_t)a[21] << 2) | ((uint32_t)a[20] << 10) | ((uint32_t)a[19] << 18);
+    r->n[4] = (uint32_t)a[18] | ((uint32_t)a[17] << 8) | ((uint32_t)a[16] << 16) | ((uint32_t)(a[15] & 0x3) << 24);
+    r->n[5] = (uint32_t)((a[15] >> 2) & 0x3f) | ((uint32_t)a[14] << 6) | ((uint32_t)a[13] << 14) | ((uint32_t)(a[12] & 0xf) << 22);
+    r->n[6] = (uint32_t)((a[12] >> 4) & 0xf) | ((uint32_t)a[11] << 4) | ((uint32_t)a[10] << 12) | ((uint32_t)(a[9] & 0x3f) << 20);
+    r->n[7] = (uint32_t)((a[9] >> 6) & 0x3) | ((uint32_t)a[8] << 2) | ((uint32_t)a[7] << 10) | ((uint32_t)a[6] << 18);
+    r->n[8] = (uint32_t)a[5] | ((uint32_t)a[4] << 8) | ((uint32_t)a[3] << 16) | ((uint32_t)(a[2] & 0x3) << 24);
+    r->n[9] = (uint32_t)((a[2] >> 2) & 0x3f) | ((uint32_t)a[1] << 6) | ((uint32_t)a[0] << 14);
+
+    if (r->n[9] == 0x3FFFFFUL && (r->n[8] & r->n[7] & r->n[6] & r->n[5] & r->n[4] & r->n[3] & r->n[2]) == 0x3FFFFFFUL && (r->n[1] + 0x40UL + ((r->n[0] + 0x3D1UL) >> 26)) > 0x3FFFFFFUL) {
+        return 0;
+    }
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+    return 1;
+}
+
+/** Convert a field element to a 32-byte big endian value. Requires the input to be normalized */
+static void secp256k1_fe_get_b32(unsigned char *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    r[0] = (a->n[9] >> 14) & 0xff;
+    r[1] = (a->n[9] >> 6) & 0xff;
+    r[2] = ((a->n[9] & 0x3F) << 2) | ((a->n[8] >> 24) & 0x3);
+    r[3] = (a->n[8] >> 16) & 0xff;
+    r[4] = (a->n[8] >> 8) & 0xff;
+    r[5] = a->n[8] & 0xff;
+    r[6] = (a->n[7] >> 18) & 0xff;
+    r[7] = (a->n[7] >> 10) & 0xff;
+    r[8] = (a->n[7] >> 2) & 0xff;
+    r[9] = ((a->n[7] & 0x3) << 6) | ((a->n[6] >> 20) & 0x3f);
+    r[10] = (a->n[6] >> 12) & 0xff;
+    r[11] = (a->n[6] >> 4) & 0xff;
+    r[12] = ((a->n[6] & 0xf) << 4) | ((a->n[5] >> 22) & 0xf);
+    r[13] = (a->n[5] >> 14) & 0xff;
+    r[14] = (a->n[5] >> 6) & 0xff;
+    r[15] = ((a->n[5] & 0x3f) << 2) | ((a->n[4] >> 24) & 0x3);
+    r[16] = (a->n[4] >> 16) & 0xff;
+    r[17] = (a->n[4] >> 8) & 0xff;
+    r[18] = a->n[4] & 0xff;
+    r[19] = (a->n[3] >> 18) & 0xff;
+    r[20] = (a->n[3] >> 10) & 0xff;
+    r[21] = (a->n[3] >> 2) & 0xff;
+    r[22] = ((a->n[3] & 0x3) << 6) | ((a->n[2] >> 20) & 0x3f);
+    r[23] = (a->n[2] >> 12) & 0xff;
+    r[24] = (a->n[2] >> 4) & 0xff;
+    r[25] = ((a->n[2] & 0xf) << 4) | ((a->n[1] >> 22) & 0xf);
+    r[26] = (a->n[1] >> 14) & 0xff;
+    r[27] = (a->n[1] >> 6) & 0xff;
+    r[28] = ((a->n[1] & 0x3f) << 2) | ((a->n[0] >> 24) & 0x3);
+    r[29] = (a->n[0] >> 16) & 0xff;
+    r[30] = (a->n[0] >> 8) & 0xff;
+    r[31] = a->n[0] & 0xff;
+}
+
+SECP256K1_INLINE static void secp256k1_fe_negate(secp256k1_fe *r, const secp256k1_fe *a, int m) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= m);
+    secp256k1_fe_verify(a);
+#endif
+    r->n[0] = 0x3FFFC2FUL * 2 * (m + 1) - a->n[0];
+    r->n[1] = 0x3FFFFBFUL * 2 * (m + 1) - a->n[1];
+    r->n[2] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[2];
+    r->n[3] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[3];
+    r->n[4] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[4];
+    r->n[5] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[5];
+    r->n[6] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[6];
+    r->n[7] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[7];
+    r->n[8] = 0x3FFFFFFUL * 2 * (m + 1) - a->n[8];
+    r->n[9] = 0x03FFFFFUL * 2 * (m + 1) - a->n[9];
+#ifdef VERIFY
+    r->magnitude = m + 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static void secp256k1_fe_mul_int(secp256k1_fe *r, int a) {
+    r->n[0] *= a;
+    r->n[1] *= a;
+    r->n[2] *= a;
+    r->n[3] *= a;
+    r->n[4] *= a;
+    r->n[5] *= a;
+    r->n[6] *= a;
+    r->n[7] *= a;
+    r->n[8] *= a;
+    r->n[9] *= a;
+#ifdef VERIFY
+    r->magnitude *= a;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static void secp256k1_fe_add(secp256k1_fe *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    secp256k1_fe_verify(a);
+#endif
+    r->n[0] += a->n[0];
+    r->n[1] += a->n[1];
+    r->n[2] += a->n[2];
+    r->n[3] += a->n[3];
+    r->n[4] += a->n[4];
+    r->n[5] += a->n[5];
+    r->n[6] += a->n[6];
+    r->n[7] += a->n[7];
+    r->n[8] += a->n[8];
+    r->n[9] += a->n[9];
+#ifdef VERIFY
+    r->magnitude += a->magnitude;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+#if defined(USE_EXTERNAL_ASM)
+
+/* External assembler implementation */
+void secp256k1_fe_mul_inner(uint32_t *r, const uint32_t *a, const uint32_t * SECP256K1_RESTRICT b);
+void secp256k1_fe_sqr_inner(uint32_t *r, const uint32_t *a);
+
+#else
+
+#ifdef VERIFY
+#define VERIFY_BITS(x, n) VERIFY_CHECK(((x) >> (n)) == 0)
+#else
+#define VERIFY_BITS(x, n) do { } while(0)
+#endif
+
+SECP256K1_INLINE static void secp256k1_fe_mul_inner(uint32_t *r, const uint32_t *a, const uint32_t * SECP256K1_RESTRICT b) {
+    uint64_t c, d;
+    uint64_t u0, u1, u2, u3, u4, u5, u6, u7, u8;
+    uint32_t t9, t1, t0, t2, t3, t4, t5, t6, t7;
+    const uint32_t M = 0x3FFFFFFUL, R0 = 0x3D10UL, R1 = 0x400UL;
+
+    VERIFY_BITS(a[0], 30);
+    VERIFY_BITS(a[1], 30);
+    VERIFY_BITS(a[2], 30);
+    VERIFY_BITS(a[3], 30);
+    VERIFY_BITS(a[4], 30);
+    VERIFY_BITS(a[5], 30);
+    VERIFY_BITS(a[6], 30);
+    VERIFY_BITS(a[7], 30);
+    VERIFY_BITS(a[8], 30);
+    VERIFY_BITS(a[9], 26);
+    VERIFY_BITS(b[0], 30);
+    VERIFY_BITS(b[1], 30);
+    VERIFY_BITS(b[2], 30);
+    VERIFY_BITS(b[3], 30);
+    VERIFY_BITS(b[4], 30);
+    VERIFY_BITS(b[5], 30);
+    VERIFY_BITS(b[6], 30);
+    VERIFY_BITS(b[7], 30);
+    VERIFY_BITS(b[8], 30);
+    VERIFY_BITS(b[9], 26);
+
+    /** [... a b c] is a shorthand for ... + a<<52 + b<<26 + c<<0 mod n.
+     *  px is a shorthand for sum(a[i]*b[x-i], i=0..x).
+     *  Note that [x 0 0 0 0 0 0 0 0 0 0] = [x*R1 x*R0].
+     */
+
+    d  = (uint64_t)a[0] * b[9]
+       + (uint64_t)a[1] * b[8]
+       + (uint64_t)a[2] * b[7]
+       + (uint64_t)a[3] * b[6]
+       + (uint64_t)a[4] * b[5]
+       + (uint64_t)a[5] * b[4]
+       + (uint64_t)a[6] * b[3]
+       + (uint64_t)a[7] * b[2]
+       + (uint64_t)a[8] * b[1]
+       + (uint64_t)a[9] * b[0];
+    /* VERIFY_BITS(d, 64); */
+    /* [d 0 0 0 0 0 0 0 0 0] = [p9 0 0 0 0 0 0 0 0 0] */
+    t9 = d & M; d >>= 26;
+    VERIFY_BITS(t9, 26);
+    VERIFY_BITS(d, 38);
+    /* [d t9 0 0 0 0 0 0 0 0 0] = [p9 0 0 0 0 0 0 0 0 0] */
+
+    c  = (uint64_t)a[0] * b[0];
+    VERIFY_BITS(c, 60);
+    /* [d t9 0 0 0 0 0 0 0 0 c] = [p9 0 0 0 0 0 0 0 0 p0] */
+    d += (uint64_t)a[1] * b[9]
+       + (uint64_t)a[2] * b[8]
+       + (uint64_t)a[3] * b[7]
+       + (uint64_t)a[4] * b[6]
+       + (uint64_t)a[5] * b[5]
+       + (uint64_t)a[6] * b[4]
+       + (uint64_t)a[7] * b[3]
+       + (uint64_t)a[8] * b[2]
+       + (uint64_t)a[9] * b[1];
+    VERIFY_BITS(d, 63);
+    /* [d t9 0 0 0 0 0 0 0 0 c] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    u0 = d & M; d >>= 26; c += u0 * R0;
+    VERIFY_BITS(u0, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 61);
+    /* [d u0 t9 0 0 0 0 0 0 0 0 c-u0*R0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    t0 = c & M; c >>= 26; c += u0 * R1;
+    VERIFY_BITS(t0, 26);
+    VERIFY_BITS(c, 37);
+    /* [d u0 t9 0 0 0 0 0 0 0 c-u0*R1 t0-u0*R0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+
+    c += (uint64_t)a[0] * b[1]
+       + (uint64_t)a[1] * b[0];
+    VERIFY_BITS(c, 62);
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    d += (uint64_t)a[2] * b[9]
+       + (uint64_t)a[3] * b[8]
+       + (uint64_t)a[4] * b[7]
+       + (uint64_t)a[5] * b[6]
+       + (uint64_t)a[6] * b[5]
+       + (uint64_t)a[7] * b[4]
+       + (uint64_t)a[8] * b[3]
+       + (uint64_t)a[9] * b[2];
+    VERIFY_BITS(d, 63);
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    u1 = d & M; d >>= 26; c += u1 * R0;
+    VERIFY_BITS(u1, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 63);
+    /* [d u1 0 t9 0 0 0 0 0 0 0 c-u1*R0 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    t1 = c & M; c >>= 26; c += u1 * R1;
+    VERIFY_BITS(t1, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u1 0 t9 0 0 0 0 0 0 c-u1*R1 t1-u1*R0 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+
+    c += (uint64_t)a[0] * b[2]
+       + (uint64_t)a[1] * b[1]
+       + (uint64_t)a[2] * b[0];
+    VERIFY_BITS(c, 62);
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    d += (uint64_t)a[3] * b[9]
+       + (uint64_t)a[4] * b[8]
+       + (uint64_t)a[5] * b[7]
+       + (uint64_t)a[6] * b[6]
+       + (uint64_t)a[7] * b[5]
+       + (uint64_t)a[8] * b[4]
+       + (uint64_t)a[9] * b[3];
+    VERIFY_BITS(d, 63);
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    u2 = d & M; d >>= 26; c += u2 * R0;
+    VERIFY_BITS(u2, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 63);
+    /* [d u2 0 0 t9 0 0 0 0 0 0 c-u2*R0 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    t2 = c & M; c >>= 26; c += u2 * R1;
+    VERIFY_BITS(t2, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u2 0 0 t9 0 0 0 0 0 c-u2*R1 t2-u2*R0 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[3]
+       + (uint64_t)a[1] * b[2]
+       + (uint64_t)a[2] * b[1]
+       + (uint64_t)a[3] * b[0];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    d += (uint64_t)a[4] * b[9]
+       + (uint64_t)a[5] * b[8]
+       + (uint64_t)a[6] * b[7]
+       + (uint64_t)a[7] * b[6]
+       + (uint64_t)a[8] * b[5]
+       + (uint64_t)a[9] * b[4];
+    VERIFY_BITS(d, 63);
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    u3 = d & M; d >>= 26; c += u3 * R0;
+    VERIFY_BITS(u3, 26);
+    VERIFY_BITS(d, 37);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u3 0 0 0 t9 0 0 0 0 0 c-u3*R0 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    t3 = c & M; c >>= 26; c += u3 * R1;
+    VERIFY_BITS(t3, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u3 0 0 0 t9 0 0 0 0 c-u3*R1 t3-u3*R0 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[4]
+       + (uint64_t)a[1] * b[3]
+       + (uint64_t)a[2] * b[2]
+       + (uint64_t)a[3] * b[1]
+       + (uint64_t)a[4] * b[0];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[5] * b[9]
+       + (uint64_t)a[6] * b[8]
+       + (uint64_t)a[7] * b[7]
+       + (uint64_t)a[8] * b[6]
+       + (uint64_t)a[9] * b[5];
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    u4 = d & M; d >>= 26; c += u4 * R0;
+    VERIFY_BITS(u4, 26);
+    VERIFY_BITS(d, 36);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u4 0 0 0 0 t9 0 0 0 0 c-u4*R0 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    t4 = c & M; c >>= 26; c += u4 * R1;
+    VERIFY_BITS(t4, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u4 0 0 0 0 t9 0 0 0 c-u4*R1 t4-u4*R0 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[5]
+       + (uint64_t)a[1] * b[4]
+       + (uint64_t)a[2] * b[3]
+       + (uint64_t)a[3] * b[2]
+       + (uint64_t)a[4] * b[1]
+       + (uint64_t)a[5] * b[0];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[6] * b[9]
+       + (uint64_t)a[7] * b[8]
+       + (uint64_t)a[8] * b[7]
+       + (uint64_t)a[9] * b[6];
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    u5 = d & M; d >>= 26; c += u5 * R0;
+    VERIFY_BITS(u5, 26);
+    VERIFY_BITS(d, 36);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u5 0 0 0 0 0 t9 0 0 0 c-u5*R0 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    t5 = c & M; c >>= 26; c += u5 * R1;
+    VERIFY_BITS(t5, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u5 0 0 0 0 0 t9 0 0 c-u5*R1 t5-u5*R0 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[6]
+       + (uint64_t)a[1] * b[5]
+       + (uint64_t)a[2] * b[4]
+       + (uint64_t)a[3] * b[3]
+       + (uint64_t)a[4] * b[2]
+       + (uint64_t)a[5] * b[1]
+       + (uint64_t)a[6] * b[0];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[7] * b[9]
+       + (uint64_t)a[8] * b[8]
+       + (uint64_t)a[9] * b[7];
+    VERIFY_BITS(d, 61);
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    u6 = d & M; d >>= 26; c += u6 * R0;
+    VERIFY_BITS(u6, 26);
+    VERIFY_BITS(d, 35);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u6 0 0 0 0 0 0 t9 0 0 c-u6*R0 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    t6 = c & M; c >>= 26; c += u6 * R1;
+    VERIFY_BITS(t6, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u6 0 0 0 0 0 0 t9 0 c-u6*R1 t6-u6*R0 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[7]
+       + (uint64_t)a[1] * b[6]
+       + (uint64_t)a[2] * b[5]
+       + (uint64_t)a[3] * b[4]
+       + (uint64_t)a[4] * b[3]
+       + (uint64_t)a[5] * b[2]
+       + (uint64_t)a[6] * b[1]
+       + (uint64_t)a[7] * b[0];
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x8000007C00000007ULL);
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[8] * b[9]
+       + (uint64_t)a[9] * b[8];
+    VERIFY_BITS(d, 58);
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    u7 = d & M; d >>= 26; c += u7 * R0;
+    VERIFY_BITS(u7, 26);
+    VERIFY_BITS(d, 32);
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x800001703FFFC2F7ULL);
+    /* [d u7 0 0 0 0 0 0 0 t9 0 c-u7*R0 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    t7 = c & M; c >>= 26; c += u7 * R1;
+    VERIFY_BITS(t7, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u7 0 0 0 0 0 0 0 t9 c-u7*R1 t7-u7*R0 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)a[0] * b[8]
+       + (uint64_t)a[1] * b[7]
+       + (uint64_t)a[2] * b[6]
+       + (uint64_t)a[3] * b[5]
+       + (uint64_t)a[4] * b[4]
+       + (uint64_t)a[5] * b[3]
+       + (uint64_t)a[6] * b[2]
+       + (uint64_t)a[7] * b[1]
+       + (uint64_t)a[8] * b[0];
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x9000007B80000008ULL);
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[9] * b[9];
+    VERIFY_BITS(d, 57);
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    u8 = d & M; d >>= 26; c += u8 * R0;
+    VERIFY_BITS(u8, 26);
+    VERIFY_BITS(d, 31);
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x9000016FBFFFC2F8ULL);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 t4 t3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    r[3] = t3;
+    VERIFY_BITS(r[3], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 t4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[4] = t4;
+    VERIFY_BITS(r[4], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[5] = t5;
+    VERIFY_BITS(r[5], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[6] = t6;
+    VERIFY_BITS(r[6], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[7] = t7;
+    VERIFY_BITS(r[7], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    r[8] = c & M; c >>= 26; c += u8 * R1;
+    VERIFY_BITS(r[8], 26);
+    VERIFY_BITS(c, 39);
+    /* [d u8 0 0 0 0 0 0 0 0 t9+c-u8*R1 r8-u8*R0 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 0 0 t9+c r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c   += d * R0 + t9;
+    VERIFY_BITS(c, 45);
+    /* [d 0 0 0 0 0 0 0 0 0 c-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[9] = c & (M >> 4); c >>= 22; c += d * (R1 << 4);
+    VERIFY_BITS(r[9], 22);
+    VERIFY_BITS(c, 46);
+    /* [d 0 0 0 0 0 0 0 0 r9+((c-d*R1<<4)<<22)-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 -d*R1 r9+(c<<22)-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    d    = c * (R0 >> 4) + t0;
+    VERIFY_BITS(d, 56);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1 d-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[0] = d & M; d >>= 26;
+    VERIFY_BITS(r[0], 26);
+    VERIFY_BITS(d, 30);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1+d r0-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d   += c * (R1 >> 4) + t1;
+    VERIFY_BITS(d, 53);
+    VERIFY_CHECK(d <= 0x10000003FFFFBFULL);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 d-c*R1>>4 r0-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [r9 r8 r7 r6 r5 r4 r3 t2 d r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[1] = d & M; d >>= 26;
+    VERIFY_BITS(r[1], 26);
+    VERIFY_BITS(d, 27);
+    VERIFY_CHECK(d <= 0x4000000ULL);
+    /* [r9 r8 r7 r6 r5 r4 r3 t2+d r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d   += t2;
+    VERIFY_BITS(d, 27);
+    /* [r9 r8 r7 r6 r5 r4 r3 d r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[2] = d;
+    VERIFY_BITS(r[2], 27);
+    /* [r9 r8 r7 r6 r5 r4 r3 r2 r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+}
+
+SECP256K1_INLINE static void secp256k1_fe_sqr_inner(uint32_t *r, const uint32_t *a) {
+    uint64_t c, d;
+    uint64_t u0, u1, u2, u3, u4, u5, u6, u7, u8;
+    uint32_t t9, t0, t1, t2, t3, t4, t5, t6, t7;
+    const uint32_t M = 0x3FFFFFFUL, R0 = 0x3D10UL, R1 = 0x400UL;
+
+    VERIFY_BITS(a[0], 30);
+    VERIFY_BITS(a[1], 30);
+    VERIFY_BITS(a[2], 30);
+    VERIFY_BITS(a[3], 30);
+    VERIFY_BITS(a[4], 30);
+    VERIFY_BITS(a[5], 30);
+    VERIFY_BITS(a[6], 30);
+    VERIFY_BITS(a[7], 30);
+    VERIFY_BITS(a[8], 30);
+    VERIFY_BITS(a[9], 26);
+
+    /** [... a b c] is a shorthand for ... + a<<52 + b<<26 + c<<0 mod n.
+     *  px is a shorthand for sum(a[i]*a[x-i], i=0..x).
+     *  Note that [x 0 0 0 0 0 0 0 0 0 0] = [x*R1 x*R0].
+     */
+
+    d  = (uint64_t)(a[0]*2) * a[9]
+       + (uint64_t)(a[1]*2) * a[8]
+       + (uint64_t)(a[2]*2) * a[7]
+       + (uint64_t)(a[3]*2) * a[6]
+       + (uint64_t)(a[4]*2) * a[5];
+    /* VERIFY_BITS(d, 64); */
+    /* [d 0 0 0 0 0 0 0 0 0] = [p9 0 0 0 0 0 0 0 0 0] */
+    t9 = d & M; d >>= 26;
+    VERIFY_BITS(t9, 26);
+    VERIFY_BITS(d, 38);
+    /* [d t9 0 0 0 0 0 0 0 0 0] = [p9 0 0 0 0 0 0 0 0 0] */
+
+    c  = (uint64_t)a[0] * a[0];
+    VERIFY_BITS(c, 60);
+    /* [d t9 0 0 0 0 0 0 0 0 c] = [p9 0 0 0 0 0 0 0 0 p0] */
+    d += (uint64_t)(a[1]*2) * a[9]
+       + (uint64_t)(a[2]*2) * a[8]
+       + (uint64_t)(a[3]*2) * a[7]
+       + (uint64_t)(a[4]*2) * a[6]
+       + (uint64_t)a[5] * a[5];
+    VERIFY_BITS(d, 63);
+    /* [d t9 0 0 0 0 0 0 0 0 c] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    u0 = d & M; d >>= 26; c += u0 * R0;
+    VERIFY_BITS(u0, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 61);
+    /* [d u0 t9 0 0 0 0 0 0 0 0 c-u0*R0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    t0 = c & M; c >>= 26; c += u0 * R1;
+    VERIFY_BITS(t0, 26);
+    VERIFY_BITS(c, 37);
+    /* [d u0 t9 0 0 0 0 0 0 0 c-u0*R1 t0-u0*R0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p10 p9 0 0 0 0 0 0 0 0 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[1];
+    VERIFY_BITS(c, 62);
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    d += (uint64_t)(a[2]*2) * a[9]
+       + (uint64_t)(a[3]*2) * a[8]
+       + (uint64_t)(a[4]*2) * a[7]
+       + (uint64_t)(a[5]*2) * a[6];
+    VERIFY_BITS(d, 63);
+    /* [d 0 t9 0 0 0 0 0 0 0 c t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    u1 = d & M; d >>= 26; c += u1 * R0;
+    VERIFY_BITS(u1, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 63);
+    /* [d u1 0 t9 0 0 0 0 0 0 0 c-u1*R0 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    t1 = c & M; c >>= 26; c += u1 * R1;
+    VERIFY_BITS(t1, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u1 0 t9 0 0 0 0 0 0 c-u1*R1 t1-u1*R0 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p11 p10 p9 0 0 0 0 0 0 0 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[2]
+       + (uint64_t)a[1] * a[1];
+    VERIFY_BITS(c, 62);
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    d += (uint64_t)(a[3]*2) * a[9]
+       + (uint64_t)(a[4]*2) * a[8]
+       + (uint64_t)(a[5]*2) * a[7]
+       + (uint64_t)a[6] * a[6];
+    VERIFY_BITS(d, 63);
+    /* [d 0 0 t9 0 0 0 0 0 0 c t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    u2 = d & M; d >>= 26; c += u2 * R0;
+    VERIFY_BITS(u2, 26);
+    VERIFY_BITS(d, 37);
+    VERIFY_BITS(c, 63);
+    /* [d u2 0 0 t9 0 0 0 0 0 0 c-u2*R0 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    t2 = c & M; c >>= 26; c += u2 * R1;
+    VERIFY_BITS(t2, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u2 0 0 t9 0 0 0 0 0 c-u2*R1 t2-u2*R0 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 0 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[3]
+       + (uint64_t)(a[1]*2) * a[2];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    d += (uint64_t)(a[4]*2) * a[9]
+       + (uint64_t)(a[5]*2) * a[8]
+       + (uint64_t)(a[6]*2) * a[7];
+    VERIFY_BITS(d, 63);
+    /* [d 0 0 0 t9 0 0 0 0 0 c t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    u3 = d & M; d >>= 26; c += u3 * R0;
+    VERIFY_BITS(u3, 26);
+    VERIFY_BITS(d, 37);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u3 0 0 0 t9 0 0 0 0 0 c-u3*R0 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    t3 = c & M; c >>= 26; c += u3 * R1;
+    VERIFY_BITS(t3, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u3 0 0 0 t9 0 0 0 0 c-u3*R1 t3-u3*R0 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 0 p3 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[4]
+       + (uint64_t)(a[1]*2) * a[3]
+       + (uint64_t)a[2] * a[2];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    d += (uint64_t)(a[5]*2) * a[9]
+       + (uint64_t)(a[6]*2) * a[8]
+       + (uint64_t)a[7] * a[7];
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 0 t9 0 0 0 0 c t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    u4 = d & M; d >>= 26; c += u4 * R0;
+    VERIFY_BITS(u4, 26);
+    VERIFY_BITS(d, 36);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u4 0 0 0 0 t9 0 0 0 0 c-u4*R0 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    t4 = c & M; c >>= 26; c += u4 * R1;
+    VERIFY_BITS(t4, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u4 0 0 0 0 t9 0 0 0 c-u4*R1 t4-u4*R0 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 0 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[5]
+       + (uint64_t)(a[1]*2) * a[4]
+       + (uint64_t)(a[2]*2) * a[3];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)(a[6]*2) * a[9]
+       + (uint64_t)(a[7]*2) * a[8];
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 0 0 t9 0 0 0 c t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    u5 = d & M; d >>= 26; c += u5 * R0;
+    VERIFY_BITS(u5, 26);
+    VERIFY_BITS(d, 36);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u5 0 0 0 0 0 t9 0 0 0 c-u5*R0 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    t5 = c & M; c >>= 26; c += u5 * R1;
+    VERIFY_BITS(t5, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u5 0 0 0 0 0 t9 0 0 c-u5*R1 t5-u5*R0 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 0 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[6]
+       + (uint64_t)(a[1]*2) * a[5]
+       + (uint64_t)(a[2]*2) * a[4]
+       + (uint64_t)a[3] * a[3];
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)(a[7]*2) * a[9]
+       + (uint64_t)a[8] * a[8];
+    VERIFY_BITS(d, 61);
+    /* [d 0 0 0 0 0 0 t9 0 0 c t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    u6 = d & M; d >>= 26; c += u6 * R0;
+    VERIFY_BITS(u6, 26);
+    VERIFY_BITS(d, 35);
+    /* VERIFY_BITS(c, 64); */
+    /* [d u6 0 0 0 0 0 0 t9 0 0 c-u6*R0 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    t6 = c & M; c >>= 26; c += u6 * R1;
+    VERIFY_BITS(t6, 26);
+    VERIFY_BITS(c, 39);
+    /* [d u6 0 0 0 0 0 0 t9 0 c-u6*R1 t6-u6*R0 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 0 p6 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[7]
+       + (uint64_t)(a[1]*2) * a[6]
+       + (uint64_t)(a[2]*2) * a[5]
+       + (uint64_t)(a[3]*2) * a[4];
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x8000007C00000007ULL);
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)(a[8]*2) * a[9];
+    VERIFY_BITS(d, 58);
+    /* [d 0 0 0 0 0 0 0 t9 0 c t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    u7 = d & M; d >>= 26; c += u7 * R0;
+    VERIFY_BITS(u7, 26);
+    VERIFY_BITS(d, 32);
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x800001703FFFC2F7ULL);
+    /* [d u7 0 0 0 0 0 0 0 t9 0 c-u7*R0 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    t7 = c & M; c >>= 26; c += u7 * R1;
+    VERIFY_BITS(t7, 26);
+    VERIFY_BITS(c, 38);
+    /* [d u7 0 0 0 0 0 0 0 t9 c-u7*R1 t7-u7*R0 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 0 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    c += (uint64_t)(a[0]*2) * a[8]
+       + (uint64_t)(a[1]*2) * a[7]
+       + (uint64_t)(a[2]*2) * a[6]
+       + (uint64_t)(a[3]*2) * a[5]
+       + (uint64_t)a[4] * a[4];
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x9000007B80000008ULL);
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint64_t)a[9] * a[9];
+    VERIFY_BITS(d, 57);
+    /* [d 0 0 0 0 0 0 0 0 t9 c t7 t6 t5 t4 t3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    u8 = d & M; d >>= 26; c += u8 * R0;
+    VERIFY_BITS(u8, 26);
+    VERIFY_BITS(d, 31);
+    /* VERIFY_BITS(c, 64); */
+    VERIFY_CHECK(c <= 0x9000016FBFFFC2F8ULL);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 t4 t3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    r[3] = t3;
+    VERIFY_BITS(r[3], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 t4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[4] = t4;
+    VERIFY_BITS(r[4], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 t5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[5] = t5;
+    VERIFY_BITS(r[5], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 t6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[6] = t6;
+    VERIFY_BITS(r[6], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 t7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[7] = t7;
+    VERIFY_BITS(r[7], 26);
+    /* [d u8 0 0 0 0 0 0 0 0 t9 c-u8*R0 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    r[8] = c & M; c >>= 26; c += u8 * R1;
+    VERIFY_BITS(r[8], 26);
+    VERIFY_BITS(c, 39);
+    /* [d u8 0 0 0 0 0 0 0 0 t9+c-u8*R1 r8-u8*R0 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 0 0 t9+c r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c   += d * R0 + t9;
+    VERIFY_BITS(c, 45);
+    /* [d 0 0 0 0 0 0 0 0 0 c-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[9] = c & (M >> 4); c >>= 22; c += d * (R1 << 4);
+    VERIFY_BITS(r[9], 22);
+    VERIFY_BITS(c, 46);
+    /* [d 0 0 0 0 0 0 0 0 r9+((c-d*R1<<4)<<22)-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [d 0 0 0 0 0 0 0 -d*R1 r9+(c<<22)-d*R0 r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1 t0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    d    = c * (R0 >> 4) + t0;
+    VERIFY_BITS(d, 56);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1 d-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[0] = d & M; d >>= 26;
+    VERIFY_BITS(r[0], 26);
+    VERIFY_BITS(d, 30);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 t1+d r0-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d   += c * (R1 >> 4) + t1;
+    VERIFY_BITS(d, 53);
+    VERIFY_CHECK(d <= 0x10000003FFFFBFULL);
+    /* [r9+(c<<22) r8 r7 r6 r5 r4 r3 t2 d-c*R1>>4 r0-c*R0>>4] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    /* [r9 r8 r7 r6 r5 r4 r3 t2 d r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[1] = d & M; d >>= 26;
+    VERIFY_BITS(r[1], 26);
+    VERIFY_BITS(d, 27);
+    VERIFY_CHECK(d <= 0x4000000ULL);
+    /* [r9 r8 r7 r6 r5 r4 r3 t2+d r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    d   += t2;
+    VERIFY_BITS(d, 27);
+    /* [r9 r8 r7 r6 r5 r4 r3 d r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[2] = d;
+    VERIFY_BITS(r[2], 27);
+    /* [r9 r8 r7 r6 r5 r4 r3 r2 r1 r0] = [p18 p17 p16 p15 p14 p13 p12 p11 p10 p9 p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+}
+#endif
+
+static void secp256k1_fe_mul(secp256k1_fe *r, const secp256k1_fe *a, const secp256k1_fe * SECP256K1_RESTRICT b) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= 8);
+    VERIFY_CHECK(b->magnitude <= 8);
+    secp256k1_fe_verify(a);
+    secp256k1_fe_verify(b);
+    VERIFY_CHECK(r != b);
+#endif
+    secp256k1_fe_mul_inner(r->n, a->n, b->n);
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_sqr(secp256k1_fe *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= 8);
+    secp256k1_fe_verify(a);
+#endif
+    secp256k1_fe_sqr_inner(r->n, a->n);
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static SECP256K1_INLINE void secp256k1_fe_cmov(secp256k1_fe *r, const secp256k1_fe *a, int flag) {
+    uint32_t mask0, mask1;
+    mask0 = flag + ~((uint32_t)0);
+    mask1 = ~mask0;
+    r->n[0] = (r->n[0] & mask0) | (a->n[0] & mask1);
+    r->n[1] = (r->n[1] & mask0) | (a->n[1] & mask1);
+    r->n[2] = (r->n[2] & mask0) | (a->n[2] & mask1);
+    r->n[3] = (r->n[3] & mask0) | (a->n[3] & mask1);
+    r->n[4] = (r->n[4] & mask0) | (a->n[4] & mask1);
+    r->n[5] = (r->n[5] & mask0) | (a->n[5] & mask1);
+    r->n[6] = (r->n[6] & mask0) | (a->n[6] & mask1);
+    r->n[7] = (r->n[7] & mask0) | (a->n[7] & mask1);
+    r->n[8] = (r->n[8] & mask0) | (a->n[8] & mask1);
+    r->n[9] = (r->n[9] & mask0) | (a->n[9] & mask1);
+#ifdef VERIFY
+    if (a->magnitude > r->magnitude) {
+        r->magnitude = a->magnitude;
+    }
+    r->normalized &= a->normalized;
+#endif
+}
+
+static SECP256K1_INLINE void secp256k1_fe_storage_cmov(secp256k1_fe_storage *r, const secp256k1_fe_storage *a, int flag) {
+    uint32_t mask0, mask1;
+    mask0 = flag + ~((uint32_t)0);
+    mask1 = ~mask0;
+    r->n[0] = (r->n[0] & mask0) | (a->n[0] & mask1);
+    r->n[1] = (r->n[1] & mask0) | (a->n[1] & mask1);
+    r->n[2] = (r->n[2] & mask0) | (a->n[2] & mask1);
+    r->n[3] = (r->n[3] & mask0) | (a->n[3] & mask1);
+    r->n[4] = (r->n[4] & mask0) | (a->n[4] & mask1);
+    r->n[5] = (r->n[5] & mask0) | (a->n[5] & mask1);
+    r->n[6] = (r->n[6] & mask0) | (a->n[6] & mask1);
+    r->n[7] = (r->n[7] & mask0) | (a->n[7] & mask1);
+}
+
+static void secp256k1_fe_to_storage(secp256k1_fe_storage *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+#endif
+    r->n[0] = a->n[0] | a->n[1] << 26;
+    r->n[1] = a->n[1] >> 6 | a->n[2] << 20;
+    r->n[2] = a->n[2] >> 12 | a->n[3] << 14;
+    r->n[3] = a->n[3] >> 18 | a->n[4] << 8;
+    r->n[4] = a->n[4] >> 24 | a->n[5] << 2 | a->n[6] << 28;
+    r->n[5] = a->n[6] >> 4 | a->n[7] << 22;
+    r->n[6] = a->n[7] >> 10 | a->n[8] << 16;
+    r->n[7] = a->n[8] >> 16 | a->n[9] << 10;
+}
+
+static SECP256K1_INLINE void secp256k1_fe_from_storage(secp256k1_fe *r, const secp256k1_fe_storage *a) {
+    r->n[0] = a->n[0] & 0x3FFFFFFUL;
+    r->n[1] = a->n[0] >> 26 | ((a->n[1] << 6) & 0x3FFFFFFUL);
+    r->n[2] = a->n[1] >> 20 | ((a->n[2] << 12) & 0x3FFFFFFUL);
+    r->n[3] = a->n[2] >> 14 | ((a->n[3] << 18) & 0x3FFFFFFUL);
+    r->n[4] = a->n[3] >> 8 | ((a->n[4] << 24) & 0x3FFFFFFUL);
+    r->n[5] = (a->n[4] >> 2) & 0x3FFFFFFUL;
+    r->n[6] = a->n[4] >> 28 | ((a->n[5] << 4) & 0x3FFFFFFUL);
+    r->n[7] = a->n[5] >> 22 | ((a->n[6] << 10) & 0x3FFFFFFUL);
+    r->n[8] = a->n[6] >> 16 | ((a->n[7] << 16) & 0x3FFFFFFUL);
+    r->n[9] = a->n[7] >> 10;
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+#endif
+}
+
+#endif /* SECP256K1_FIELD_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52.h
new file mode 100644
index 000000000..bccd8feb4
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52.h
@@ -0,0 +1,47 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_REPR_H
+#define SECP256K1_FIELD_REPR_H
+
+#include <stdint.h>
+
+typedef struct {
+    /* X = sum(i=0..4, elem[i]*2^52) mod n */
+    uint64_t n[5];
+#ifdef VERIFY
+    int magnitude;
+    int normalized;
+#endif
+} secp256k1_fe;
+
+/* Unpacks a constant into a overlapping multi-limbed FE element. */
+#define SECP256K1_FE_CONST_INNER(d7, d6, d5, d4, d3, d2, d1, d0) { \
+    (d0) | (((uint64_t)(d1) & 0xFFFFFUL) << 32), \
+    ((uint64_t)(d1) >> 20) | (((uint64_t)(d2)) << 12) | (((uint64_t)(d3) & 0xFFUL) << 44), \
+    ((uint64_t)(d3) >> 8) | (((uint64_t)(d4) & 0xFFFFFFFUL) << 24), \
+    ((uint64_t)(d4) >> 28) | (((uint64_t)(d5)) << 4) | (((uint64_t)(d6) & 0xFFFFUL) << 36), \
+    ((uint64_t)(d6) >> 16) | (((uint64_t)(d7)) << 16) \
+}
+
+#ifdef VERIFY
+#define SECP256K1_FE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {SECP256K1_FE_CONST_INNER((d7), (d6), (d5), (d4), (d3), (d2), (d1), (d0)), 1, 1}
+#else
+#define SECP256K1_FE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {SECP256K1_FE_CONST_INNER((d7), (d6), (d5), (d4), (d3), (d2), (d1), (d0))}
+#endif
+
+typedef struct {
+    uint64_t n[4];
+} secp256k1_fe_storage;
+
+#define SECP256K1_FE_STORAGE_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {{ \
+    (d0) | (((uint64_t)(d1)) << 32), \
+    (d2) | (((uint64_t)(d3)) << 32), \
+    (d4) | (((uint64_t)(d5)) << 32), \
+    (d6) | (((uint64_t)(d7)) << 32) \
+}}
+
+#endif /* SECP256K1_FIELD_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_asm_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_asm_impl.h
new file mode 100644
index 000000000..1fc3171f6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_asm_impl.h
@@ -0,0 +1,502 @@
+/**********************************************************************
+ * Copyright (c) 2013-2014 Diederik Huys, Pieter Wuille               *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+/**
+ * Changelog:
+ * - March 2013, Diederik Huys:    original version
+ * - November 2014, Pieter Wuille: updated to use Peter Dettman's parallel multiplication algorithm
+ * - December 2014, Pieter Wuille: converted from YASM to GCC inline assembly
+ */
+
+#ifndef SECP256K1_FIELD_INNER5X52_IMPL_H
+#define SECP256K1_FIELD_INNER5X52_IMPL_H
+
+SECP256K1_INLINE static void secp256k1_fe_mul_inner(uint64_t *r, const uint64_t *a, const uint64_t * SECP256K1_RESTRICT b) {
+/**
+ * Registers: rdx:rax = multiplication accumulator
+ *            r9:r8   = c
+ *            r15:rcx = d
+ *            r10-r14 = a0-a4
+ *            rbx     = b
+ *            rdi     = r
+ *            rsi     = a / t?
+ */
+  uint64_t tmp1, tmp2, tmp3;
+__asm__ __volatile__(
+    "movq 0(%%rsi),%%r10\n"
+    "movq 8(%%rsi),%%r11\n"
+    "movq 16(%%rsi),%%r12\n"
+    "movq 24(%%rsi),%%r13\n"
+    "movq 32(%%rsi),%%r14\n"
+
+    /* d += a3 * b0 */
+    "movq 0(%%rbx),%%rax\n"
+    "mulq %%r13\n"
+    "movq %%rax,%%rcx\n"
+    "movq %%rdx,%%r15\n"
+    /* d += a2 * b1 */
+    "movq 8(%%rbx),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a1 * b2 */
+    "movq 16(%%rbx),%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d = a0 * b3 */
+    "movq 24(%%rbx),%%rax\n"
+    "mulq %%r10\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* c = a4 * b4 */
+    "movq 32(%%rbx),%%rax\n"
+    "mulq %%r14\n"
+    "movq %%rax,%%r8\n"
+    "movq %%rdx,%%r9\n"
+    /* d += (c & M) * R */
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* c >>= 52 (%%r8 only) */
+    "shrdq $52,%%r9,%%r8\n"
+    /* t3 (tmp1) = d & M */
+    "movq %%rcx,%%rsi\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rsi\n"
+    "movq %%rsi,%q1\n"
+    /* d >>= 52 */
+    "shrdq $52,%%r15,%%rcx\n"
+    "xorq %%r15,%%r15\n"
+    /* d += a4 * b0 */
+    "movq 0(%%rbx),%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a3 * b1 */
+    "movq 8(%%rbx),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a2 * b2 */
+    "movq 16(%%rbx),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a1 * b3 */
+    "movq 24(%%rbx),%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a0 * b4 */
+    "movq 32(%%rbx),%%rax\n"
+    "mulq %%r10\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += c * R */
+    "movq %%r8,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* t4 = d & M (%%rsi) */
+    "movq %%rcx,%%rsi\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rsi\n"
+    /* d >>= 52 */
+    "shrdq $52,%%r15,%%rcx\n"
+    "xorq %%r15,%%r15\n"
+    /* tx = t4 >> 48 (tmp3) */
+    "movq %%rsi,%%rax\n"
+    "shrq $48,%%rax\n"
+    "movq %%rax,%q3\n"
+    /* t4 &= (M >> 4) (tmp2) */
+    "movq $0xffffffffffff,%%rax\n"
+    "andq %%rax,%%rsi\n"
+    "movq %%rsi,%q2\n"
+    /* c = a0 * b0 */
+    "movq 0(%%rbx),%%rax\n"
+    "mulq %%r10\n"
+    "movq %%rax,%%r8\n"
+    "movq %%rdx,%%r9\n"
+    /* d += a4 * b1 */
+    "movq 8(%%rbx),%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a3 * b2 */
+    "movq 16(%%rbx),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a2 * b3 */
+    "movq 24(%%rbx),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a1 * b4 */
+    "movq 32(%%rbx),%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* u0 = d & M (%%rsi) */
+    "movq %%rcx,%%rsi\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rsi\n"
+    /* d >>= 52 */
+    "shrdq $52,%%r15,%%rcx\n"
+    "xorq %%r15,%%r15\n"
+    /* u0 = (u0 << 4) | tx (%%rsi) */
+    "shlq $4,%%rsi\n"
+    "movq %q3,%%rax\n"
+    "orq %%rax,%%rsi\n"
+    /* c += u0 * (R >> 4) */
+    "movq $0x1000003d1,%%rax\n"
+    "mulq %%rsi\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* r[0] = c & M */
+    "movq %%r8,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq %%rax,0(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* c += a1 * b0 */
+    "movq 0(%%rbx),%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* c += a0 * b1 */
+    "movq 8(%%rbx),%%rax\n"
+    "mulq %%r10\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d += a4 * b2 */
+    "movq 16(%%rbx),%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a3 * b3 */
+    "movq 24(%%rbx),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a2 * b4 */
+    "movq 32(%%rbx),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* c += (d & M) * R */
+    "movq %%rcx,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d >>= 52 */
+    "shrdq $52,%%r15,%%rcx\n"
+    "xorq %%r15,%%r15\n"
+    /* r[1] = c & M */
+    "movq %%r8,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq %%rax,8(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* c += a2 * b0 */
+    "movq 0(%%rbx),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* c += a1 * b1 */
+    "movq 8(%%rbx),%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* c += a0 * b2 (last use of %%r10 = a0) */
+    "movq 16(%%rbx),%%rax\n"
+    "mulq %%r10\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* fetch t3 (%%r10, overwrites a0), t4 (%%rsi) */
+    "movq %q2,%%rsi\n"
+    "movq %q1,%%r10\n"
+    /* d += a4 * b3 */
+    "movq 24(%%rbx),%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* d += a3 * b4 */
+    "movq 32(%%rbx),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rcx\n"
+    "adcq %%rdx,%%r15\n"
+    /* c += (d & M) * R */
+    "movq %%rcx,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d >>= 52 (%%rcx only) */
+    "shrdq $52,%%r15,%%rcx\n"
+    /* r[2] = c & M */
+    "movq %%r8,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq %%rax,16(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* c += t3 */
+    "addq %%r10,%%r8\n"
+    /* c += d * R */
+    "movq %%rcx,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* r[3] = c & M */
+    "movq %%r8,%%rax\n"
+    "movq $0xfffffffffffff,%%rdx\n"
+    "andq %%rdx,%%rax\n"
+    "movq %%rax,24(%%rdi)\n"
+    /* c >>= 52 (%%r8 only) */
+    "shrdq $52,%%r9,%%r8\n"
+    /* c += t4 (%%r8 only) */
+    "addq %%rsi,%%r8\n"
+    /* r[4] = c */
+    "movq %%r8,32(%%rdi)\n"
+: "+S"(a), "=m"(tmp1), "=m"(tmp2), "=m"(tmp3)
+: "b"(b), "D"(r)
+: "%rax", "%rcx", "%rdx", "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15", "cc", "memory"
+);
+}
+
+SECP256K1_INLINE static void secp256k1_fe_sqr_inner(uint64_t *r, const uint64_t *a) {
+/**
+ * Registers: rdx:rax = multiplication accumulator
+ *            r9:r8   = c
+ *            rcx:rbx = d
+ *            r10-r14 = a0-a4
+ *            r15     = M (0xfffffffffffff)
+ *            rdi     = r
+ *            rsi     = a / t?
+ */
+  uint64_t tmp1, tmp2, tmp3;
+__asm__ __volatile__(
+    "movq 0(%%rsi),%%r10\n"
+    "movq 8(%%rsi),%%r11\n"
+    "movq 16(%%rsi),%%r12\n"
+    "movq 24(%%rsi),%%r13\n"
+    "movq 32(%%rsi),%%r14\n"
+    "movq $0xfffffffffffff,%%r15\n"
+
+    /* d = (a0*2) * a3 */
+    "leaq (%%r10,%%r10,1),%%rax\n"
+    "mulq %%r13\n"
+    "movq %%rax,%%rbx\n"
+    "movq %%rdx,%%rcx\n"
+    /* d += (a1*2) * a2 */
+    "leaq (%%r11,%%r11,1),%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* c = a4 * a4 */
+    "movq %%r14,%%rax\n"
+    "mulq %%r14\n"
+    "movq %%rax,%%r8\n"
+    "movq %%rdx,%%r9\n"
+    /* d += (c & M) * R */
+    "andq %%r15,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* c >>= 52 (%%r8 only) */
+    "shrdq $52,%%r9,%%r8\n"
+    /* t3 (tmp1) = d & M */
+    "movq %%rbx,%%rsi\n"
+    "andq %%r15,%%rsi\n"
+    "movq %%rsi,%q1\n"
+    /* d >>= 52 */
+    "shrdq $52,%%rcx,%%rbx\n"
+    "xorq %%rcx,%%rcx\n"
+    /* a4 *= 2 */
+    "addq %%r14,%%r14\n"
+    /* d += a0 * a4 */
+    "movq %%r10,%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* d+= (a1*2) * a3 */
+    "leaq (%%r11,%%r11,1),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* d += a2 * a2 */
+    "movq %%r12,%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* d += c * R */
+    "movq %%r8,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* t4 = d & M (%%rsi) */
+    "movq %%rbx,%%rsi\n"
+    "andq %%r15,%%rsi\n"
+    /* d >>= 52 */
+    "shrdq $52,%%rcx,%%rbx\n"
+    "xorq %%rcx,%%rcx\n"
+    /* tx = t4 >> 48 (tmp3) */
+    "movq %%rsi,%%rax\n"
+    "shrq $48,%%rax\n"
+    "movq %%rax,%q3\n"
+    /* t4 &= (M >> 4) (tmp2) */
+    "movq $0xffffffffffff,%%rax\n"
+    "andq %%rax,%%rsi\n"
+    "movq %%rsi,%q2\n"
+    /* c = a0 * a0 */
+    "movq %%r10,%%rax\n"
+    "mulq %%r10\n"
+    "movq %%rax,%%r8\n"
+    "movq %%rdx,%%r9\n"
+    /* d += a1 * a4 */
+    "movq %%r11,%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* d += (a2*2) * a3 */
+    "leaq (%%r12,%%r12,1),%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* u0 = d & M (%%rsi) */
+    "movq %%rbx,%%rsi\n"
+    "andq %%r15,%%rsi\n"
+    /* d >>= 52 */
+    "shrdq $52,%%rcx,%%rbx\n"
+    "xorq %%rcx,%%rcx\n"
+    /* u0 = (u0 << 4) | tx (%%rsi) */
+    "shlq $4,%%rsi\n"
+    "movq %q3,%%rax\n"
+    "orq %%rax,%%rsi\n"
+    /* c += u0 * (R >> 4) */
+    "movq $0x1000003d1,%%rax\n"
+    "mulq %%rsi\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* r[0] = c & M */
+    "movq %%r8,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq %%rax,0(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* a0 *= 2 */
+    "addq %%r10,%%r10\n"
+    /* c += a0 * a1 */
+    "movq %%r10,%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d += a2 * a4 */
+    "movq %%r12,%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* d += a3 * a3 */
+    "movq %%r13,%%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* c += (d & M) * R */
+    "movq %%rbx,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d >>= 52 */
+    "shrdq $52,%%rcx,%%rbx\n"
+    "xorq %%rcx,%%rcx\n"
+    /* r[1] = c & M */
+    "movq %%r8,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq %%rax,8(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* c += a0 * a2 (last use of %%r10) */
+    "movq %%r10,%%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* fetch t3 (%%r10, overwrites a0),t4 (%%rsi) */
+    "movq %q2,%%rsi\n"
+    "movq %q1,%%r10\n"
+    /* c += a1 * a1 */
+    "movq %%r11,%%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d += a3 * a4 */
+    "movq %%r13,%%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax,%%rbx\n"
+    "adcq %%rdx,%%rcx\n"
+    /* c += (d & M) * R */
+    "movq %%rbx,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* d >>= 52 (%%rbx only) */
+    "shrdq $52,%%rcx,%%rbx\n"
+    /* r[2] = c & M */
+    "movq %%r8,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq %%rax,16(%%rdi)\n"
+    /* c >>= 52 */
+    "shrdq $52,%%r9,%%r8\n"
+    "xorq %%r9,%%r9\n"
+    /* c += t3 */
+    "addq %%r10,%%r8\n"
+    /* c += d * R */
+    "movq %%rbx,%%rax\n"
+    "movq $0x1000003d10,%%rdx\n"
+    "mulq %%rdx\n"
+    "addq %%rax,%%r8\n"
+    "adcq %%rdx,%%r9\n"
+    /* r[3] = c & M */
+    "movq %%r8,%%rax\n"
+    "andq %%r15,%%rax\n"
+    "movq %%rax,24(%%rdi)\n"
+    /* c >>= 52 (%%r8 only) */
+    "shrdq $52,%%r9,%%r8\n"
+    /* c += t4 (%%r8 only) */
+    "addq %%rsi,%%r8\n"
+    /* r[4] = c */
+    "movq %%r8,32(%%rdi)\n"
+: "+S"(a), "=m"(tmp1), "=m"(tmp2), "=m"(tmp3)
+: "D"(r)
+: "%rax", "%rbx", "%rcx", "%rdx", "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15", "cc", "memory"
+);
+}
+
+#endif /* SECP256K1_FIELD_INNER5X52_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_impl.h
new file mode 100644
index 000000000..957c61b01
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_impl.h
@@ -0,0 +1,496 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_REPR_IMPL_H
+#define SECP256K1_FIELD_REPR_IMPL_H
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#include "util.h"
+#include "num.h"
+#include "field.h"
+
+#if defined(USE_ASM_X86_64)
+#include "field_5x52_asm_impl.h"
+#else
+#include "field_5x52_int128_impl.h"
+#endif
+
+/** Implements arithmetic modulo FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFE FFFFFC2F,
+ *  represented as 5 uint64_t's in base 2^52. The values are allowed to contain >52 each. In particular,
+ *  each FieldElem has a 'magnitude' associated with it. Internally, a magnitude M means each element
+ *  is at most M*(2^53-1), except the most significant one, which is limited to M*(2^49-1). All operations
+ *  accept any input with magnitude at most M, and have different rules for propagating magnitude to their
+ *  output.
+ */
+
+#ifdef VERIFY
+static void secp256k1_fe_verify(const secp256k1_fe *a) {
+    const uint64_t *d = a->n;
+    int m = a->normalized ? 1 : 2 * a->magnitude, r = 1;
+   /* secp256k1 'p' value defined in "Standards for Efficient Cryptography" (SEC2) 2.7.1. */
+    r &= (d[0] <= 0xFFFFFFFFFFFFFULL * m);
+    r &= (d[1] <= 0xFFFFFFFFFFFFFULL * m);
+    r &= (d[2] <= 0xFFFFFFFFFFFFFULL * m);
+    r &= (d[3] <= 0xFFFFFFFFFFFFFULL * m);
+    r &= (d[4] <= 0x0FFFFFFFFFFFFULL * m);
+    r &= (a->magnitude >= 0);
+    r &= (a->magnitude <= 2048);
+    if (a->normalized) {
+        r &= (a->magnitude <= 1);
+        if (r && (d[4] == 0x0FFFFFFFFFFFFULL) && ((d[3] & d[2] & d[1]) == 0xFFFFFFFFFFFFFULL)) {
+            r &= (d[0] < 0xFFFFEFFFFFC2FULL);
+        }
+    }
+    VERIFY_CHECK(r == 1);
+}
+#endif
+
+static void secp256k1_fe_normalize(secp256k1_fe *r) {
+    uint64_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4];
+
+    /* Reduce t4 at the start so there will be at most a single carry from the first pass */
+    uint64_t m;
+    uint64_t x = t4 >> 48; t4 &= 0x0FFFFFFFFFFFFULL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x1000003D1ULL;
+    t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL;
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL; m = t1;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL; m &= t2;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL; m &= t3;
+
+    /* ... except for a possible carry at bit 48 of t4 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t4 >> 49 == 0);
+
+    /* At most a single final reduction is needed; check if the value is >= the field characteristic */
+    x = (t4 >> 48) | ((t4 == 0x0FFFFFFFFFFFFULL) & (m == 0xFFFFFFFFFFFFFULL)
+        & (t0 >= 0xFFFFEFFFFFC2FULL));
+
+    /* Apply the final reduction (for constant-time behaviour, we do it always) */
+    t0 += x * 0x1000003D1ULL;
+    t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL;
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL;
+
+    /* If t4 didn't carry to bit 48 already, then it should have after any final reduction */
+    VERIFY_CHECK(t4 >> 48 == x);
+
+    /* Mask off the possible multiple of 2^256 from the final reduction */
+    t4 &= 0x0FFFFFFFFFFFFULL;
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_normalize_weak(secp256k1_fe *r) {
+    uint64_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4];
+
+    /* Reduce t4 at the start so there will be at most a single carry from the first pass */
+    uint64_t x = t4 >> 48; t4 &= 0x0FFFFFFFFFFFFULL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x1000003D1ULL;
+    t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL;
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL;
+
+    /* ... except for a possible carry at bit 48 of t4 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t4 >> 49 == 0);
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_normalize_var(secp256k1_fe *r) {
+    uint64_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4];
+
+    /* Reduce t4 at the start so there will be at most a single carry from the first pass */
+    uint64_t m;
+    uint64_t x = t4 >> 48; t4 &= 0x0FFFFFFFFFFFFULL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x1000003D1ULL;
+    t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL;
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL; m = t1;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL; m &= t2;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL; m &= t3;
+
+    /* ... except for a possible carry at bit 48 of t4 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t4 >> 49 == 0);
+
+    /* At most a single final reduction is needed; check if the value is >= the field characteristic */
+    x = (t4 >> 48) | ((t4 == 0x0FFFFFFFFFFFFULL) & (m == 0xFFFFFFFFFFFFFULL)
+        & (t0 >= 0xFFFFEFFFFFC2FULL));
+
+    if (x) {
+        t0 += 0x1000003D1ULL;
+        t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL;
+        t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL;
+        t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL;
+        t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL;
+
+        /* If t4 didn't carry to bit 48 already, then it should have after any final reduction */
+        VERIFY_CHECK(t4 >> 48 == x);
+
+        /* Mask off the possible multiple of 2^256 from the final reduction */
+        t4 &= 0x0FFFFFFFFFFFFULL;
+    }
+
+    r->n[0] = t0; r->n[1] = t1; r->n[2] = t2; r->n[3] = t3; r->n[4] = t4;
+
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static int secp256k1_fe_normalizes_to_zero(secp256k1_fe *r) {
+    uint64_t t0 = r->n[0], t1 = r->n[1], t2 = r->n[2], t3 = r->n[3], t4 = r->n[4];
+
+    /* z0 tracks a possible raw value of 0, z1 tracks a possible raw value of P */
+    uint64_t z0, z1;
+
+    /* Reduce t4 at the start so there will be at most a single carry from the first pass */
+    uint64_t x = t4 >> 48; t4 &= 0x0FFFFFFFFFFFFULL;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x1000003D1ULL;
+    t1 += (t0 >> 52); t0 &= 0xFFFFFFFFFFFFFULL; z0  = t0; z1  = t0 ^ 0x1000003D0ULL;
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL; z0 |= t1; z1 &= t1;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL; z0 |= t2; z1 &= t2;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL; z0 |= t3; z1 &= t3;
+                                                z0 |= t4; z1 &= t4 ^ 0xF000000000000ULL;
+
+    /* ... except for a possible carry at bit 48 of t4 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t4 >> 49 == 0);
+
+    return (z0 == 0) | (z1 == 0xFFFFFFFFFFFFFULL);
+}
+
+static int secp256k1_fe_normalizes_to_zero_var(secp256k1_fe *r) {
+    uint64_t t0, t1, t2, t3, t4;
+    uint64_t z0, z1;
+    uint64_t x;
+
+    t0 = r->n[0];
+    t4 = r->n[4];
+
+    /* Reduce t4 at the start so there will be at most a single carry from the first pass */
+    x = t4 >> 48;
+
+    /* The first pass ensures the magnitude is 1, ... */
+    t0 += x * 0x1000003D1ULL;
+
+    /* z0 tracks a possible raw value of 0, z1 tracks a possible raw value of P */
+    z0 = t0 & 0xFFFFFFFFFFFFFULL;
+    z1 = z0 ^ 0x1000003D0ULL;
+
+    /* Fast return path should catch the majority of cases */
+    if ((z0 != 0ULL) & (z1 != 0xFFFFFFFFFFFFFULL)) {
+        return 0;
+    }
+
+    t1 = r->n[1];
+    t2 = r->n[2];
+    t3 = r->n[3];
+
+    t4 &= 0x0FFFFFFFFFFFFULL;
+
+    t1 += (t0 >> 52);
+    t2 += (t1 >> 52); t1 &= 0xFFFFFFFFFFFFFULL; z0 |= t1; z1 &= t1;
+    t3 += (t2 >> 52); t2 &= 0xFFFFFFFFFFFFFULL; z0 |= t2; z1 &= t2;
+    t4 += (t3 >> 52); t3 &= 0xFFFFFFFFFFFFFULL; z0 |= t3; z1 &= t3;
+                                                z0 |= t4; z1 &= t4 ^ 0xF000000000000ULL;
+
+    /* ... except for a possible carry at bit 48 of t4 (i.e. bit 256 of the field element) */
+    VERIFY_CHECK(t4 >> 49 == 0);
+
+    return (z0 == 0) | (z1 == 0xFFFFFFFFFFFFFULL);
+}
+
+SECP256K1_INLINE static void secp256k1_fe_set_int(secp256k1_fe *r, int a) {
+    r->n[0] = a;
+    r->n[1] = r->n[2] = r->n[3] = r->n[4] = 0;
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static int secp256k1_fe_is_zero(const secp256k1_fe *a) {
+    const uint64_t *t = a->n;
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    return (t[0] | t[1] | t[2] | t[3] | t[4]) == 0;
+}
+
+SECP256K1_INLINE static int secp256k1_fe_is_odd(const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    return a->n[0] & 1;
+}
+
+SECP256K1_INLINE static void secp256k1_fe_clear(secp256k1_fe *a) {
+    int i;
+#ifdef VERIFY
+    a->magnitude = 0;
+    a->normalized = 1;
+#endif
+    for (i=0; i<5; i++) {
+        a->n[i] = 0;
+    }
+}
+
+static int secp256k1_fe_cmp_var(const secp256k1_fe *a, const secp256k1_fe *b) {
+    int i;
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    VERIFY_CHECK(b->normalized);
+    secp256k1_fe_verify(a);
+    secp256k1_fe_verify(b);
+#endif
+    for (i = 4; i >= 0; i--) {
+        if (a->n[i] > b->n[i]) {
+            return 1;
+        }
+        if (a->n[i] < b->n[i]) {
+            return -1;
+        }
+    }
+    return 0;
+}
+
+static int secp256k1_fe_set_b32(secp256k1_fe *r, const unsigned char *a) {
+    r->n[0] = (uint64_t)a[31]
+            | ((uint64_t)a[30] << 8)
+            | ((uint64_t)a[29] << 16)
+            | ((uint64_t)a[28] << 24)
+            | ((uint64_t)a[27] << 32)
+            | ((uint64_t)a[26] << 40)
+            | ((uint64_t)(a[25] & 0xF)  << 48);
+    r->n[1] = (uint64_t)((a[25] >> 4) & 0xF)
+            | ((uint64_t)a[24] << 4)
+            | ((uint64_t)a[23] << 12)
+            | ((uint64_t)a[22] << 20)
+            | ((uint64_t)a[21] << 28)
+            | ((uint64_t)a[20] << 36)
+            | ((uint64_t)a[19] << 44);
+    r->n[2] = (uint64_t)a[18]
+            | ((uint64_t)a[17] << 8)
+            | ((uint64_t)a[16] << 16)
+            | ((uint64_t)a[15] << 24)
+            | ((uint64_t)a[14] << 32)
+            | ((uint64_t)a[13] << 40)
+            | ((uint64_t)(a[12] & 0xF) << 48);
+    r->n[3] = (uint64_t)((a[12] >> 4) & 0xF)
+            | ((uint64_t)a[11] << 4)
+            | ((uint64_t)a[10] << 12)
+            | ((uint64_t)a[9]  << 20)
+            | ((uint64_t)a[8]  << 28)
+            | ((uint64_t)a[7]  << 36)
+            | ((uint64_t)a[6]  << 44);
+    r->n[4] = (uint64_t)a[5]
+            | ((uint64_t)a[4] << 8)
+            | ((uint64_t)a[3] << 16)
+            | ((uint64_t)a[2] << 24)
+            | ((uint64_t)a[1] << 32)
+            | ((uint64_t)a[0] << 40);
+    if (r->n[4] == 0x0FFFFFFFFFFFFULL && (r->n[3] & r->n[2] & r->n[1]) == 0xFFFFFFFFFFFFFULL && r->n[0] >= 0xFFFFEFFFFFC2FULL) {
+        return 0;
+    }
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+    secp256k1_fe_verify(r);
+#endif
+    return 1;
+}
+
+/** Convert a field element to a 32-byte big endian value. Requires the input to be normalized */
+static void secp256k1_fe_get_b32(unsigned char *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+    secp256k1_fe_verify(a);
+#endif
+    r[0] = (a->n[4] >> 40) & 0xFF;
+    r[1] = (a->n[4] >> 32) & 0xFF;
+    r[2] = (a->n[4] >> 24) & 0xFF;
+    r[3] = (a->n[4] >> 16) & 0xFF;
+    r[4] = (a->n[4] >> 8) & 0xFF;
+    r[5] = a->n[4] & 0xFF;
+    r[6] = (a->n[3] >> 44) & 0xFF;
+    r[7] = (a->n[3] >> 36) & 0xFF;
+    r[8] = (a->n[3] >> 28) & 0xFF;
+    r[9] = (a->n[3] >> 20) & 0xFF;
+    r[10] = (a->n[3] >> 12) & 0xFF;
+    r[11] = (a->n[3] >> 4) & 0xFF;
+    r[12] = ((a->n[2] >> 48) & 0xF) | ((a->n[3] & 0xF) << 4);
+    r[13] = (a->n[2] >> 40) & 0xFF;
+    r[14] = (a->n[2] >> 32) & 0xFF;
+    r[15] = (a->n[2] >> 24) & 0xFF;
+    r[16] = (a->n[2] >> 16) & 0xFF;
+    r[17] = (a->n[2] >> 8) & 0xFF;
+    r[18] = a->n[2] & 0xFF;
+    r[19] = (a->n[1] >> 44) & 0xFF;
+    r[20] = (a->n[1] >> 36) & 0xFF;
+    r[21] = (a->n[1] >> 28) & 0xFF;
+    r[22] = (a->n[1] >> 20) & 0xFF;
+    r[23] = (a->n[1] >> 12) & 0xFF;
+    r[24] = (a->n[1] >> 4) & 0xFF;
+    r[25] = ((a->n[0] >> 48) & 0xF) | ((a->n[1] & 0xF) << 4);
+    r[26] = (a->n[0] >> 40) & 0xFF;
+    r[27] = (a->n[0] >> 32) & 0xFF;
+    r[28] = (a->n[0] >> 24) & 0xFF;
+    r[29] = (a->n[0] >> 16) & 0xFF;
+    r[30] = (a->n[0] >> 8) & 0xFF;
+    r[31] = a->n[0] & 0xFF;
+}
+
+SECP256K1_INLINE static void secp256k1_fe_negate(secp256k1_fe *r, const secp256k1_fe *a, int m) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= m);
+    secp256k1_fe_verify(a);
+#endif
+    r->n[0] = 0xFFFFEFFFFFC2FULL * 2 * (m + 1) - a->n[0];
+    r->n[1] = 0xFFFFFFFFFFFFFULL * 2 * (m + 1) - a->n[1];
+    r->n[2] = 0xFFFFFFFFFFFFFULL * 2 * (m + 1) - a->n[2];
+    r->n[3] = 0xFFFFFFFFFFFFFULL * 2 * (m + 1) - a->n[3];
+    r->n[4] = 0x0FFFFFFFFFFFFULL * 2 * (m + 1) - a->n[4];
+#ifdef VERIFY
+    r->magnitude = m + 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static void secp256k1_fe_mul_int(secp256k1_fe *r, int a) {
+    r->n[0] *= a;
+    r->n[1] *= a;
+    r->n[2] *= a;
+    r->n[3] *= a;
+    r->n[4] *= a;
+#ifdef VERIFY
+    r->magnitude *= a;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+SECP256K1_INLINE static void secp256k1_fe_add(secp256k1_fe *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    secp256k1_fe_verify(a);
+#endif
+    r->n[0] += a->n[0];
+    r->n[1] += a->n[1];
+    r->n[2] += a->n[2];
+    r->n[3] += a->n[3];
+    r->n[4] += a->n[4];
+#ifdef VERIFY
+    r->magnitude += a->magnitude;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_mul(secp256k1_fe *r, const secp256k1_fe *a, const secp256k1_fe * SECP256K1_RESTRICT b) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= 8);
+    VERIFY_CHECK(b->magnitude <= 8);
+    secp256k1_fe_verify(a);
+    secp256k1_fe_verify(b);
+    VERIFY_CHECK(r != b);
+#endif
+    secp256k1_fe_mul_inner(r->n, a->n, b->n);
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static void secp256k1_fe_sqr(secp256k1_fe *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->magnitude <= 8);
+    secp256k1_fe_verify(a);
+#endif
+    secp256k1_fe_sqr_inner(r->n, a->n);
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 0;
+    secp256k1_fe_verify(r);
+#endif
+}
+
+static SECP256K1_INLINE void secp256k1_fe_cmov(secp256k1_fe *r, const secp256k1_fe *a, int flag) {
+    uint64_t mask0, mask1;
+    mask0 = flag + ~((uint64_t)0);
+    mask1 = ~mask0;
+    r->n[0] = (r->n[0] & mask0) | (a->n[0] & mask1);
+    r->n[1] = (r->n[1] & mask0) | (a->n[1] & mask1);
+    r->n[2] = (r->n[2] & mask0) | (a->n[2] & mask1);
+    r->n[3] = (r->n[3] & mask0) | (a->n[3] & mask1);
+    r->n[4] = (r->n[4] & mask0) | (a->n[4] & mask1);
+#ifdef VERIFY
+    if (a->magnitude > r->magnitude) {
+        r->magnitude = a->magnitude;
+    }
+    r->normalized &= a->normalized;
+#endif
+}
+
+static SECP256K1_INLINE void secp256k1_fe_storage_cmov(secp256k1_fe_storage *r, const secp256k1_fe_storage *a, int flag) {
+    uint64_t mask0, mask1;
+    mask0 = flag + ~((uint64_t)0);
+    mask1 = ~mask0;
+    r->n[0] = (r->n[0] & mask0) | (a->n[0] & mask1);
+    r->n[1] = (r->n[1] & mask0) | (a->n[1] & mask1);
+    r->n[2] = (r->n[2] & mask0) | (a->n[2] & mask1);
+    r->n[3] = (r->n[3] & mask0) | (a->n[3] & mask1);
+}
+
+static void secp256k1_fe_to_storage(secp256k1_fe_storage *r, const secp256k1_fe *a) {
+#ifdef VERIFY
+    VERIFY_CHECK(a->normalized);
+#endif
+    r->n[0] = a->n[0] | a->n[1] << 52;
+    r->n[1] = a->n[1] >> 12 | a->n[2] << 40;
+    r->n[2] = a->n[2] >> 24 | a->n[3] << 28;
+    r->n[3] = a->n[3] >> 36 | a->n[4] << 16;
+}
+
+static SECP256K1_INLINE void secp256k1_fe_from_storage(secp256k1_fe *r, const secp256k1_fe_storage *a) {
+    r->n[0] = a->n[0] & 0xFFFFFFFFFFFFFULL;
+    r->n[1] = a->n[0] >> 52 | ((a->n[1] << 12) & 0xFFFFFFFFFFFFFULL);
+    r->n[2] = a->n[1] >> 40 | ((a->n[2] << 24) & 0xFFFFFFFFFFFFFULL);
+    r->n[3] = a->n[2] >> 28 | ((a->n[3] << 36) & 0xFFFFFFFFFFFFFULL);
+    r->n[4] = a->n[3] >> 16;
+#ifdef VERIFY
+    r->magnitude = 1;
+    r->normalized = 1;
+#endif
+}
+
+#endif /* SECP256K1_FIELD_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_int128_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_int128_impl.h
new file mode 100644
index 000000000..95a0d1791
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_5x52_int128_impl.h
@@ -0,0 +1,277 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_INNER5X52_IMPL_H
+#define SECP256K1_FIELD_INNER5X52_IMPL_H
+
+#include <stdint.h>
+
+#ifdef VERIFY
+#define VERIFY_BITS(x, n) VERIFY_CHECK(((x) >> (n)) == 0)
+#else
+#define VERIFY_BITS(x, n) do { } while(0)
+#endif
+
+SECP256K1_INLINE static void secp256k1_fe_mul_inner(uint64_t *r, const uint64_t *a, const uint64_t * SECP256K1_RESTRICT b) {
+    uint128_t c, d;
+    uint64_t t3, t4, tx, u0;
+    uint64_t a0 = a[0], a1 = a[1], a2 = a[2], a3 = a[3], a4 = a[4];
+    const uint64_t M = 0xFFFFFFFFFFFFFULL, R = 0x1000003D10ULL;
+
+    VERIFY_BITS(a[0], 56);
+    VERIFY_BITS(a[1], 56);
+    VERIFY_BITS(a[2], 56);
+    VERIFY_BITS(a[3], 56);
+    VERIFY_BITS(a[4], 52);
+    VERIFY_BITS(b[0], 56);
+    VERIFY_BITS(b[1], 56);
+    VERIFY_BITS(b[2], 56);
+    VERIFY_BITS(b[3], 56);
+    VERIFY_BITS(b[4], 52);
+    VERIFY_CHECK(r != b);
+
+    /*  [... a b c] is a shorthand for ... + a<<104 + b<<52 + c<<0 mod n.
+     *  px is a shorthand for sum(a[i]*b[x-i], i=0..x).
+     *  Note that [x 0 0 0 0 0] = [x*R].
+     */
+
+    d  = (uint128_t)a0 * b[3]
+       + (uint128_t)a1 * b[2]
+       + (uint128_t)a2 * b[1]
+       + (uint128_t)a3 * b[0];
+    VERIFY_BITS(d, 114);
+    /* [d 0 0 0] = [p3 0 0 0] */
+    c  = (uint128_t)a4 * b[4];
+    VERIFY_BITS(c, 112);
+    /* [c 0 0 0 0 d 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+    d += (c & M) * R; c >>= 52;
+    VERIFY_BITS(d, 115);
+    VERIFY_BITS(c, 60);
+    /* [c 0 0 0 0 0 d 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+    t3 = d & M; d >>= 52;
+    VERIFY_BITS(t3, 52);
+    VERIFY_BITS(d, 63);
+    /* [c 0 0 0 0 d t3 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+
+    d += (uint128_t)a0 * b[4]
+       + (uint128_t)a1 * b[3]
+       + (uint128_t)a2 * b[2]
+       + (uint128_t)a3 * b[1]
+       + (uint128_t)a4 * b[0];
+    VERIFY_BITS(d, 115);
+    /* [c 0 0 0 0 d t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    d += c * R;
+    VERIFY_BITS(d, 116);
+    /* [d t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    t4 = d & M; d >>= 52;
+    VERIFY_BITS(t4, 52);
+    VERIFY_BITS(d, 64);
+    /* [d t4 t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    tx = (t4 >> 48); t4 &= (M >> 4);
+    VERIFY_BITS(tx, 4);
+    VERIFY_BITS(t4, 48);
+    /* [d t4+(tx<<48) t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+
+    c  = (uint128_t)a0 * b[0];
+    VERIFY_BITS(c, 112);
+    /* [d t4+(tx<<48) t3 0 0 c] = [p8 0 0 0 p4 p3 0 0 p0] */
+    d += (uint128_t)a1 * b[4]
+       + (uint128_t)a2 * b[3]
+       + (uint128_t)a3 * b[2]
+       + (uint128_t)a4 * b[1];
+    VERIFY_BITS(d, 115);
+    /* [d t4+(tx<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    u0 = d & M; d >>= 52;
+    VERIFY_BITS(u0, 52);
+    VERIFY_BITS(d, 63);
+    /* [d u0 t4+(tx<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    /* [d 0 t4+(tx<<48)+(u0<<52) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    u0 = (u0 << 4) | tx;
+    VERIFY_BITS(u0, 56);
+    /* [d 0 t4+(u0<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    c += (uint128_t)u0 * (R >> 4);
+    VERIFY_BITS(c, 115);
+    /* [d 0 t4 t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    r[0] = c & M; c >>= 52;
+    VERIFY_BITS(r[0], 52);
+    VERIFY_BITS(c, 61);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 0 p5 p4 p3 0 0 p0] */
+
+    c += (uint128_t)a0 * b[1]
+       + (uint128_t)a1 * b[0];
+    VERIFY_BITS(c, 114);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 0 p5 p4 p3 0 p1 p0] */
+    d += (uint128_t)a2 * b[4]
+       + (uint128_t)a3 * b[3]
+       + (uint128_t)a4 * b[2];
+    VERIFY_BITS(d, 114);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+    c += (d & M) * R; d >>= 52;
+    VERIFY_BITS(c, 115);
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 t4 t3 0 c r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+    r[1] = c & M; c >>= 52;
+    VERIFY_BITS(r[1], 52);
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 t4 t3 c r1 r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+
+    c += (uint128_t)a0 * b[2]
+       + (uint128_t)a1 * b[1]
+       + (uint128_t)a2 * b[0];
+    VERIFY_BITS(c, 114);
+    /* [d 0 0 t4 t3 c r1 r0] = [p8 0 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint128_t)a3 * b[4]
+       + (uint128_t)a4 * b[3];
+    VERIFY_BITS(d, 114);
+    /* [d 0 0 t4 t3 c t1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c += (d & M) * R; d >>= 52;
+    VERIFY_BITS(c, 115);
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 t4 t3 c r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    /* [d 0 0 0 t4 t3 c r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[2] = c & M; c >>= 52;
+    VERIFY_BITS(r[2], 52);
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 t4 t3+c r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c   += d * R + t3;
+    VERIFY_BITS(c, 100);
+    /* [t4 c r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[3] = c & M; c >>= 52;
+    VERIFY_BITS(r[3], 52);
+    VERIFY_BITS(c, 48);
+    /* [t4+c r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c   += t4;
+    VERIFY_BITS(c, 49);
+    /* [c r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[4] = c;
+    VERIFY_BITS(r[4], 49);
+    /* [r4 r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+}
+
+SECP256K1_INLINE static void secp256k1_fe_sqr_inner(uint64_t *r, const uint64_t *a) {
+    uint128_t c, d;
+    uint64_t a0 = a[0], a1 = a[1], a2 = a[2], a3 = a[3], a4 = a[4];
+    int64_t t3, t4, tx, u0;
+    const uint64_t M = 0xFFFFFFFFFFFFFULL, R = 0x1000003D10ULL;
+
+    VERIFY_BITS(a[0], 56);
+    VERIFY_BITS(a[1], 56);
+    VERIFY_BITS(a[2], 56);
+    VERIFY_BITS(a[3], 56);
+    VERIFY_BITS(a[4], 52);
+
+    /**  [... a b c] is a shorthand for ... + a<<104 + b<<52 + c<<0 mod n.
+     *  px is a shorthand for sum(a[i]*a[x-i], i=0..x).
+     *  Note that [x 0 0 0 0 0] = [x*R].
+     */
+
+    d  = (uint128_t)(a0*2) * a3
+       + (uint128_t)(a1*2) * a2;
+    VERIFY_BITS(d, 114);
+    /* [d 0 0 0] = [p3 0 0 0] */
+    c  = (uint128_t)a4 * a4;
+    VERIFY_BITS(c, 112);
+    /* [c 0 0 0 0 d 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+    d += (c & M) * R; c >>= 52;
+    VERIFY_BITS(d, 115);
+    VERIFY_BITS(c, 60);
+    /* [c 0 0 0 0 0 d 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+    t3 = d & M; d >>= 52;
+    VERIFY_BITS(t3, 52);
+    VERIFY_BITS(d, 63);
+    /* [c 0 0 0 0 d t3 0 0 0] = [p8 0 0 0 0 p3 0 0 0] */
+
+    a4 *= 2;
+    d += (uint128_t)a0 * a4
+       + (uint128_t)(a1*2) * a3
+       + (uint128_t)a2 * a2;
+    VERIFY_BITS(d, 115);
+    /* [c 0 0 0 0 d t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    d += c * R;
+    VERIFY_BITS(d, 116);
+    /* [d t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    t4 = d & M; d >>= 52;
+    VERIFY_BITS(t4, 52);
+    VERIFY_BITS(d, 64);
+    /* [d t4 t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+    tx = (t4 >> 48); t4 &= (M >> 4);
+    VERIFY_BITS(tx, 4);
+    VERIFY_BITS(t4, 48);
+    /* [d t4+(tx<<48) t3 0 0 0] = [p8 0 0 0 p4 p3 0 0 0] */
+
+    c  = (uint128_t)a0 * a0;
+    VERIFY_BITS(c, 112);
+    /* [d t4+(tx<<48) t3 0 0 c] = [p8 0 0 0 p4 p3 0 0 p0] */
+    d += (uint128_t)a1 * a4
+       + (uint128_t)(a2*2) * a3;
+    VERIFY_BITS(d, 114);
+    /* [d t4+(tx<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    u0 = d & M; d >>= 52;
+    VERIFY_BITS(u0, 52);
+    VERIFY_BITS(d, 62);
+    /* [d u0 t4+(tx<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    /* [d 0 t4+(tx<<48)+(u0<<52) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    u0 = (u0 << 4) | tx;
+    VERIFY_BITS(u0, 56);
+    /* [d 0 t4+(u0<<48) t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    c += (uint128_t)u0 * (R >> 4);
+    VERIFY_BITS(c, 113);
+    /* [d 0 t4 t3 0 0 c] = [p8 0 0 p5 p4 p3 0 0 p0] */
+    r[0] = c & M; c >>= 52;
+    VERIFY_BITS(r[0], 52);
+    VERIFY_BITS(c, 61);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 0 p5 p4 p3 0 0 p0] */
+
+    a0 *= 2;
+    c += (uint128_t)a0 * a1;
+    VERIFY_BITS(c, 114);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 0 p5 p4 p3 0 p1 p0] */
+    d += (uint128_t)a2 * a4
+       + (uint128_t)a3 * a3;
+    VERIFY_BITS(d, 114);
+    /* [d 0 t4 t3 0 c r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+    c += (d & M) * R; d >>= 52;
+    VERIFY_BITS(c, 115);
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 t4 t3 0 c r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+    r[1] = c & M; c >>= 52;
+    VERIFY_BITS(r[1], 52);
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 t4 t3 c r1 r0] = [p8 0 p6 p5 p4 p3 0 p1 p0] */
+
+    c += (uint128_t)a0 * a2
+       + (uint128_t)a1 * a1;
+    VERIFY_BITS(c, 114);
+    /* [d 0 0 t4 t3 c r1 r0] = [p8 0 p6 p5 p4 p3 p2 p1 p0] */
+    d += (uint128_t)a3 * a4;
+    VERIFY_BITS(d, 114);
+    /* [d 0 0 t4 t3 c r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c += (d & M) * R; d >>= 52;
+    VERIFY_BITS(c, 115);
+    VERIFY_BITS(d, 62);
+    /* [d 0 0 0 t4 t3 c r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[2] = c & M; c >>= 52;
+    VERIFY_BITS(r[2], 52);
+    VERIFY_BITS(c, 63);
+    /* [d 0 0 0 t4 t3+c r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+
+    c   += d * R + t3;
+    VERIFY_BITS(c, 100);
+    /* [t4 c r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[3] = c & M; c >>= 52;
+    VERIFY_BITS(r[3], 52);
+    VERIFY_BITS(c, 48);
+    /* [t4+c r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    c   += t4;
+    VERIFY_BITS(c, 49);
+    /* [c r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+    r[4] = c;
+    VERIFY_BITS(r[4], 49);
+    /* [r4 r3 r2 r1 r0] = [p8 p7 p6 p5 p4 p3 p2 p1 p0] */
+}
+
+#endif /* SECP256K1_FIELD_INNER5X52_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_impl.h
new file mode 100644
index 000000000..20428648a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/field_impl.h
@@ -0,0 +1,315 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_FIELD_IMPL_H
+#define SECP256K1_FIELD_IMPL_H
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#include "util.h"
+
+#if defined(USE_FIELD_10X26)
+#include "field_10x26_impl.h"
+#elif defined(USE_FIELD_5X52)
+#include "field_5x52_impl.h"
+#else
+#error "Please select field implementation"
+#endif
+
+SECP256K1_INLINE static int secp256k1_fe_equal(const secp256k1_fe *a, const secp256k1_fe *b) {
+    secp256k1_fe na;
+    secp256k1_fe_negate(&na, a, 1);
+    secp256k1_fe_add(&na, b);
+    return secp256k1_fe_normalizes_to_zero(&na);
+}
+
+SECP256K1_INLINE static int secp256k1_fe_equal_var(const secp256k1_fe *a, const secp256k1_fe *b) {
+    secp256k1_fe na;
+    secp256k1_fe_negate(&na, a, 1);
+    secp256k1_fe_add(&na, b);
+    return secp256k1_fe_normalizes_to_zero_var(&na);
+}
+
+static int secp256k1_fe_sqrt(secp256k1_fe *r, const secp256k1_fe *a) {
+    /** Given that p is congruent to 3 mod 4, we can compute the square root of
+     *  a mod p as the (p+1)/4'th power of a.
+     *
+     *  As (p+1)/4 is an even number, it will have the same result for a and for
+     *  (-a). Only one of these two numbers actually has a square root however,
+     *  so we test at the end by squaring and comparing to the input.
+     *  Also because (p+1)/4 is an even number, the computed square root is
+     *  itself always a square (a ** ((p+1)/4) is the square of a ** ((p+1)/8)).
+     */
+    secp256k1_fe x2, x3, x6, x9, x11, x22, x44, x88, x176, x220, x223, t1;
+    int j;
+
+    /** The binary representation of (p + 1)/4 has 3 blocks of 1s, with lengths in
+     *  { 2, 22, 223 }. Use an addition chain to calculate 2^n - 1 for each block:
+     *  1, [2], 3, 6, 9, 11, [22], 44, 88, 176, 220, [223]
+     */
+
+    secp256k1_fe_sqr(&x2, a);
+    secp256k1_fe_mul(&x2, &x2, a);
+
+    secp256k1_fe_sqr(&x3, &x2);
+    secp256k1_fe_mul(&x3, &x3, a);
+
+    x6 = x3;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x6, &x6);
+    }
+    secp256k1_fe_mul(&x6, &x6, &x3);
+
+    x9 = x6;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x9, &x9);
+    }
+    secp256k1_fe_mul(&x9, &x9, &x3);
+
+    x11 = x9;
+    for (j=0; j<2; j++) {
+        secp256k1_fe_sqr(&x11, &x11);
+    }
+    secp256k1_fe_mul(&x11, &x11, &x2);
+
+    x22 = x11;
+    for (j=0; j<11; j++) {
+        secp256k1_fe_sqr(&x22, &x22);
+    }
+    secp256k1_fe_mul(&x22, &x22, &x11);
+
+    x44 = x22;
+    for (j=0; j<22; j++) {
+        secp256k1_fe_sqr(&x44, &x44);
+    }
+    secp256k1_fe_mul(&x44, &x44, &x22);
+
+    x88 = x44;
+    for (j=0; j<44; j++) {
+        secp256k1_fe_sqr(&x88, &x88);
+    }
+    secp256k1_fe_mul(&x88, &x88, &x44);
+
+    x176 = x88;
+    for (j=0; j<88; j++) {
+        secp256k1_fe_sqr(&x176, &x176);
+    }
+    secp256k1_fe_mul(&x176, &x176, &x88);
+
+    x220 = x176;
+    for (j=0; j<44; j++) {
+        secp256k1_fe_sqr(&x220, &x220);
+    }
+    secp256k1_fe_mul(&x220, &x220, &x44);
+
+    x223 = x220;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x223, &x223);
+    }
+    secp256k1_fe_mul(&x223, &x223, &x3);
+
+    /* The final result is then assembled using a sliding window over the blocks. */
+
+    t1 = x223;
+    for (j=0; j<23; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(&t1, &t1, &x22);
+    for (j=0; j<6; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(&t1, &t1, &x2);
+    secp256k1_fe_sqr(&t1, &t1);
+    secp256k1_fe_sqr(r, &t1);
+
+    /* Check that a square root was actually calculated */
+
+    secp256k1_fe_sqr(&t1, r);
+    return secp256k1_fe_equal(&t1, a);
+}
+
+static void secp256k1_fe_inv(secp256k1_fe *r, const secp256k1_fe *a) {
+    secp256k1_fe x2, x3, x6, x9, x11, x22, x44, x88, x176, x220, x223, t1;
+    int j;
+
+    /** The binary representation of (p - 2) has 5 blocks of 1s, with lengths in
+     *  { 1, 2, 22, 223 }. Use an addition chain to calculate 2^n - 1 for each block:
+     *  [1], [2], 3, 6, 9, 11, [22], 44, 88, 176, 220, [223]
+     */
+
+    secp256k1_fe_sqr(&x2, a);
+    secp256k1_fe_mul(&x2, &x2, a);
+
+    secp256k1_fe_sqr(&x3, &x2);
+    secp256k1_fe_mul(&x3, &x3, a);
+
+    x6 = x3;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x6, &x6);
+    }
+    secp256k1_fe_mul(&x6, &x6, &x3);
+
+    x9 = x6;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x9, &x9);
+    }
+    secp256k1_fe_mul(&x9, &x9, &x3);
+
+    x11 = x9;
+    for (j=0; j<2; j++) {
+        secp256k1_fe_sqr(&x11, &x11);
+    }
+    secp256k1_fe_mul(&x11, &x11, &x2);
+
+    x22 = x11;
+    for (j=0; j<11; j++) {
+        secp256k1_fe_sqr(&x22, &x22);
+    }
+    secp256k1_fe_mul(&x22, &x22, &x11);
+
+    x44 = x22;
+    for (j=0; j<22; j++) {
+        secp256k1_fe_sqr(&x44, &x44);
+    }
+    secp256k1_fe_mul(&x44, &x44, &x22);
+
+    x88 = x44;
+    for (j=0; j<44; j++) {
+        secp256k1_fe_sqr(&x88, &x88);
+    }
+    secp256k1_fe_mul(&x88, &x88, &x44);
+
+    x176 = x88;
+    for (j=0; j<88; j++) {
+        secp256k1_fe_sqr(&x176, &x176);
+    }
+    secp256k1_fe_mul(&x176, &x176, &x88);
+
+    x220 = x176;
+    for (j=0; j<44; j++) {
+        secp256k1_fe_sqr(&x220, &x220);
+    }
+    secp256k1_fe_mul(&x220, &x220, &x44);
+
+    x223 = x220;
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&x223, &x223);
+    }
+    secp256k1_fe_mul(&x223, &x223, &x3);
+
+    /* The final result is then assembled using a sliding window over the blocks. */
+
+    t1 = x223;
+    for (j=0; j<23; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(&t1, &t1, &x22);
+    for (j=0; j<5; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(&t1, &t1, a);
+    for (j=0; j<3; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(&t1, &t1, &x2);
+    for (j=0; j<2; j++) {
+        secp256k1_fe_sqr(&t1, &t1);
+    }
+    secp256k1_fe_mul(r, a, &t1);
+}
+
+static void secp256k1_fe_inv_var(secp256k1_fe *r, const secp256k1_fe *a) {
+#if defined(USE_FIELD_INV_BUILTIN)
+    secp256k1_fe_inv(r, a);
+#elif defined(USE_FIELD_INV_NUM)
+    secp256k1_num n, m;
+    static const secp256k1_fe negone = SECP256K1_FE_CONST(
+        0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFFUL,
+        0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFEUL, 0xFFFFFC2EUL
+    );
+    /* secp256k1 field prime, value p defined in "Standards for Efficient Cryptography" (SEC2) 2.7.1. */
+    static const unsigned char prime[32] = {
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFE,0xFF,0xFF,0xFC,0x2F
+    };
+    unsigned char b[32];
+    int res;
+    secp256k1_fe c = *a;
+    secp256k1_fe_normalize_var(&c);
+    secp256k1_fe_get_b32(b, &c);
+    secp256k1_num_set_bin(&n, b, 32);
+    secp256k1_num_set_bin(&m, prime, 32);
+    secp256k1_num_mod_inverse(&n, &n, &m);
+    secp256k1_num_get_bin(b, 32, &n);
+    res = secp256k1_fe_set_b32(r, b);
+    (void)res;
+    VERIFY_CHECK(res);
+    /* Verify the result is the (unique) valid inverse using non-GMP code. */
+    secp256k1_fe_mul(&c, &c, r);
+    secp256k1_fe_add(&c, &negone);
+    CHECK(secp256k1_fe_normalizes_to_zero_var(&c));
+#else
+#error "Please select field inverse implementation"
+#endif
+}
+
+static void secp256k1_fe_inv_all_var(secp256k1_fe *r, const secp256k1_fe *a, size_t len) {
+    secp256k1_fe u;
+    size_t i;
+    if (len < 1) {
+        return;
+    }
+
+    VERIFY_CHECK((r + len <= a) || (a + len <= r));
+
+    r[0] = a[0];
+
+    i = 0;
+    while (++i < len) {
+        secp256k1_fe_mul(&r[i], &r[i - 1], &a[i]);
+    }
+
+    secp256k1_fe_inv_var(&u, &r[--i]);
+
+    while (i > 0) {
+        size_t j = i--;
+        secp256k1_fe_mul(&r[j], &r[i], &u);
+        secp256k1_fe_mul(&u, &u, &a[j]);
+    }
+
+    r[0] = u;
+}
+
+static int secp256k1_fe_is_quad_var(const secp256k1_fe *a) {
+#ifndef USE_NUM_NONE
+    unsigned char b[32];
+    secp256k1_num n;
+    secp256k1_num m;
+    /* secp256k1 field prime, value p defined in "Standards for Efficient Cryptography" (SEC2) 2.7.1. */
+    static const unsigned char prime[32] = {
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFE,0xFF,0xFF,0xFC,0x2F
+    };
+
+    secp256k1_fe c = *a;
+    secp256k1_fe_normalize_var(&c);
+    secp256k1_fe_get_b32(b, &c);
+    secp256k1_num_set_bin(&n, b, 32);
+    secp256k1_num_set_bin(&m, prime, 32);
+    return secp256k1_num_jacobi(&n, &m) >= 0;
+#else
+    secp256k1_fe r;
+    return secp256k1_fe_sqrt(&r, a);
+#endif
+}
+
+#endif /* SECP256K1_FIELD_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group.h
new file mode 100644
index 000000000..3947ea2dd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group.h
@@ -0,0 +1,147 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_GROUP_H
+#define SECP256K1_GROUP_H
+
+#include "num.h"
+#include "field.h"
+
+/** A group element of the secp256k1 curve, in affine coordinates. */
+typedef struct {
+    secp256k1_fe x;
+    secp256k1_fe y;
+    int infinity; /* whether this represents the point at infinity */
+} secp256k1_ge;
+
+#define SECP256K1_GE_CONST(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) {SECP256K1_FE_CONST((a),(b),(c),(d),(e),(f),(g),(h)), SECP256K1_FE_CONST((i),(j),(k),(l),(m),(n),(o),(p)), 0}
+#define SECP256K1_GE_CONST_INFINITY {SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 0), SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 0), 1}
+
+/** A group element of the secp256k1 curve, in jacobian coordinates. */
+typedef struct {
+    secp256k1_fe x; /* actual X: x/z^2 */
+    secp256k1_fe y; /* actual Y: y/z^3 */
+    secp256k1_fe z;
+    int infinity; /* whether this represents the point at infinity */
+} secp256k1_gej;
+
+#define SECP256K1_GEJ_CONST(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) {SECP256K1_FE_CONST((a),(b),(c),(d),(e),(f),(g),(h)), SECP256K1_FE_CONST((i),(j),(k),(l),(m),(n),(o),(p)), SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 1), 0}
+#define SECP256K1_GEJ_CONST_INFINITY {SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 0), SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 0), SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 0), 1}
+
+typedef struct {
+    secp256k1_fe_storage x;
+    secp256k1_fe_storage y;
+} secp256k1_ge_storage;
+
+#define SECP256K1_GE_STORAGE_CONST(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) {SECP256K1_FE_STORAGE_CONST((a),(b),(c),(d),(e),(f),(g),(h)), SECP256K1_FE_STORAGE_CONST((i),(j),(k),(l),(m),(n),(o),(p))}
+
+#define SECP256K1_GE_STORAGE_CONST_GET(t) SECP256K1_FE_STORAGE_CONST_GET(t.x), SECP256K1_FE_STORAGE_CONST_GET(t.y)
+
+/** Set a group element equal to the point with given X and Y coordinates */
+static void secp256k1_ge_set_xy(secp256k1_ge *r, const secp256k1_fe *x, const secp256k1_fe *y);
+
+/** Set a group element (affine) equal to the point with the given X coordinate
+ *  and a Y coordinate that is a quadratic residue modulo p. The return value
+ *  is true iff a coordinate with the given X coordinate exists.
+ */
+static int secp256k1_ge_set_xquad(secp256k1_ge *r, const secp256k1_fe *x);
+
+/** Set a group element (affine) equal to the point with the given X coordinate, and given oddness
+ *  for Y. Return value indicates whether the result is valid. */
+static int secp256k1_ge_set_xo_var(secp256k1_ge *r, const secp256k1_fe *x, int odd);
+
+/** Check whether a group element is the point at infinity. */
+static int secp256k1_ge_is_infinity(const secp256k1_ge *a);
+
+/** Check whether a group element is valid (i.e., on the curve). */
+static int secp256k1_ge_is_valid_var(const secp256k1_ge *a);
+
+static void secp256k1_ge_neg(secp256k1_ge *r, const secp256k1_ge *a);
+
+/** Set a group element equal to another which is given in jacobian coordinates */
+static void secp256k1_ge_set_gej(secp256k1_ge *r, secp256k1_gej *a);
+
+/** Set a batch of group elements equal to the inputs given in jacobian coordinates */
+static void secp256k1_ge_set_all_gej_var(secp256k1_ge *r, const secp256k1_gej *a, size_t len, const secp256k1_callback *cb);
+
+/** Set a batch of group elements equal to the inputs given in jacobian
+ *  coordinates (with known z-ratios). zr must contain the known z-ratios such
+ *  that mul(a[i].z, zr[i+1]) == a[i+1].z. zr[0] is ignored. */
+static void secp256k1_ge_set_table_gej_var(secp256k1_ge *r, const secp256k1_gej *a, const secp256k1_fe *zr, size_t len);
+
+/** Bring a batch inputs given in jacobian coordinates (with known z-ratios) to
+ *  the same global z "denominator". zr must contain the known z-ratios such
+ *  that mul(a[i].z, zr[i+1]) == a[i+1].z. zr[0] is ignored. The x and y
+ *  coordinates of the result are stored in r, the common z coordinate is
+ *  stored in globalz. */
+static void secp256k1_ge_globalz_set_table_gej(size_t len, secp256k1_ge *r, secp256k1_fe *globalz, const secp256k1_gej *a, const secp256k1_fe *zr);
+
+/** Set a group element (affine) equal to the point at infinity. */
+static void secp256k1_ge_set_infinity(secp256k1_ge *r);
+
+/** Set a group element (jacobian) equal to the point at infinity. */
+static void secp256k1_gej_set_infinity(secp256k1_gej *r);
+
+/** Set a group element (jacobian) equal to another which is given in affine coordinates. */
+static void secp256k1_gej_set_ge(secp256k1_gej *r, const secp256k1_ge *a);
+
+/** Compare the X coordinate of a group element (jacobian). */
+static int secp256k1_gej_eq_x_var(const secp256k1_fe *x, const secp256k1_gej *a);
+
+/** Set r equal to the inverse of a (i.e., mirrored around the X axis) */
+static void secp256k1_gej_neg(secp256k1_gej *r, const secp256k1_gej *a);
+
+/** Check whether a group element is the point at infinity. */
+static int secp256k1_gej_is_infinity(const secp256k1_gej *a);
+
+/** Check whether a group element's y coordinate is a quadratic residue. */
+static int secp256k1_gej_has_quad_y_var(const secp256k1_gej *a);
+
+/** Set r equal to the double of a. If rzr is not-NULL, r->z = a->z * *rzr (where infinity means an implicit z = 0).
+ * a may not be zero. Constant time. */
+static void secp256k1_gej_double_nonzero(secp256k1_gej *r, const secp256k1_gej *a, secp256k1_fe *rzr);
+
+/** Set r equal to the double of a. If rzr is not-NULL, r->z = a->z * *rzr (where infinity means an implicit z = 0). */
+static void secp256k1_gej_double_var(secp256k1_gej *r, const secp256k1_gej *a, secp256k1_fe *rzr);
+
+/** Set r equal to the sum of a and b. If rzr is non-NULL, r->z = a->z * *rzr (a cannot be infinity in that case). */
+static void secp256k1_gej_add_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_gej *b, secp256k1_fe *rzr);
+
+/** Set r equal to the sum of a and b (with b given in affine coordinates, and not infinity). */
+static void secp256k1_gej_add_ge(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b);
+
+/** Set r equal to the sum of a and b (with b given in affine coordinates). This is more efficient
+    than secp256k1_gej_add_var. It is identical to secp256k1_gej_add_ge but without constant-time
+    guarantee, and b is allowed to be infinity. If rzr is non-NULL, r->z = a->z * *rzr (a cannot be infinity in that case). */
+static void secp256k1_gej_add_ge_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b, secp256k1_fe *rzr);
+
+/** Set r equal to the sum of a and b (with the inverse of b's Z coordinate passed as bzinv). */
+static void secp256k1_gej_add_zinv_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b, const secp256k1_fe *bzinv);
+
+#ifdef USE_ENDOMORPHISM
+/** Set r to be equal to lambda times a, where lambda is chosen in a way such that this is very fast. */
+static void secp256k1_ge_mul_lambda(secp256k1_ge *r, const secp256k1_ge *a);
+#endif
+
+/** Clear a secp256k1_gej to prevent leaking sensitive information. */
+static void secp256k1_gej_clear(secp256k1_gej *r);
+
+/** Clear a secp256k1_ge to prevent leaking sensitive information. */
+static void secp256k1_ge_clear(secp256k1_ge *r);
+
+/** Convert a group element to the storage type. */
+static void secp256k1_ge_to_storage(secp256k1_ge_storage *r, const secp256k1_ge *a);
+
+/** Convert a group element back from the storage type. */
+static void secp256k1_ge_from_storage(secp256k1_ge *r, const secp256k1_ge_storage *a);
+
+/** If flag is true, set *r equal to *a; otherwise leave it. Constant-time. */
+static void secp256k1_ge_storage_cmov(secp256k1_ge_storage *r, const secp256k1_ge_storage *a, int flag);
+
+/** Rescale a jacobian point by b which must be non-zero. Constant-time. */
+static void secp256k1_gej_rescale(secp256k1_gej *r, const secp256k1_fe *b);
+
+#endif /* SECP256K1_GROUP_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group_impl.h
new file mode 100644
index 000000000..b1ace87b6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/group_impl.h
@@ -0,0 +1,706 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_GROUP_IMPL_H
+#define SECP256K1_GROUP_IMPL_H
+
+#include "num.h"
+#include "field.h"
+#include "group.h"
+
+/* These points can be generated in sage as follows:
+ *
+ * 0. Setup a worksheet with the following parameters.
+ *   b = 4  # whatever CURVE_B will be set to
+ *   F = FiniteField (0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F)
+ *   C = EllipticCurve ([F (0), F (b)])
+ *
+ * 1. Determine all the small orders available to you. (If there are
+ *    no satisfactory ones, go back and change b.)
+ *   print C.order().factor(limit=1000)
+ *
+ * 2. Choose an order as one of the prime factors listed in the above step.
+ *    (You can also multiply some to get a composite order, though the
+ *    tests will crash trying to invert scalars during signing.) We take a
+ *    random point and scale it to drop its order to the desired value.
+ *    There is some probability this won't work; just try again.
+ *   order = 199
+ *   P = C.random_point()
+ *   P = (int(P.order()) / int(order)) * P
+ *   assert(P.order() == order)
+ *
+ * 3. Print the values. You'll need to use a vim macro or something to
+ *    split the hex output into 4-byte chunks.
+ *   print "%x %x" % P.xy()
+ */
+#if defined(EXHAUSTIVE_TEST_ORDER)
+#  if EXHAUSTIVE_TEST_ORDER == 199
+const secp256k1_ge secp256k1_ge_const_g = SECP256K1_GE_CONST(
+    0xFA7CC9A7, 0x0737F2DB, 0xA749DD39, 0x2B4FB069,
+    0x3B017A7D, 0xA808C2F1, 0xFB12940C, 0x9EA66C18,
+    0x78AC123A, 0x5ED8AEF3, 0x8732BC91, 0x1F3A2868,
+    0x48DF246C, 0x808DAE72, 0xCFE52572, 0x7F0501ED
+);
+
+const int CURVE_B = 4;
+#  elif EXHAUSTIVE_TEST_ORDER == 13
+const secp256k1_ge secp256k1_ge_const_g = SECP256K1_GE_CONST(
+    0xedc60018, 0xa51a786b, 0x2ea91f4d, 0x4c9416c0,
+    0x9de54c3b, 0xa1316554, 0x6cf4345c, 0x7277ef15,
+    0x54cb1b6b, 0xdc8c1273, 0x087844ea, 0x43f4603e,
+    0x0eaf9a43, 0xf6effe55, 0x939f806d, 0x37adf8ac
+);
+const int CURVE_B = 2;
+#  else
+#    error No known generator for the specified exhaustive test group order.
+#  endif
+#else
+/** Generator for secp256k1, value 'g' defined in
+ *  "Standards for Efficient Cryptography" (SEC2) 2.7.1.
+ */
+static const secp256k1_ge secp256k1_ge_const_g = SECP256K1_GE_CONST(
+    0x79BE667EUL, 0xF9DCBBACUL, 0x55A06295UL, 0xCE870B07UL,
+    0x029BFCDBUL, 0x2DCE28D9UL, 0x59F2815BUL, 0x16F81798UL,
+    0x483ADA77UL, 0x26A3C465UL, 0x5DA4FBFCUL, 0x0E1108A8UL,
+    0xFD17B448UL, 0xA6855419UL, 0x9C47D08FUL, 0xFB10D4B8UL
+);
+
+const int CURVE_B = 7;
+#endif
+
+static void secp256k1_ge_set_gej_zinv(secp256k1_ge *r, const secp256k1_gej *a, const secp256k1_fe *zi) {
+    secp256k1_fe zi2;
+    secp256k1_fe zi3;
+    secp256k1_fe_sqr(&zi2, zi);
+    secp256k1_fe_mul(&zi3, &zi2, zi);
+    secp256k1_fe_mul(&r->x, &a->x, &zi2);
+    secp256k1_fe_mul(&r->y, &a->y, &zi3);
+    r->infinity = a->infinity;
+}
+
+static void secp256k1_ge_set_xy(secp256k1_ge *r, const secp256k1_fe *x, const secp256k1_fe *y) {
+    r->infinity = 0;
+    r->x = *x;
+    r->y = *y;
+}
+
+static int secp256k1_ge_is_infinity(const secp256k1_ge *a) {
+    return a->infinity;
+}
+
+static void secp256k1_ge_neg(secp256k1_ge *r, const secp256k1_ge *a) {
+    *r = *a;
+    secp256k1_fe_normalize_weak(&r->y);
+    secp256k1_fe_negate(&r->y, &r->y, 1);
+}
+
+static void secp256k1_ge_set_gej(secp256k1_ge *r, secp256k1_gej *a) {
+    secp256k1_fe z2, z3;
+    r->infinity = a->infinity;
+    secp256k1_fe_inv(&a->z, &a->z);
+    secp256k1_fe_sqr(&z2, &a->z);
+    secp256k1_fe_mul(&z3, &a->z, &z2);
+    secp256k1_fe_mul(&a->x, &a->x, &z2);
+    secp256k1_fe_mul(&a->y, &a->y, &z3);
+    secp256k1_fe_set_int(&a->z, 1);
+    r->x = a->x;
+    r->y = a->y;
+}
+
+static void secp256k1_ge_set_gej_var(secp256k1_ge *r, secp256k1_gej *a) {
+    secp256k1_fe z2, z3;
+    r->infinity = a->infinity;
+    if (a->infinity) {
+        return;
+    }
+    secp256k1_fe_inv_var(&a->z, &a->z);
+    secp256k1_fe_sqr(&z2, &a->z);
+    secp256k1_fe_mul(&z3, &a->z, &z2);
+    secp256k1_fe_mul(&a->x, &a->x, &z2);
+    secp256k1_fe_mul(&a->y, &a->y, &z3);
+    secp256k1_fe_set_int(&a->z, 1);
+    r->x = a->x;
+    r->y = a->y;
+}
+
+static void secp256k1_ge_set_all_gej_var(secp256k1_ge *r, const secp256k1_gej *a, size_t len, const secp256k1_callback *cb) {
+    secp256k1_fe *az;
+    secp256k1_fe *azi;
+    size_t i;
+    size_t count = 0;
+    az = (secp256k1_fe *)checked_malloc(cb, sizeof(secp256k1_fe) * len);
+    for (i = 0; i < len; i++) {
+        if (!a[i].infinity) {
+            az[count++] = a[i].z;
+        }
+    }
+
+    azi = (secp256k1_fe *)checked_malloc(cb, sizeof(secp256k1_fe) * count);
+    secp256k1_fe_inv_all_var(azi, az, count);
+    free(az);
+
+    count = 0;
+    for (i = 0; i < len; i++) {
+        r[i].infinity = a[i].infinity;
+        if (!a[i].infinity) {
+            secp256k1_ge_set_gej_zinv(&r[i], &a[i], &azi[count++]);
+        }
+    }
+    free(azi);
+}
+
+static void secp256k1_ge_set_table_gej_var(secp256k1_ge *r, const secp256k1_gej *a, const secp256k1_fe *zr, size_t len) {
+    size_t i = len - 1;
+    secp256k1_fe zi;
+
+    if (len > 0) {
+        /* Compute the inverse of the last z coordinate, and use it to compute the last affine output. */
+        secp256k1_fe_inv(&zi, &a[i].z);
+        secp256k1_ge_set_gej_zinv(&r[i], &a[i], &zi);
+
+        /* Work out way backwards, using the z-ratios to scale the x/y values. */
+        while (i > 0) {
+            secp256k1_fe_mul(&zi, &zi, &zr[i]);
+            i--;
+            secp256k1_ge_set_gej_zinv(&r[i], &a[i], &zi);
+        }
+    }
+}
+
+static void secp256k1_ge_globalz_set_table_gej(size_t len, secp256k1_ge *r, secp256k1_fe *globalz, const secp256k1_gej *a, const secp256k1_fe *zr) {
+    size_t i = len - 1;
+    secp256k1_fe zs;
+
+    if (len > 0) {
+        /* The z of the final point gives us the "global Z" for the table. */
+        r[i].x = a[i].x;
+        r[i].y = a[i].y;
+        *globalz = a[i].z;
+        r[i].infinity = 0;
+        zs = zr[i];
+
+        /* Work our way backwards, using the z-ratios to scale the x/y values. */
+        while (i > 0) {
+            if (i != len - 1) {
+                secp256k1_fe_mul(&zs, &zs, &zr[i]);
+            }
+            i--;
+            secp256k1_ge_set_gej_zinv(&r[i], &a[i], &zs);
+        }
+    }
+}
+
+static void secp256k1_gej_set_infinity(secp256k1_gej *r) {
+    r->infinity = 1;
+    secp256k1_fe_clear(&r->x);
+    secp256k1_fe_clear(&r->y);
+    secp256k1_fe_clear(&r->z);
+}
+
+static void secp256k1_ge_set_infinity(secp256k1_ge *r) {
+    r->infinity = 1;
+    secp256k1_fe_clear(&r->x);
+    secp256k1_fe_clear(&r->y);
+}
+
+static void secp256k1_gej_clear(secp256k1_gej *r) {
+    r->infinity = 0;
+    secp256k1_fe_clear(&r->x);
+    secp256k1_fe_clear(&r->y);
+    secp256k1_fe_clear(&r->z);
+}
+
+static void secp256k1_ge_clear(secp256k1_ge *r) {
+    r->infinity = 0;
+    secp256k1_fe_clear(&r->x);
+    secp256k1_fe_clear(&r->y);
+}
+
+static int secp256k1_ge_set_xquad(secp256k1_ge *r, const secp256k1_fe *x) {
+    secp256k1_fe x2, x3, c;
+    r->x = *x;
+    secp256k1_fe_sqr(&x2, x);
+    secp256k1_fe_mul(&x3, x, &x2);
+    r->infinity = 0;
+    secp256k1_fe_set_int(&c, CURVE_B);
+    secp256k1_fe_add(&c, &x3);
+    return secp256k1_fe_sqrt(&r->y, &c);
+}
+
+static int secp256k1_ge_set_xo_var(secp256k1_ge *r, const secp256k1_fe *x, int odd) {
+    if (!secp256k1_ge_set_xquad(r, x)) {
+        return 0;
+    }
+    secp256k1_fe_normalize_var(&r->y);
+    if (secp256k1_fe_is_odd(&r->y) != odd) {
+        secp256k1_fe_negate(&r->y, &r->y, 1);
+    }
+    return 1;
+
+}
+
+static void secp256k1_gej_set_ge(secp256k1_gej *r, const secp256k1_ge *a) {
+   r->infinity = a->infinity;
+   r->x = a->x;
+   r->y = a->y;
+   secp256k1_fe_set_int(&r->z, 1);
+}
+
+static int secp256k1_gej_eq_x_var(const secp256k1_fe *x, const secp256k1_gej *a) {
+    secp256k1_fe r, r2;
+    VERIFY_CHECK(!a->infinity);
+    secp256k1_fe_sqr(&r, &a->z); secp256k1_fe_mul(&r, &r, x);
+    r2 = a->x; secp256k1_fe_normalize_weak(&r2);
+    return secp256k1_fe_equal_var(&r, &r2);
+}
+
+static void secp256k1_gej_neg(secp256k1_gej *r, const secp256k1_gej *a) {
+    r->infinity = a->infinity;
+    r->x = a->x;
+    r->y = a->y;
+    r->z = a->z;
+    secp256k1_fe_normalize_weak(&r->y);
+    secp256k1_fe_negate(&r->y, &r->y, 1);
+}
+
+static int secp256k1_gej_is_infinity(const secp256k1_gej *a) {
+    return a->infinity;
+}
+
+static int secp256k1_gej_is_valid_var(const secp256k1_gej *a) {
+    secp256k1_fe y2, x3, z2, z6;
+    if (a->infinity) {
+        return 0;
+    }
+    /** y^2 = x^3 + 7
+     *  (Y/Z^3)^2 = (X/Z^2)^3 + 7
+     *  Y^2 / Z^6 = X^3 / Z^6 + 7
+     *  Y^2 = X^3 + 7*Z^6
+     */
+    secp256k1_fe_sqr(&y2, &a->y);
+    secp256k1_fe_sqr(&x3, &a->x); secp256k1_fe_mul(&x3, &x3, &a->x);
+    secp256k1_fe_sqr(&z2, &a->z);
+    secp256k1_fe_sqr(&z6, &z2); secp256k1_fe_mul(&z6, &z6, &z2);
+    secp256k1_fe_mul_int(&z6, CURVE_B);
+    secp256k1_fe_add(&x3, &z6);
+    secp256k1_fe_normalize_weak(&x3);
+    return secp256k1_fe_equal_var(&y2, &x3);
+}
+
+static int secp256k1_ge_is_valid_var(const secp256k1_ge *a) {
+    secp256k1_fe y2, x3, c;
+    if (a->infinity) {
+        return 0;
+    }
+    /* y^2 = x^3 + 7 */
+    secp256k1_fe_sqr(&y2, &a->y);
+    secp256k1_fe_sqr(&x3, &a->x); secp256k1_fe_mul(&x3, &x3, &a->x);
+    secp256k1_fe_set_int(&c, CURVE_B);
+    secp256k1_fe_add(&x3, &c);
+    secp256k1_fe_normalize_weak(&x3);
+    return secp256k1_fe_equal_var(&y2, &x3);
+}
+
+static void secp256k1_gej_double_var(secp256k1_gej *r, const secp256k1_gej *a, secp256k1_fe *rzr) {
+    /* Operations: 3 mul, 4 sqr, 0 normalize, 12 mul_int/add/negate.
+     *
+     * Note that there is an implementation described at
+     *     https://hyperelliptic.org/EFD/g1p/auto-shortw-jacobian-0.html#doubling-dbl-2009-l
+     * which trades a multiply for a square, but in practice this is actually slower,
+     * mainly because it requires more normalizations.
+     */
+    secp256k1_fe t1,t2,t3,t4;
+    /** For secp256k1, 2Q is infinity if and only if Q is infinity. This is because if 2Q = infinity,
+     *  Q must equal -Q, or that Q.y == -(Q.y), or Q.y is 0. For a point on y^2 = x^3 + 7 to have
+     *  y=0, x^3 must be -7 mod p. However, -7 has no cube root mod p.
+     *
+     *  Having said this, if this function receives a point on a sextic twist, e.g. by
+     *  a fault attack, it is possible for y to be 0. This happens for y^2 = x^3 + 6,
+     *  since -6 does have a cube root mod p. For this point, this function will not set
+     *  the infinity flag even though the point doubles to infinity, and the result
+     *  point will be gibberish (z = 0 but infinity = 0).
+     */
+    r->infinity = a->infinity;
+    if (r->infinity) {
+        if (rzr != NULL) {
+            secp256k1_fe_set_int(rzr, 1);
+        }
+        return;
+    }
+
+    if (rzr != NULL) {
+        *rzr = a->y;
+        secp256k1_fe_normalize_weak(rzr);
+        secp256k1_fe_mul_int(rzr, 2);
+    }
+
+    secp256k1_fe_mul(&r->z, &a->z, &a->y);
+    secp256k1_fe_mul_int(&r->z, 2);       /* Z' = 2*Y*Z (2) */
+    secp256k1_fe_sqr(&t1, &a->x);
+    secp256k1_fe_mul_int(&t1, 3);         /* T1 = 3*X^2 (3) */
+    secp256k1_fe_sqr(&t2, &t1);           /* T2 = 9*X^4 (1) */
+    secp256k1_fe_sqr(&t3, &a->y);
+    secp256k1_fe_mul_int(&t3, 2);         /* T3 = 2*Y^2 (2) */
+    secp256k1_fe_sqr(&t4, &t3);
+    secp256k1_fe_mul_int(&t4, 2);         /* T4 = 8*Y^4 (2) */
+    secp256k1_fe_mul(&t3, &t3, &a->x);    /* T3 = 2*X*Y^2 (1) */
+    r->x = t3;
+    secp256k1_fe_mul_int(&r->x, 4);       /* X' = 8*X*Y^2 (4) */
+    secp256k1_fe_negate(&r->x, &r->x, 4); /* X' = -8*X*Y^2 (5) */
+    secp256k1_fe_add(&r->x, &t2);         /* X' = 9*X^4 - 8*X*Y^2 (6) */
+    secp256k1_fe_negate(&t2, &t2, 1);     /* T2 = -9*X^4 (2) */
+    secp256k1_fe_mul_int(&t3, 6);         /* T3 = 12*X*Y^2 (6) */
+    secp256k1_fe_add(&t3, &t2);           /* T3 = 12*X*Y^2 - 9*X^4 (8) */
+    secp256k1_fe_mul(&r->y, &t1, &t3);    /* Y' = 36*X^3*Y^2 - 27*X^6 (1) */
+    secp256k1_fe_negate(&t2, &t4, 2);     /* T2 = -8*Y^4 (3) */
+    secp256k1_fe_add(&r->y, &t2);         /* Y' = 36*X^3*Y^2 - 27*X^6 - 8*Y^4 (4) */
+}
+
+static SECP256K1_INLINE void secp256k1_gej_double_nonzero(secp256k1_gej *r, const secp256k1_gej *a, secp256k1_fe *rzr) {
+    VERIFY_CHECK(!secp256k1_gej_is_infinity(a));
+    secp256k1_gej_double_var(r, a, rzr);
+}
+
+static void secp256k1_gej_add_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_gej *b, secp256k1_fe *rzr) {
+    /* Operations: 12 mul, 4 sqr, 2 normalize, 12 mul_int/add/negate */
+    secp256k1_fe z22, z12, u1, u2, s1, s2, h, i, i2, h2, h3, t;
+
+    if (a->infinity) {
+        VERIFY_CHECK(rzr == NULL);
+        *r = *b;
+        return;
+    }
+
+    if (b->infinity) {
+        if (rzr != NULL) {
+            secp256k1_fe_set_int(rzr, 1);
+        }
+        *r = *a;
+        return;
+    }
+
+    r->infinity = 0;
+    secp256k1_fe_sqr(&z22, &b->z);
+    secp256k1_fe_sqr(&z12, &a->z);
+    secp256k1_fe_mul(&u1, &a->x, &z22);
+    secp256k1_fe_mul(&u2, &b->x, &z12);
+    secp256k1_fe_mul(&s1, &a->y, &z22); secp256k1_fe_mul(&s1, &s1, &b->z);
+    secp256k1_fe_mul(&s2, &b->y, &z12); secp256k1_fe_mul(&s2, &s2, &a->z);
+    secp256k1_fe_negate(&h, &u1, 1); secp256k1_fe_add(&h, &u2);
+    secp256k1_fe_negate(&i, &s1, 1); secp256k1_fe_add(&i, &s2);
+    if (secp256k1_fe_normalizes_to_zero_var(&h)) {
+        if (secp256k1_fe_normalizes_to_zero_var(&i)) {
+            secp256k1_gej_double_var(r, a, rzr);
+        } else {
+            if (rzr != NULL) {
+                secp256k1_fe_set_int(rzr, 0);
+            }
+            r->infinity = 1;
+        }
+        return;
+    }
+    secp256k1_fe_sqr(&i2, &i);
+    secp256k1_fe_sqr(&h2, &h);
+    secp256k1_fe_mul(&h3, &h, &h2);
+    secp256k1_fe_mul(&h, &h, &b->z);
+    if (rzr != NULL) {
+        *rzr = h;
+    }
+    secp256k1_fe_mul(&r->z, &a->z, &h);
+    secp256k1_fe_mul(&t, &u1, &h2);
+    r->x = t; secp256k1_fe_mul_int(&r->x, 2); secp256k1_fe_add(&r->x, &h3); secp256k1_fe_negate(&r->x, &r->x, 3); secp256k1_fe_add(&r->x, &i2);
+    secp256k1_fe_negate(&r->y, &r->x, 5); secp256k1_fe_add(&r->y, &t); secp256k1_fe_mul(&r->y, &r->y, &i);
+    secp256k1_fe_mul(&h3, &h3, &s1); secp256k1_fe_negate(&h3, &h3, 1);
+    secp256k1_fe_add(&r->y, &h3);
+}
+
+static void secp256k1_gej_add_ge_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b, secp256k1_fe *rzr) {
+    /* 8 mul, 3 sqr, 4 normalize, 12 mul_int/add/negate */
+    secp256k1_fe z12, u1, u2, s1, s2, h, i, i2, h2, h3, t;
+    if (a->infinity) {
+        VERIFY_CHECK(rzr == NULL);
+        secp256k1_gej_set_ge(r, b);
+        return;
+    }
+    if (b->infinity) {
+        if (rzr != NULL) {
+            secp256k1_fe_set_int(rzr, 1);
+        }
+        *r = *a;
+        return;
+    }
+    r->infinity = 0;
+
+    secp256k1_fe_sqr(&z12, &a->z);
+    u1 = a->x; secp256k1_fe_normalize_weak(&u1);
+    secp256k1_fe_mul(&u2, &b->x, &z12);
+    s1 = a->y; secp256k1_fe_normalize_weak(&s1);
+    secp256k1_fe_mul(&s2, &b->y, &z12); secp256k1_fe_mul(&s2, &s2, &a->z);
+    secp256k1_fe_negate(&h, &u1, 1); secp256k1_fe_add(&h, &u2);
+    secp256k1_fe_negate(&i, &s1, 1); secp256k1_fe_add(&i, &s2);
+    if (secp256k1_fe_normalizes_to_zero_var(&h)) {
+        if (secp256k1_fe_normalizes_to_zero_var(&i)) {
+            secp256k1_gej_double_var(r, a, rzr);
+        } else {
+            if (rzr != NULL) {
+                secp256k1_fe_set_int(rzr, 0);
+            }
+            r->infinity = 1;
+        }
+        return;
+    }
+    secp256k1_fe_sqr(&i2, &i);
+    secp256k1_fe_sqr(&h2, &h);
+    secp256k1_fe_mul(&h3, &h, &h2);
+    if (rzr != NULL) {
+        *rzr = h;
+    }
+    secp256k1_fe_mul(&r->z, &a->z, &h);
+    secp256k1_fe_mul(&t, &u1, &h2);
+    r->x = t; secp256k1_fe_mul_int(&r->x, 2); secp256k1_fe_add(&r->x, &h3); secp256k1_fe_negate(&r->x, &r->x, 3); secp256k1_fe_add(&r->x, &i2);
+    secp256k1_fe_negate(&r->y, &r->x, 5); secp256k1_fe_add(&r->y, &t); secp256k1_fe_mul(&r->y, &r->y, &i);
+    secp256k1_fe_mul(&h3, &h3, &s1); secp256k1_fe_negate(&h3, &h3, 1);
+    secp256k1_fe_add(&r->y, &h3);
+}
+
+static void secp256k1_gej_add_zinv_var(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b, const secp256k1_fe *bzinv) {
+    /* 9 mul, 3 sqr, 4 normalize, 12 mul_int/add/negate */
+    secp256k1_fe az, z12, u1, u2, s1, s2, h, i, i2, h2, h3, t;
+
+    if (b->infinity) {
+        *r = *a;
+        return;
+    }
+    if (a->infinity) {
+        secp256k1_fe bzinv2, bzinv3;
+        r->infinity = b->infinity;
+        secp256k1_fe_sqr(&bzinv2, bzinv);
+        secp256k1_fe_mul(&bzinv3, &bzinv2, bzinv);
+        secp256k1_fe_mul(&r->x, &b->x, &bzinv2);
+        secp256k1_fe_mul(&r->y, &b->y, &bzinv3);
+        secp256k1_fe_set_int(&r->z, 1);
+        return;
+    }
+    r->infinity = 0;
+
+    /** We need to calculate (rx,ry,rz) = (ax,ay,az) + (bx,by,1/bzinv). Due to
+     *  secp256k1's isomorphism we can multiply the Z coordinates on both sides
+     *  by bzinv, and get: (rx,ry,rz*bzinv) = (ax,ay,az*bzinv) + (bx,by,1).
+     *  This means that (rx,ry,rz) can be calculated as
+     *  (ax,ay,az*bzinv) + (bx,by,1), when not applying the bzinv factor to rz.
+     *  The variable az below holds the modified Z coordinate for a, which is used
+     *  for the computation of rx and ry, but not for rz.
+     */
+    secp256k1_fe_mul(&az, &a->z, bzinv);
+
+    secp256k1_fe_sqr(&z12, &az);
+    u1 = a->x; secp256k1_fe_normalize_weak(&u1);
+    secp256k1_fe_mul(&u2, &b->x, &z12);
+    s1 = a->y; secp256k1_fe_normalize_weak(&s1);
+    secp256k1_fe_mul(&s2, &b->y, &z12); secp256k1_fe_mul(&s2, &s2, &az);
+    secp256k1_fe_negate(&h, &u1, 1); secp256k1_fe_add(&h, &u2);
+    secp256k1_fe_negate(&i, &s1, 1); secp256k1_fe_add(&i, &s2);
+    if (secp256k1_fe_normalizes_to_zero_var(&h)) {
+        if (secp256k1_fe_normalizes_to_zero_var(&i)) {
+            secp256k1_gej_double_var(r, a, NULL);
+        } else {
+            r->infinity = 1;
+        }
+        return;
+    }
+    secp256k1_fe_sqr(&i2, &i);
+    secp256k1_fe_sqr(&h2, &h);
+    secp256k1_fe_mul(&h3, &h, &h2);
+    r->z = a->z; secp256k1_fe_mul(&r->z, &r->z, &h);
+    secp256k1_fe_mul(&t, &u1, &h2);
+    r->x = t; secp256k1_fe_mul_int(&r->x, 2); secp256k1_fe_add(&r->x, &h3); secp256k1_fe_negate(&r->x, &r->x, 3); secp256k1_fe_add(&r->x, &i2);
+    secp256k1_fe_negate(&r->y, &r->x, 5); secp256k1_fe_add(&r->y, &t); secp256k1_fe_mul(&r->y, &r->y, &i);
+    secp256k1_fe_mul(&h3, &h3, &s1); secp256k1_fe_negate(&h3, &h3, 1);
+    secp256k1_fe_add(&r->y, &h3);
+}
+
+
+static void secp256k1_gej_add_ge(secp256k1_gej *r, const secp256k1_gej *a, const secp256k1_ge *b) {
+    /* Operations: 7 mul, 5 sqr, 4 normalize, 21 mul_int/add/negate/cmov */
+    static const secp256k1_fe fe_1 = SECP256K1_FE_CONST(0, 0, 0, 0, 0, 0, 0, 1);
+    secp256k1_fe zz, u1, u2, s1, s2, t, tt, m, n, q, rr;
+    secp256k1_fe m_alt, rr_alt;
+    int infinity, degenerate;
+    VERIFY_CHECK(!b->infinity);
+    VERIFY_CHECK(a->infinity == 0 || a->infinity == 1);
+
+    /** In:
+     *    Eric Brier and Marc Joye, Weierstrass Elliptic Curves and Side-Channel Attacks.
+     *    In D. Naccache and P. Paillier, Eds., Public Key Cryptography, vol. 2274 of Lecture Notes in Computer Science, pages 335-345. Springer-Verlag, 2002.
+     *  we find as solution for a unified addition/doubling formula:
+     *    lambda = ((x1 + x2)^2 - x1 * x2 + a) / (y1 + y2), with a = 0 for secp256k1's curve equation.
+     *    x3 = lambda^2 - (x1 + x2)
+     *    2*y3 = lambda * (x1 + x2 - 2 * x3) - (y1 + y2).
+     *
+     *  Substituting x_i = Xi / Zi^2 and yi = Yi / Zi^3, for i=1,2,3, gives:
+     *    U1 = X1*Z2^2, U2 = X2*Z1^2
+     *    S1 = Y1*Z2^3, S2 = Y2*Z1^3
+     *    Z = Z1*Z2
+     *    T = U1+U2
+     *    M = S1+S2
+     *    Q = T*M^2
+     *    R = T^2-U1*U2
+     *    X3 = 4*(R^2-Q)
+     *    Y3 = 4*(R*(3*Q-2*R^2)-M^4)
+     *    Z3 = 2*M*Z
+     *  (Note that the paper uses xi = Xi / Zi and yi = Yi / Zi instead.)
+     *
+     *  This formula has the benefit of being the same for both addition
+     *  of distinct points and doubling. However, it breaks down in the
+     *  case that either point is infinity, or that y1 = -y2. We handle
+     *  these cases in the following ways:
+     *
+     *    - If b is infinity we simply bail by means of a VERIFY_CHECK.
+     *
+     *    - If a is infinity, we detect this, and at the end of the
+     *      computation replace the result (which will be meaningless,
+     *      but we compute to be constant-time) with b.x : b.y : 1.
+     *
+     *    - If a = -b, we have y1 = -y2, which is a degenerate case.
+     *      But here the answer is infinity, so we simply set the
+     *      infinity flag of the result, overriding the computed values
+     *      without even needing to cmov.
+     *
+     *    - If y1 = -y2 but x1 != x2, which does occur thanks to certain
+     *      properties of our curve (specifically, 1 has nontrivial cube
+     *      roots in our field, and the curve equation has no x coefficient)
+     *      then the answer is not infinity but also not given by the above
+     *      equation. In this case, we cmov in place an alternate expression
+     *      for lambda. Specifically (y1 - y2)/(x1 - x2). Where both these
+     *      expressions for lambda are defined, they are equal, and can be
+     *      obtained from each other by multiplication by (y1 + y2)/(y1 + y2)
+     *      then substitution of x^3 + 7 for y^2 (using the curve equation).
+     *      For all pairs of nonzero points (a, b) at least one is defined,
+     *      so this covers everything.
+     */
+
+    secp256k1_fe_sqr(&zz, &a->z);                       /* z = Z1^2 */
+    u1 = a->x; secp256k1_fe_normalize_weak(&u1);        /* u1 = U1 = X1*Z2^2 (1) */
+    secp256k1_fe_mul(&u2, &b->x, &zz);                  /* u2 = U2 = X2*Z1^2 (1) */
+    s1 = a->y; secp256k1_fe_normalize_weak(&s1);        /* s1 = S1 = Y1*Z2^3 (1) */
+    secp256k1_fe_mul(&s2, &b->y, &zz);                  /* s2 = Y2*Z1^2 (1) */
+    secp256k1_fe_mul(&s2, &s2, &a->z);                  /* s2 = S2 = Y2*Z1^3 (1) */
+    t = u1; secp256k1_fe_add(&t, &u2);                  /* t = T = U1+U2 (2) */
+    m = s1; secp256k1_fe_add(&m, &s2);                  /* m = M = S1+S2 (2) */
+    secp256k1_fe_sqr(&rr, &t);                          /* rr = T^2 (1) */
+    secp256k1_fe_negate(&m_alt, &u2, 1);                /* Malt = -X2*Z1^2 */
+    secp256k1_fe_mul(&tt, &u1, &m_alt);                 /* tt = -U1*U2 (2) */
+    secp256k1_fe_add(&rr, &tt);                         /* rr = R = T^2-U1*U2 (3) */
+    /** If lambda = R/M = 0/0 we have a problem (except in the "trivial"
+     *  case that Z = z1z2 = 0, and this is special-cased later on). */
+    degenerate = secp256k1_fe_normalizes_to_zero(&m) &
+                 secp256k1_fe_normalizes_to_zero(&rr);
+    /* This only occurs when y1 == -y2 and x1^3 == x2^3, but x1 != x2.
+     * This means either x1 == beta*x2 or beta*x1 == x2, where beta is
+     * a nontrivial cube root of one. In either case, an alternate
+     * non-indeterminate expression for lambda is (y1 - y2)/(x1 - x2),
+     * so we set R/M equal to this. */
+    rr_alt = s1;
+    secp256k1_fe_mul_int(&rr_alt, 2);       /* rr = Y1*Z2^3 - Y2*Z1^3 (2) */
+    secp256k1_fe_add(&m_alt, &u1);          /* Malt = X1*Z2^2 - X2*Z1^2 */
+
+    secp256k1_fe_cmov(&rr_alt, &rr, !degenerate);
+    secp256k1_fe_cmov(&m_alt, &m, !degenerate);
+    /* Now Ralt / Malt = lambda and is guaranteed not to be 0/0.
+     * From here on out Ralt and Malt represent the numerator
+     * and denominator of lambda; R and M represent the explicit
+     * expressions x1^2 + x2^2 + x1x2 and y1 + y2. */
+    secp256k1_fe_sqr(&n, &m_alt);                       /* n = Malt^2 (1) */
+    secp256k1_fe_mul(&q, &n, &t);                       /* q = Q = T*Malt^2 (1) */
+    /* These two lines use the observation that either M == Malt or M == 0,
+     * so M^3 * Malt is either Malt^4 (which is computed by squaring), or
+     * zero (which is "computed" by cmov). So the cost is one squaring
+     * versus two multiplications. */
+    secp256k1_fe_sqr(&n, &n);
+    secp256k1_fe_cmov(&n, &m, degenerate);              /* n = M^3 * Malt (2) */
+    secp256k1_fe_sqr(&t, &rr_alt);                      /* t = Ralt^2 (1) */
+    secp256k1_fe_mul(&r->z, &a->z, &m_alt);             /* r->z = Malt*Z (1) */
+    infinity = secp256k1_fe_normalizes_to_zero(&r->z) * (1 - a->infinity);
+    secp256k1_fe_mul_int(&r->z, 2);                     /* r->z = Z3 = 2*Malt*Z (2) */
+    secp256k1_fe_negate(&q, &q, 1);                     /* q = -Q (2) */
+    secp256k1_fe_add(&t, &q);                           /* t = Ralt^2-Q (3) */
+    secp256k1_fe_normalize_weak(&t);
+    r->x = t;                                           /* r->x = Ralt^2-Q (1) */
+    secp256k1_fe_mul_int(&t, 2);                        /* t = 2*x3 (2) */
+    secp256k1_fe_add(&t, &q);                           /* t = 2*x3 - Q: (4) */
+    secp256k1_fe_mul(&t, &t, &rr_alt);                  /* t = Ralt*(2*x3 - Q) (1) */
+    secp256k1_fe_add(&t, &n);                           /* t = Ralt*(2*x3 - Q) + M^3*Malt (3) */
+    secp256k1_fe_negate(&r->y, &t, 3);                  /* r->y = Ralt*(Q - 2x3) - M^3*Malt (4) */
+    secp256k1_fe_normalize_weak(&r->y);
+    secp256k1_fe_mul_int(&r->x, 4);                     /* r->x = X3 = 4*(Ralt^2-Q) */
+    secp256k1_fe_mul_int(&r->y, 4);                     /* r->y = Y3 = 4*Ralt*(Q - 2x3) - 4*M^3*Malt (4) */
+
+    /** In case a->infinity == 1, replace r with (b->x, b->y, 1). */
+    secp256k1_fe_cmov(&r->x, &b->x, a->infinity);
+    secp256k1_fe_cmov(&r->y, &b->y, a->infinity);
+    secp256k1_fe_cmov(&r->z, &fe_1, a->infinity);
+    r->infinity = infinity;
+}
+
+static void secp256k1_gej_rescale(secp256k1_gej *r, const secp256k1_fe *s) {
+    /* Operations: 4 mul, 1 sqr */
+    secp256k1_fe zz;
+    VERIFY_CHECK(!secp256k1_fe_is_zero(s));
+    secp256k1_fe_sqr(&zz, s);
+    secp256k1_fe_mul(&r->x, &r->x, &zz);                /* r->x *= s^2 */
+    secp256k1_fe_mul(&r->y, &r->y, &zz);
+    secp256k1_fe_mul(&r->y, &r->y, s);                  /* r->y *= s^3 */
+    secp256k1_fe_mul(&r->z, &r->z, s);                  /* r->z *= s   */
+}
+
+static void secp256k1_ge_to_storage(secp256k1_ge_storage *r, const secp256k1_ge *a) {
+    secp256k1_fe x, y;
+    VERIFY_CHECK(!a->infinity);
+    x = a->x;
+    secp256k1_fe_normalize(&x);
+    y = a->y;
+    secp256k1_fe_normalize(&y);
+    secp256k1_fe_to_storage(&r->x, &x);
+    secp256k1_fe_to_storage(&r->y, &y);
+}
+
+static void secp256k1_ge_from_storage(secp256k1_ge *r, const secp256k1_ge_storage *a) {
+    secp256k1_fe_from_storage(&r->x, &a->x);
+    secp256k1_fe_from_storage(&r->y, &a->y);
+    r->infinity = 0;
+}
+
+static SECP256K1_INLINE void secp256k1_ge_storage_cmov(secp256k1_ge_storage *r, const secp256k1_ge_storage *a, int flag) {
+    secp256k1_fe_storage_cmov(&r->x, &a->x, flag);
+    secp256k1_fe_storage_cmov(&r->y, &a->y, flag);
+}
+
+#ifdef USE_ENDOMORPHISM
+static void secp256k1_ge_mul_lambda(secp256k1_ge *r, const secp256k1_ge *a) {
+    static const secp256k1_fe beta = SECP256K1_FE_CONST(
+        0x7ae96a2bul, 0x657c0710ul, 0x6e64479eul, 0xac3434e9ul,
+        0x9cf04975ul, 0x12f58995ul, 0xc1396c28ul, 0x719501eeul
+    );
+    *r = *a;
+    secp256k1_fe_mul(&r->x, &r->x, &beta);
+}
+#endif
+
+static int secp256k1_gej_has_quad_y_var(const secp256k1_gej *a) {
+    secp256k1_fe yz;
+
+    if (a->infinity) {
+        return 0;
+    }
+
+    /* We rely on the fact that the Jacobi symbol of 1 / a->z^3 is the same as
+     * that of a->z. Thus a->y / a->z^3 is a quadratic residue iff a->y * a->z
+       is */
+    secp256k1_fe_mul(&yz, &a->y, &a->z);
+    return secp256k1_fe_is_quad_var(&yz);
+}
+
+#endif /* SECP256K1_GROUP_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash.h
new file mode 100644
index 000000000..de26e4b89
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash.h
@@ -0,0 +1,41 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_HASH_H
+#define SECP256K1_HASH_H
+
+#include <stdlib.h>
+#include <stdint.h>
+
+typedef struct {
+    uint32_t s[8];
+    uint32_t buf[16]; /* In big endian */
+    size_t bytes;
+} secp256k1_sha256;
+
+static void secp256k1_sha256_initialize(secp256k1_sha256 *hash);
+static void secp256k1_sha256_write(secp256k1_sha256 *hash, const unsigned char *data, size_t size);
+static void secp256k1_sha256_finalize(secp256k1_sha256 *hash, unsigned char *out32);
+
+typedef struct {
+    secp256k1_sha256 inner, outer;
+} secp256k1_hmac_sha256;
+
+static void secp256k1_hmac_sha256_initialize(secp256k1_hmac_sha256 *hash, const unsigned char *key, size_t size);
+static void secp256k1_hmac_sha256_write(secp256k1_hmac_sha256 *hash, const unsigned char *data, size_t size);
+static void secp256k1_hmac_sha256_finalize(secp256k1_hmac_sha256 *hash, unsigned char *out32);
+
+typedef struct {
+    unsigned char v[32];
+    unsigned char k[32];
+    int retry;
+} secp256k1_rfc6979_hmac_sha256;
+
+static void secp256k1_rfc6979_hmac_sha256_initialize(secp256k1_rfc6979_hmac_sha256 *rng, const unsigned char *key, size_t keylen);
+static void secp256k1_rfc6979_hmac_sha256_generate(secp256k1_rfc6979_hmac_sha256 *rng, unsigned char *out, size_t outlen);
+static void secp256k1_rfc6979_hmac_sha256_finalize(secp256k1_rfc6979_hmac_sha256 *rng);
+
+#endif /* SECP256K1_HASH_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash_impl.h
new file mode 100644
index 000000000..009f26beb
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/hash_impl.h
@@ -0,0 +1,282 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_HASH_IMPL_H
+#define SECP256K1_HASH_IMPL_H
+
+#include "hash.h"
+
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+
+#define Ch(x,y,z) ((z) ^ ((x) & ((y) ^ (z))))
+#define Maj(x,y,z) (((x) & (y)) | ((z) & ((x) | (y))))
+#define Sigma0(x) (((x) >> 2 | (x) << 30) ^ ((x) >> 13 | (x) << 19) ^ ((x) >> 22 | (x) << 10))
+#define Sigma1(x) (((x) >> 6 | (x) << 26) ^ ((x) >> 11 | (x) << 21) ^ ((x) >> 25 | (x) << 7))
+#define sigma0(x) (((x) >> 7 | (x) << 25) ^ ((x) >> 18 | (x) << 14) ^ ((x) >> 3))
+#define sigma1(x) (((x) >> 17 | (x) << 15) ^ ((x) >> 19 | (x) << 13) ^ ((x) >> 10))
+
+#define Round(a,b,c,d,e,f,g,h,k,w) do { \
+    uint32_t t1 = (h) + Sigma1(e) + Ch((e), (f), (g)) + (k) + (w); \
+    uint32_t t2 = Sigma0(a) + Maj((a), (b), (c)); \
+    (d) += t1; \
+    (h) = t1 + t2; \
+} while(0)
+
+#ifdef WORDS_BIGENDIAN
+#define BE32(x) (x)
+#else
+#define BE32(p) ((((p) & 0xFF) << 24) | (((p) & 0xFF00) << 8) | (((p) & 0xFF0000) >> 8) | (((p) & 0xFF000000) >> 24))
+#endif
+
+static void secp256k1_sha256_initialize(secp256k1_sha256 *hash) {
+    hash->s[0] = 0x6a09e667ul;
+    hash->s[1] = 0xbb67ae85ul;
+    hash->s[2] = 0x3c6ef372ul;
+    hash->s[3] = 0xa54ff53aul;
+    hash->s[4] = 0x510e527ful;
+    hash->s[5] = 0x9b05688cul;
+    hash->s[6] = 0x1f83d9abul;
+    hash->s[7] = 0x5be0cd19ul;
+    hash->bytes = 0;
+}
+
+/** Perform one SHA-256 transformation, processing 16 big endian 32-bit words. */
+static void secp256k1_sha256_transform(uint32_t* s, const uint32_t* chunk) {
+    uint32_t a = s[0], b = s[1], c = s[2], d = s[3], e = s[4], f = s[5], g = s[6], h = s[7];
+    uint32_t w0, w1, w2, w3, w4, w5, w6, w7, w8, w9, w10, w11, w12, w13, w14, w15;
+
+    Round(a, b, c, d, e, f, g, h, 0x428a2f98, w0 = BE32(chunk[0]));
+    Round(h, a, b, c, d, e, f, g, 0x71374491, w1 = BE32(chunk[1]));
+    Round(g, h, a, b, c, d, e, f, 0xb5c0fbcf, w2 = BE32(chunk[2]));
+    Round(f, g, h, a, b, c, d, e, 0xe9b5dba5, w3 = BE32(chunk[3]));
+    Round(e, f, g, h, a, b, c, d, 0x3956c25b, w4 = BE32(chunk[4]));
+    Round(d, e, f, g, h, a, b, c, 0x59f111f1, w5 = BE32(chunk[5]));
+    Round(c, d, e, f, g, h, a, b, 0x923f82a4, w6 = BE32(chunk[6]));
+    Round(b, c, d, e, f, g, h, a, 0xab1c5ed5, w7 = BE32(chunk[7]));
+    Round(a, b, c, d, e, f, g, h, 0xd807aa98, w8 = BE32(chunk[8]));
+    Round(h, a, b, c, d, e, f, g, 0x12835b01, w9 = BE32(chunk[9]));
+    Round(g, h, a, b, c, d, e, f, 0x243185be, w10 = BE32(chunk[10]));
+    Round(f, g, h, a, b, c, d, e, 0x550c7dc3, w11 = BE32(chunk[11]));
+    Round(e, f, g, h, a, b, c, d, 0x72be5d74, w12 = BE32(chunk[12]));
+    Round(d, e, f, g, h, a, b, c, 0x80deb1fe, w13 = BE32(chunk[13]));
+    Round(c, d, e, f, g, h, a, b, 0x9bdc06a7, w14 = BE32(chunk[14]));
+    Round(b, c, d, e, f, g, h, a, 0xc19bf174, w15 = BE32(chunk[15]));
+
+    Round(a, b, c, d, e, f, g, h, 0xe49b69c1, w0 += sigma1(w14) + w9 + sigma0(w1));
+    Round(h, a, b, c, d, e, f, g, 0xefbe4786, w1 += sigma1(w15) + w10 + sigma0(w2));
+    Round(g, h, a, b, c, d, e, f, 0x0fc19dc6, w2 += sigma1(w0) + w11 + sigma0(w3));
+    Round(f, g, h, a, b, c, d, e, 0x240ca1cc, w3 += sigma1(w1) + w12 + sigma0(w4));
+    Round(e, f, g, h, a, b, c, d, 0x2de92c6f, w4 += sigma1(w2) + w13 + sigma0(w5));
+    Round(d, e, f, g, h, a, b, c, 0x4a7484aa, w5 += sigma1(w3) + w14 + sigma0(w6));
+    Round(c, d, e, f, g, h, a, b, 0x5cb0a9dc, w6 += sigma1(w4) + w15 + sigma0(w7));
+    Round(b, c, d, e, f, g, h, a, 0x76f988da, w7 += sigma1(w5) + w0 + sigma0(w8));
+    Round(a, b, c, d, e, f, g, h, 0x983e5152, w8 += sigma1(w6) + w1 + sigma0(w9));
+    Round(h, a, b, c, d, e, f, g, 0xa831c66d, w9 += sigma1(w7) + w2 + sigma0(w10));
+    Round(g, h, a, b, c, d, e, f, 0xb00327c8, w10 += sigma1(w8) + w3 + sigma0(w11));
+    Round(f, g, h, a, b, c, d, e, 0xbf597fc7, w11 += sigma1(w9) + w4 + sigma0(w12));
+    Round(e, f, g, h, a, b, c, d, 0xc6e00bf3, w12 += sigma1(w10) + w5 + sigma0(w13));
+    Round(d, e, f, g, h, a, b, c, 0xd5a79147, w13 += sigma1(w11) + w6 + sigma0(w14));
+    Round(c, d, e, f, g, h, a, b, 0x06ca6351, w14 += sigma1(w12) + w7 + sigma0(w15));
+    Round(b, c, d, e, f, g, h, a, 0x14292967, w15 += sigma1(w13) + w8 + sigma0(w0));
+
+    Round(a, b, c, d, e, f, g, h, 0x27b70a85, w0 += sigma1(w14) + w9 + sigma0(w1));
+    Round(h, a, b, c, d, e, f, g, 0x2e1b2138, w1 += sigma1(w15) + w10 + sigma0(w2));
+    Round(g, h, a, b, c, d, e, f, 0x4d2c6dfc, w2 += sigma1(w0) + w11 + sigma0(w3));
+    Round(f, g, h, a, b, c, d, e, 0x53380d13, w3 += sigma1(w1) + w12 + sigma0(w4));
+    Round(e, f, g, h, a, b, c, d, 0x650a7354, w4 += sigma1(w2) + w13 + sigma0(w5));
+    Round(d, e, f, g, h, a, b, c, 0x766a0abb, w5 += sigma1(w3) + w14 + sigma0(w6));
+    Round(c, d, e, f, g, h, a, b, 0x81c2c92e, w6 += sigma1(w4) + w15 + sigma0(w7));
+    Round(b, c, d, e, f, g, h, a, 0x92722c85, w7 += sigma1(w5) + w0 + sigma0(w8));
+    Round(a, b, c, d, e, f, g, h, 0xa2bfe8a1, w8 += sigma1(w6) + w1 + sigma0(w9));
+    Round(h, a, b, c, d, e, f, g, 0xa81a664b, w9 += sigma1(w7) + w2 + sigma0(w10));
+    Round(g, h, a, b, c, d, e, f, 0xc24b8b70, w10 += sigma1(w8) + w3 + sigma0(w11));
+    Round(f, g, h, a, b, c, d, e, 0xc76c51a3, w11 += sigma1(w9) + w4 + sigma0(w12));
+    Round(e, f, g, h, a, b, c, d, 0xd192e819, w12 += sigma1(w10) + w5 + sigma0(w13));
+    Round(d, e, f, g, h, a, b, c, 0xd6990624, w13 += sigma1(w11) + w6 + sigma0(w14));
+    Round(c, d, e, f, g, h, a, b, 0xf40e3585, w14 += sigma1(w12) + w7 + sigma0(w15));
+    Round(b, c, d, e, f, g, h, a, 0x106aa070, w15 += sigma1(w13) + w8 + sigma0(w0));
+
+    Round(a, b, c, d, e, f, g, h, 0x19a4c116, w0 += sigma1(w14) + w9 + sigma0(w1));
+    Round(h, a, b, c, d, e, f, g, 0x1e376c08, w1 += sigma1(w15) + w10 + sigma0(w2));
+    Round(g, h, a, b, c, d, e, f, 0x2748774c, w2 += sigma1(w0) + w11 + sigma0(w3));
+    Round(f, g, h, a, b, c, d, e, 0x34b0bcb5, w3 += sigma1(w1) + w12 + sigma0(w4));
+    Round(e, f, g, h, a, b, c, d, 0x391c0cb3, w4 += sigma1(w2) + w13 + sigma0(w5));
+    Round(d, e, f, g, h, a, b, c, 0x4ed8aa4a, w5 += sigma1(w3) + w14 + sigma0(w6));
+    Round(c, d, e, f, g, h, a, b, 0x5b9cca4f, w6 += sigma1(w4) + w15 + sigma0(w7));
+    Round(b, c, d, e, f, g, h, a, 0x682e6ff3, w7 += sigma1(w5) + w0 + sigma0(w8));
+    Round(a, b, c, d, e, f, g, h, 0x748f82ee, w8 += sigma1(w6) + w1 + sigma0(w9));
+    Round(h, a, b, c, d, e, f, g, 0x78a5636f, w9 += sigma1(w7) + w2 + sigma0(w10));
+    Round(g, h, a, b, c, d, e, f, 0x84c87814, w10 += sigma1(w8) + w3 + sigma0(w11));
+    Round(f, g, h, a, b, c, d, e, 0x8cc70208, w11 += sigma1(w9) + w4 + sigma0(w12));
+    Round(e, f, g, h, a, b, c, d, 0x90befffa, w12 += sigma1(w10) + w5 + sigma0(w13));
+    Round(d, e, f, g, h, a, b, c, 0xa4506ceb, w13 += sigma1(w11) + w6 + sigma0(w14));
+    Round(c, d, e, f, g, h, a, b, 0xbef9a3f7, w14 + sigma1(w12) + w7 + sigma0(w15));
+    Round(b, c, d, e, f, g, h, a, 0xc67178f2, w15 + sigma1(w13) + w8 + sigma0(w0));
+
+    s[0] += a;
+    s[1] += b;
+    s[2] += c;
+    s[3] += d;
+    s[4] += e;
+    s[5] += f;
+    s[6] += g;
+    s[7] += h;
+}
+
+static void secp256k1_sha256_write(secp256k1_sha256 *hash, const unsigned char *data, size_t len) {
+    size_t bufsize = hash->bytes & 0x3F;
+    hash->bytes += len;
+    while (bufsize + len >= 64) {
+        /* Fill the buffer, and process it. */
+        size_t chunk_len = 64 - bufsize;
+        memcpy(((unsigned char*)hash->buf) + bufsize, data, chunk_len);
+        data += chunk_len;
+        len -= chunk_len;
+        secp256k1_sha256_transform(hash->s, hash->buf);
+        bufsize = 0;
+    }
+    if (len) {
+        /* Fill the buffer with what remains. */
+        memcpy(((unsigned char*)hash->buf) + bufsize, data, len);
+    }
+}
+
+static void secp256k1_sha256_finalize(secp256k1_sha256 *hash, unsigned char *out32) {
+    static const unsigned char pad[64] = {0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
+    uint32_t sizedesc[2];
+    uint32_t out[8];
+    int i = 0;
+    sizedesc[0] = BE32(hash->bytes >> 29);
+    sizedesc[1] = BE32(hash->bytes << 3);
+    secp256k1_sha256_write(hash, pad, 1 + ((119 - (hash->bytes % 64)) % 64));
+    secp256k1_sha256_write(hash, (const unsigned char*)sizedesc, 8);
+    for (i = 0; i < 8; i++) {
+        out[i] = BE32(hash->s[i]);
+        hash->s[i] = 0;
+    }
+    memcpy(out32, (const unsigned char*)out, 32);
+}
+
+static void secp256k1_hmac_sha256_initialize(secp256k1_hmac_sha256 *hash, const unsigned char *key, size_t keylen) {
+    size_t n;
+    unsigned char rkey[64];
+    if (keylen <= sizeof(rkey)) {
+        memcpy(rkey, key, keylen);
+        memset(rkey + keylen, 0, sizeof(rkey) - keylen);
+    } else {
+        secp256k1_sha256 sha256;
+        secp256k1_sha256_initialize(&sha256);
+        secp256k1_sha256_write(&sha256, key, keylen);
+        secp256k1_sha256_finalize(&sha256, rkey);
+        memset(rkey + 32, 0, 32);
+    }
+
+    secp256k1_sha256_initialize(&hash->outer);
+    for (n = 0; n < sizeof(rkey); n++) {
+        rkey[n] ^= 0x5c;
+    }
+    secp256k1_sha256_write(&hash->outer, rkey, sizeof(rkey));
+
+    secp256k1_sha256_initialize(&hash->inner);
+    for (n = 0; n < sizeof(rkey); n++) {
+        rkey[n] ^= 0x5c ^ 0x36;
+    }
+    secp256k1_sha256_write(&hash->inner, rkey, sizeof(rkey));
+    memset(rkey, 0, sizeof(rkey));
+}
+
+static void secp256k1_hmac_sha256_write(secp256k1_hmac_sha256 *hash, const unsigned char *data, size_t size) {
+    secp256k1_sha256_write(&hash->inner, data, size);
+}
+
+static void secp256k1_hmac_sha256_finalize(secp256k1_hmac_sha256 *hash, unsigned char *out32) {
+    unsigned char temp[32];
+    secp256k1_sha256_finalize(&hash->inner, temp);
+    secp256k1_sha256_write(&hash->outer, temp, 32);
+    memset(temp, 0, 32);
+    secp256k1_sha256_finalize(&hash->outer, out32);
+}
+
+
+static void secp256k1_rfc6979_hmac_sha256_initialize(secp256k1_rfc6979_hmac_sha256 *rng, const unsigned char *key, size_t keylen) {
+    secp256k1_hmac_sha256 hmac;
+    static const unsigned char zero[1] = {0x00};
+    static const unsigned char one[1] = {0x01};
+
+    memset(rng->v, 0x01, 32); /* RFC6979 3.2.b. */
+    memset(rng->k, 0x00, 32); /* RFC6979 3.2.c. */
+
+    /* RFC6979 3.2.d. */
+    secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+    secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+    secp256k1_hmac_sha256_write(&hmac, zero, 1);
+    secp256k1_hmac_sha256_write(&hmac, key, keylen);
+    secp256k1_hmac_sha256_finalize(&hmac, rng->k);
+    secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+    secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+    secp256k1_hmac_sha256_finalize(&hmac, rng->v);
+
+    /* RFC6979 3.2.f. */
+    secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+    secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+    secp256k1_hmac_sha256_write(&hmac, one, 1);
+    secp256k1_hmac_sha256_write(&hmac, key, keylen);
+    secp256k1_hmac_sha256_finalize(&hmac, rng->k);
+    secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+    secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+    secp256k1_hmac_sha256_finalize(&hmac, rng->v);
+    rng->retry = 0;
+}
+
+static void secp256k1_rfc6979_hmac_sha256_generate(secp256k1_rfc6979_hmac_sha256 *rng, unsigned char *out, size_t outlen) {
+    /* RFC6979 3.2.h. */
+    static const unsigned char zero[1] = {0x00};
+    if (rng->retry) {
+        secp256k1_hmac_sha256 hmac;
+        secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+        secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+        secp256k1_hmac_sha256_write(&hmac, zero, 1);
+        secp256k1_hmac_sha256_finalize(&hmac, rng->k);
+        secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+        secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+        secp256k1_hmac_sha256_finalize(&hmac, rng->v);
+    }
+
+    while (outlen > 0) {
+        secp256k1_hmac_sha256 hmac;
+        int now = outlen;
+        secp256k1_hmac_sha256_initialize(&hmac, rng->k, 32);
+        secp256k1_hmac_sha256_write(&hmac, rng->v, 32);
+        secp256k1_hmac_sha256_finalize(&hmac, rng->v);
+        if (now > 32) {
+            now = 32;
+        }
+        memcpy(out, rng->v, now);
+        out += now;
+        outlen -= now;
+    }
+
+    rng->retry = 1;
+}
+
+static void secp256k1_rfc6979_hmac_sha256_finalize(secp256k1_rfc6979_hmac_sha256 *rng) {
+    memset(rng->k, 0, 32);
+    memset(rng->v, 0, 32);
+    rng->retry = 0;
+}
+
+#undef BE32
+#undef Round
+#undef sigma1
+#undef sigma0
+#undef Sigma1
+#undef Sigma0
+#undef Maj
+#undef Ch
+
+#endif /* SECP256K1_HASH_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.ml b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.ml
new file mode 100644
index 000000000..ea52c48ea
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.ml
@@ -0,0 +1,413 @@
+module Num = struct
+  type t = Cstruct.buffer
+
+  external size :
+    unit -> int = "sizeof_secp256k1_num" [@@noalloc]
+  external copy :
+    t -> t -> unit = "ml_secp256k1_num_copy" [@@noalloc]
+  external get_bin :
+    Cstruct.buffer -> int -> t -> unit = "ml_secp256k1_num_get_bin" [@@noalloc]
+  external set_bin :
+    t -> Cstruct.buffer -> int -> unit = "ml_secp256k1_num_set_bin" [@@noalloc]
+  external mod_inverse :
+    t -> t -> t -> unit = "ml_secp256k1_num_mod_inverse" [@@noalloc]
+  external jacobi :
+    t -> t -> int = "ml_secp256k1_num_jacobi" [@@noalloc]
+  external compare :
+    t -> t -> int = "ml_secp256k1_num_cmp" [@@noalloc]
+  external equal :
+    t -> t -> bool = "ml_secp256k1_num_eq" [@@noalloc]
+  external add :
+    t -> t -> t -> unit = "ml_secp256k1_num_add" [@@noalloc]
+  external sub :
+    t -> t -> t -> unit = "ml_secp256k1_num_sub" [@@noalloc]
+  external mul :
+    t -> t -> t -> unit = "ml_secp256k1_num_mul" [@@noalloc]
+  external modulo :
+    t -> t -> unit = "ml_secp256k1_num_mod" [@@noalloc]
+  external shift :
+    t -> int -> unit = "ml_secp256k1_num_shift" [@@noalloc]
+  external is_zero :
+    t -> bool = "ml_secp256k1_num_is_zero" [@@noalloc]
+  external is_one :
+    t -> bool = "ml_secp256k1_num_is_one" [@@noalloc]
+  external is_neg :
+    t -> bool = "ml_secp256k1_num_is_neg" [@@noalloc]
+  external negate :
+    t -> unit = "ml_secp256k1_num_negate" [@@noalloc]
+
+  let size = size ()
+
+  let get_bin cs =
+    Cstruct.(get_bin (to_bigarray cs) (len cs))
+  let set_bin r cs =
+    Cstruct.(set_bin r (to_bigarray cs) (len cs))
+
+  let of_uint16 i =
+    let t = Cstruct.create size in
+    let cs = Cstruct.create 2 in
+    Cstruct.BE.set_uint16 cs 0 i ;
+    set_bin t.buffer cs ;
+    t.buffer
+
+  let zero () = of_uint16 0
+  let one () = of_uint16 1
+
+  let of_uint32 i =
+    let t = Cstruct.create size in
+    let cs = Cstruct.create 4 in
+    Cstruct.BE.set_uint32 cs 0 i ;
+    set_bin t.buffer cs ;
+    t.buffer
+
+  let of_uint64 i =
+    let t = Cstruct.create size in
+    let cs = Cstruct.create 8 in
+    Cstruct.BE.set_uint64 cs 0 i ;
+    set_bin t.buffer cs ;
+    t.buffer
+end
+
+module Scalar = struct
+  type t = Cstruct.buffer
+
+  let size = 32
+
+  external const :
+    t -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> unit =
+    "ml_secp256k1_scalar_const_bytecode" "ml_secp256k1_scalar_const" [@@noalloc]
+
+  let const ?(d7=0L) ?(d6=0L) ?(d5=0L) ?(d4=0L) ?(d3=0L) ?(d2=0L) ?(d1=0L) ?(d0=0L) () =
+    let buf = Cstruct.create size in
+    const buf.buffer d7 d6 d5 d4 d3 d2 d1 d0 ;
+    buf.buffer
+
+  let zero () = const ()
+  let one () = const ~d0:1L ()
+  let copy t =
+    let ret = Cstruct.create size in
+    Cstruct.(blit (of_bigarray t) 0 ret 0 size) ;
+    ret.buffer
+
+  external clear :
+    t -> unit = "ml_secp256k1_scalar_clear" [@@noalloc]
+  external get_bits :
+    t -> int -> int -> int = "ml_secp256k1_scalar_get_bits" [@@noalloc]
+  external get_bits_var :
+    t -> int -> int -> int = "ml_secp256k1_scalar_get_bits_var" [@@noalloc]
+  external set_b32 :
+    t -> Cstruct.buffer -> bool = "ml_secp256k1_scalar_set_b32" [@@noalloc]
+  external set_int :
+    Cstruct.buffer -> int -> unit = "ml_secp256k1_scalar_set_int" [@@noalloc]
+  external get_b32 :
+    Cstruct.buffer -> t -> unit = "ml_secp256k1_scalar_get_b32" [@@noalloc]
+  external add :
+    t -> t -> t -> bool = "ml_secp256k1_scalar_add" [@@noalloc]
+  external cadd_bit :
+    t -> int -> bool -> unit = "ml_secp256k1_scalar_cadd_bit" [@@noalloc]
+  external mul :
+    t -> t -> t -> unit = "ml_secp256k1_scalar_mul" [@@noalloc]
+  external shr_int :
+    t -> int -> int = "ml_secp256k1_scalar_shr_int" [@@noalloc]
+  external sqr :
+    t -> t -> unit = "ml_secp256k1_scalar_sqr" [@@noalloc]
+  external inverse :
+    t -> t -> unit = "ml_secp256k1_scalar_inverse" [@@noalloc]
+  external inverse_var :
+    t -> t -> unit = "ml_secp256k1_scalar_inverse_var" [@@noalloc]
+  external negate :
+    t -> t -> unit = "ml_secp256k1_scalar_negate" [@@noalloc]
+  external is_zero :
+    t -> bool = "ml_secp256k1_scalar_is_zero" [@@noalloc]
+  external is_one :
+    t -> bool = "ml_secp256k1_scalar_is_one" [@@noalloc]
+  external is_even :
+    t -> bool = "ml_secp256k1_scalar_is_even" [@@noalloc]
+  external is_high :
+    t -> bool = "ml_secp256k1_scalar_is_high" [@@noalloc]
+  external cond_negate :
+    t -> bool -> bool = "ml_secp256k1_scalar_cond_negate" [@@noalloc]
+  external get_num :
+    Num.t -> t -> unit = "ml_secp256k1_scalar_get_num" [@@noalloc]
+  external order_get_num :
+    Num.t -> unit = "ml_secp256k1_scalar_order_get_num" [@@noalloc]
+  external equal :
+    t -> t -> bool = "ml_secp256k1_scalar_eq" [@@noalloc]
+  external mul_shift_var :
+    t -> t -> t -> int -> unit = "ml_secp256k1_mul_shift_var" [@@noalloc]
+
+  let set_b32 t buf = set_b32 t (Cstruct.to_bigarray buf)
+  let get_b32 buf t = get_b32 (Cstruct.to_bigarray buf) t
+end
+
+module Field = struct
+  type t = Cstruct.buffer
+
+  module Storage = struct
+    type t = Cstruct.buffer
+    let size = 32
+    let to_cstruct t = Cstruct.of_bigarray t
+    let of_cstruct cs =
+      let res = Cstruct.create size in
+      try
+        Cstruct.blit cs 0 res 0 size ;
+        Some res.buffer
+      with _ -> None
+    let of_cstruct_exn cs =
+      match of_cstruct cs with
+      | Some t -> t
+      | None -> invalid_arg "Field.Storage.of_cstruct_exn"
+
+    external const :
+      t -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> unit =
+      "ml_secp256k1_fe_storage_const_bytecode" "ml_secp256k1_fe_storage_const" [@@noalloc]
+
+    let const ?(d7=0L) ?(d6=0L) ?(d5=0L) ?(d4=0L) ?(d3=0L) ?(d2=0L) ?(d1=0L) ?(d0=0L) () =
+      let buf = Cstruct.create size in
+      const buf.buffer d7 d6 d5 d4 d3 d2 d1 d0 ;
+      buf.buffer
+
+    external cmov :
+      t -> t -> bool -> unit = "ml_secp256k1_fe_storage_cmov" [@@noalloc]
+  end
+
+  let size = 40
+
+  external const :
+    t -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> int64 -> unit =
+    "ml_secp256k1_fe_const_bytecode" "ml_secp256k1_fe_const" [@@noalloc]
+
+  let const ?(d7=0L) ?(d6=0L) ?(d5=0L) ?(d4=0L) ?(d3=0L) ?(d2=0L) ?(d1=0L) ?(d0=0L) () =
+    let buf = Cstruct.create size in
+    const buf.buffer d7 d6 d5 d4 d3 d2 d1 d0 ;
+    buf.buffer
+
+  external normalize :
+    t -> unit = "ml_secp256k1_fe_normalize" [@@noalloc]
+  external normalize_weak :
+    t -> unit = "ml_secp256k1_fe_normalize_weak" [@@noalloc]
+  external normalize_var :
+    t -> unit = "ml_secp256k1_fe_normalize_var" [@@noalloc]
+  external normalizes_to_zero :
+    t -> bool = "ml_secp256k1_fe_normalizes_to_zero" [@@noalloc]
+  external normalizes_to_zero_var :
+    t -> bool = "ml_secp256k1_fe_normalizes_to_zero_var" [@@noalloc]
+  external set_int :
+    t -> int -> unit = "ml_secp256k1_fe_set_int" [@@noalloc]
+  external clear :
+    t -> unit = "ml_secp256k1_fe_clear" [@@noalloc]
+  external is_zero :
+    t -> bool = "ml_secp256k1_fe_is_zero" [@@noalloc]
+  external is_odd :
+    t -> bool = "ml_secp256k1_fe_is_odd" [@@noalloc]
+  external equal :
+    t -> t -> bool = "ml_secp256k1_fe_equal" [@@noalloc]
+  external equal_var :
+    t -> t -> bool = "ml_secp256k1_fe_equal_var" [@@noalloc]
+  external cmp_var :
+    t -> t -> int = "ml_secp256k1_fe_cmp_var" [@@noalloc]
+  external set_b32 :
+    t -> Cstruct.buffer -> bool = "ml_secp256k1_fe_set_b32" [@@noalloc]
+  external get_b32 :
+    Cstruct.buffer -> t -> unit = "ml_secp256k1_fe_get_b32" [@@noalloc]
+  external negate :
+    t -> t -> int -> unit = "ml_secp256k1_fe_negate" [@@noalloc]
+  external mul_int :
+    t -> int -> unit = "ml_secp256k1_fe_mul_int" [@@noalloc]
+  external add :
+    t -> t -> unit = "ml_secp256k1_fe_add" [@@noalloc]
+  external mul :
+    t -> t -> t -> unit = "ml_secp256k1_fe_mul" [@@noalloc]
+  external sqr :
+    t -> t -> unit = "ml_secp256k1_fe_sqr" [@@noalloc]
+  external sqrt :
+    t -> t -> int = "ml_secp256k1_fe_sqrt" [@@noalloc]
+  external is_quad_var :
+    t -> bool = "ml_secp256k1_fe_is_quad_var" [@@noalloc]
+  external inv :
+    t -> t -> unit = "ml_secp256k1_fe_inv" [@@noalloc]
+  external inv_var :
+    t -> t -> unit = "ml_secp256k1_fe_inv_var" [@@noalloc]
+  external inv_all_var :
+    t -> Cstruct.buffer -> int -> unit = "ml_secp256k1_fe_inv_all_var" [@@noalloc]
+  external to_storage :
+    Storage.t -> t -> unit = "ml_secp256k1_fe_to_storage" [@@noalloc]
+  external from_storage :
+    t -> Storage.t -> unit = "ml_secp256k1_fe_from_storage" [@@noalloc]
+  external cmov :
+    t -> t -> bool -> unit = "ml_secp256k1_fe_cmov" [@@noalloc]
+
+  let inv_all_var r fes =
+    let nb_fe = List.length fes in
+    let cs = Cstruct.create (nb_fe * size) in
+    List.iteri
+      (fun i fe -> Cstruct.(blit (of_bigarray fe) 0 cs (i*size) size)) fes ;
+    inv_all_var r cs.buffer nb_fe ;
+    Cstruct.memset cs 0
+
+  let set_b32 t buf = set_b32 t (Cstruct.to_bigarray buf)
+  let get_b32 buf t = get_b32 (Cstruct.to_bigarray buf) t
+
+  let compare = cmp_var
+end
+
+module Group = struct
+  type t = Cstruct.buffer
+  type ge = t
+
+  let size = 2 * Field.size + 8
+
+  module Storage = struct
+    type t = Cstruct.buffer
+    let size = 2 * Field.Storage.size
+    let to_cstruct t = Cstruct.of_bigarray t
+    let of_cstruct cs =
+      let res = Cstruct.create size in
+      try
+        Cstruct.blit cs 0 res 0 size ;
+        Some res.buffer
+      with _ -> None
+    let of_cstruct_exn cs =
+      match of_cstruct cs with
+      | Some t -> t
+      | None -> invalid_arg "Group.Storage.of_cstruct_exn"
+    external of_fields :
+      t -> Field.Storage.t -> Field.Storage.t -> unit =
+      "ml_secp256k1_ge_storage_of_fields" [@@noalloc]
+    let of_fields ?(x=Field.const ()) ?(y=Field.const ()) () =
+      let cs = Cstruct.create size in
+      of_fields cs.buffer x y ;
+      cs.buffer
+    external cmov : t -> t -> bool -> unit =
+      "ml_secp256k1_ge_storage_cmov" [@@noalloc]
+  end
+
+  module Jacobian = struct
+    type t = Cstruct.buffer
+
+    let size = 3 * Field.size + 8
+
+    external of_fields :
+      t -> Field.t -> Field.t -> Field.t -> bool -> unit =
+      "ml_secp256k1_gej_of_fields" [@@noalloc]
+
+    external set_infinity : t -> unit =
+      "ml_secp256k1_gej_set_infinity" [@@noalloc]
+
+    external set_ge : t -> ge -> unit =
+      "ml_secp256k1_gej_set_ge" [@@noalloc]
+
+    external get_ge : ge -> t -> unit =
+      "ml_secp256k1_ge_set_gej" [@@noalloc]
+
+    external eq_x_var : Field.t -> t -> int =
+      "ml_secp256k1_gej_eq_x_var" [@@noalloc]
+
+    external neg : t -> t -> unit =
+      "ml_secp256k1_gej_neg" [@@noalloc]
+
+    external is_infinity : t -> bool =
+      "ml_secp256k1_gej_is_infinity" [@@noalloc]
+
+    external has_quad_y_var : t -> bool =
+      "ml_secp256k1_gej_has_quad_y_var" [@@noalloc]
+
+    external double_nonzero : t -> t -> Field.t option -> unit =
+      "ml_secp256k1_gej_double_nonzero" [@@noalloc]
+
+    external double_var : t -> t -> Field.t option -> unit =
+      "ml_secp256k1_gej_double_var" [@@noalloc]
+
+    external add_var : t -> t -> t -> Field.t option -> unit =
+      "ml_secp256k1_gej_add_var" [@@noalloc]
+
+    external add_ge : t -> t -> ge -> unit =
+      "ml_secp256k1_gej_add_ge" [@@noalloc]
+
+    external add_ge_var : t -> t -> ge -> Field.t option -> unit =
+      "ml_secp256k1_gej_add_ge_var" [@@noalloc]
+
+    external add_zinv_var : t -> t -> ge -> Field.t -> unit =
+      "ml_secp256k1_gej_add_zinv_var" [@@noalloc]
+
+    external mul : t -> ge -> Scalar.t -> unit =
+      "ml_secp256k1_ecmult_const" [@@noalloc]
+
+    external clear : t -> unit =
+      "ml_secp256k1_gej_clear" [@@noalloc]
+
+    external rescale : t -> Field.t -> unit =
+      "ml_secp256k1_gej_rescale" [@@noalloc]
+
+    let of_fields ?(x=Field.const ()) ?(y=Field.const ()) ?(z=Field.const ()) ?(infinity=false) () =
+      let cs = Cstruct.create size in
+      of_fields cs.buffer x y z infinity ;
+      cs.buffer
+
+    let double_nonzero ?rzr r a = double_nonzero r a rzr
+    let double_var ?rzr r a = double_var r a rzr
+    let add_var ?rzr r a b = add_var r a b rzr
+    let add_ge_var ?rzr r a b = add_ge_var r a b rzr
+  end
+
+  external of_fields :
+    t -> Field.t -> Field.t -> bool -> unit =
+    "ml_secp256k1_ge_of_fields" [@@noalloc]
+
+  external set_xy : t -> Field.t -> Field.t -> unit =
+    "ml_secp256k1_ge_set_xy" [@@noalloc]
+
+  external set_xquad : t -> Field.t -> unit =
+    "ml_secp256k1_ge_set_xquad" [@@noalloc]
+
+  external set_xovar : t -> Field.t -> int -> bool =
+    "ml_secp256k1_ge_set_xquad" [@@noalloc]
+
+  external is_infinity : t -> bool =
+    "ml_secp256k1_ge_is_infinity" [@@noalloc]
+
+  external is_valid_var : t -> bool =
+    "ml_secp256k1_ge_is_valid_var" [@@noalloc]
+
+  external neg : t -> t -> unit =
+    "ml_secp256k1_ge_neg" [@@noalloc]
+
+  external clear : t -> unit =
+    "ml_secp256k1_ge_clear" [@@noalloc]
+
+  external to_storage : Storage.t -> t -> unit =
+    "ml_secp256k1_ge_to_storage" [@@noalloc]
+
+  external from_storage : t -> Storage.t -> unit =
+    "ml_secp256k1_ge_from_storage" [@@noalloc]
+
+  let of_fields ?(x=Field.const ()) ?(y=Field.const ()) ?(infinity=false) () =
+    let cs = Cstruct.create size in
+    of_fields cs.buffer x y infinity ;
+    cs.buffer
+
+  let g =
+    let x = Field.const
+        ~d7:0x79BE667EL ~d6:0xF9DCBBACL ~d5:0x55A06295L ~d4:0xCE870B07L
+        ~d3:0x029BFCDBL ~d2:0x2DCE28D9L ~d1:0x59F2815BL ~d0:0x16F81798L () in
+    let y = Field.const
+        ~d7:0x483ADA77L ~d6:0x26A3C465L ~d5:0x5DA4FBFCL ~d4:0x0E1108A8L
+        ~d3:0xFD17B448L ~d2:0xA6855419L ~d1:0x9C47D08FL ~d0:0xFB10D4B8L () in
+    of_fields ~x ~y ~infinity:false ()
+
+  external serialize : t -> Cstruct.buffer -> int -> bool -> int =
+    "ml_secp256k1_eckey_pubkey_serialize" [@@noalloc]
+
+  external parse : t -> Cstruct.buffer -> int -> bool =
+    "ml_secp256k1_eckey_pubkey_parse" [@@noalloc]
+
+  let to_pubkey ?(compress=true) cs e =
+    match serialize e cs.Cstruct.buffer cs.len compress with
+    | 0 -> failwith "Group.to_pubkey"
+    | len -> Cstruct.sub cs 0 len
+
+  let from_pubkey t cs =
+    match parse t cs.Cstruct.buffer cs.len with
+    | false -> failwith "Group.from_pubkey"
+    | true -> ()
+end
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.mli b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.mli
new file mode 100644
index 000000000..e4816168a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/internal.mli
@@ -0,0 +1,450 @@
+module Num : sig
+  type t
+
+  val zero : unit -> t
+  val one : unit -> t
+  val of_uint16 : int -> t
+  val of_uint32 : int32 -> t
+  val of_uint64 : int64 -> t
+
+  val copy : t -> t -> unit
+  (** Copy a number. *)
+
+  val get_bin : Cstruct.t -> t -> unit
+  (** Convert a number's absolute value to a binary big-endian string.
+      There must be enough place. *)
+
+  val set_bin : t -> Cstruct.t -> unit
+  (** Set a number to the value of a binary big-endian string. *)
+
+  val mod_inverse : t -> t -> t -> unit
+  (** [mod_inverse r a m] Compute a modular inverse. The input must be
+      less than the modulus. *)
+
+  val jacobi : t -> t -> int
+  (** Compute the jacobi symbol (a|b). b must be positive and odd. *)
+
+  val compare : t -> t -> int
+  (** Compare the absolute value of two numbers. *)
+
+  val equal : t -> t -> bool
+  (** Test whether two number are equal (including sign). *)
+
+  val add : t -> t -> t -> unit
+  (** [add r a b] Add two (signed) numbers. *)
+
+  val sub : t -> t -> t -> unit
+  (** [sub r a b] Subtract two (signed) numbers. *)
+
+  val mul : t -> t -> t -> unit
+  (** [mul r a b] Multiply two (signed) numbers. *)
+
+  val modulo : t -> t -> unit
+  (** Replace a number by its remainder modulo m. M's sign is
+      ignored. The result is a number between 0 and m-1, even if r was
+      negative. *)
+
+  val shift : t -> int -> unit
+  (** [shift t bits] Right-shift the passed number by [bits] bits. *)
+
+  val is_zero : t -> bool
+  (** Check whether a number is zero. *)
+
+  val is_one : t -> bool
+  (** Check whether a number is one. *)
+
+  val is_neg : t -> bool
+  (** Check whether a number is strictly negative. *)
+
+  val negate : t -> unit
+  (** Change a number's sign. *)
+end
+
+module Scalar : sig
+  type t
+  (** A scalar modulo the group order of the secp256k1 curve. *)
+
+  val zero : unit -> t
+  val one : unit -> t
+  val copy : t -> t
+
+  val const :
+    ?d7:int64 -> ?d6:int64 -> ?d5:int64 -> ?d4:int64 ->
+    ?d3:int64 -> ?d2:int64 -> ?d1:int64 -> ?d0:int64 -> unit -> t
+
+  val clear : t -> unit
+  (** Clear a scalar to prevent the leak of sensitive data. *)
+
+  val get_bits : t -> int -> int -> int
+  (** [get_bits a offset count] Access bits from a scalar. All
+      requested bits must belong to the same 32-bit limb. *)
+
+  val get_bits_var : t -> int -> int -> int
+  (** [get_bits a offset count] Access bits from a scalar. Not
+      constant time. *)
+
+  val set_b32 : t -> Cstruct.t -> bool
+  (** Set a scalar from a big endian byte array. *)
+
+  val set_int : t -> int -> unit
+  (** Set a scalar to an unsigned integer. *)
+
+  val get_b32 : Cstruct.t -> t -> unit
+  (** Convert a scalar to a byte array. *)
+
+  val add : t -> t -> t -> bool
+  (** [add r a b] Add two scalars together (modulo the group
+      order). Returns whether it overflowed. *)
+
+  val cadd_bit : t -> int -> bool -> unit
+  (** [cadd_bit r bit flag] Conditionally add a power of two to a
+      scalar. The result is not allowed to overflow. *)
+
+  val mul : t -> t -> t -> unit
+  (** [mul r a b] Multiply two scalars (modulo the group order). *)
+
+  val shr_int : t -> int -> int
+  (** Shift a scalar right by some amount strictly between 0 and 16,
+      returning the low bits that were shifted off *)
+
+  val sqr : t -> t -> unit
+  (** [sqr r a] Compute the square of a scalar (modulo the group
+      order). *)
+
+  val inverse : t -> t -> unit
+  (** [inverse r a] Compute the inverse of a scalar (modulo the group
+      order). *)
+
+  val inverse_var : t -> t -> unit
+  (** [inverse_var r a] Compute the inverse of a scalar (modulo the
+      group order), without constant-time guarantee. *)
+
+  val negate : t -> t -> unit
+  (** [negate r a] Compute the complement of a scalar (modulo the
+      group order). *)
+
+  val is_zero : t -> bool
+  (** Check whether a scalar equals zero. *)
+
+  val is_one : t -> bool
+  (** Check whether a scalar equals one. *)
+
+  val is_even : t -> bool
+  (** Check whether a scalar, considered as an nonnegative integer, is
+      even. *)
+
+  val is_high : t -> bool
+  (** Check whether a scalar is higher than the group order divided by
+      2. *)
+
+  val cond_negate : t -> bool -> bool
+  (** Conditionally negate a number, in constant time. Returns [true]
+      if the number was negated, [false] otherwise *)
+
+  val get_num : Num.t -> t -> unit
+  (** Convert a scalar to a number. *)
+
+  val order_get_num : Num.t -> unit
+  (** Get the order of the group as a number. *)
+
+  val equal : t -> t -> bool
+  (** Compare two scalars. *)
+
+  val mul_shift_var : t -> t -> t -> int -> unit
+  (** Multiply a and b (without taking the modulus!), divide by
+      2**shift, and round to the nearest integer. Shift must be at
+      least 256. *)
+end
+
+(** Field element module.
+ *
+ *  Field elements can be represented in several ways, but code accessing
+ *  it (and implementations) need to take certain properties into account:
+ *  - Each field element can be normalized or not.
+ *  - Each field element has a magnitude, which represents how far away
+ *    its representation is away from normalization. Normalized elements
+ *    always have a magnitude of 1, but a magnitude of 1 doesn't imply
+ *    normality. *)
+module Field : sig
+  type t
+
+  module Storage : sig
+    type t
+    val size : int
+    val of_cstruct : Cstruct.t -> t option
+    val of_cstruct_exn : Cstruct.t -> t
+    val to_cstruct : t -> Cstruct.t
+    val const :
+      ?d7:int64 -> ?d6:int64 -> ?d5:int64 -> ?d4:int64 ->
+      ?d3:int64 -> ?d2:int64 -> ?d1:int64 -> ?d0:int64 -> unit -> t
+    val cmov : t -> t -> bool -> unit
+    (** If flag is true, set *r equal to *a; otherwise leave
+        it. Constant-time. *)
+  end
+
+  val const :
+    ?d7:int64 -> ?d6:int64 -> ?d5:int64 -> ?d4:int64 ->
+    ?d3:int64 -> ?d2:int64 -> ?d1:int64 -> ?d0:int64 -> unit -> t
+  (** Unpacks a constant into a overlapping multi-limbed FE
+      element. *)
+
+  val normalize : t -> unit
+  (** Normalize a field element. *)
+
+  val normalize_weak : t -> unit
+  (** Weakly normalize a field element: reduce it magnitude to 1, but
+      don't fully normalize. *)
+
+  val normalize_var : t -> unit
+  (** Normalize a field element, without constant-time guarantee. *)
+
+  val normalizes_to_zero : t -> bool
+  (** Verify whether a field element represents zero i.e. would
+      normalize to a zero value. The field implementation may
+      optionally normalize the input, but this should not be relied
+      upon. *)
+
+  val normalizes_to_zero_var : t -> bool
+  (** Verify whether a field element represents zero i.e. would
+      normalize to a zero value. The field implementation may
+      optionally normalize the input, but this should not be relied
+      upon. *)
+
+  val set_int : t -> int -> unit
+  (** Set a field element equal to a small integer. Resulting field
+      element is normalized. *)
+
+  val clear : t -> unit
+  (** Sets a field element equal to zero, initializing all fields. *)
+
+  val is_zero : t -> bool
+  (** Verify whether a field element is zero. Requires the input to be
+      normalized. *)
+
+  val is_odd : t -> bool
+  (** Check the "oddness" of a field element. Requires the input to be
+      normalized. *)
+
+  val equal : t -> t -> bool
+  (** Compare two field elements. Requires magnitude-1 inputs. *)
+
+  val equal_var : t -> t -> bool
+  (** Same as secp256k1_fe_equal, but may be variable time. *)
+
+  val cmp_var : t -> t -> int
+  (** Compare two field elements. Requires both inputs to be
+      normalized. *)
+
+  val compare : t -> t -> int
+  (** Alias to [cmp_var]. *)
+
+  val set_b32 : t -> Cstruct.t -> bool
+  (** Set a field element equal to 32-byte big endian value. If
+      successful, the resulting field element is normalized. *)
+
+  val get_b32 : Cstruct.t -> t -> unit
+  (** Convert a field element to a 32-byte big endian value. Requires
+      the input to be normalized. *)
+
+  val negate : t -> t -> int -> unit
+  (** Set a field element equal to the additive inverse of
+      another. Takes a maximum magnitude of the input as an
+      argument. The magnitude of the output is one higher. *)
+
+  val mul_int : t -> int -> unit
+  (** Multiplies the passed field element with a small integer
+      constant. Multiplies the magnitude by that small integer. *)
+
+  val add : t -> t -> unit
+  (** Adds a field element to another. The result has the sum of the
+      inputs' magnitudes as magnitude. *)
+
+  val mul : t -> t -> t -> unit
+  (** Sets a field element to be the product of two others. Requires
+      the inputs' magnitudes to be at most 8.  The output magnitude is
+      1 (but not guaranteed to be normalized). *)
+
+  val sqr : t -> t -> unit
+  (** Sets a field element to be the square of another. Requires the
+      input's magnitude to be at most 8.  The output magnitude is 1
+      (but not guaranteed to be normalized). *)
+
+  val sqrt : t -> t -> int
+  (** If a has a square root, it is computed in r and 1 is
+      returned. If a does not have a square root, the root of its
+      negation is computed and 0 is returned. The input's magnitude
+      can be at most 8. The output magnitude is 1 (but not guaranteed
+      to be normalized). The result in r will always be a square
+      itself. *)
+
+  val is_quad_var : t -> bool
+  (** Checks whether a field element is a quadratic residue. *)
+
+  val inv : t -> t -> unit
+  (** Sets a field element to be the (modular) inverse of
+      another. Requires the input's magnitude to be at most 8. The
+      output magnitude is 1 (but not guaranteed to be normalized). *)
+
+  val inv_var : t -> t -> unit
+  (** Potentially faster version of secp256k1_fe_inv, without
+      constant-time guarantee. *)
+
+  val inv_all_var : t -> t list -> unit
+  (** Calculate the (modular) inverses of a batch of field
+      elements. Requires the inputs' magnitudes to be at most 8. The
+      output magnitudes are 1 (but not guaranteed to be
+      normalized). The inputs and outputs must not overlap in
+      memory. *)
+
+  val to_storage : Storage.t -> t -> unit
+  (** Convert a field element to the storage type. *)
+
+  val from_storage : t -> Storage.t -> unit
+  (** Convert a field element back from the storage type. *)
+
+  val cmov : t -> t -> bool -> unit
+  (** If flag is true, set *r equal to *a; otherwise leave
+      it. Constant-time. *)
+end
+
+module Group : sig
+  type t
+  (** Type of a group element (affine coordinates). *)
+
+  type ge = t
+
+  module Storage : sig
+    type t
+    val size : int
+    val of_cstruct : Cstruct.t -> t option
+    val of_cstruct_exn : Cstruct.t -> t
+    val to_cstruct : t -> Cstruct.t
+    val of_fields :
+      ?x:Field.Storage.t -> ?y:Field.Storage.t -> unit -> t
+    val cmov : t -> t -> bool -> unit
+    (** If flag is true, set *r equal to *a; otherwise leave
+        it. Constant-time. *)
+  end
+
+  module Jacobian : sig
+    type t
+    (** Type of a group element (jacobian). *)
+
+    val of_fields :
+      ?x:Field.t -> ?y:Field.t -> ?z:Field.t -> ?infinity:bool -> unit -> t
+
+    val set_infinity : t -> unit
+    (** Set a group element (jacobian) equal to the point at
+        infinity. *)
+
+    val get_ge : ge -> t -> unit
+    (** Set a group element equal to another which is given in jacobian
+        coordinates. *)
+
+    val set_ge : t -> ge -> unit
+    (** Set a group element (jacobian) equal to another which is given
+        in affine coordinates. *)
+
+    val eq_x_var : Field.t -> t -> int
+    (** Compare the X coordinate of a group element (jacobian). *)
+
+    val neg : t -> t -> unit
+    (** [neg r a] Set r equal to the inverse of a (i.e., mirrored
+        around the X axis) *)
+
+    val is_infinity : t -> bool
+    (** Check whether a group element is the point at infinity. *)
+
+    val has_quad_y_var : t -> bool
+    (** Check whether a group element's y coordinate is a quadratic
+        residue. *)
+
+    val double_nonzero : ?rzr:Field.t -> t -> t -> unit
+    (** [double_nonzero ?rzr r a] Set [r] equal to the double of
+        [a]. If rzr is not-None, [r->z = a->z * *rzr] (where infinity
+        means an implicit z = 0). [a] may not be zero. Constant
+        time. *)
+
+    val double_var : ?rzr:Field.t -> t -> t -> unit
+    (** [double_var ?rzr r a] Set [r] equal to the double of [a]. If
+        [rzr] is not-None, [r->z = a->z * *rzr] (where infinity means
+        an implicit z = 0). *)
+
+    val add_var : ?rzr:Field.t -> t -> t -> t -> unit
+    (** [add_var ?rzr r a b] Set [r] equal to the sum of [a] and
+        [b]. If rzr is non-None, [r->z = a->z * *rzr] ([a] cannot be
+        infinity in that case). *)
+
+    val add_ge : t -> t -> ge -> unit
+    (** [add_ge r a b] Set [r] equal to the sum of [a] and [b] (with [b] given
+        in affine coordinates, and not infinity). *)
+
+    val add_ge_var : ?rzr:Field.t -> t -> t -> ge -> unit
+    (** [add_ge_var ?rzr r a b] Set [r] equal to the sum of [a] and [b]
+        (with [b] given in affine coordinates). This is more efficient
+        than [add_var]. It is identical to [add_ge] but without
+        constant-time guarantee, and [b] is allowed to be infinity. If
+        rzr is non-None, [r->z = a->z * *rzr] ([a] cannot be infinity
+        in that case). *)
+
+    val add_zinv_var : t -> t -> ge -> Field.t -> unit
+    (** Set r equal to the sum of a and b (with the inverse of b's Z
+        coordinate passed as bzinv). *)
+
+    val mul : t -> ge -> Scalar.t -> unit
+
+    val clear : t -> unit
+    (** Clear a [t] to prevent leaking sensitive information. *)
+
+    val rescale : t -> Field.t -> unit
+    (** Rescale a jacobian point by b which must be
+        non-zero. Constant-time. *)
+  end
+
+  val of_fields :
+    ?x:Field.t -> ?y:Field.t -> ?infinity:bool -> unit -> t
+
+  val g : t
+
+  val set_xy : t -> Field.t -> Field.t -> unit
+  (** Set a group element equal to the point with given X and Y
+      coordinates *)
+
+  val set_xquad : t -> Field.t -> unit
+  (** Set a group element (affine) equal to the point with the given X
+      coordinate and a Y coordinate that is a quadratic residue modulo
+      p. The return value is true iff a coordinate with the given X
+      coordinate exists. *)
+
+  val set_xovar : t -> Field.t -> int -> bool
+  (** Set a group element (affine) equal to the point with the given X
+      coordinate, and given oddness for Y. Return value indicates
+      whether the result is valid. *)
+
+  val is_infinity : t -> bool
+  (** Check whether a group element is the point at infinity. *)
+
+  val is_valid_var : t -> bool
+  (** Check whether a group element is valid (i.e., on the curve). *)
+
+  val neg : t -> t -> unit
+  (** [neg r a] Set r equal to the inverse of a (i.e., mirrored
+      around the X axis) *)
+
+  val clear : t -> unit
+  (** Clear a [t] to prevent leaking sensitive information. *)
+
+  val to_storage : Storage.t -> t -> unit
+  (** Convert a group element to the storage type. *)
+
+  val from_storage : t -> Storage.t -> unit
+  (** Convert a group element back from the storage type. *)
+
+  val to_pubkey : ?compress:bool -> Cstruct.t -> t -> Cstruct.t
+  (** [to_pubkey ?compress buf ge] serializes [ge] in [buf] and
+      returns [buf], adjusted to the actual size. *)
+
+  val from_pubkey : t -> Cstruct.t -> unit
+  (** [from_pubkey ge buf] parses a serialized pubkey in [buf] and
+      writes the result in [ge]. *)
+end
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num.h
new file mode 100644
index 000000000..49f2dd791
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num.h
@@ -0,0 +1,74 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_NUM_H
+#define SECP256K1_NUM_H
+
+#ifndef USE_NUM_NONE
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#if defined(USE_NUM_GMP)
+#include "num_gmp.h"
+#else
+#error "Please select num implementation"
+#endif
+
+/** Copy a number. */
+static void secp256k1_num_copy(secp256k1_num *r, const secp256k1_num *a);
+
+/** Convert a number's absolute value to a binary big-endian string.
+ *  There must be enough place. */
+static void secp256k1_num_get_bin(unsigned char *r, unsigned int rlen, const secp256k1_num *a);
+
+/** Set a number to the value of a binary big-endian string. */
+static void secp256k1_num_set_bin(secp256k1_num *r, const unsigned char *a, unsigned int alen);
+
+/** Compute a modular inverse. The input must be less than the modulus. */
+static void secp256k1_num_mod_inverse(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *m);
+
+/** Compute the jacobi symbol (a|b). b must be positive and odd. */
+static int secp256k1_num_jacobi(const secp256k1_num *a, const secp256k1_num *b);
+
+/** Compare the absolute value of two numbers. */
+static int secp256k1_num_cmp(const secp256k1_num *a, const secp256k1_num *b);
+
+/** Test whether two number are equal (including sign). */
+static int secp256k1_num_eq(const secp256k1_num *a, const secp256k1_num *b);
+
+/** Add two (signed) numbers. */
+static void secp256k1_num_add(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b);
+
+/** Subtract two (signed) numbers. */
+static void secp256k1_num_sub(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b);
+
+/** Multiply two (signed) numbers. */
+static void secp256k1_num_mul(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b);
+
+/** Replace a number by its remainder modulo m. M's sign is ignored. The result is a number between 0 and m-1,
+    even if r was negative. */
+static void secp256k1_num_mod(secp256k1_num *r, const secp256k1_num *m);
+
+/** Right-shift the passed number by bits bits. */
+static void secp256k1_num_shift(secp256k1_num *r, int bits);
+
+/** Check whether a number is zero. */
+static int secp256k1_num_is_zero(const secp256k1_num *a);
+
+/** Check whether a number is one. */
+static int secp256k1_num_is_one(const secp256k1_num *a);
+
+/** Check whether a number is strictly negative. */
+static int secp256k1_num_is_neg(const secp256k1_num *a);
+
+/** Change a number's sign. */
+static void secp256k1_num_negate(secp256k1_num *r);
+
+#endif
+
+#endif /* SECP256K1_NUM_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp.h
new file mode 100644
index 000000000..3619844bd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp.h
@@ -0,0 +1,20 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_NUM_REPR_H
+#define SECP256K1_NUM_REPR_H
+
+#include <gmp.h>
+
+#define NUM_LIMBS ((256+GMP_NUMB_BITS-1)/GMP_NUMB_BITS)
+
+typedef struct {
+    mp_limb_t data[2*NUM_LIMBS];
+    int neg;
+    int limbs;
+} secp256k1_num;
+
+#endif /* SECP256K1_NUM_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp_impl.h
new file mode 100644
index 000000000..0ae2a8ba0
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_gmp_impl.h
@@ -0,0 +1,288 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_NUM_REPR_IMPL_H
+#define SECP256K1_NUM_REPR_IMPL_H
+
+#include <string.h>
+#include <stdlib.h>
+#include <gmp.h>
+
+#include "util.h"
+#include "num.h"
+
+#ifdef VERIFY
+static void secp256k1_num_sanity(const secp256k1_num *a) {
+    VERIFY_CHECK(a->limbs == 1 || (a->limbs > 1 && a->data[a->limbs-1] != 0));
+}
+#else
+#define secp256k1_num_sanity(a) do { } while(0)
+#endif
+
+static void secp256k1_num_copy(secp256k1_num *r, const secp256k1_num *a) {
+    *r = *a;
+}
+
+static void secp256k1_num_get_bin(unsigned char *r, unsigned int rlen, const secp256k1_num *a) {
+    unsigned char tmp[65];
+    int len = 0;
+    int shift = 0;
+    if (a->limbs>1 || a->data[0] != 0) {
+        len = mpn_get_str(tmp, 256, (mp_limb_t*)a->data, a->limbs);
+    }
+    while (shift < len && tmp[shift] == 0) shift++;
+    VERIFY_CHECK(len-shift <= (int)rlen);
+    memset(r, 0, rlen - len + shift);
+    if (len > shift) {
+        memcpy(r + rlen - len + shift, tmp + shift, len - shift);
+    }
+    memset(tmp, 0, sizeof(tmp));
+}
+
+static void secp256k1_num_set_bin(secp256k1_num *r, const unsigned char *a, unsigned int alen) {
+    int len;
+    VERIFY_CHECK(alen > 0);
+    VERIFY_CHECK(alen <= 64);
+    len = mpn_set_str(r->data, a, alen, 256);
+    if (len == 0) {
+        r->data[0] = 0;
+        len = 1;
+    }
+    VERIFY_CHECK(len <= NUM_LIMBS*2);
+    r->limbs = len;
+    r->neg = 0;
+    while (r->limbs > 1 && r->data[r->limbs-1]==0) {
+        r->limbs--;
+    }
+}
+
+static void secp256k1_num_add_abs(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b) {
+    mp_limb_t c = mpn_add(r->data, a->data, a->limbs, b->data, b->limbs);
+    r->limbs = a->limbs;
+    if (c != 0) {
+        VERIFY_CHECK(r->limbs < 2*NUM_LIMBS);
+        r->data[r->limbs++] = c;
+    }
+}
+
+static void secp256k1_num_sub_abs(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b) {
+    mp_limb_t c = mpn_sub(r->data, a->data, a->limbs, b->data, b->limbs);
+    (void)c;
+    VERIFY_CHECK(c == 0);
+    r->limbs = a->limbs;
+    while (r->limbs > 1 && r->data[r->limbs-1]==0) {
+        r->limbs--;
+    }
+}
+
+static void secp256k1_num_mod(secp256k1_num *r, const secp256k1_num *m) {
+    secp256k1_num_sanity(r);
+    secp256k1_num_sanity(m);
+
+    if (r->limbs >= m->limbs) {
+        mp_limb_t t[2*NUM_LIMBS];
+        mpn_tdiv_qr(t, r->data, 0, r->data, r->limbs, m->data, m->limbs);
+        memset(t, 0, sizeof(t));
+        r->limbs = m->limbs;
+        while (r->limbs > 1 && r->data[r->limbs-1]==0) {
+            r->limbs--;
+        }
+    }
+
+    if (r->neg && (r->limbs > 1 || r->data[0] != 0)) {
+        secp256k1_num_sub_abs(r, m, r);
+        r->neg = 0;
+    }
+}
+
+static void secp256k1_num_mod_inverse(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *m) {
+    int i;
+    mp_limb_t g[NUM_LIMBS+1];
+    mp_limb_t u[NUM_LIMBS+1];
+    mp_limb_t v[NUM_LIMBS+1];
+    mp_size_t sn;
+    mp_size_t gn;
+    secp256k1_num_sanity(a);
+    secp256k1_num_sanity(m);
+
+    /** mpn_gcdext computes: (G,S) = gcdext(U,V), where
+     *  * G = gcd(U,V)
+     *  * G = U*S + V*T
+     *  * U has equal or more limbs than V, and V has no padding
+     *  If we set U to be (a padded version of) a, and V = m:
+     *    G = a*S + m*T
+     *    G = a*S mod m
+     *  Assuming G=1:
+     *    S = 1/a mod m
+     */
+    VERIFY_CHECK(m->limbs <= NUM_LIMBS);
+    VERIFY_CHECK(m->data[m->limbs-1] != 0);
+    for (i = 0; i < m->limbs; i++) {
+        u[i] = (i < a->limbs) ? a->data[i] : 0;
+        v[i] = m->data[i];
+    }
+    sn = NUM_LIMBS+1;
+    gn = mpn_gcdext(g, r->data, &sn, u, m->limbs, v, m->limbs);
+    (void)gn;
+    VERIFY_CHECK(gn == 1);
+    VERIFY_CHECK(g[0] == 1);
+    r->neg = a->neg ^ m->neg;
+    if (sn < 0) {
+        mpn_sub(r->data, m->data, m->limbs, r->data, -sn);
+        r->limbs = m->limbs;
+        while (r->limbs > 1 && r->data[r->limbs-1]==0) {
+            r->limbs--;
+        }
+    } else {
+        r->limbs = sn;
+    }
+    memset(g, 0, sizeof(g));
+    memset(u, 0, sizeof(u));
+    memset(v, 0, sizeof(v));
+}
+
+static int secp256k1_num_jacobi(const secp256k1_num *a, const secp256k1_num *b) {
+    int ret;
+    mpz_t ga, gb;
+    secp256k1_num_sanity(a);
+    secp256k1_num_sanity(b);
+    VERIFY_CHECK(!b->neg && (b->limbs > 0) && (b->data[0] & 1));
+
+    mpz_inits(ga, gb, NULL);
+
+    mpz_import(gb, b->limbs, -1, sizeof(mp_limb_t), 0, 0, b->data);
+    mpz_import(ga, a->limbs, -1, sizeof(mp_limb_t), 0, 0, a->data);
+    if (a->neg) {
+        mpz_neg(ga, ga);
+    }
+
+    ret = mpz_jacobi(ga, gb);
+
+    mpz_clears(ga, gb, NULL);
+
+    return ret;
+}
+
+static int secp256k1_num_is_one(const secp256k1_num *a) {
+    return (a->limbs == 1 && a->data[0] == 1);
+}
+
+static int secp256k1_num_is_zero(const secp256k1_num *a) {
+    return (a->limbs == 1 && a->data[0] == 0);
+}
+
+static int secp256k1_num_is_neg(const secp256k1_num *a) {
+    return (a->limbs > 1 || a->data[0] != 0) && a->neg;
+}
+
+static int secp256k1_num_cmp(const secp256k1_num *a, const secp256k1_num *b) {
+    if (a->limbs > b->limbs) {
+        return 1;
+    }
+    if (a->limbs < b->limbs) {
+        return -1;
+    }
+    return mpn_cmp(a->data, b->data, a->limbs);
+}
+
+static int secp256k1_num_eq(const secp256k1_num *a, const secp256k1_num *b) {
+    if (a->limbs > b->limbs) {
+        return 0;
+    }
+    if (a->limbs < b->limbs) {
+        return 0;
+    }
+    if ((a->neg && !secp256k1_num_is_zero(a)) != (b->neg && !secp256k1_num_is_zero(b))) {
+        return 0;
+    }
+    return mpn_cmp(a->data, b->data, a->limbs) == 0;
+}
+
+static void secp256k1_num_subadd(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b, int bneg) {
+    if (!(b->neg ^ bneg ^ a->neg)) { /* a and b have the same sign */
+        r->neg = a->neg;
+        if (a->limbs >= b->limbs) {
+            secp256k1_num_add_abs(r, a, b);
+        } else {
+            secp256k1_num_add_abs(r, b, a);
+        }
+    } else {
+        if (secp256k1_num_cmp(a, b) > 0) {
+            r->neg = a->neg;
+            secp256k1_num_sub_abs(r, a, b);
+        } else {
+            r->neg = b->neg ^ bneg;
+            secp256k1_num_sub_abs(r, b, a);
+        }
+    }
+}
+
+static void secp256k1_num_add(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b) {
+    secp256k1_num_sanity(a);
+    secp256k1_num_sanity(b);
+    secp256k1_num_subadd(r, a, b, 0);
+}
+
+static void secp256k1_num_sub(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b) {
+    secp256k1_num_sanity(a);
+    secp256k1_num_sanity(b);
+    secp256k1_num_subadd(r, a, b, 1);
+}
+
+static void secp256k1_num_mul(secp256k1_num *r, const secp256k1_num *a, const secp256k1_num *b) {
+    mp_limb_t tmp[2*NUM_LIMBS+1];
+    secp256k1_num_sanity(a);
+    secp256k1_num_sanity(b);
+
+    VERIFY_CHECK(a->limbs + b->limbs <= 2*NUM_LIMBS+1);
+    if ((a->limbs==1 && a->data[0]==0) || (b->limbs==1 && b->data[0]==0)) {
+        r->limbs = 1;
+        r->neg = 0;
+        r->data[0] = 0;
+        return;
+    }
+    if (a->limbs >= b->limbs) {
+        mpn_mul(tmp, a->data, a->limbs, b->data, b->limbs);
+    } else {
+        mpn_mul(tmp, b->data, b->limbs, a->data, a->limbs);
+    }
+    r->limbs = a->limbs + b->limbs;
+    if (r->limbs > 1 && tmp[r->limbs - 1]==0) {
+        r->limbs--;
+    }
+    VERIFY_CHECK(r->limbs <= 2*NUM_LIMBS);
+    mpn_copyi(r->data, tmp, r->limbs);
+    r->neg = a->neg ^ b->neg;
+    memset(tmp, 0, sizeof(tmp));
+}
+
+static void secp256k1_num_shift(secp256k1_num *r, int bits) {
+    if (bits % GMP_NUMB_BITS) {
+        /* Shift within limbs. */
+        mpn_rshift(r->data, r->data, r->limbs, bits % GMP_NUMB_BITS);
+    }
+    if (bits >= GMP_NUMB_BITS) {
+        int i;
+        /* Shift full limbs. */
+        for (i = 0; i < r->limbs; i++) {
+            int index = i + (bits / GMP_NUMB_BITS);
+            if (index < r->limbs && index < 2*NUM_LIMBS) {
+                r->data[i] = r->data[index];
+            } else {
+                r->data[i] = 0;
+            }
+        }
+    }
+    while (r->limbs>1 && r->data[r->limbs-1]==0) {
+        r->limbs--;
+    }
+}
+
+static void secp256k1_num_negate(secp256k1_num *r) {
+    r->neg ^= 1;
+}
+
+#endif /* SECP256K1_NUM_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_impl.h
new file mode 100644
index 000000000..c45193b03
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/num_impl.h
@@ -0,0 +1,24 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_NUM_IMPL_H
+#define SECP256K1_NUM_IMPL_H
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#include "num.h"
+
+#if defined(USE_NUM_GMP)
+#include "num_gmp_impl.h"
+#elif defined(USE_NUM_NONE)
+/* Nothing. */
+#else
+#error "Please select num implementation"
+#endif
+
+#endif /* SECP256K1_NUM_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/recovery.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/recovery.h
new file mode 100644
index 000000000..1abe509ff
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/recovery.h
@@ -0,0 +1,193 @@
+/**********************************************************************
+ * Copyright (c) 2013-2015 Pieter Wuille                              *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_MODULE_RECOVERY_MAIN_H
+#define SECP256K1_MODULE_RECOVERY_MAIN_H
+
+#include "secp256k1_recovery.h"
+
+static void secp256k1_ecdsa_recoverable_signature_load(const secp256k1_context* ctx, secp256k1_scalar* r, secp256k1_scalar* s, int* recid, const secp256k1_ecdsa_recoverable_signature* sig) {
+    (void)ctx;
+    if (sizeof(secp256k1_scalar) == 32) {
+        /* When the secp256k1_scalar type is exactly 32 byte, use its
+         * representation inside secp256k1_ecdsa_signature, as conversion is very fast.
+         * Note that secp256k1_ecdsa_signature_save must use the same representation. */
+        memcpy(r, &sig->data[0], 32);
+        memcpy(s, &sig->data[32], 32);
+    } else {
+        secp256k1_scalar_set_b32(r, &sig->data[0], NULL);
+        secp256k1_scalar_set_b32(s, &sig->data[32], NULL);
+    }
+    *recid = sig->data[64];
+}
+
+static void secp256k1_ecdsa_recoverable_signature_save(secp256k1_ecdsa_recoverable_signature* sig, const secp256k1_scalar* r, const secp256k1_scalar* s, int recid) {
+    if (sizeof(secp256k1_scalar) == 32) {
+        memcpy(&sig->data[0], r, 32);
+        memcpy(&sig->data[32], s, 32);
+    } else {
+        secp256k1_scalar_get_b32(&sig->data[0], r);
+        secp256k1_scalar_get_b32(&sig->data[32], s);
+    }
+    sig->data[64] = recid;
+}
+
+int secp256k1_ecdsa_recoverable_signature_parse_compact(const secp256k1_context* ctx, secp256k1_ecdsa_recoverable_signature* sig, const unsigned char *input64, int recid) {
+    secp256k1_scalar r, s;
+    int ret = 1;
+    int overflow = 0;
+
+    (void)ctx;
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(input64 != NULL);
+    ARG_CHECK(recid >= 0 && recid <= 3);
+
+    secp256k1_scalar_set_b32(&r, &input64[0], &overflow);
+    ret &= !overflow;
+    secp256k1_scalar_set_b32(&s, &input64[32], &overflow);
+    ret &= !overflow;
+    if (ret) {
+        secp256k1_ecdsa_recoverable_signature_save(sig, &r, &s, recid);
+    } else {
+        memset(sig, 0, sizeof(*sig));
+    }
+    return ret;
+}
+
+int secp256k1_ecdsa_recoverable_signature_serialize_compact(const secp256k1_context* ctx, unsigned char *output64, int *recid, const secp256k1_ecdsa_recoverable_signature* sig) {
+    secp256k1_scalar r, s;
+
+    (void)ctx;
+    ARG_CHECK(output64 != NULL);
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(recid != NULL);
+
+    secp256k1_ecdsa_recoverable_signature_load(ctx, &r, &s, recid, sig);
+    secp256k1_scalar_get_b32(&output64[0], &r);
+    secp256k1_scalar_get_b32(&output64[32], &s);
+    return 1;
+}
+
+int secp256k1_ecdsa_recoverable_signature_convert(const secp256k1_context* ctx, secp256k1_ecdsa_signature* sig, const secp256k1_ecdsa_recoverable_signature* sigin) {
+    secp256k1_scalar r, s;
+    int recid;
+
+    (void)ctx;
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(sigin != NULL);
+
+    secp256k1_ecdsa_recoverable_signature_load(ctx, &r, &s, &recid, sigin);
+    secp256k1_ecdsa_signature_save(sig, &r, &s);
+    return 1;
+}
+
+static int secp256k1_ecdsa_sig_recover(const secp256k1_ecmult_context *ctx, const secp256k1_scalar *sigr, const secp256k1_scalar* sigs, secp256k1_ge *pubkey, const secp256k1_scalar *message, int recid) {
+    unsigned char brx[32];
+    secp256k1_fe fx;
+    secp256k1_ge x;
+    secp256k1_gej xj;
+    secp256k1_scalar rn, u1, u2;
+    secp256k1_gej qj;
+    int r;
+
+    if (secp256k1_scalar_is_zero(sigr) || secp256k1_scalar_is_zero(sigs)) {
+        return 0;
+    }
+
+    secp256k1_scalar_get_b32(brx, sigr);
+    r = secp256k1_fe_set_b32(&fx, brx);
+    (void)r;
+    VERIFY_CHECK(r); /* brx comes from a scalar, so is less than the order; certainly less than p */
+    if (recid & 2) {
+        if (secp256k1_fe_cmp_var(&fx, &secp256k1_ecdsa_const_p_minus_order) >= 0) {
+            return 0;
+        }
+        secp256k1_fe_add(&fx, &secp256k1_ecdsa_const_order_as_fe);
+    }
+    if (!secp256k1_ge_set_xo_var(&x, &fx, recid & 1)) {
+        return 0;
+    }
+    secp256k1_gej_set_ge(&xj, &x);
+    secp256k1_scalar_inverse_var(&rn, sigr);
+    secp256k1_scalar_mul(&u1, &rn, message);
+    secp256k1_scalar_negate(&u1, &u1);
+    secp256k1_scalar_mul(&u2, &rn, sigs);
+    secp256k1_ecmult(ctx, &qj, &xj, &u2, &u1);
+    secp256k1_ge_set_gej_var(pubkey, &qj);
+    return !secp256k1_gej_is_infinity(&qj);
+}
+
+int secp256k1_ecdsa_sign_recoverable(const secp256k1_context* ctx, secp256k1_ecdsa_recoverable_signature *signature, const unsigned char *msg32, const unsigned char *seckey, secp256k1_nonce_function noncefp, const void* noncedata) {
+    secp256k1_scalar r, s;
+    secp256k1_scalar sec, non, msg;
+    int recid;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_gen_context_is_built(&ctx->ecmult_gen_ctx));
+    ARG_CHECK(msg32 != NULL);
+    ARG_CHECK(signature != NULL);
+    ARG_CHECK(seckey != NULL);
+    if (noncefp == NULL) {
+        noncefp = secp256k1_nonce_function_default;
+    }
+
+    secp256k1_scalar_set_b32(&sec, seckey, &overflow);
+    /* Fail if the secret key is invalid. */
+    if (!overflow && !secp256k1_scalar_is_zero(&sec)) {
+        unsigned char nonce32[32];
+        unsigned int count = 0;
+        secp256k1_scalar_set_b32(&msg, msg32, NULL);
+        while (1) {
+            ret = noncefp(nonce32, msg32, seckey, NULL, (void*)noncedata, count);
+            if (!ret) {
+                break;
+            }
+            secp256k1_scalar_set_b32(&non, nonce32, &overflow);
+            if (!secp256k1_scalar_is_zero(&non) && !overflow) {
+                if (secp256k1_ecdsa_sig_sign(&ctx->ecmult_gen_ctx, &r, &s, &sec, &msg, &non, &recid)) {
+                    break;
+                }
+            }
+            count++;
+        }
+        memset(nonce32, 0, 32);
+        secp256k1_scalar_clear(&msg);
+        secp256k1_scalar_clear(&non);
+        secp256k1_scalar_clear(&sec);
+    }
+    if (ret) {
+        secp256k1_ecdsa_recoverable_signature_save(signature, &r, &s, recid);
+    } else {
+        memset(signature, 0, sizeof(*signature));
+    }
+    return ret;
+}
+
+int secp256k1_ecdsa_recover(const secp256k1_context* ctx, secp256k1_pubkey *pubkey, const secp256k1_ecdsa_recoverable_signature *signature, const unsigned char *msg32) {
+    secp256k1_ge q;
+    secp256k1_scalar r, s;
+    secp256k1_scalar m;
+    int recid;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_context_is_built(&ctx->ecmult_ctx));
+    ARG_CHECK(msg32 != NULL);
+    ARG_CHECK(signature != NULL);
+    ARG_CHECK(pubkey != NULL);
+
+    secp256k1_ecdsa_recoverable_signature_load(ctx, &r, &s, &recid, signature);
+    VERIFY_CHECK(recid >= 0 && recid < 4);  /* should have been caught in parse_compact */
+    secp256k1_scalar_set_b32(&m, msg32, NULL);
+    if (secp256k1_ecdsa_sig_recover(&ctx->ecmult_ctx, &r, &s, &q, &m, recid)) {
+        secp256k1_pubkey_save(pubkey, &q);
+        return 1;
+    } else {
+        memset(pubkey, 0, sizeof(*pubkey));
+        return 0;
+    }
+}
+
+#endif /* SECP256K1_MODULE_RECOVERY_MAIN_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar.h
new file mode 100644
index 000000000..59304cb66
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar.h
@@ -0,0 +1,106 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_H
+#define SECP256K1_SCALAR_H
+
+#include "num.h"
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#if defined(EXHAUSTIVE_TEST_ORDER)
+#include "scalar_low.h"
+#elif defined(USE_SCALAR_4X64)
+#include "scalar_4x64.h"
+#elif defined(USE_SCALAR_8X32)
+#include "scalar_8x32.h"
+#else
+#error "Please select scalar implementation"
+#endif
+
+/** Clear a scalar to prevent the leak of sensitive data. */
+static void secp256k1_scalar_clear(secp256k1_scalar *r);
+
+/** Access bits from a scalar. All requested bits must belong to the same 32-bit limb. */
+static unsigned int secp256k1_scalar_get_bits(const secp256k1_scalar *a, unsigned int offset, unsigned int count);
+
+/** Access bits from a scalar. Not constant time. */
+static unsigned int secp256k1_scalar_get_bits_var(const secp256k1_scalar *a, unsigned int offset, unsigned int count);
+
+/** Set a scalar from a big endian byte array. */
+static void secp256k1_scalar_set_b32(secp256k1_scalar *r, const unsigned char *bin, int *overflow);
+
+/** Set a scalar to an unsigned integer. */
+static void secp256k1_scalar_set_int(secp256k1_scalar *r, unsigned int v);
+
+/** Convert a scalar to a byte array. */
+static void secp256k1_scalar_get_b32(unsigned char *bin, const secp256k1_scalar* a);
+
+/** Add two scalars together (modulo the group order). Returns whether it overflowed. */
+static int secp256k1_scalar_add(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b);
+
+/** Conditionally add a power of two to a scalar. The result is not allowed to overflow. */
+static void secp256k1_scalar_cadd_bit(secp256k1_scalar *r, unsigned int bit, int flag);
+
+/** Multiply two scalars (modulo the group order). */
+static void secp256k1_scalar_mul(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b);
+
+/** Shift a scalar right by some amount strictly between 0 and 16, returning
+ *  the low bits that were shifted off */
+static int secp256k1_scalar_shr_int(secp256k1_scalar *r, int n);
+
+/** Compute the square of a scalar (modulo the group order). */
+static void secp256k1_scalar_sqr(secp256k1_scalar *r, const secp256k1_scalar *a);
+
+/** Compute the inverse of a scalar (modulo the group order). */
+static void secp256k1_scalar_inverse(secp256k1_scalar *r, const secp256k1_scalar *a);
+
+/** Compute the inverse of a scalar (modulo the group order), without constant-time guarantee. */
+static void secp256k1_scalar_inverse_var(secp256k1_scalar *r, const secp256k1_scalar *a);
+
+/** Compute the complement of a scalar (modulo the group order). */
+static void secp256k1_scalar_negate(secp256k1_scalar *r, const secp256k1_scalar *a);
+
+/** Check whether a scalar equals zero. */
+static int secp256k1_scalar_is_zero(const secp256k1_scalar *a);
+
+/** Check whether a scalar equals one. */
+static int secp256k1_scalar_is_one(const secp256k1_scalar *a);
+
+/** Check whether a scalar, considered as an nonnegative integer, is even. */
+static int secp256k1_scalar_is_even(const secp256k1_scalar *a);
+
+/** Check whether a scalar is higher than the group order divided by 2. */
+static int secp256k1_scalar_is_high(const secp256k1_scalar *a);
+
+/** Conditionally negate a number, in constant time.
+ * Returns -1 if the number was negated, 1 otherwise */
+static int secp256k1_scalar_cond_negate(secp256k1_scalar *a, int flag);
+
+#ifndef USE_NUM_NONE
+/** Convert a scalar to a number. */
+static void secp256k1_scalar_get_num(secp256k1_num *r, const secp256k1_scalar *a);
+
+/** Get the order of the group as a number. */
+static void secp256k1_scalar_order_get_num(secp256k1_num *r);
+#endif
+
+/** Compare two scalars. */
+static int secp256k1_scalar_eq(const secp256k1_scalar *a, const secp256k1_scalar *b);
+
+#ifdef USE_ENDOMORPHISM
+/** Find r1 and r2 such that r1+r2*2^128 = a. */
+static void secp256k1_scalar_split_128(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a);
+/** Find r1 and r2 such that r1+r2*lambda = a, and r1 and r2 are maximum 128 bits long (see secp256k1_gej_mul_lambda). */
+static void secp256k1_scalar_split_lambda(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a);
+#endif
+
+/** Multiply a and b (without taking the modulus!), divide by 2**shift, and round to the nearest integer. Shift must be at least 256. */
+static void secp256k1_scalar_mul_shift_var(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b, unsigned int shift);
+
+#endif /* SECP256K1_SCALAR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64.h
new file mode 100644
index 000000000..19c7495d1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64.h
@@ -0,0 +1,19 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_H
+#define SECP256K1_SCALAR_REPR_H
+
+#include <stdint.h>
+
+/** A scalar modulo the group order of the secp256k1 curve. */
+typedef struct {
+    uint64_t d[4];
+} secp256k1_scalar;
+
+#define SECP256K1_SCALAR_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {{((uint64_t)(d1)) << 32 | (d0), ((uint64_t)(d3)) << 32 | (d2), ((uint64_t)(d5)) << 32 | (d4), ((uint64_t)(d7)) << 32 | (d6)}}
+
+#endif /* SECP256K1_SCALAR_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64_impl.h
new file mode 100644
index 000000000..db1ebf94b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_4x64_impl.h
@@ -0,0 +1,949 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_IMPL_H
+#define SECP256K1_SCALAR_REPR_IMPL_H
+
+/* Limbs of the secp256k1 order. */
+#define SECP256K1_N_0 ((uint64_t)0xBFD25E8CD0364141ULL)
+#define SECP256K1_N_1 ((uint64_t)0xBAAEDCE6AF48A03BULL)
+#define SECP256K1_N_2 ((uint64_t)0xFFFFFFFFFFFFFFFEULL)
+#define SECP256K1_N_3 ((uint64_t)0xFFFFFFFFFFFFFFFFULL)
+
+/* Limbs of 2^256 minus the secp256k1 order. */
+#define SECP256K1_N_C_0 (~SECP256K1_N_0 + 1)
+#define SECP256K1_N_C_1 (~SECP256K1_N_1)
+#define SECP256K1_N_C_2 (1)
+
+/* Limbs of half the secp256k1 order. */
+#define SECP256K1_N_H_0 ((uint64_t)0xDFE92F46681B20A0ULL)
+#define SECP256K1_N_H_1 ((uint64_t)0x5D576E7357A4501DULL)
+#define SECP256K1_N_H_2 ((uint64_t)0xFFFFFFFFFFFFFFFFULL)
+#define SECP256K1_N_H_3 ((uint64_t)0x7FFFFFFFFFFFFFFFULL)
+
+SECP256K1_INLINE static void secp256k1_scalar_clear(secp256k1_scalar *r) {
+    r->d[0] = 0;
+    r->d[1] = 0;
+    r->d[2] = 0;
+    r->d[3] = 0;
+}
+
+SECP256K1_INLINE static void secp256k1_scalar_set_int(secp256k1_scalar *r, unsigned int v) {
+    r->d[0] = v;
+    r->d[1] = 0;
+    r->d[2] = 0;
+    r->d[3] = 0;
+}
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    VERIFY_CHECK((offset + count - 1) >> 6 == offset >> 6);
+    return (a->d[offset >> 6] >> (offset & 0x3F)) & ((((uint64_t)1) << count) - 1);
+}
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits_var(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    VERIFY_CHECK(count < 32);
+    VERIFY_CHECK(offset + count <= 256);
+    if ((offset + count - 1) >> 6 == offset >> 6) {
+        return secp256k1_scalar_get_bits(a, offset, count);
+    } else {
+        VERIFY_CHECK((offset >> 6) + 1 < 4);
+        return ((a->d[offset >> 6] >> (offset & 0x3F)) | (a->d[(offset >> 6) + 1] << (64 - (offset & 0x3F)))) & ((((uint64_t)1) << count) - 1);
+    }
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_check_overflow(const secp256k1_scalar *a) {
+    int yes = 0;
+    int no = 0;
+    no |= (a->d[3] < SECP256K1_N_3); /* No need for a > check. */
+    no |= (a->d[2] < SECP256K1_N_2);
+    yes |= (a->d[2] > SECP256K1_N_2) & ~no;
+    no |= (a->d[1] < SECP256K1_N_1);
+    yes |= (a->d[1] > SECP256K1_N_1) & ~no;
+    yes |= (a->d[0] >= SECP256K1_N_0) & ~no;
+    return yes;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_reduce(secp256k1_scalar *r, unsigned int overflow) {
+    uint128_t t;
+    VERIFY_CHECK(overflow <= 1);
+    t = (uint128_t)r->d[0] + overflow * SECP256K1_N_C_0;
+    r->d[0] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)r->d[1] + overflow * SECP256K1_N_C_1;
+    r->d[1] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)r->d[2] + overflow * SECP256K1_N_C_2;
+    r->d[2] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint64_t)r->d[3];
+    r->d[3] = t & 0xFFFFFFFFFFFFFFFFULL;
+    return overflow;
+}
+
+static int secp256k1_scalar_add(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    int overflow;
+    uint128_t t = (uint128_t)a->d[0] + b->d[0];
+    r->d[0] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)a->d[1] + b->d[1];
+    r->d[1] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)a->d[2] + b->d[2];
+    r->d[2] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)a->d[3] + b->d[3];
+    r->d[3] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    overflow = t + secp256k1_scalar_check_overflow(r);
+    VERIFY_CHECK(overflow == 0 || overflow == 1);
+    secp256k1_scalar_reduce(r, overflow);
+    return overflow;
+}
+
+static void secp256k1_scalar_cadd_bit(secp256k1_scalar *r, unsigned int bit, int flag) {
+    uint128_t t;
+    VERIFY_CHECK(bit < 256);
+    bit += ((uint32_t) flag - 1) & 0x100;  /* forcing (bit >> 6) > 3 makes this a noop */
+    t = (uint128_t)r->d[0] + (((uint64_t)((bit >> 6) == 0)) << (bit & 0x3F));
+    r->d[0] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)r->d[1] + (((uint64_t)((bit >> 6) == 1)) << (bit & 0x3F));
+    r->d[1] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)r->d[2] + (((uint64_t)((bit >> 6) == 2)) << (bit & 0x3F));
+    r->d[2] = t & 0xFFFFFFFFFFFFFFFFULL; t >>= 64;
+    t += (uint128_t)r->d[3] + (((uint64_t)((bit >> 6) == 3)) << (bit & 0x3F));
+    r->d[3] = t & 0xFFFFFFFFFFFFFFFFULL;
+#ifdef VERIFY
+    VERIFY_CHECK((t >> 64) == 0);
+    VERIFY_CHECK(secp256k1_scalar_check_overflow(r) == 0);
+#endif
+}
+
+static void secp256k1_scalar_set_b32(secp256k1_scalar *r, const unsigned char *b32, int *overflow) {
+    int over;
+    r->d[0] = (uint64_t)b32[31] | (uint64_t)b32[30] << 8 | (uint64_t)b32[29] << 16 | (uint64_t)b32[28] << 24 | (uint64_t)b32[27] << 32 | (uint64_t)b32[26] << 40 | (uint64_t)b32[25] << 48 | (uint64_t)b32[24] << 56;
+    r->d[1] = (uint64_t)b32[23] | (uint64_t)b32[22] << 8 | (uint64_t)b32[21] << 16 | (uint64_t)b32[20] << 24 | (uint64_t)b32[19] << 32 | (uint64_t)b32[18] << 40 | (uint64_t)b32[17] << 48 | (uint64_t)b32[16] << 56;
+    r->d[2] = (uint64_t)b32[15] | (uint64_t)b32[14] << 8 | (uint64_t)b32[13] << 16 | (uint64_t)b32[12] << 24 | (uint64_t)b32[11] << 32 | (uint64_t)b32[10] << 40 | (uint64_t)b32[9] << 48 | (uint64_t)b32[8] << 56;
+    r->d[3] = (uint64_t)b32[7] | (uint64_t)b32[6] << 8 | (uint64_t)b32[5] << 16 | (uint64_t)b32[4] << 24 | (uint64_t)b32[3] << 32 | (uint64_t)b32[2] << 40 | (uint64_t)b32[1] << 48 | (uint64_t)b32[0] << 56;
+    over = secp256k1_scalar_reduce(r, secp256k1_scalar_check_overflow(r));
+    if (overflow) {
+        *overflow = over;
+    }
+}
+
+static void secp256k1_scalar_get_b32(unsigned char *bin, const secp256k1_scalar* a) {
+    bin[0] = a->d[3] >> 56; bin[1] = a->d[3] >> 48; bin[2] = a->d[3] >> 40; bin[3] = a->d[3] >> 32; bin[4] = a->d[3] >> 24; bin[5] = a->d[3] >> 16; bin[6] = a->d[3] >> 8; bin[7] = a->d[3];
+    bin[8] = a->d[2] >> 56; bin[9] = a->d[2] >> 48; bin[10] = a->d[2] >> 40; bin[11] = a->d[2] >> 32; bin[12] = a->d[2] >> 24; bin[13] = a->d[2] >> 16; bin[14] = a->d[2] >> 8; bin[15] = a->d[2];
+    bin[16] = a->d[1] >> 56; bin[17] = a->d[1] >> 48; bin[18] = a->d[1] >> 40; bin[19] = a->d[1] >> 32; bin[20] = a->d[1] >> 24; bin[21] = a->d[1] >> 16; bin[22] = a->d[1] >> 8; bin[23] = a->d[1];
+    bin[24] = a->d[0] >> 56; bin[25] = a->d[0] >> 48; bin[26] = a->d[0] >> 40; bin[27] = a->d[0] >> 32; bin[28] = a->d[0] >> 24; bin[29] = a->d[0] >> 16; bin[30] = a->d[0] >> 8; bin[31] = a->d[0];
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_zero(const secp256k1_scalar *a) {
+    return (a->d[0] | a->d[1] | a->d[2] | a->d[3]) == 0;
+}
+
+static void secp256k1_scalar_negate(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    uint64_t nonzero = 0xFFFFFFFFFFFFFFFFULL * (secp256k1_scalar_is_zero(a) == 0);
+    uint128_t t = (uint128_t)(~a->d[0]) + SECP256K1_N_0 + 1;
+    r->d[0] = t & nonzero; t >>= 64;
+    t += (uint128_t)(~a->d[1]) + SECP256K1_N_1;
+    r->d[1] = t & nonzero; t >>= 64;
+    t += (uint128_t)(~a->d[2]) + SECP256K1_N_2;
+    r->d[2] = t & nonzero; t >>= 64;
+    t += (uint128_t)(~a->d[3]) + SECP256K1_N_3;
+    r->d[3] = t & nonzero;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_one(const secp256k1_scalar *a) {
+    return ((a->d[0] ^ 1) | a->d[1] | a->d[2] | a->d[3]) == 0;
+}
+
+static int secp256k1_scalar_is_high(const secp256k1_scalar *a) {
+    int yes = 0;
+    int no = 0;
+    no |= (a->d[3] < SECP256K1_N_H_3);
+    yes |= (a->d[3] > SECP256K1_N_H_3) & ~no;
+    no |= (a->d[2] < SECP256K1_N_H_2) & ~yes; /* No need for a > check. */
+    no |= (a->d[1] < SECP256K1_N_H_1) & ~yes;
+    yes |= (a->d[1] > SECP256K1_N_H_1) & ~no;
+    yes |= (a->d[0] > SECP256K1_N_H_0) & ~no;
+    return yes;
+}
+
+static int secp256k1_scalar_cond_negate(secp256k1_scalar *r, int flag) {
+    /* If we are flag = 0, mask = 00...00 and this is a no-op;
+     * if we are flag = 1, mask = 11...11 and this is identical to secp256k1_scalar_negate */
+    uint64_t mask = !flag - 1;
+    uint64_t nonzero = (secp256k1_scalar_is_zero(r) != 0) - 1;
+    uint128_t t = (uint128_t)(r->d[0] ^ mask) + ((SECP256K1_N_0 + 1) & mask);
+    r->d[0] = t & nonzero; t >>= 64;
+    t += (uint128_t)(r->d[1] ^ mask) + (SECP256K1_N_1 & mask);
+    r->d[1] = t & nonzero; t >>= 64;
+    t += (uint128_t)(r->d[2] ^ mask) + (SECP256K1_N_2 & mask);
+    r->d[2] = t & nonzero; t >>= 64;
+    t += (uint128_t)(r->d[3] ^ mask) + (SECP256K1_N_3 & mask);
+    r->d[3] = t & nonzero;
+    return 2 * (mask == 0) - 1;
+}
+
+/* Inspired by the macros in OpenSSL's crypto/bn/asm/x86_64-gcc.c. */
+
+/** Add a*b to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define muladd(a,b) { \
+    uint64_t tl, th; \
+    { \
+        uint128_t t = (uint128_t)a * b; \
+        th = t >> 64;         /* at most 0xFFFFFFFFFFFFFFFE */ \
+        tl = t; \
+    } \
+    c0 += tl;                 /* overflow is handled on the next line */ \
+    th += (c0 < tl) ? 1 : 0;  /* at most 0xFFFFFFFFFFFFFFFF */ \
+    c1 += th;                 /* overflow is handled on the next line */ \
+    c2 += (c1 < th) ? 1 : 0;  /* never overflows by contract (verified in the next line) */ \
+    VERIFY_CHECK((c1 >= th) || (c2 != 0)); \
+}
+
+/** Add a*b to the number defined by (c0,c1). c1 must never overflow. */
+#define muladd_fast(a,b) { \
+    uint64_t tl, th; \
+    { \
+        uint128_t t = (uint128_t)a * b; \
+        th = t >> 64;         /* at most 0xFFFFFFFFFFFFFFFE */ \
+        tl = t; \
+    } \
+    c0 += tl;                 /* overflow is handled on the next line */ \
+    th += (c0 < tl) ? 1 : 0;  /* at most 0xFFFFFFFFFFFFFFFF */ \
+    c1 += th;                 /* never overflows by contract (verified in the next line) */ \
+    VERIFY_CHECK(c1 >= th); \
+}
+
+/** Add 2*a*b to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define muladd2(a,b) { \
+    uint64_t tl, th, th2, tl2; \
+    { \
+        uint128_t t = (uint128_t)a * b; \
+        th = t >> 64;               /* at most 0xFFFFFFFFFFFFFFFE */ \
+        tl = t; \
+    } \
+    th2 = th + th;                  /* at most 0xFFFFFFFFFFFFFFFE (in case th was 0x7FFFFFFFFFFFFFFF) */ \
+    c2 += (th2 < th) ? 1 : 0;       /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((th2 >= th) || (c2 != 0)); \
+    tl2 = tl + tl;                  /* at most 0xFFFFFFFFFFFFFFFE (in case the lowest 63 bits of tl were 0x7FFFFFFFFFFFFFFF) */ \
+    th2 += (tl2 < tl) ? 1 : 0;      /* at most 0xFFFFFFFFFFFFFFFF */ \
+    c0 += tl2;                      /* overflow is handled on the next line */ \
+    th2 += (c0 < tl2) ? 1 : 0;      /* second overflow is handled on the next line */ \
+    c2 += (c0 < tl2) & (th2 == 0);  /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c0 >= tl2) || (th2 != 0) || (c2 != 0)); \
+    c1 += th2;                      /* overflow is handled on the next line */ \
+    c2 += (c1 < th2) ? 1 : 0;       /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c1 >= th2) || (c2 != 0)); \
+}
+
+/** Add a to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define sumadd(a) { \
+    unsigned int over; \
+    c0 += (a);                  /* overflow is handled on the next line */ \
+    over = (c0 < (a)) ? 1 : 0; \
+    c1 += over;                 /* overflow is handled on the next line */ \
+    c2 += (c1 < over) ? 1 : 0;  /* never overflows by contract */ \
+}
+
+/** Add a to the number defined by (c0,c1). c1 must never overflow, c2 must be zero. */
+#define sumadd_fast(a) { \
+    c0 += (a);                 /* overflow is handled on the next line */ \
+    c1 += (c0 < (a)) ? 1 : 0;  /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c1 != 0) | (c0 >= (a))); \
+    VERIFY_CHECK(c2 == 0); \
+}
+
+/** Extract the lowest 64 bits of (c0,c1,c2) into n, and left shift the number 64 bits. */
+#define extract(n) { \
+    (n) = c0; \
+    c0 = c1; \
+    c1 = c2; \
+    c2 = 0; \
+}
+
+/** Extract the lowest 64 bits of (c0,c1,c2) into n, and left shift the number 64 bits. c2 is required to be zero. */
+#define extract_fast(n) { \
+    (n) = c0; \
+    c0 = c1; \
+    c1 = 0; \
+    VERIFY_CHECK(c2 == 0); \
+}
+
+static void secp256k1_scalar_reduce_512(secp256k1_scalar *r, const uint64_t *l) {
+#ifdef USE_ASM_X86_64
+    /* Reduce 512 bits into 385. */
+    uint64_t m0, m1, m2, m3, m4, m5, m6;
+    uint64_t p0, p1, p2, p3, p4;
+    uint64_t c;
+
+    __asm__ __volatile__(
+    /* Preload. */
+    "movq 32(%%rsi), %%r11\n"
+    "movq 40(%%rsi), %%r12\n"
+    "movq 48(%%rsi), %%r13\n"
+    "movq 56(%%rsi), %%r14\n"
+    /* Initialize r8,r9,r10 */
+    "movq 0(%%rsi), %%r8\n"
+    "xorq %%r9, %%r9\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9) += n0 * c0 */
+    "movq %8, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    /* extract m0 */
+    "movq %%r8, %q0\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10) += l1 */
+    "addq 8(%%rsi), %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r9,r10,r8) += n1 * c0 */
+    "movq %8, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += n0 * c1 */
+    "movq %9, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* extract m1 */
+    "movq %%r9, %q1\n"
+    "xorq %%r9, %%r9\n"
+    /* (r10,r8,r9) += l2 */
+    "addq 16(%%rsi), %%r10\n"
+    "adcq $0, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += n2 * c0 */
+    "movq %8, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += n1 * c1 */
+    "movq %9, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += n0 */
+    "addq %%r11, %%r10\n"
+    "adcq $0, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* extract m2 */
+    "movq %%r10, %q2\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9,r10) += l3 */
+    "addq 24(%%rsi), %%r8\n"
+    "adcq $0, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += n3 * c0 */
+    "movq %8, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += n2 * c1 */
+    "movq %9, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += n1 */
+    "addq %%r12, %%r8\n"
+    "adcq $0, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* extract m3 */
+    "movq %%r8, %q3\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10,r8) += n3 * c1 */
+    "movq %9, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += n2 */
+    "addq %%r13, %%r9\n"
+    "adcq $0, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* extract m4 */
+    "movq %%r9, %q4\n"
+    /* (r10,r8) += n3 */
+    "addq %%r14, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* extract m5 */
+    "movq %%r10, %q5\n"
+    /* extract m6 */
+    "movq %%r8, %q6\n"
+    : "=g"(m0), "=g"(m1), "=g"(m2), "=g"(m3), "=g"(m4), "=g"(m5), "=g"(m6)
+    : "S"(l), "n"(SECP256K1_N_C_0), "n"(SECP256K1_N_C_1)
+    : "rax", "rdx", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "cc");
+
+    /* Reduce 385 bits into 258. */
+    __asm__ __volatile__(
+    /* Preload */
+    "movq %q9, %%r11\n"
+    "movq %q10, %%r12\n"
+    "movq %q11, %%r13\n"
+    /* Initialize (r8,r9,r10) */
+    "movq %q5, %%r8\n"
+    "xorq %%r9, %%r9\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9) += m4 * c0 */
+    "movq %12, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    /* extract p0 */
+    "movq %%r8, %q0\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10) += m1 */
+    "addq %q6, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r9,r10,r8) += m5 * c0 */
+    "movq %12, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += m4 * c1 */
+    "movq %13, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* extract p1 */
+    "movq %%r9, %q1\n"
+    "xorq %%r9, %%r9\n"
+    /* (r10,r8,r9) += m2 */
+    "addq %q7, %%r10\n"
+    "adcq $0, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += m6 * c0 */
+    "movq %12, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += m5 * c1 */
+    "movq %13, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += m4 */
+    "addq %%r11, %%r10\n"
+    "adcq $0, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* extract p2 */
+    "movq %%r10, %q2\n"
+    /* (r8,r9) += m3 */
+    "addq %q8, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r8,r9) += m6 * c1 */
+    "movq %13, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    /* (r8,r9) += m5 */
+    "addq %%r12, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* extract p3 */
+    "movq %%r8, %q3\n"
+    /* (r9) += m6 */
+    "addq %%r13, %%r9\n"
+    /* extract p4 */
+    "movq %%r9, %q4\n"
+    : "=&g"(p0), "=&g"(p1), "=&g"(p2), "=g"(p3), "=g"(p4)
+    : "g"(m0), "g"(m1), "g"(m2), "g"(m3), "g"(m4), "g"(m5), "g"(m6), "n"(SECP256K1_N_C_0), "n"(SECP256K1_N_C_1)
+    : "rax", "rdx", "r8", "r9", "r10", "r11", "r12", "r13", "cc");
+
+    /* Reduce 258 bits into 256. */
+    __asm__ __volatile__(
+    /* Preload */
+    "movq %q5, %%r10\n"
+    /* (rax,rdx) = p4 * c0 */
+    "movq %7, %%rax\n"
+    "mulq %%r10\n"
+    /* (rax,rdx) += p0 */
+    "addq %q1, %%rax\n"
+    "adcq $0, %%rdx\n"
+    /* extract r0 */
+    "movq %%rax, 0(%q6)\n"
+    /* Move to (r8,r9) */
+    "movq %%rdx, %%r8\n"
+    "xorq %%r9, %%r9\n"
+    /* (r8,r9) += p1 */
+    "addq %q2, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r8,r9) += p4 * c1 */
+    "movq %8, %%rax\n"
+    "mulq %%r10\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    /* Extract r1 */
+    "movq %%r8, 8(%q6)\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r8) += p4 */
+    "addq %%r10, %%r9\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r8) += p2 */
+    "addq %q3, %%r9\n"
+    "adcq $0, %%r8\n"
+    /* Extract r2 */
+    "movq %%r9, 16(%q6)\n"
+    "xorq %%r9, %%r9\n"
+    /* (r8,r9) += p3 */
+    "addq %q4, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* Extract r3 */
+    "movq %%r8, 24(%q6)\n"
+    /* Extract c */
+    "movq %%r9, %q0\n"
+    : "=g"(c)
+    : "g"(p0), "g"(p1), "g"(p2), "g"(p3), "g"(p4), "D"(r), "n"(SECP256K1_N_C_0), "n"(SECP256K1_N_C_1)
+    : "rax", "rdx", "r8", "r9", "r10", "cc", "memory");
+#else
+    uint128_t c;
+    uint64_t c0, c1, c2;
+    uint64_t n0 = l[4], n1 = l[5], n2 = l[6], n3 = l[7];
+    uint64_t m0, m1, m2, m3, m4, m5;
+    uint32_t m6;
+    uint64_t p0, p1, p2, p3;
+    uint32_t p4;
+
+    /* Reduce 512 bits into 385. */
+    /* m[0..6] = l[0..3] + n[0..3] * SECP256K1_N_C. */
+    c0 = l[0]; c1 = 0; c2 = 0;
+    muladd_fast(n0, SECP256K1_N_C_0);
+    extract_fast(m0);
+    sumadd_fast(l[1]);
+    muladd(n1, SECP256K1_N_C_0);
+    muladd(n0, SECP256K1_N_C_1);
+    extract(m1);
+    sumadd(l[2]);
+    muladd(n2, SECP256K1_N_C_0);
+    muladd(n1, SECP256K1_N_C_1);
+    sumadd(n0);
+    extract(m2);
+    sumadd(l[3]);
+    muladd(n3, SECP256K1_N_C_0);
+    muladd(n2, SECP256K1_N_C_1);
+    sumadd(n1);
+    extract(m3);
+    muladd(n3, SECP256K1_N_C_1);
+    sumadd(n2);
+    extract(m4);
+    sumadd_fast(n3);
+    extract_fast(m5);
+    VERIFY_CHECK(c0 <= 1);
+    m6 = c0;
+
+    /* Reduce 385 bits into 258. */
+    /* p[0..4] = m[0..3] + m[4..6] * SECP256K1_N_C. */
+    c0 = m0; c1 = 0; c2 = 0;
+    muladd_fast(m4, SECP256K1_N_C_0);
+    extract_fast(p0);
+    sumadd_fast(m1);
+    muladd(m5, SECP256K1_N_C_0);
+    muladd(m4, SECP256K1_N_C_1);
+    extract(p1);
+    sumadd(m2);
+    muladd(m6, SECP256K1_N_C_0);
+    muladd(m5, SECP256K1_N_C_1);
+    sumadd(m4);
+    extract(p2);
+    sumadd_fast(m3);
+    muladd_fast(m6, SECP256K1_N_C_1);
+    sumadd_fast(m5);
+    extract_fast(p3);
+    p4 = c0 + m6;
+    VERIFY_CHECK(p4 <= 2);
+
+    /* Reduce 258 bits into 256. */
+    /* r[0..3] = p[0..3] + p[4] * SECP256K1_N_C. */
+    c = p0 + (uint128_t)SECP256K1_N_C_0 * p4;
+    r->d[0] = c & 0xFFFFFFFFFFFFFFFFULL; c >>= 64;
+    c += p1 + (uint128_t)SECP256K1_N_C_1 * p4;
+    r->d[1] = c & 0xFFFFFFFFFFFFFFFFULL; c >>= 64;
+    c += p2 + (uint128_t)p4;
+    r->d[2] = c & 0xFFFFFFFFFFFFFFFFULL; c >>= 64;
+    c += p3;
+    r->d[3] = c & 0xFFFFFFFFFFFFFFFFULL; c >>= 64;
+#endif
+
+    /* Final reduction of r. */
+    secp256k1_scalar_reduce(r, c + secp256k1_scalar_check_overflow(r));
+}
+
+static void secp256k1_scalar_mul_512(uint64_t l[8], const secp256k1_scalar *a, const secp256k1_scalar *b) {
+#ifdef USE_ASM_X86_64
+    const uint64_t *pb = b->d;
+    __asm__ __volatile__(
+    /* Preload */
+    "movq 0(%%rdi), %%r15\n"
+    "movq 8(%%rdi), %%rbx\n"
+    "movq 16(%%rdi), %%rcx\n"
+    "movq 0(%%rdx), %%r11\n"
+    "movq 8(%%rdx), %%r12\n"
+    "movq 16(%%rdx), %%r13\n"
+    "movq 24(%%rdx), %%r14\n"
+    /* (rax,rdx) = a0 * b0 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r11\n"
+    /* Extract l0 */
+    "movq %%rax, 0(%%rsi)\n"
+    /* (r8,r9,r10) = (rdx) */
+    "movq %%rdx, %%r8\n"
+    "xorq %%r9, %%r9\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9,r10) += a0 * b1 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += a1 * b0 */
+    "movq %%rbx, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* Extract l1 */
+    "movq %%r8, 8(%%rsi)\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10,r8) += a0 * b2 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += a1 * b1 */
+    "movq %%rbx, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += a2 * b0 */
+    "movq %%rcx, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* Extract l2 */
+    "movq %%r9, 16(%%rsi)\n"
+    "xorq %%r9, %%r9\n"
+    /* (r10,r8,r9) += a0 * b3 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* Preload a3 */
+    "movq 24(%%rdi), %%r15\n"
+    /* (r10,r8,r9) += a1 * b2 */
+    "movq %%rbx, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += a2 * b1 */
+    "movq %%rcx, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += a3 * b0 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r11\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* Extract l3 */
+    "movq %%r10, 24(%%rsi)\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9,r10) += a1 * b3 */
+    "movq %%rbx, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += a2 * b2 */
+    "movq %%rcx, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += a3 * b1 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* Extract l4 */
+    "movq %%r8, 32(%%rsi)\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10,r8) += a2 * b3 */
+    "movq %%rcx, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += a3 * b2 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* Extract l5 */
+    "movq %%r9, 40(%%rsi)\n"
+    /* (r10,r8) += a3 * b3 */
+    "movq %%r15, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    /* Extract l6 */
+    "movq %%r10, 48(%%rsi)\n"
+    /* Extract l7 */
+    "movq %%r8, 56(%%rsi)\n"
+    : "+d"(pb)
+    : "S"(l), "D"(a->d)
+    : "rax", "rbx", "rcx", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "r15", "cc", "memory");
+#else
+    /* 160 bit accumulator. */
+    uint64_t c0 = 0, c1 = 0;
+    uint32_t c2 = 0;
+
+    /* l[0..7] = a[0..3] * b[0..3]. */
+    muladd_fast(a->d[0], b->d[0]);
+    extract_fast(l[0]);
+    muladd(a->d[0], b->d[1]);
+    muladd(a->d[1], b->d[0]);
+    extract(l[1]);
+    muladd(a->d[0], b->d[2]);
+    muladd(a->d[1], b->d[1]);
+    muladd(a->d[2], b->d[0]);
+    extract(l[2]);
+    muladd(a->d[0], b->d[3]);
+    muladd(a->d[1], b->d[2]);
+    muladd(a->d[2], b->d[1]);
+    muladd(a->d[3], b->d[0]);
+    extract(l[3]);
+    muladd(a->d[1], b->d[3]);
+    muladd(a->d[2], b->d[2]);
+    muladd(a->d[3], b->d[1]);
+    extract(l[4]);
+    muladd(a->d[2], b->d[3]);
+    muladd(a->d[3], b->d[2]);
+    extract(l[5]);
+    muladd_fast(a->d[3], b->d[3]);
+    extract_fast(l[6]);
+    VERIFY_CHECK(c1 == 0);
+    l[7] = c0;
+#endif
+}
+
+static void secp256k1_scalar_sqr_512(uint64_t l[8], const secp256k1_scalar *a) {
+#ifdef USE_ASM_X86_64
+    __asm__ __volatile__(
+    /* Preload */
+    "movq 0(%%rdi), %%r11\n"
+    "movq 8(%%rdi), %%r12\n"
+    "movq 16(%%rdi), %%r13\n"
+    "movq 24(%%rdi), %%r14\n"
+    /* (rax,rdx) = a0 * a0 */
+    "movq %%r11, %%rax\n"
+    "mulq %%r11\n"
+    /* Extract l0 */
+    "movq %%rax, 0(%%rsi)\n"
+    /* (r8,r9,r10) = (rdx,0) */
+    "movq %%rdx, %%r8\n"
+    "xorq %%r9, %%r9\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9,r10) += 2 * a0 * a1 */
+    "movq %%r11, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* Extract l1 */
+    "movq %%r8, 8(%%rsi)\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10,r8) += 2 * a0 * a2 */
+    "movq %%r11, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* (r9,r10,r8) += a1 * a1 */
+    "movq %%r12, %%rax\n"
+    "mulq %%r12\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* Extract l2 */
+    "movq %%r9, 16(%%rsi)\n"
+    "xorq %%r9, %%r9\n"
+    /* (r10,r8,r9) += 2 * a0 * a3 */
+    "movq %%r11, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* (r10,r8,r9) += 2 * a1 * a2 */
+    "movq %%r12, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    "adcq $0, %%r9\n"
+    /* Extract l3 */
+    "movq %%r10, 24(%%rsi)\n"
+    "xorq %%r10, %%r10\n"
+    /* (r8,r9,r10) += 2 * a1 * a3 */
+    "movq %%r12, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* (r8,r9,r10) += a2 * a2 */
+    "movq %%r13, %%rax\n"
+    "mulq %%r13\n"
+    "addq %%rax, %%r8\n"
+    "adcq %%rdx, %%r9\n"
+    "adcq $0, %%r10\n"
+    /* Extract l4 */
+    "movq %%r8, 32(%%rsi)\n"
+    "xorq %%r8, %%r8\n"
+    /* (r9,r10,r8) += 2 * a2 * a3 */
+    "movq %%r13, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    "addq %%rax, %%r9\n"
+    "adcq %%rdx, %%r10\n"
+    "adcq $0, %%r8\n"
+    /* Extract l5 */
+    "movq %%r9, 40(%%rsi)\n"
+    /* (r10,r8) += a3 * a3 */
+    "movq %%r14, %%rax\n"
+    "mulq %%r14\n"
+    "addq %%rax, %%r10\n"
+    "adcq %%rdx, %%r8\n"
+    /* Extract l6 */
+    "movq %%r10, 48(%%rsi)\n"
+    /* Extract l7 */
+    "movq %%r8, 56(%%rsi)\n"
+    :
+    : "S"(l), "D"(a->d)
+    : "rax", "rdx", "r8", "r9", "r10", "r11", "r12", "r13", "r14", "cc", "memory");
+#else
+    /* 160 bit accumulator. */
+    uint64_t c0 = 0, c1 = 0;
+    uint32_t c2 = 0;
+
+    /* l[0..7] = a[0..3] * b[0..3]. */
+    muladd_fast(a->d[0], a->d[0]);
+    extract_fast(l[0]);
+    muladd2(a->d[0], a->d[1]);
+    extract(l[1]);
+    muladd2(a->d[0], a->d[2]);
+    muladd(a->d[1], a->d[1]);
+    extract(l[2]);
+    muladd2(a->d[0], a->d[3]);
+    muladd2(a->d[1], a->d[2]);
+    extract(l[3]);
+    muladd2(a->d[1], a->d[3]);
+    muladd(a->d[2], a->d[2]);
+    extract(l[4]);
+    muladd2(a->d[2], a->d[3]);
+    extract(l[5]);
+    muladd_fast(a->d[3], a->d[3]);
+    extract_fast(l[6]);
+    VERIFY_CHECK(c1 == 0);
+    l[7] = c0;
+#endif
+}
+
+#undef sumadd
+#undef sumadd_fast
+#undef muladd
+#undef muladd_fast
+#undef muladd2
+#undef extract
+#undef extract_fast
+
+static void secp256k1_scalar_mul(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    uint64_t l[8];
+    secp256k1_scalar_mul_512(l, a, b);
+    secp256k1_scalar_reduce_512(r, l);
+}
+
+static int secp256k1_scalar_shr_int(secp256k1_scalar *r, int n) {
+    int ret;
+    VERIFY_CHECK(n > 0);
+    VERIFY_CHECK(n < 16);
+    ret = r->d[0] & ((1 << n) - 1);
+    r->d[0] = (r->d[0] >> n) + (r->d[1] << (64 - n));
+    r->d[1] = (r->d[1] >> n) + (r->d[2] << (64 - n));
+    r->d[2] = (r->d[2] >> n) + (r->d[3] << (64 - n));
+    r->d[3] = (r->d[3] >> n);
+    return ret;
+}
+
+static void secp256k1_scalar_sqr(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    uint64_t l[8];
+    secp256k1_scalar_sqr_512(l, a);
+    secp256k1_scalar_reduce_512(r, l);
+}
+
+#ifdef USE_ENDOMORPHISM
+static void secp256k1_scalar_split_128(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a) {
+    r1->d[0] = a->d[0];
+    r1->d[1] = a->d[1];
+    r1->d[2] = 0;
+    r1->d[3] = 0;
+    r2->d[0] = a->d[2];
+    r2->d[1] = a->d[3];
+    r2->d[2] = 0;
+    r2->d[3] = 0;
+}
+#endif
+
+SECP256K1_INLINE static int secp256k1_scalar_eq(const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    return ((a->d[0] ^ b->d[0]) | (a->d[1] ^ b->d[1]) | (a->d[2] ^ b->d[2]) | (a->d[3] ^ b->d[3])) == 0;
+}
+
+SECP256K1_INLINE static void secp256k1_scalar_mul_shift_var(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b, unsigned int shift) {
+    uint64_t l[8];
+    unsigned int shiftlimbs;
+    unsigned int shiftlow;
+    unsigned int shifthigh;
+    VERIFY_CHECK(shift >= 256);
+    secp256k1_scalar_mul_512(l, a, b);
+    shiftlimbs = shift >> 6;
+    shiftlow = shift & 0x3F;
+    shifthigh = 64 - shiftlow;
+    r->d[0] = shift < 512 ? (l[0 + shiftlimbs] >> shiftlow | (shift < 448 && shiftlow ? (l[1 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[1] = shift < 448 ? (l[1 + shiftlimbs] >> shiftlow | (shift < 384 && shiftlow ? (l[2 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[2] = shift < 384 ? (l[2 + shiftlimbs] >> shiftlow | (shift < 320 && shiftlow ? (l[3 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[3] = shift < 320 ? (l[3 + shiftlimbs] >> shiftlow) : 0;
+    secp256k1_scalar_cadd_bit(r, 0, (l[(shift - 1) >> 6] >> ((shift - 1) & 0x3f)) & 1);
+}
+
+#endif /* SECP256K1_SCALAR_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32.h
new file mode 100644
index 000000000..2c9a348e2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32.h
@@ -0,0 +1,19 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_H
+#define SECP256K1_SCALAR_REPR_H
+
+#include <stdint.h>
+
+/** A scalar modulo the group order of the secp256k1 curve. */
+typedef struct {
+    uint32_t d[8];
+} secp256k1_scalar;
+
+#define SECP256K1_SCALAR_CONST(d7, d6, d5, d4, d3, d2, d1, d0) {{(d0), (d1), (d2), (d3), (d4), (d5), (d6), (d7)}}
+
+#endif /* SECP256K1_SCALAR_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32_impl.h
new file mode 100644
index 000000000..4f9ed61fe
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_8x32_impl.h
@@ -0,0 +1,721 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_IMPL_H
+#define SECP256K1_SCALAR_REPR_IMPL_H
+
+/* Limbs of the secp256k1 order. */
+#define SECP256K1_N_0 ((uint32_t)0xD0364141UL)
+#define SECP256K1_N_1 ((uint32_t)0xBFD25E8CUL)
+#define SECP256K1_N_2 ((uint32_t)0xAF48A03BUL)
+#define SECP256K1_N_3 ((uint32_t)0xBAAEDCE6UL)
+#define SECP256K1_N_4 ((uint32_t)0xFFFFFFFEUL)
+#define SECP256K1_N_5 ((uint32_t)0xFFFFFFFFUL)
+#define SECP256K1_N_6 ((uint32_t)0xFFFFFFFFUL)
+#define SECP256K1_N_7 ((uint32_t)0xFFFFFFFFUL)
+
+/* Limbs of 2^256 minus the secp256k1 order. */
+#define SECP256K1_N_C_0 (~SECP256K1_N_0 + 1)
+#define SECP256K1_N_C_1 (~SECP256K1_N_1)
+#define SECP256K1_N_C_2 (~SECP256K1_N_2)
+#define SECP256K1_N_C_3 (~SECP256K1_N_3)
+#define SECP256K1_N_C_4 (1)
+
+/* Limbs of half the secp256k1 order. */
+#define SECP256K1_N_H_0 ((uint32_t)0x681B20A0UL)
+#define SECP256K1_N_H_1 ((uint32_t)0xDFE92F46UL)
+#define SECP256K1_N_H_2 ((uint32_t)0x57A4501DUL)
+#define SECP256K1_N_H_3 ((uint32_t)0x5D576E73UL)
+#define SECP256K1_N_H_4 ((uint32_t)0xFFFFFFFFUL)
+#define SECP256K1_N_H_5 ((uint32_t)0xFFFFFFFFUL)
+#define SECP256K1_N_H_6 ((uint32_t)0xFFFFFFFFUL)
+#define SECP256K1_N_H_7 ((uint32_t)0x7FFFFFFFUL)
+
+SECP256K1_INLINE static void secp256k1_scalar_clear(secp256k1_scalar *r) {
+    r->d[0] = 0;
+    r->d[1] = 0;
+    r->d[2] = 0;
+    r->d[3] = 0;
+    r->d[4] = 0;
+    r->d[5] = 0;
+    r->d[6] = 0;
+    r->d[7] = 0;
+}
+
+SECP256K1_INLINE static void secp256k1_scalar_set_int(secp256k1_scalar *r, unsigned int v) {
+    r->d[0] = v;
+    r->d[1] = 0;
+    r->d[2] = 0;
+    r->d[3] = 0;
+    r->d[4] = 0;
+    r->d[5] = 0;
+    r->d[6] = 0;
+    r->d[7] = 0;
+}
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    VERIFY_CHECK((offset + count - 1) >> 5 == offset >> 5);
+    return (a->d[offset >> 5] >> (offset & 0x1F)) & ((1 << count) - 1);
+}
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits_var(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    VERIFY_CHECK(count < 32);
+    VERIFY_CHECK(offset + count <= 256);
+    if ((offset + count - 1) >> 5 == offset >> 5) {
+        return secp256k1_scalar_get_bits(a, offset, count);
+    } else {
+        VERIFY_CHECK((offset >> 5) + 1 < 8);
+        return ((a->d[offset >> 5] >> (offset & 0x1F)) | (a->d[(offset >> 5) + 1] << (32 - (offset & 0x1F)))) & ((((uint32_t)1) << count) - 1);
+    }
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_check_overflow(const secp256k1_scalar *a) {
+    int yes = 0;
+    int no = 0;
+    no |= (a->d[7] < SECP256K1_N_7); /* No need for a > check. */
+    no |= (a->d[6] < SECP256K1_N_6); /* No need for a > check. */
+    no |= (a->d[5] < SECP256K1_N_5); /* No need for a > check. */
+    no |= (a->d[4] < SECP256K1_N_4);
+    yes |= (a->d[4] > SECP256K1_N_4) & ~no;
+    no |= (a->d[3] < SECP256K1_N_3) & ~yes;
+    yes |= (a->d[3] > SECP256K1_N_3) & ~no;
+    no |= (a->d[2] < SECP256K1_N_2) & ~yes;
+    yes |= (a->d[2] > SECP256K1_N_2) & ~no;
+    no |= (a->d[1] < SECP256K1_N_1) & ~yes;
+    yes |= (a->d[1] > SECP256K1_N_1) & ~no;
+    yes |= (a->d[0] >= SECP256K1_N_0) & ~no;
+    return yes;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_reduce(secp256k1_scalar *r, uint32_t overflow) {
+    uint64_t t;
+    VERIFY_CHECK(overflow <= 1);
+    t = (uint64_t)r->d[0] + overflow * SECP256K1_N_C_0;
+    r->d[0] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[1] + overflow * SECP256K1_N_C_1;
+    r->d[1] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[2] + overflow * SECP256K1_N_C_2;
+    r->d[2] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[3] + overflow * SECP256K1_N_C_3;
+    r->d[3] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[4] + overflow * SECP256K1_N_C_4;
+    r->d[4] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[5];
+    r->d[5] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[6];
+    r->d[6] = t & 0xFFFFFFFFUL; t >>= 32;
+    t += (uint64_t)r->d[7];
+    r->d[7] = t & 0xFFFFFFFFUL;
+    return overflow;
+}
+
+static int secp256k1_scalar_add(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    int overflow;
+    uint64_t t = (uint64_t)a->d[0] + b->d[0];
+    r->d[0] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[1] + b->d[1];
+    r->d[1] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[2] + b->d[2];
+    r->d[2] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[3] + b->d[3];
+    r->d[3] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[4] + b->d[4];
+    r->d[4] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[5] + b->d[5];
+    r->d[5] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[6] + b->d[6];
+    r->d[6] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)a->d[7] + b->d[7];
+    r->d[7] = t & 0xFFFFFFFFULL; t >>= 32;
+    overflow = t + secp256k1_scalar_check_overflow(r);
+    VERIFY_CHECK(overflow == 0 || overflow == 1);
+    secp256k1_scalar_reduce(r, overflow);
+    return overflow;
+}
+
+static void secp256k1_scalar_cadd_bit(secp256k1_scalar *r, unsigned int bit, int flag) {
+    uint64_t t;
+    VERIFY_CHECK(bit < 256);
+    bit += ((uint32_t) flag - 1) & 0x100;  /* forcing (bit >> 5) > 7 makes this a noop */
+    t = (uint64_t)r->d[0] + (((uint32_t)((bit >> 5) == 0)) << (bit & 0x1F));
+    r->d[0] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[1] + (((uint32_t)((bit >> 5) == 1)) << (bit & 0x1F));
+    r->d[1] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[2] + (((uint32_t)((bit >> 5) == 2)) << (bit & 0x1F));
+    r->d[2] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[3] + (((uint32_t)((bit >> 5) == 3)) << (bit & 0x1F));
+    r->d[3] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[4] + (((uint32_t)((bit >> 5) == 4)) << (bit & 0x1F));
+    r->d[4] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[5] + (((uint32_t)((bit >> 5) == 5)) << (bit & 0x1F));
+    r->d[5] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[6] + (((uint32_t)((bit >> 5) == 6)) << (bit & 0x1F));
+    r->d[6] = t & 0xFFFFFFFFULL; t >>= 32;
+    t += (uint64_t)r->d[7] + (((uint32_t)((bit >> 5) == 7)) << (bit & 0x1F));
+    r->d[7] = t & 0xFFFFFFFFULL;
+#ifdef VERIFY
+    VERIFY_CHECK((t >> 32) == 0);
+    VERIFY_CHECK(secp256k1_scalar_check_overflow(r) == 0);
+#endif
+}
+
+static void secp256k1_scalar_set_b32(secp256k1_scalar *r, const unsigned char *b32, int *overflow) {
+    int over;
+    r->d[0] = (uint32_t)b32[31] | (uint32_t)b32[30] << 8 | (uint32_t)b32[29] << 16 | (uint32_t)b32[28] << 24;
+    r->d[1] = (uint32_t)b32[27] | (uint32_t)b32[26] << 8 | (uint32_t)b32[25] << 16 | (uint32_t)b32[24] << 24;
+    r->d[2] = (uint32_t)b32[23] | (uint32_t)b32[22] << 8 | (uint32_t)b32[21] << 16 | (uint32_t)b32[20] << 24;
+    r->d[3] = (uint32_t)b32[19] | (uint32_t)b32[18] << 8 | (uint32_t)b32[17] << 16 | (uint32_t)b32[16] << 24;
+    r->d[4] = (uint32_t)b32[15] | (uint32_t)b32[14] << 8 | (uint32_t)b32[13] << 16 | (uint32_t)b32[12] << 24;
+    r->d[5] = (uint32_t)b32[11] | (uint32_t)b32[10] << 8 | (uint32_t)b32[9] << 16 | (uint32_t)b32[8] << 24;
+    r->d[6] = (uint32_t)b32[7] | (uint32_t)b32[6] << 8 | (uint32_t)b32[5] << 16 | (uint32_t)b32[4] << 24;
+    r->d[7] = (uint32_t)b32[3] | (uint32_t)b32[2] << 8 | (uint32_t)b32[1] << 16 | (uint32_t)b32[0] << 24;
+    over = secp256k1_scalar_reduce(r, secp256k1_scalar_check_overflow(r));
+    if (overflow) {
+        *overflow = over;
+    }
+}
+
+static void secp256k1_scalar_get_b32(unsigned char *bin, const secp256k1_scalar* a) {
+    bin[0] = a->d[7] >> 24; bin[1] = a->d[7] >> 16; bin[2] = a->d[7] >> 8; bin[3] = a->d[7];
+    bin[4] = a->d[6] >> 24; bin[5] = a->d[6] >> 16; bin[6] = a->d[6] >> 8; bin[7] = a->d[6];
+    bin[8] = a->d[5] >> 24; bin[9] = a->d[5] >> 16; bin[10] = a->d[5] >> 8; bin[11] = a->d[5];
+    bin[12] = a->d[4] >> 24; bin[13] = a->d[4] >> 16; bin[14] = a->d[4] >> 8; bin[15] = a->d[4];
+    bin[16] = a->d[3] >> 24; bin[17] = a->d[3] >> 16; bin[18] = a->d[3] >> 8; bin[19] = a->d[3];
+    bin[20] = a->d[2] >> 24; bin[21] = a->d[2] >> 16; bin[22] = a->d[2] >> 8; bin[23] = a->d[2];
+    bin[24] = a->d[1] >> 24; bin[25] = a->d[1] >> 16; bin[26] = a->d[1] >> 8; bin[27] = a->d[1];
+    bin[28] = a->d[0] >> 24; bin[29] = a->d[0] >> 16; bin[30] = a->d[0] >> 8; bin[31] = a->d[0];
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_zero(const secp256k1_scalar *a) {
+    return (a->d[0] | a->d[1] | a->d[2] | a->d[3] | a->d[4] | a->d[5] | a->d[6] | a->d[7]) == 0;
+}
+
+static void secp256k1_scalar_negate(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    uint32_t nonzero = 0xFFFFFFFFUL * (secp256k1_scalar_is_zero(a) == 0);
+    uint64_t t = (uint64_t)(~a->d[0]) + SECP256K1_N_0 + 1;
+    r->d[0] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[1]) + SECP256K1_N_1;
+    r->d[1] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[2]) + SECP256K1_N_2;
+    r->d[2] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[3]) + SECP256K1_N_3;
+    r->d[3] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[4]) + SECP256K1_N_4;
+    r->d[4] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[5]) + SECP256K1_N_5;
+    r->d[5] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[6]) + SECP256K1_N_6;
+    r->d[6] = t & nonzero; t >>= 32;
+    t += (uint64_t)(~a->d[7]) + SECP256K1_N_7;
+    r->d[7] = t & nonzero;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_one(const secp256k1_scalar *a) {
+    return ((a->d[0] ^ 1) | a->d[1] | a->d[2] | a->d[3] | a->d[4] | a->d[5] | a->d[6] | a->d[7]) == 0;
+}
+
+static int secp256k1_scalar_is_high(const secp256k1_scalar *a) {
+    int yes = 0;
+    int no = 0;
+    no |= (a->d[7] < SECP256K1_N_H_7);
+    yes |= (a->d[7] > SECP256K1_N_H_7) & ~no;
+    no |= (a->d[6] < SECP256K1_N_H_6) & ~yes; /* No need for a > check. */
+    no |= (a->d[5] < SECP256K1_N_H_5) & ~yes; /* No need for a > check. */
+    no |= (a->d[4] < SECP256K1_N_H_4) & ~yes; /* No need for a > check. */
+    no |= (a->d[3] < SECP256K1_N_H_3) & ~yes;
+    yes |= (a->d[3] > SECP256K1_N_H_3) & ~no;
+    no |= (a->d[2] < SECP256K1_N_H_2) & ~yes;
+    yes |= (a->d[2] > SECP256K1_N_H_2) & ~no;
+    no |= (a->d[1] < SECP256K1_N_H_1) & ~yes;
+    yes |= (a->d[1] > SECP256K1_N_H_1) & ~no;
+    yes |= (a->d[0] > SECP256K1_N_H_0) & ~no;
+    return yes;
+}
+
+static int secp256k1_scalar_cond_negate(secp256k1_scalar *r, int flag) {
+    /* If we are flag = 0, mask = 00...00 and this is a no-op;
+     * if we are flag = 1, mask = 11...11 and this is identical to secp256k1_scalar_negate */
+    uint32_t mask = !flag - 1;
+    uint32_t nonzero = 0xFFFFFFFFUL * (secp256k1_scalar_is_zero(r) == 0);
+    uint64_t t = (uint64_t)(r->d[0] ^ mask) + ((SECP256K1_N_0 + 1) & mask);
+    r->d[0] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[1] ^ mask) + (SECP256K1_N_1 & mask);
+    r->d[1] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[2] ^ mask) + (SECP256K1_N_2 & mask);
+    r->d[2] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[3] ^ mask) + (SECP256K1_N_3 & mask);
+    r->d[3] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[4] ^ mask) + (SECP256K1_N_4 & mask);
+    r->d[4] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[5] ^ mask) + (SECP256K1_N_5 & mask);
+    r->d[5] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[6] ^ mask) + (SECP256K1_N_6 & mask);
+    r->d[6] = t & nonzero; t >>= 32;
+    t += (uint64_t)(r->d[7] ^ mask) + (SECP256K1_N_7 & mask);
+    r->d[7] = t & nonzero;
+    return 2 * (mask == 0) - 1;
+}
+
+
+/* Inspired by the macros in OpenSSL's crypto/bn/asm/x86_64-gcc.c. */
+
+/** Add a*b to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define muladd(a,b) { \
+    uint32_t tl, th; \
+    { \
+        uint64_t t = (uint64_t)a * b; \
+        th = t >> 32;         /* at most 0xFFFFFFFE */ \
+        tl = t; \
+    } \
+    c0 += tl;                 /* overflow is handled on the next line */ \
+    th += (c0 < tl) ? 1 : 0;  /* at most 0xFFFFFFFF */ \
+    c1 += th;                 /* overflow is handled on the next line */ \
+    c2 += (c1 < th) ? 1 : 0;  /* never overflows by contract (verified in the next line) */ \
+    VERIFY_CHECK((c1 >= th) || (c2 != 0)); \
+}
+
+/** Add a*b to the number defined by (c0,c1). c1 must never overflow. */
+#define muladd_fast(a,b) { \
+    uint32_t tl, th; \
+    { \
+        uint64_t t = (uint64_t)a * b; \
+        th = t >> 32;         /* at most 0xFFFFFFFE */ \
+        tl = t; \
+    } \
+    c0 += tl;                 /* overflow is handled on the next line */ \
+    th += (c0 < tl) ? 1 : 0;  /* at most 0xFFFFFFFF */ \
+    c1 += th;                 /* never overflows by contract (verified in the next line) */ \
+    VERIFY_CHECK(c1 >= th); \
+}
+
+/** Add 2*a*b to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define muladd2(a,b) { \
+    uint32_t tl, th, th2, tl2; \
+    { \
+        uint64_t t = (uint64_t)a * b; \
+        th = t >> 32;               /* at most 0xFFFFFFFE */ \
+        tl = t; \
+    } \
+    th2 = th + th;                  /* at most 0xFFFFFFFE (in case th was 0x7FFFFFFF) */ \
+    c2 += (th2 < th) ? 1 : 0;       /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((th2 >= th) || (c2 != 0)); \
+    tl2 = tl + tl;                  /* at most 0xFFFFFFFE (in case the lowest 63 bits of tl were 0x7FFFFFFF) */ \
+    th2 += (tl2 < tl) ? 1 : 0;      /* at most 0xFFFFFFFF */ \
+    c0 += tl2;                      /* overflow is handled on the next line */ \
+    th2 += (c0 < tl2) ? 1 : 0;      /* second overflow is handled on the next line */ \
+    c2 += (c0 < tl2) & (th2 == 0);  /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c0 >= tl2) || (th2 != 0) || (c2 != 0)); \
+    c1 += th2;                      /* overflow is handled on the next line */ \
+    c2 += (c1 < th2) ? 1 : 0;       /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c1 >= th2) || (c2 != 0)); \
+}
+
+/** Add a to the number defined by (c0,c1,c2). c2 must never overflow. */
+#define sumadd(a) { \
+    unsigned int over; \
+    c0 += (a);                  /* overflow is handled on the next line */ \
+    over = (c0 < (a)) ? 1 : 0; \
+    c1 += over;                 /* overflow is handled on the next line */ \
+    c2 += (c1 < over) ? 1 : 0;  /* never overflows by contract */ \
+}
+
+/** Add a to the number defined by (c0,c1). c1 must never overflow, c2 must be zero. */
+#define sumadd_fast(a) { \
+    c0 += (a);                 /* overflow is handled on the next line */ \
+    c1 += (c0 < (a)) ? 1 : 0;  /* never overflows by contract (verified the next line) */ \
+    VERIFY_CHECK((c1 != 0) | (c0 >= (a))); \
+    VERIFY_CHECK(c2 == 0); \
+}
+
+/** Extract the lowest 32 bits of (c0,c1,c2) into n, and left shift the number 32 bits. */
+#define extract(n) { \
+    (n) = c0; \
+    c0 = c1; \
+    c1 = c2; \
+    c2 = 0; \
+}
+
+/** Extract the lowest 32 bits of (c0,c1,c2) into n, and left shift the number 32 bits. c2 is required to be zero. */
+#define extract_fast(n) { \
+    (n) = c0; \
+    c0 = c1; \
+    c1 = 0; \
+    VERIFY_CHECK(c2 == 0); \
+}
+
+static void secp256k1_scalar_reduce_512(secp256k1_scalar *r, const uint32_t *l) {
+    uint64_t c;
+    uint32_t n0 = l[8], n1 = l[9], n2 = l[10], n3 = l[11], n4 = l[12], n5 = l[13], n6 = l[14], n7 = l[15];
+    uint32_t m0, m1, m2, m3, m4, m5, m6, m7, m8, m9, m10, m11, m12;
+    uint32_t p0, p1, p2, p3, p4, p5, p6, p7, p8;
+
+    /* 96 bit accumulator. */
+    uint32_t c0, c1, c2;
+
+    /* Reduce 512 bits into 385. */
+    /* m[0..12] = l[0..7] + n[0..7] * SECP256K1_N_C. */
+    c0 = l[0]; c1 = 0; c2 = 0;
+    muladd_fast(n0, SECP256K1_N_C_0);
+    extract_fast(m0);
+    sumadd_fast(l[1]);
+    muladd(n1, SECP256K1_N_C_0);
+    muladd(n0, SECP256K1_N_C_1);
+    extract(m1);
+    sumadd(l[2]);
+    muladd(n2, SECP256K1_N_C_0);
+    muladd(n1, SECP256K1_N_C_1);
+    muladd(n0, SECP256K1_N_C_2);
+    extract(m2);
+    sumadd(l[3]);
+    muladd(n3, SECP256K1_N_C_0);
+    muladd(n2, SECP256K1_N_C_1);
+    muladd(n1, SECP256K1_N_C_2);
+    muladd(n0, SECP256K1_N_C_3);
+    extract(m3);
+    sumadd(l[4]);
+    muladd(n4, SECP256K1_N_C_0);
+    muladd(n3, SECP256K1_N_C_1);
+    muladd(n2, SECP256K1_N_C_2);
+    muladd(n1, SECP256K1_N_C_3);
+    sumadd(n0);
+    extract(m4);
+    sumadd(l[5]);
+    muladd(n5, SECP256K1_N_C_0);
+    muladd(n4, SECP256K1_N_C_1);
+    muladd(n3, SECP256K1_N_C_2);
+    muladd(n2, SECP256K1_N_C_3);
+    sumadd(n1);
+    extract(m5);
+    sumadd(l[6]);
+    muladd(n6, SECP256K1_N_C_0);
+    muladd(n5, SECP256K1_N_C_1);
+    muladd(n4, SECP256K1_N_C_2);
+    muladd(n3, SECP256K1_N_C_3);
+    sumadd(n2);
+    extract(m6);
+    sumadd(l[7]);
+    muladd(n7, SECP256K1_N_C_0);
+    muladd(n6, SECP256K1_N_C_1);
+    muladd(n5, SECP256K1_N_C_2);
+    muladd(n4, SECP256K1_N_C_3);
+    sumadd(n3);
+    extract(m7);
+    muladd(n7, SECP256K1_N_C_1);
+    muladd(n6, SECP256K1_N_C_2);
+    muladd(n5, SECP256K1_N_C_3);
+    sumadd(n4);
+    extract(m8);
+    muladd(n7, SECP256K1_N_C_2);
+    muladd(n6, SECP256K1_N_C_3);
+    sumadd(n5);
+    extract(m9);
+    muladd(n7, SECP256K1_N_C_3);
+    sumadd(n6);
+    extract(m10);
+    sumadd_fast(n7);
+    extract_fast(m11);
+    VERIFY_CHECK(c0 <= 1);
+    m12 = c0;
+
+    /* Reduce 385 bits into 258. */
+    /* p[0..8] = m[0..7] + m[8..12] * SECP256K1_N_C. */
+    c0 = m0; c1 = 0; c2 = 0;
+    muladd_fast(m8, SECP256K1_N_C_0);
+    extract_fast(p0);
+    sumadd_fast(m1);
+    muladd(m9, SECP256K1_N_C_0);
+    muladd(m8, SECP256K1_N_C_1);
+    extract(p1);
+    sumadd(m2);
+    muladd(m10, SECP256K1_N_C_0);
+    muladd(m9, SECP256K1_N_C_1);
+    muladd(m8, SECP256K1_N_C_2);
+    extract(p2);
+    sumadd(m3);
+    muladd(m11, SECP256K1_N_C_0);
+    muladd(m10, SECP256K1_N_C_1);
+    muladd(m9, SECP256K1_N_C_2);
+    muladd(m8, SECP256K1_N_C_3);
+    extract(p3);
+    sumadd(m4);
+    muladd(m12, SECP256K1_N_C_0);
+    muladd(m11, SECP256K1_N_C_1);
+    muladd(m10, SECP256K1_N_C_2);
+    muladd(m9, SECP256K1_N_C_3);
+    sumadd(m8);
+    extract(p4);
+    sumadd(m5);
+    muladd(m12, SECP256K1_N_C_1);
+    muladd(m11, SECP256K1_N_C_2);
+    muladd(m10, SECP256K1_N_C_3);
+    sumadd(m9);
+    extract(p5);
+    sumadd(m6);
+    muladd(m12, SECP256K1_N_C_2);
+    muladd(m11, SECP256K1_N_C_3);
+    sumadd(m10);
+    extract(p6);
+    sumadd_fast(m7);
+    muladd_fast(m12, SECP256K1_N_C_3);
+    sumadd_fast(m11);
+    extract_fast(p7);
+    p8 = c0 + m12;
+    VERIFY_CHECK(p8 <= 2);
+
+    /* Reduce 258 bits into 256. */
+    /* r[0..7] = p[0..7] + p[8] * SECP256K1_N_C. */
+    c = p0 + (uint64_t)SECP256K1_N_C_0 * p8;
+    r->d[0] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p1 + (uint64_t)SECP256K1_N_C_1 * p8;
+    r->d[1] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p2 + (uint64_t)SECP256K1_N_C_2 * p8;
+    r->d[2] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p3 + (uint64_t)SECP256K1_N_C_3 * p8;
+    r->d[3] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p4 + (uint64_t)p8;
+    r->d[4] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p5;
+    r->d[5] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p6;
+    r->d[6] = c & 0xFFFFFFFFUL; c >>= 32;
+    c += p7;
+    r->d[7] = c & 0xFFFFFFFFUL; c >>= 32;
+
+    /* Final reduction of r. */
+    secp256k1_scalar_reduce(r, c + secp256k1_scalar_check_overflow(r));
+}
+
+static void secp256k1_scalar_mul_512(uint32_t *l, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    /* 96 bit accumulator. */
+    uint32_t c0 = 0, c1 = 0, c2 = 0;
+
+    /* l[0..15] = a[0..7] * b[0..7]. */
+    muladd_fast(a->d[0], b->d[0]);
+    extract_fast(l[0]);
+    muladd(a->d[0], b->d[1]);
+    muladd(a->d[1], b->d[0]);
+    extract(l[1]);
+    muladd(a->d[0], b->d[2]);
+    muladd(a->d[1], b->d[1]);
+    muladd(a->d[2], b->d[0]);
+    extract(l[2]);
+    muladd(a->d[0], b->d[3]);
+    muladd(a->d[1], b->d[2]);
+    muladd(a->d[2], b->d[1]);
+    muladd(a->d[3], b->d[0]);
+    extract(l[3]);
+    muladd(a->d[0], b->d[4]);
+    muladd(a->d[1], b->d[3]);
+    muladd(a->d[2], b->d[2]);
+    muladd(a->d[3], b->d[1]);
+    muladd(a->d[4], b->d[0]);
+    extract(l[4]);
+    muladd(a->d[0], b->d[5]);
+    muladd(a->d[1], b->d[4]);
+    muladd(a->d[2], b->d[3]);
+    muladd(a->d[3], b->d[2]);
+    muladd(a->d[4], b->d[1]);
+    muladd(a->d[5], b->d[0]);
+    extract(l[5]);
+    muladd(a->d[0], b->d[6]);
+    muladd(a->d[1], b->d[5]);
+    muladd(a->d[2], b->d[4]);
+    muladd(a->d[3], b->d[3]);
+    muladd(a->d[4], b->d[2]);
+    muladd(a->d[5], b->d[1]);
+    muladd(a->d[6], b->d[0]);
+    extract(l[6]);
+    muladd(a->d[0], b->d[7]);
+    muladd(a->d[1], b->d[6]);
+    muladd(a->d[2], b->d[5]);
+    muladd(a->d[3], b->d[4]);
+    muladd(a->d[4], b->d[3]);
+    muladd(a->d[5], b->d[2]);
+    muladd(a->d[6], b->d[1]);
+    muladd(a->d[7], b->d[0]);
+    extract(l[7]);
+    muladd(a->d[1], b->d[7]);
+    muladd(a->d[2], b->d[6]);
+    muladd(a->d[3], b->d[5]);
+    muladd(a->d[4], b->d[4]);
+    muladd(a->d[5], b->d[3]);
+    muladd(a->d[6], b->d[2]);
+    muladd(a->d[7], b->d[1]);
+    extract(l[8]);
+    muladd(a->d[2], b->d[7]);
+    muladd(a->d[3], b->d[6]);
+    muladd(a->d[4], b->d[5]);
+    muladd(a->d[5], b->d[4]);
+    muladd(a->d[6], b->d[3]);
+    muladd(a->d[7], b->d[2]);
+    extract(l[9]);
+    muladd(a->d[3], b->d[7]);
+    muladd(a->d[4], b->d[6]);
+    muladd(a->d[5], b->d[5]);
+    muladd(a->d[6], b->d[4]);
+    muladd(a->d[7], b->d[3]);
+    extract(l[10]);
+    muladd(a->d[4], b->d[7]);
+    muladd(a->d[5], b->d[6]);
+    muladd(a->d[6], b->d[5]);
+    muladd(a->d[7], b->d[4]);
+    extract(l[11]);
+    muladd(a->d[5], b->d[7]);
+    muladd(a->d[6], b->d[6]);
+    muladd(a->d[7], b->d[5]);
+    extract(l[12]);
+    muladd(a->d[6], b->d[7]);
+    muladd(a->d[7], b->d[6]);
+    extract(l[13]);
+    muladd_fast(a->d[7], b->d[7]);
+    extract_fast(l[14]);
+    VERIFY_CHECK(c1 == 0);
+    l[15] = c0;
+}
+
+static void secp256k1_scalar_sqr_512(uint32_t *l, const secp256k1_scalar *a) {
+    /* 96 bit accumulator. */
+    uint32_t c0 = 0, c1 = 0, c2 = 0;
+
+    /* l[0..15] = a[0..7]^2. */
+    muladd_fast(a->d[0], a->d[0]);
+    extract_fast(l[0]);
+    muladd2(a->d[0], a->d[1]);
+    extract(l[1]);
+    muladd2(a->d[0], a->d[2]);
+    muladd(a->d[1], a->d[1]);
+    extract(l[2]);
+    muladd2(a->d[0], a->d[3]);
+    muladd2(a->d[1], a->d[2]);
+    extract(l[3]);
+    muladd2(a->d[0], a->d[4]);
+    muladd2(a->d[1], a->d[3]);
+    muladd(a->d[2], a->d[2]);
+    extract(l[4]);
+    muladd2(a->d[0], a->d[5]);
+    muladd2(a->d[1], a->d[4]);
+    muladd2(a->d[2], a->d[3]);
+    extract(l[5]);
+    muladd2(a->d[0], a->d[6]);
+    muladd2(a->d[1], a->d[5]);
+    muladd2(a->d[2], a->d[4]);
+    muladd(a->d[3], a->d[3]);
+    extract(l[6]);
+    muladd2(a->d[0], a->d[7]);
+    muladd2(a->d[1], a->d[6]);
+    muladd2(a->d[2], a->d[5]);
+    muladd2(a->d[3], a->d[4]);
+    extract(l[7]);
+    muladd2(a->d[1], a->d[7]);
+    muladd2(a->d[2], a->d[6]);
+    muladd2(a->d[3], a->d[5]);
+    muladd(a->d[4], a->d[4]);
+    extract(l[8]);
+    muladd2(a->d[2], a->d[7]);
+    muladd2(a->d[3], a->d[6]);
+    muladd2(a->d[4], a->d[5]);
+    extract(l[9]);
+    muladd2(a->d[3], a->d[7]);
+    muladd2(a->d[4], a->d[6]);
+    muladd(a->d[5], a->d[5]);
+    extract(l[10]);
+    muladd2(a->d[4], a->d[7]);
+    muladd2(a->d[5], a->d[6]);
+    extract(l[11]);
+    muladd2(a->d[5], a->d[7]);
+    muladd(a->d[6], a->d[6]);
+    extract(l[12]);
+    muladd2(a->d[6], a->d[7]);
+    extract(l[13]);
+    muladd_fast(a->d[7], a->d[7]);
+    extract_fast(l[14]);
+    VERIFY_CHECK(c1 == 0);
+    l[15] = c0;
+}
+
+#undef sumadd
+#undef sumadd_fast
+#undef muladd
+#undef muladd_fast
+#undef muladd2
+#undef extract
+#undef extract_fast
+
+static void secp256k1_scalar_mul(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    uint32_t l[16];
+    secp256k1_scalar_mul_512(l, a, b);
+    secp256k1_scalar_reduce_512(r, l);
+}
+
+static int secp256k1_scalar_shr_int(secp256k1_scalar *r, int n) {
+    int ret;
+    VERIFY_CHECK(n > 0);
+    VERIFY_CHECK(n < 16);
+    ret = r->d[0] & ((1 << n) - 1);
+    r->d[0] = (r->d[0] >> n) + (r->d[1] << (32 - n));
+    r->d[1] = (r->d[1] >> n) + (r->d[2] << (32 - n));
+    r->d[2] = (r->d[2] >> n) + (r->d[3] << (32 - n));
+    r->d[3] = (r->d[3] >> n) + (r->d[4] << (32 - n));
+    r->d[4] = (r->d[4] >> n) + (r->d[5] << (32 - n));
+    r->d[5] = (r->d[5] >> n) + (r->d[6] << (32 - n));
+    r->d[6] = (r->d[6] >> n) + (r->d[7] << (32 - n));
+    r->d[7] = (r->d[7] >> n);
+    return ret;
+}
+
+static void secp256k1_scalar_sqr(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    uint32_t l[16];
+    secp256k1_scalar_sqr_512(l, a);
+    secp256k1_scalar_reduce_512(r, l);
+}
+
+#ifdef USE_ENDOMORPHISM
+static void secp256k1_scalar_split_128(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a) {
+    r1->d[0] = a->d[0];
+    r1->d[1] = a->d[1];
+    r1->d[2] = a->d[2];
+    r1->d[3] = a->d[3];
+    r1->d[4] = 0;
+    r1->d[5] = 0;
+    r1->d[6] = 0;
+    r1->d[7] = 0;
+    r2->d[0] = a->d[4];
+    r2->d[1] = a->d[5];
+    r2->d[2] = a->d[6];
+    r2->d[3] = a->d[7];
+    r2->d[4] = 0;
+    r2->d[5] = 0;
+    r2->d[6] = 0;
+    r2->d[7] = 0;
+}
+#endif
+
+SECP256K1_INLINE static int secp256k1_scalar_eq(const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    return ((a->d[0] ^ b->d[0]) | (a->d[1] ^ b->d[1]) | (a->d[2] ^ b->d[2]) | (a->d[3] ^ b->d[3]) | (a->d[4] ^ b->d[4]) | (a->d[5] ^ b->d[5]) | (a->d[6] ^ b->d[6]) | (a->d[7] ^ b->d[7])) == 0;
+}
+
+SECP256K1_INLINE static void secp256k1_scalar_mul_shift_var(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b, unsigned int shift) {
+    uint32_t l[16];
+    unsigned int shiftlimbs;
+    unsigned int shiftlow;
+    unsigned int shifthigh;
+    VERIFY_CHECK(shift >= 256);
+    secp256k1_scalar_mul_512(l, a, b);
+    shiftlimbs = shift >> 5;
+    shiftlow = shift & 0x1F;
+    shifthigh = 32 - shiftlow;
+    r->d[0] = shift < 512 ? (l[0 + shiftlimbs] >> shiftlow | (shift < 480 && shiftlow ? (l[1 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[1] = shift < 480 ? (l[1 + shiftlimbs] >> shiftlow | (shift < 448 && shiftlow ? (l[2 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[2] = shift < 448 ? (l[2 + shiftlimbs] >> shiftlow | (shift < 416 && shiftlow ? (l[3 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[3] = shift < 416 ? (l[3 + shiftlimbs] >> shiftlow | (shift < 384 && shiftlow ? (l[4 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[4] = shift < 384 ? (l[4 + shiftlimbs] >> shiftlow | (shift < 352 && shiftlow ? (l[5 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[5] = shift < 352 ? (l[5 + shiftlimbs] >> shiftlow | (shift < 320 && shiftlow ? (l[6 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[6] = shift < 320 ? (l[6 + shiftlimbs] >> shiftlow | (shift < 288 && shiftlow ? (l[7 + shiftlimbs] << shifthigh) : 0)) : 0;
+    r->d[7] = shift < 288 ? (l[7 + shiftlimbs] >> shiftlow)  : 0;
+    secp256k1_scalar_cadd_bit(r, 0, (l[(shift - 1) >> 5] >> ((shift - 1) & 0x1f)) & 1);
+}
+
+#endif /* SECP256K1_SCALAR_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_impl.h
new file mode 100644
index 000000000..fa790570f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_impl.h
@@ -0,0 +1,333 @@
+/**********************************************************************
+ * Copyright (c) 2014 Pieter Wuille                                   *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_IMPL_H
+#define SECP256K1_SCALAR_IMPL_H
+
+#include "group.h"
+#include "scalar.h"
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#if defined(EXHAUSTIVE_TEST_ORDER)
+#include "scalar_low_impl.h"
+#elif defined(USE_SCALAR_4X64)
+#include "scalar_4x64_impl.h"
+#elif defined(USE_SCALAR_8X32)
+#include "scalar_8x32_impl.h"
+#else
+#error "Please select scalar implementation"
+#endif
+
+#ifndef USE_NUM_NONE
+static void secp256k1_scalar_get_num(secp256k1_num *r, const secp256k1_scalar *a) {
+    unsigned char c[32];
+    secp256k1_scalar_get_b32(c, a);
+    secp256k1_num_set_bin(r, c, 32);
+}
+
+/** secp256k1 curve order, see secp256k1_ecdsa_const_order_as_fe in ecdsa_impl.h */
+static void secp256k1_scalar_order_get_num(secp256k1_num *r) {
+#if defined(EXHAUSTIVE_TEST_ORDER)
+    static const unsigned char order[32] = {
+        0,0,0,0,0,0,0,0,
+        0,0,0,0,0,0,0,0,
+        0,0,0,0,0,0,0,0,
+        0,0,0,0,0,0,0,EXHAUSTIVE_TEST_ORDER
+    };
+#else
+    static const unsigned char order[32] = {
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+        0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFE,
+        0xBA,0xAE,0xDC,0xE6,0xAF,0x48,0xA0,0x3B,
+        0xBF,0xD2,0x5E,0x8C,0xD0,0x36,0x41,0x41
+    };
+#endif
+    secp256k1_num_set_bin(r, order, 32);
+}
+#endif
+
+static void secp256k1_scalar_inverse(secp256k1_scalar *r, const secp256k1_scalar *x) {
+#if defined(EXHAUSTIVE_TEST_ORDER)
+    int i;
+    *r = 0;
+    for (i = 0; i < EXHAUSTIVE_TEST_ORDER; i++)
+        if ((i * *x) % EXHAUSTIVE_TEST_ORDER == 1)
+            *r = i;
+    /* If this VERIFY_CHECK triggers we were given a noninvertible scalar (and thus
+     * have a composite group order; fix it in exhaustive_tests.c). */
+    VERIFY_CHECK(*r != 0);
+}
+#else
+    secp256k1_scalar *t;
+    int i;
+    /* First compute xN as x ^ (2^N - 1) for some values of N,
+     * and uM as x ^ M for some values of M. */
+    secp256k1_scalar x2, x3, x6, x8, x14, x28, x56, x112, x126;
+    secp256k1_scalar u2, u5, u9, u11, u13;
+
+    secp256k1_scalar_sqr(&u2, x);
+    secp256k1_scalar_mul(&x2, &u2,  x);
+    secp256k1_scalar_mul(&u5, &u2, &x2);
+    secp256k1_scalar_mul(&x3, &u5,  &u2);
+    secp256k1_scalar_mul(&u9, &x3, &u2);
+    secp256k1_scalar_mul(&u11, &u9, &u2);
+    secp256k1_scalar_mul(&u13, &u11, &u2);
+
+    secp256k1_scalar_sqr(&x6, &u13);
+    secp256k1_scalar_sqr(&x6, &x6);
+    secp256k1_scalar_mul(&x6, &x6, &u11);
+
+    secp256k1_scalar_sqr(&x8, &x6);
+    secp256k1_scalar_sqr(&x8, &x8);
+    secp256k1_scalar_mul(&x8, &x8,  &x2);
+
+    secp256k1_scalar_sqr(&x14, &x8);
+    for (i = 0; i < 5; i++) {
+        secp256k1_scalar_sqr(&x14, &x14);
+    }
+    secp256k1_scalar_mul(&x14, &x14, &x6);
+
+    secp256k1_scalar_sqr(&x28, &x14);
+    for (i = 0; i < 13; i++) {
+        secp256k1_scalar_sqr(&x28, &x28);
+    }
+    secp256k1_scalar_mul(&x28, &x28, &x14);
+
+    secp256k1_scalar_sqr(&x56, &x28);
+    for (i = 0; i < 27; i++) {
+        secp256k1_scalar_sqr(&x56, &x56);
+    }
+    secp256k1_scalar_mul(&x56, &x56, &x28);
+
+    secp256k1_scalar_sqr(&x112, &x56);
+    for (i = 0; i < 55; i++) {
+        secp256k1_scalar_sqr(&x112, &x112);
+    }
+    secp256k1_scalar_mul(&x112, &x112, &x56);
+
+    secp256k1_scalar_sqr(&x126, &x112);
+    for (i = 0; i < 13; i++) {
+        secp256k1_scalar_sqr(&x126, &x126);
+    }
+    secp256k1_scalar_mul(&x126, &x126, &x14);
+
+    /* Then accumulate the final result (t starts at x126). */
+    t = &x126;
+    for (i = 0; i < 3; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u5); /* 101 */
+    for (i = 0; i < 4; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 4; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u5); /* 101 */
+    for (i = 0; i < 5; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u11); /* 1011 */
+    for (i = 0; i < 4; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u11); /* 1011 */
+    for (i = 0; i < 4; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 5; i++) { /* 00 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 6; i++) { /* 00 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u13); /* 1101 */
+    for (i = 0; i < 4; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u5); /* 101 */
+    for (i = 0; i < 3; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 5; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u9); /* 1001 */
+    for (i = 0; i < 6; i++) { /* 000 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u5); /* 101 */
+    for (i = 0; i < 10; i++) { /* 0000000 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 4; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x3); /* 111 */
+    for (i = 0; i < 9; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x8); /* 11111111 */
+    for (i = 0; i < 5; i++) { /* 0 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u9); /* 1001 */
+    for (i = 0; i < 6; i++) { /* 00 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u11); /* 1011 */
+    for (i = 0; i < 4; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u13); /* 1101 */
+    for (i = 0; i < 5; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &x2); /* 11 */
+    for (i = 0; i < 6; i++) { /* 00 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u13); /* 1101 */
+    for (i = 0; i < 10; i++) { /* 000000 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u13); /* 1101 */
+    for (i = 0; i < 4; i++) {
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, &u9); /* 1001 */
+    for (i = 0; i < 6; i++) { /* 00000 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(t, t, x); /* 1 */
+    for (i = 0; i < 8; i++) { /* 00 */
+        secp256k1_scalar_sqr(t, t);
+    }
+    secp256k1_scalar_mul(r, t, &x6); /* 111111 */
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_even(const secp256k1_scalar *a) {
+    return !(a->d[0] & 1);
+}
+#endif
+
+static void secp256k1_scalar_inverse_var(secp256k1_scalar *r, const secp256k1_scalar *x) {
+#if defined(USE_SCALAR_INV_BUILTIN)
+    secp256k1_scalar_inverse(r, x);
+#elif defined(USE_SCALAR_INV_NUM)
+    unsigned char b[32];
+    secp256k1_num n, m;
+    secp256k1_scalar t = *x;
+    secp256k1_scalar_get_b32(b, &t);
+    secp256k1_num_set_bin(&n, b, 32);
+    secp256k1_scalar_order_get_num(&m);
+    secp256k1_num_mod_inverse(&n, &n, &m);
+    secp256k1_num_get_bin(b, 32, &n);
+    secp256k1_scalar_set_b32(r, b, NULL);
+    /* Verify that the inverse was computed correctly, without GMP code. */
+    secp256k1_scalar_mul(&t, &t, r);
+    CHECK(secp256k1_scalar_is_one(&t));
+#else
+#error "Please select scalar inverse implementation"
+#endif
+}
+
+#ifdef USE_ENDOMORPHISM
+#if defined(EXHAUSTIVE_TEST_ORDER)
+/**
+ * Find k1 and k2 given k, such that k1 + k2 * lambda == k mod n; unlike in the
+ * full case we don't bother making k1 and k2 be small, we just want them to be
+ * nontrivial to get full test coverage for the exhaustive tests. We therefore
+ * (arbitrarily) set k2 = k + 5 and k1 = k - k2 * lambda.
+ */
+static void secp256k1_scalar_split_lambda(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a) {
+    *r2 = (*a + 5) % EXHAUSTIVE_TEST_ORDER;
+    *r1 = (*a + (EXHAUSTIVE_TEST_ORDER - *r2) * EXHAUSTIVE_TEST_LAMBDA) % EXHAUSTIVE_TEST_ORDER;
+}
+#else
+/**
+ * The Secp256k1 curve has an endomorphism, where lambda * (x, y) = (beta * x, y), where
+ * lambda is {0x53,0x63,0xad,0x4c,0xc0,0x5c,0x30,0xe0,0xa5,0x26,0x1c,0x02,0x88,0x12,0x64,0x5a,
+ *            0x12,0x2e,0x22,0xea,0x20,0x81,0x66,0x78,0xdf,0x02,0x96,0x7c,0x1b,0x23,0xbd,0x72}
+ *
+ * "Guide to Elliptic Curve Cryptography" (Hankerson, Menezes, Vanstone) gives an algorithm
+ * (algorithm 3.74) to find k1 and k2 given k, such that k1 + k2 * lambda == k mod n, and k1
+ * and k2 have a small size.
+ * It relies on constants a1, b1, a2, b2. These constants for the value of lambda above are:
+ *
+ * - a1 =      {0x30,0x86,0xd2,0x21,0xa7,0xd4,0x6b,0xcd,0xe8,0x6c,0x90,0xe4,0x92,0x84,0xeb,0x15}
+ * - b1 =     -{0xe4,0x43,0x7e,0xd6,0x01,0x0e,0x88,0x28,0x6f,0x54,0x7f,0xa9,0x0a,0xbf,0xe4,0xc3}
+ * - a2 = {0x01,0x14,0xca,0x50,0xf7,0xa8,0xe2,0xf3,0xf6,0x57,0xc1,0x10,0x8d,0x9d,0x44,0xcf,0xd8}
+ * - b2 =      {0x30,0x86,0xd2,0x21,0xa7,0xd4,0x6b,0xcd,0xe8,0x6c,0x90,0xe4,0x92,0x84,0xeb,0x15}
+ *
+ * The algorithm then computes c1 = round(b1 * k / n) and c2 = round(b2 * k / n), and gives
+ * k1 = k - (c1*a1 + c2*a2) and k2 = -(c1*b1 + c2*b2). Instead, we use modular arithmetic, and
+ * compute k1 as k - k2 * lambda, avoiding the need for constants a1 and a2.
+ *
+ * g1, g2 are precomputed constants used to replace division with a rounded multiplication
+ * when decomposing the scalar for an endomorphism-based point multiplication.
+ *
+ * The possibility of using precomputed estimates is mentioned in "Guide to Elliptic Curve
+ * Cryptography" (Hankerson, Menezes, Vanstone) in section 3.5.
+ *
+ * The derivation is described in the paper "Efficient Software Implementation of Public-Key
+ * Cryptography on Sensor Networks Using the MSP430X Microcontroller" (Gouvea, Oliveira, Lopez),
+ * Section 4.3 (here we use a somewhat higher-precision estimate):
+ * d = a1*b2 - b1*a2
+ * g1 = round((2^272)*b2/d)
+ * g2 = round((2^272)*b1/d)
+ *
+ * (Note that 'd' is also equal to the curve order here because [a1,b1] and [a2,b2] are found
+ * as outputs of the Extended Euclidean Algorithm on inputs 'order' and 'lambda').
+ *
+ * The function below splits a in r1 and r2, such that r1 + lambda * r2 == a (mod order).
+ */
+
+static void secp256k1_scalar_split_lambda(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a) {
+    secp256k1_scalar c1, c2;
+    static const secp256k1_scalar minus_lambda = SECP256K1_SCALAR_CONST(
+        0xAC9C52B3UL, 0x3FA3CF1FUL, 0x5AD9E3FDUL, 0x77ED9BA4UL,
+        0xA880B9FCUL, 0x8EC739C2UL, 0xE0CFC810UL, 0xB51283CFUL
+    );
+    static const secp256k1_scalar minus_b1 = SECP256K1_SCALAR_CONST(
+        0x00000000UL, 0x00000000UL, 0x00000000UL, 0x00000000UL,
+        0xE4437ED6UL, 0x010E8828UL, 0x6F547FA9UL, 0x0ABFE4C3UL
+    );
+    static const secp256k1_scalar minus_b2 = SECP256K1_SCALAR_CONST(
+        0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFFUL, 0xFFFFFFFEUL,
+        0x8A280AC5UL, 0x0774346DUL, 0xD765CDA8UL, 0x3DB1562CUL
+    );
+    static const secp256k1_scalar g1 = SECP256K1_SCALAR_CONST(
+        0x00000000UL, 0x00000000UL, 0x00000000UL, 0x00003086UL,
+        0xD221A7D4UL, 0x6BCDE86CUL, 0x90E49284UL, 0xEB153DABUL
+    );
+    static const secp256k1_scalar g2 = SECP256K1_SCALAR_CONST(
+        0x00000000UL, 0x00000000UL, 0x00000000UL, 0x0000E443UL,
+        0x7ED6010EUL, 0x88286F54UL, 0x7FA90ABFUL, 0xE4C42212UL
+    );
+    VERIFY_CHECK(r1 != a);
+    VERIFY_CHECK(r2 != a);
+    /* these _var calls are constant time since the shift amount is constant */
+    secp256k1_scalar_mul_shift_var(&c1, a, &g1, 272);
+    secp256k1_scalar_mul_shift_var(&c2, a, &g2, 272);
+    secp256k1_scalar_mul(&c1, &c1, &minus_b1);
+    secp256k1_scalar_mul(&c2, &c2, &minus_b2);
+    secp256k1_scalar_add(r2, &c1, &c2);
+    secp256k1_scalar_mul(r1, r2, &minus_lambda);
+    secp256k1_scalar_add(r1, r1, a);
+}
+#endif
+#endif
+
+#endif /* SECP256K1_SCALAR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low.h
new file mode 100644
index 000000000..5836febc5
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low.h
@@ -0,0 +1,15 @@
+/**********************************************************************
+ * Copyright (c) 2015 Andrew Poelstra                                 *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_H
+#define SECP256K1_SCALAR_REPR_H
+
+#include <stdint.h>
+
+/** A scalar modulo the group order of the secp256k1 curve. */
+typedef uint32_t secp256k1_scalar;
+
+#endif /* SECP256K1_SCALAR_REPR_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low_impl.h
new file mode 100644
index 000000000..c80e70c5a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scalar_low_impl.h
@@ -0,0 +1,114 @@
+/**********************************************************************
+ * Copyright (c) 2015 Andrew Poelstra                                 *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_SCALAR_REPR_IMPL_H
+#define SECP256K1_SCALAR_REPR_IMPL_H
+
+#include "scalar.h"
+
+#include <string.h>
+
+SECP256K1_INLINE static int secp256k1_scalar_is_even(const secp256k1_scalar *a) {
+    return !(*a & 1);
+}
+
+SECP256K1_INLINE static void secp256k1_scalar_clear(secp256k1_scalar *r) { *r = 0; }
+SECP256K1_INLINE static void secp256k1_scalar_set_int(secp256k1_scalar *r, unsigned int v) { *r = v; }
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    if (offset < 32)
+        return ((*a >> offset) & ((((uint32_t)1) << count) - 1));
+    else
+        return 0;
+}
+
+SECP256K1_INLINE static unsigned int secp256k1_scalar_get_bits_var(const secp256k1_scalar *a, unsigned int offset, unsigned int count) {
+    return secp256k1_scalar_get_bits(a, offset, count);
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_check_overflow(const secp256k1_scalar *a) { return *a >= EXHAUSTIVE_TEST_ORDER; }
+
+static int secp256k1_scalar_add(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    *r = (*a + *b) % EXHAUSTIVE_TEST_ORDER;
+    return *r < *b;
+}
+
+static void secp256k1_scalar_cadd_bit(secp256k1_scalar *r, unsigned int bit, int flag) {
+    if (flag && bit < 32)
+        *r += (1 << bit);
+#ifdef VERIFY
+    VERIFY_CHECK(secp256k1_scalar_check_overflow(r) == 0);
+#endif
+}
+
+static void secp256k1_scalar_set_b32(secp256k1_scalar *r, const unsigned char *b32, int *overflow) {
+    const int base = 0x100 % EXHAUSTIVE_TEST_ORDER;
+    int i;
+    *r = 0;
+    for (i = 0; i < 32; i++) {
+       *r = ((*r * base) + b32[i]) % EXHAUSTIVE_TEST_ORDER;
+    }
+    /* just deny overflow, it basically always happens */
+    if (overflow) *overflow = 0;
+}
+
+static void secp256k1_scalar_get_b32(unsigned char *bin, const secp256k1_scalar* a) {
+    memset(bin, 0, 32);
+    bin[28] = *a >> 24; bin[29] = *a >> 16; bin[30] = *a >> 8; bin[31] = *a;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_zero(const secp256k1_scalar *a) {
+    return *a == 0;
+}
+
+static void secp256k1_scalar_negate(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    if (*a == 0) {
+        *r = 0;
+    } else {
+        *r = EXHAUSTIVE_TEST_ORDER - *a;
+    }
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_is_one(const secp256k1_scalar *a) {
+    return *a == 1;
+}
+
+static int secp256k1_scalar_is_high(const secp256k1_scalar *a) {
+    return *a > EXHAUSTIVE_TEST_ORDER / 2;
+}
+
+static int secp256k1_scalar_cond_negate(secp256k1_scalar *r, int flag) {
+    if (flag) secp256k1_scalar_negate(r, r);
+    return flag ? -1 : 1;
+}
+
+static void secp256k1_scalar_mul(secp256k1_scalar *r, const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    *r = (*a * *b) % EXHAUSTIVE_TEST_ORDER;
+}
+
+static int secp256k1_scalar_shr_int(secp256k1_scalar *r, int n) {
+    int ret;
+    VERIFY_CHECK(n > 0);
+    VERIFY_CHECK(n < 16);
+    ret = *r & ((1 << n) - 1);
+    *r >>= n;
+    return ret;
+}
+
+static void secp256k1_scalar_sqr(secp256k1_scalar *r, const secp256k1_scalar *a) {
+    *r = (*a * *a) % EXHAUSTIVE_TEST_ORDER;
+}
+
+static void secp256k1_scalar_split_128(secp256k1_scalar *r1, secp256k1_scalar *r2, const secp256k1_scalar *a) {
+    *r1 = *a;
+    *r2 = 0;
+}
+
+SECP256K1_INLINE static int secp256k1_scalar_eq(const secp256k1_scalar *a, const secp256k1_scalar *b) {
+    return *a == *b;
+}
+
+#endif /* SECP256K1_SCALAR_REPR_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch.h
new file mode 100644
index 000000000..aba56e215
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch.h
@@ -0,0 +1,35 @@
+/**********************************************************************
+ * Copyright (c) 2017 Andrew Poelstra	                              *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef _SECP256K1_SCRATCH_
+#define _SECP256K1_SCRATCH_
+
+/* The typedef is used internally; the struct name is used in the public API
+ * (where it is exposed as a different typedef) */
+typedef struct secp256k1_scratch_space_struct {
+    void *data;
+    size_t offset;
+    size_t init_size;
+    size_t max_size;
+    const secp256k1_callback* error_callback;
+} secp256k1_scratch;
+
+static secp256k1_scratch* secp256k1_scratch_create(const secp256k1_callback* error_callback, size_t init_size, size_t max_size);
+static void secp256k1_scratch_destroy(secp256k1_scratch* scratch);
+
+/** Returns the maximum allocation the scratch space will allow */
+static size_t secp256k1_scratch_max_allocation(const secp256k1_scratch* scratch, size_t n_objects);
+
+/** Attempts to allocate so that there are `n` available bytes. Returns 1 on success, 0 on failure */
+static int secp256k1_scratch_resize(secp256k1_scratch* scratch, size_t n, size_t n_objects);
+
+/** Returns a pointer into the scratch space or NULL if there is insufficient available space */
+static void *secp256k1_scratch_alloc(secp256k1_scratch* scratch, size_t n);
+
+/** Resets the returned pointer to the beginning of space */
+static void secp256k1_scratch_reset(secp256k1_scratch* scratch);
+
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch_impl.h
new file mode 100644
index 000000000..9bd68fe10
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/scratch_impl.h
@@ -0,0 +1,77 @@
+/**********************************************************************
+ * Copyright (c) 2017 Andrew Poelstra                                 *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef _SECP256K1_SCRATCH_IMPL_H_
+#define _SECP256K1_SCRATCH_IMPL_H_
+
+#include "scratch.h"
+
+/* Using 16 bytes alignment because common architectures never have alignment
+ * requirements above 8 for any of the types we care about. In addition we
+ * leave some room because currently we don't care about a few bytes.
+ * TODO: Determine this at configure time. */
+#define ALIGNMENT 16
+
+static secp256k1_scratch* secp256k1_scratch_create(const secp256k1_callback* error_callback, size_t init_size, size_t max_size) {
+    secp256k1_scratch* ret = (secp256k1_scratch*)checked_malloc(error_callback, sizeof(*ret));
+    if (ret != NULL) {
+        ret->data = checked_malloc(error_callback, init_size);
+        if (ret->data == NULL) {
+            free (ret);
+            return NULL;
+        }
+        ret->offset = 0;
+        ret->init_size = init_size;
+        ret->max_size = max_size;
+        ret->error_callback = error_callback;
+    }
+    return ret;
+}
+
+static void secp256k1_scratch_destroy(secp256k1_scratch* scratch) {
+    if (scratch != NULL) {
+        free(scratch->data);
+        free(scratch);
+    }
+}
+
+static size_t secp256k1_scratch_max_allocation(const secp256k1_scratch* scratch, size_t objects) {
+    if (scratch->max_size <= objects * ALIGNMENT) {
+        return 0;
+    }
+    return scratch->max_size - objects * ALIGNMENT;
+}
+
+static int secp256k1_scratch_resize(secp256k1_scratch* scratch, size_t n, size_t objects) {
+    n += objects * ALIGNMENT;
+    if (n > scratch->init_size && n <= scratch->max_size) {
+        void *tmp = checked_realloc(scratch->error_callback, scratch->data, n);
+        if (tmp == NULL) {
+            return 0;
+        }
+        scratch->init_size = n;
+        scratch->data = tmp;
+    }
+    return n <= scratch->max_size;
+}
+
+static void *secp256k1_scratch_alloc(secp256k1_scratch* scratch, size_t size) {
+    void *ret;
+    size = ((size + ALIGNMENT - 1) / ALIGNMENT) * ALIGNMENT;
+    if (size + scratch->offset > scratch->init_size) {
+        return NULL;
+    }
+    ret = (void *) ((unsigned char *) scratch->data + scratch->offset);
+    memset(ret, 0, size);
+    scratch->offset += size;
+    return ret;
+}
+
+static void secp256k1_scratch_reset(secp256k1_scratch* scratch) {
+    scratch->offset = 0;
+}
+
+#endif
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.c b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.c
new file mode 100644
index 000000000..9ba5dd5e1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.c
@@ -0,0 +1,1124 @@
+/**********************************************************************
+ * Copyright (c) 2013-2015 Pieter Wuille                              *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#include "secp256k1.h"
+
+#include "util.h"
+#include "num_impl.h"
+#include "field_impl.h"
+#include "scalar_impl.h"
+#include "group_impl.h"
+#include "ecmult_impl.h"
+#include "ecmult_const_impl.h"
+#include "ecmult_gen_impl.h"
+#include "ecdsa_impl.h"
+#include "eckey_impl.h"
+#include "hash_impl.h"
+#include "scratch_impl.h"
+
+#define ARG_CHECK(cond) do { \
+    if (EXPECT(!(cond), 0)) { \
+        secp256k1_callback_call(&ctx->illegal_callback, #cond); \
+        return 0; \
+    } \
+} while(0)
+
+static void default_illegal_callback_fn(const char* str, void* data) {
+    (void)data;
+    fprintf(stderr, "[libsecp256k1] illegal argument: %s\n", str);
+    abort();
+}
+
+static const secp256k1_callback default_illegal_callback = {
+    default_illegal_callback_fn,
+    NULL
+};
+
+static void default_error_callback_fn(const char* str, void* data) {
+    (void)data;
+    fprintf(stderr, "[libsecp256k1] internal consistency check failed: %s\n", str);
+    abort();
+}
+
+static const secp256k1_callback default_error_callback = {
+    default_error_callback_fn,
+    NULL
+};
+
+
+struct secp256k1_context_struct {
+    secp256k1_ecmult_context ecmult_ctx;
+    secp256k1_ecmult_gen_context ecmult_gen_ctx;
+    secp256k1_callback illegal_callback;
+    secp256k1_callback error_callback;
+};
+
+secp256k1_context* secp256k1_context_create(unsigned int flags) {
+    secp256k1_context* ret = (secp256k1_context*)checked_malloc(&default_error_callback, sizeof(secp256k1_context));
+    ret->illegal_callback = default_illegal_callback;
+    ret->error_callback = default_error_callback;
+
+    if (EXPECT((flags & SECP256K1_FLAGS_TYPE_MASK) != SECP256K1_FLAGS_TYPE_CONTEXT, 0)) {
+            secp256k1_callback_call(&ret->illegal_callback,
+                                    "Invalid flags");
+            free(ret);
+            return NULL;
+    }
+
+    secp256k1_ecmult_context_init(&ret->ecmult_ctx);
+    secp256k1_ecmult_gen_context_init(&ret->ecmult_gen_ctx);
+
+    if (flags & SECP256K1_FLAGS_BIT_CONTEXT_SIGN) {
+        secp256k1_ecmult_gen_context_build(&ret->ecmult_gen_ctx, &ret->error_callback);
+    }
+    if (flags & SECP256K1_FLAGS_BIT_CONTEXT_VERIFY) {
+        secp256k1_ecmult_context_build(&ret->ecmult_ctx, &ret->error_callback);
+    }
+
+    return ret;
+}
+
+secp256k1_context* secp256k1_context_clone(const secp256k1_context* ctx) {
+    secp256k1_context* ret = (secp256k1_context*)checked_malloc(&ctx->error_callback, sizeof(secp256k1_context));
+    ret->illegal_callback = ctx->illegal_callback;
+    ret->error_callback = ctx->error_callback;
+    secp256k1_ecmult_context_clone(&ret->ecmult_ctx, &ctx->ecmult_ctx, &ctx->error_callback);
+    secp256k1_ecmult_gen_context_clone(&ret->ecmult_gen_ctx, &ctx->ecmult_gen_ctx, &ctx->error_callback);
+    return ret;
+}
+
+void secp256k1_context_destroy(secp256k1_context* ctx) {
+    if (ctx != NULL) {
+        secp256k1_ecmult_context_clear(&ctx->ecmult_ctx);
+        secp256k1_ecmult_gen_context_clear(&ctx->ecmult_gen_ctx);
+
+        free(ctx);
+    }
+}
+
+void secp256k1_context_set_illegal_callback(secp256k1_context* ctx, void (*fun)(const char* message, void* data), const void* data) {
+    if (fun == NULL) {
+        fun = default_illegal_callback_fn;
+    }
+    ctx->illegal_callback.fn = fun;
+    ctx->illegal_callback.data = data;
+}
+
+void secp256k1_context_set_error_callback(secp256k1_context* ctx, void (*fun)(const char* message, void* data), const void* data) {
+    if (fun == NULL) {
+        fun = default_error_callback_fn;
+    }
+    ctx->error_callback.fn = fun;
+    ctx->error_callback.data = data;
+}
+
+secp256k1_scratch_space* secp256k1_scratch_space_create(const secp256k1_context* ctx, size_t init_size, size_t max_size) {
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(max_size >= init_size);
+
+    return secp256k1_scratch_create(&ctx->error_callback, init_size, max_size);
+}
+
+void secp256k1_scratch_space_destroy(secp256k1_scratch_space* scratch) {
+    secp256k1_scratch_destroy(scratch);
+}
+
+static int secp256k1_pubkey_load(const secp256k1_context* ctx, secp256k1_ge* ge, const secp256k1_pubkey* pubkey) {
+    if (sizeof(secp256k1_ge_storage) == 64) {
+        /* When the secp256k1_ge_storage type is exactly 64 byte, use its
+         * representation inside secp256k1_pubkey, as conversion is very fast.
+         * Note that secp256k1_pubkey_save must use the same representation. */
+        secp256k1_ge_storage s;
+        memcpy(&s, &pubkey->data[0], sizeof(s));
+        secp256k1_ge_from_storage(ge, &s);
+    } else {
+        /* Otherwise, fall back to 32-byte big endian for X and Y. */
+        secp256k1_fe x, y;
+        secp256k1_fe_set_b32(&x, pubkey->data);
+        secp256k1_fe_set_b32(&y, pubkey->data + 32);
+        secp256k1_ge_set_xy(ge, &x, &y);
+    }
+    ARG_CHECK(!secp256k1_fe_is_zero(&ge->x));
+    return 1;
+}
+
+static void secp256k1_pubkey_save(secp256k1_pubkey* pubkey, secp256k1_ge* ge) {
+    if (sizeof(secp256k1_ge_storage) == 64) {
+        secp256k1_ge_storage s;
+        secp256k1_ge_to_storage(&s, ge);
+        memcpy(&pubkey->data[0], &s, sizeof(s));
+    } else {
+        VERIFY_CHECK(!secp256k1_ge_is_infinity(ge));
+        secp256k1_fe_normalize_var(&ge->x);
+        secp256k1_fe_normalize_var(&ge->y);
+        secp256k1_fe_get_b32(pubkey->data, &ge->x);
+        secp256k1_fe_get_b32(pubkey->data + 32, &ge->y);
+    }
+}
+
+int secp256k1_ec_pubkey_parse(const secp256k1_context* ctx, secp256k1_pubkey* pubkey, const unsigned char *input, size_t inputlen) {
+    secp256k1_ge Q;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(pubkey != NULL);
+    memset(pubkey, 0, sizeof(*pubkey));
+    ARG_CHECK(input != NULL);
+    if (!secp256k1_eckey_pubkey_parse(&Q, input, inputlen)) {
+        return 0;
+    }
+    secp256k1_pubkey_save(pubkey, &Q);
+    secp256k1_ge_clear(&Q);
+    return 1;
+}
+
+int secp256k1_ec_pubkey_serialize(const secp256k1_context* ctx, unsigned char *output, size_t *outputlen, const secp256k1_pubkey* pubkey, unsigned int flags) {
+    secp256k1_ge Q;
+    size_t len;
+    int ret = 0;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(outputlen != NULL);
+    ARG_CHECK(*outputlen >= ((flags & SECP256K1_FLAGS_BIT_COMPRESSION) ? 33 : 65));
+    len = *outputlen;
+    *outputlen = 0;
+    ARG_CHECK(output != NULL);
+    memset(output, 0, len);
+    ARG_CHECK(pubkey != NULL);
+    ARG_CHECK((flags & SECP256K1_FLAGS_TYPE_MASK) == SECP256K1_FLAGS_TYPE_COMPRESSION);
+    if (secp256k1_pubkey_load(ctx, &Q, pubkey)) {
+        ret = secp256k1_eckey_pubkey_serialize(&Q, output, &len, flags & SECP256K1_FLAGS_BIT_COMPRESSION);
+        if (ret) {
+            *outputlen = len;
+        }
+    }
+    return ret;
+}
+
+static void secp256k1_ecdsa_signature_load(const secp256k1_context* ctx, secp256k1_scalar* r, secp256k1_scalar* s, const secp256k1_ecdsa_signature* sig) {
+    (void)ctx;
+    if (sizeof(secp256k1_scalar) == 32) {
+        /* When the secp256k1_scalar type is exactly 32 byte, use its
+         * representation inside secp256k1_ecdsa_signature, as conversion is very fast.
+         * Note that secp256k1_ecdsa_signature_save must use the same representation. */
+        memcpy(r, &sig->data[0], 32);
+        memcpy(s, &sig->data[32], 32);
+    } else {
+        secp256k1_scalar_set_b32(r, &sig->data[0], NULL);
+        secp256k1_scalar_set_b32(s, &sig->data[32], NULL);
+    }
+}
+
+static void secp256k1_ecdsa_signature_save(secp256k1_ecdsa_signature* sig, const secp256k1_scalar* r, const secp256k1_scalar* s) {
+    if (sizeof(secp256k1_scalar) == 32) {
+        memcpy(&sig->data[0], r, 32);
+        memcpy(&sig->data[32], s, 32);
+    } else {
+        secp256k1_scalar_get_b32(&sig->data[0], r);
+        secp256k1_scalar_get_b32(&sig->data[32], s);
+    }
+}
+
+int secp256k1_ecdsa_signature_parse_der(const secp256k1_context* ctx, secp256k1_ecdsa_signature* sig, const unsigned char *input, size_t inputlen) {
+    secp256k1_scalar r, s;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(input != NULL);
+
+    if (secp256k1_ecdsa_sig_parse(&r, &s, input, inputlen)) {
+        secp256k1_ecdsa_signature_save(sig, &r, &s);
+        return 1;
+    } else {
+        memset(sig, 0, sizeof(*sig));
+        return 0;
+    }
+}
+
+int secp256k1_ecdsa_signature_parse_compact(const secp256k1_context* ctx, secp256k1_ecdsa_signature* sig, const unsigned char *input64) {
+    secp256k1_scalar r, s;
+    int ret = 1;
+    int overflow = 0;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(input64 != NULL);
+
+    secp256k1_scalar_set_b32(&r, &input64[0], &overflow);
+    ret &= !overflow;
+    secp256k1_scalar_set_b32(&s, &input64[32], &overflow);
+    ret &= !overflow;
+    if (ret) {
+        secp256k1_ecdsa_signature_save(sig, &r, &s);
+    } else {
+        memset(sig, 0, sizeof(*sig));
+    }
+    return ret;
+}
+
+int secp256k1_ecdsa_signature_serialize_der(const secp256k1_context* ctx, unsigned char *output, size_t *outputlen, const secp256k1_ecdsa_signature* sig) {
+    secp256k1_scalar r, s;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(output != NULL);
+    ARG_CHECK(outputlen != NULL);
+    ARG_CHECK(sig != NULL);
+
+    secp256k1_ecdsa_signature_load(ctx, &r, &s, sig);
+    return secp256k1_ecdsa_sig_serialize(output, outputlen, &r, &s);
+}
+
+int secp256k1_ecdsa_signature_serialize_compact(const secp256k1_context* ctx, unsigned char *output64, const secp256k1_ecdsa_signature* sig) {
+    secp256k1_scalar r, s;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(output64 != NULL);
+    ARG_CHECK(sig != NULL);
+
+    secp256k1_ecdsa_signature_load(ctx, &r, &s, sig);
+    secp256k1_scalar_get_b32(&output64[0], &r);
+    secp256k1_scalar_get_b32(&output64[32], &s);
+    return 1;
+}
+
+int secp256k1_ecdsa_signature_normalize(const secp256k1_context* ctx, secp256k1_ecdsa_signature *sigout, const secp256k1_ecdsa_signature *sigin) {
+    secp256k1_scalar r, s;
+    int ret = 0;
+
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(sigin != NULL);
+
+    secp256k1_ecdsa_signature_load(ctx, &r, &s, sigin);
+    ret = secp256k1_scalar_is_high(&s);
+    if (sigout != NULL) {
+        if (ret) {
+            secp256k1_scalar_negate(&s, &s);
+        }
+        secp256k1_ecdsa_signature_save(sigout, &r, &s);
+    }
+
+    return ret;
+}
+
+int secp256k1_ecdsa_verify(const secp256k1_context* ctx, const secp256k1_ecdsa_signature *sig, const unsigned char *msg32, const secp256k1_pubkey *pubkey) {
+    secp256k1_ge q;
+    secp256k1_scalar r, s;
+    secp256k1_scalar m;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_context_is_built(&ctx->ecmult_ctx));
+    ARG_CHECK(msg32 != NULL);
+    ARG_CHECK(sig != NULL);
+    ARG_CHECK(pubkey != NULL);
+
+    secp256k1_scalar_set_b32(&m, msg32, NULL);
+    secp256k1_ecdsa_signature_load(ctx, &r, &s, sig);
+    return (!secp256k1_scalar_is_high(&s) &&
+            secp256k1_pubkey_load(ctx, &q, pubkey) &&
+            secp256k1_ecdsa_sig_verify(&ctx->ecmult_ctx, &r, &s, &q, &m));
+}
+
+static SECP256K1_INLINE void buffer_append(unsigned char *buf, unsigned int *offset, const void *data, unsigned int len) {
+    memcpy(buf + *offset, data, len);
+    *offset += len;
+}
+
+static int nonce_function_rfc6979(unsigned char *nonce32, const unsigned char *msg32, const unsigned char *key32, const unsigned char *algo16, void *data, unsigned int counter) {
+   unsigned char keydata[112];
+   unsigned int offset = 0;
+   secp256k1_rfc6979_hmac_sha256 rng;
+   unsigned int i;
+   /* We feed a byte array to the PRNG as input, consisting of:
+    * - the private key (32 bytes) and message (32 bytes), see RFC 6979 3.2d.
+    * - optionally 32 extra bytes of data, see RFC 6979 3.6 Additional Data.
+    * - optionally 16 extra bytes with the algorithm name.
+    * Because the arguments have distinct fixed lengths it is not possible for
+    *  different argument mixtures to emulate each other and result in the same
+    *  nonces.
+    */
+   buffer_append(keydata, &offset, key32, 32);
+   buffer_append(keydata, &offset, msg32, 32);
+   if (data != NULL) {
+       buffer_append(keydata, &offset, data, 32);
+   }
+   if (algo16 != NULL) {
+       buffer_append(keydata, &offset, algo16, 16);
+   }
+   secp256k1_rfc6979_hmac_sha256_initialize(&rng, keydata, offset);
+   memset(keydata, 0, sizeof(keydata));
+   for (i = 0; i <= counter; i++) {
+       secp256k1_rfc6979_hmac_sha256_generate(&rng, nonce32, 32);
+   }
+   secp256k1_rfc6979_hmac_sha256_finalize(&rng);
+   return 1;
+}
+
+const secp256k1_nonce_function secp256k1_nonce_function_rfc6979 = nonce_function_rfc6979;
+const secp256k1_nonce_function secp256k1_nonce_function_default = nonce_function_rfc6979;
+
+int secp256k1_ecdsa_sign(const secp256k1_context* ctx, secp256k1_ecdsa_signature *signature, const unsigned char *msg32, const unsigned char *seckey, secp256k1_nonce_function noncefp, const void* noncedata) {
+    secp256k1_scalar r, s;
+    secp256k1_scalar sec, non, msg;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_gen_context_is_built(&ctx->ecmult_gen_ctx));
+    ARG_CHECK(msg32 != NULL);
+    ARG_CHECK(signature != NULL);
+    ARG_CHECK(seckey != NULL);
+    if (noncefp == NULL) {
+        noncefp = secp256k1_nonce_function_default;
+    }
+
+    secp256k1_scalar_set_b32(&sec, seckey, &overflow);
+    /* Fail if the secret key is invalid. */
+    if (!overflow && !secp256k1_scalar_is_zero(&sec)) {
+        unsigned char nonce32[32];
+        unsigned int count = 0;
+        secp256k1_scalar_set_b32(&msg, msg32, NULL);
+        while (1) {
+            ret = noncefp(nonce32, msg32, seckey, NULL, (void*)noncedata, count);
+            if (!ret) {
+                break;
+            }
+            secp256k1_scalar_set_b32(&non, nonce32, &overflow);
+            if (!overflow && !secp256k1_scalar_is_zero(&non)) {
+                if (secp256k1_ecdsa_sig_sign(&ctx->ecmult_gen_ctx, &r, &s, &sec, &msg, &non, NULL)) {
+                    break;
+                }
+            }
+            count++;
+        }
+        memset(nonce32, 0, 32);
+        secp256k1_scalar_clear(&msg);
+        secp256k1_scalar_clear(&non);
+        secp256k1_scalar_clear(&sec);
+    }
+    if (ret) {
+        secp256k1_ecdsa_signature_save(signature, &r, &s);
+    } else {
+        memset(signature, 0, sizeof(*signature));
+    }
+    return ret;
+}
+
+int secp256k1_ec_seckey_verify(const secp256k1_context* ctx, const unsigned char *seckey) {
+    secp256k1_scalar sec;
+    int ret;
+    int overflow;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(seckey != NULL);
+
+    secp256k1_scalar_set_b32(&sec, seckey, &overflow);
+    ret = !overflow && !secp256k1_scalar_is_zero(&sec);
+    secp256k1_scalar_clear(&sec);
+    return ret;
+}
+
+int secp256k1_ec_pubkey_create(const secp256k1_context* ctx, secp256k1_pubkey *pubkey, const unsigned char *seckey) {
+    secp256k1_gej pj;
+    secp256k1_ge p;
+    secp256k1_scalar sec;
+    int overflow;
+    int ret = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(pubkey != NULL);
+    memset(pubkey, 0, sizeof(*pubkey));
+    ARG_CHECK(secp256k1_ecmult_gen_context_is_built(&ctx->ecmult_gen_ctx));
+    ARG_CHECK(seckey != NULL);
+
+    secp256k1_scalar_set_b32(&sec, seckey, &overflow);
+    ret = (!overflow) & (!secp256k1_scalar_is_zero(&sec));
+    if (ret) {
+        secp256k1_ecmult_gen(&ctx->ecmult_gen_ctx, &pj, &sec);
+        secp256k1_ge_set_gej(&p, &pj);
+        secp256k1_pubkey_save(pubkey, &p);
+    }
+    secp256k1_scalar_clear(&sec);
+    return ret;
+}
+
+int secp256k1_ec_privkey_negate(const secp256k1_context* ctx, unsigned char *seckey) {
+    secp256k1_scalar sec;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(seckey != NULL);
+
+    secp256k1_scalar_set_b32(&sec, seckey, NULL);
+    secp256k1_scalar_negate(&sec, &sec);
+    secp256k1_scalar_get_b32(seckey, &sec);
+
+    return 1;
+}
+
+int secp256k1_ec_pubkey_negate(const secp256k1_context* ctx, secp256k1_pubkey *pubkey) {
+    int ret = 0;
+    secp256k1_ge p;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(pubkey != NULL);
+
+    ret = secp256k1_pubkey_load(ctx, &p, pubkey);
+    memset(pubkey, 0, sizeof(*pubkey));
+    if (ret) {
+        secp256k1_ge_neg(&p, &p);
+        secp256k1_pubkey_save(pubkey, &p);
+    }
+    return ret;
+}
+
+int secp256k1_ec_privkey_tweak_add(const secp256k1_context* ctx, unsigned char *seckey, const unsigned char *tweak) {
+    secp256k1_scalar term;
+    secp256k1_scalar sec;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(seckey != NULL);
+    ARG_CHECK(tweak != NULL);
+
+    secp256k1_scalar_set_b32(&term, tweak, &overflow);
+    secp256k1_scalar_set_b32(&sec, seckey, NULL);
+
+    ret = !overflow && secp256k1_eckey_privkey_tweak_add(&sec, &term);
+    memset(seckey, 0, 32);
+    if (ret) {
+        secp256k1_scalar_get_b32(seckey, &sec);
+    }
+
+    secp256k1_scalar_clear(&sec);
+    secp256k1_scalar_clear(&term);
+    return ret;
+}
+
+int secp256k1_ec_pubkey_tweak_add(const secp256k1_context* ctx, secp256k1_pubkey *pubkey, const unsigned char *tweak) {
+    secp256k1_ge p;
+    secp256k1_scalar term;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_context_is_built(&ctx->ecmult_ctx));
+    ARG_CHECK(pubkey != NULL);
+    ARG_CHECK(tweak != NULL);
+
+    secp256k1_scalar_set_b32(&term, tweak, &overflow);
+    ret = !overflow && secp256k1_pubkey_load(ctx, &p, pubkey);
+    memset(pubkey, 0, sizeof(*pubkey));
+    if (ret) {
+        if (secp256k1_eckey_pubkey_tweak_add(&ctx->ecmult_ctx, &p, &term)) {
+            secp256k1_pubkey_save(pubkey, &p);
+        } else {
+            ret = 0;
+        }
+    }
+
+    return ret;
+}
+
+int secp256k1_ec_privkey_tweak_mul(const secp256k1_context* ctx, unsigned char *seckey, const unsigned char *tweak) {
+    secp256k1_scalar factor;
+    secp256k1_scalar sec;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(seckey != NULL);
+    ARG_CHECK(tweak != NULL);
+
+    secp256k1_scalar_set_b32(&factor, tweak, &overflow);
+    secp256k1_scalar_set_b32(&sec, seckey, NULL);
+    ret = !overflow && secp256k1_eckey_privkey_tweak_mul(&sec, &factor);
+    memset(seckey, 0, 32);
+    if (ret) {
+        secp256k1_scalar_get_b32(seckey, &sec);
+    }
+
+    secp256k1_scalar_clear(&sec);
+    secp256k1_scalar_clear(&factor);
+    return ret;
+}
+
+int secp256k1_ec_pubkey_tweak_mul(const secp256k1_context* ctx, secp256k1_pubkey *pubkey, const unsigned char *tweak) {
+    secp256k1_ge p;
+    secp256k1_scalar factor;
+    int ret = 0;
+    int overflow = 0;
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_context_is_built(&ctx->ecmult_ctx));
+    ARG_CHECK(pubkey != NULL);
+    ARG_CHECK(tweak != NULL);
+
+    secp256k1_scalar_set_b32(&factor, tweak, &overflow);
+    ret = !overflow && secp256k1_pubkey_load(ctx, &p, pubkey);
+    memset(pubkey, 0, sizeof(*pubkey));
+    if (ret) {
+        if (secp256k1_eckey_pubkey_tweak_mul(&ctx->ecmult_ctx, &p, &factor)) {
+            secp256k1_pubkey_save(pubkey, &p);
+        } else {
+            ret = 0;
+        }
+    }
+
+    return ret;
+}
+
+int secp256k1_context_randomize(secp256k1_context* ctx, const unsigned char *seed32) {
+    VERIFY_CHECK(ctx != NULL);
+    ARG_CHECK(secp256k1_ecmult_gen_context_is_built(&ctx->ecmult_gen_ctx));
+    secp256k1_ecmult_gen_blind(&ctx->ecmult_gen_ctx, seed32);
+    return 1;
+}
+
+int secp256k1_ec_pubkey_combine(const secp256k1_context* ctx, secp256k1_pubkey *pubnonce, const secp256k1_pubkey * const *pubnonces, size_t n) {
+    size_t i;
+    secp256k1_gej Qj;
+    secp256k1_ge Q;
+
+    ARG_CHECK(pubnonce != NULL);
+    memset(pubnonce, 0, sizeof(*pubnonce));
+    ARG_CHECK(n >= 1);
+    ARG_CHECK(pubnonces != NULL);
+
+    secp256k1_gej_set_infinity(&Qj);
+
+    for (i = 0; i < n; i++) {
+        secp256k1_pubkey_load(ctx, &Q, pubnonces[i]);
+        secp256k1_gej_add_ge(&Qj, &Qj, &Q);
+    }
+    if (secp256k1_gej_is_infinity(&Qj)) {
+        return 0;
+    }
+    secp256k1_ge_set_gej(&Q, &Qj);
+    secp256k1_pubkey_save(pubnonce, &Q);
+    return 1;
+}
+
+#ifdef ENABLE_MODULE_ECDH
+# include "ecdh.h"
+#endif
+
+#ifdef ENABLE_MODULE_RECOVERY
+# include "recovery.h"
+#endif
+
+/* START OF CUSTOM CODE */
+
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+CAMLprim value sizeof_secp256k1_num(value unit) {
+    return Val_int(sizeof(secp256k1_num));
+}
+
+CAMLprim value ml_secp256k1_num_copy(value r, value a) {
+    secp256k1_num_copy(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_get_bin(value r, value rlen, value a) {
+    secp256k1_num_get_bin(Caml_ba_data_val(r), Int_val(rlen), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_set_bin(value r, value a, value alen) {
+    secp256k1_num_set_bin(Caml_ba_data_val(r), Caml_ba_data_val(a), Int_val(alen));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_mod_inverse(value r, value a, value m) {
+    secp256k1_num_mod_inverse(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(m));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_jacobi(value a, value b) {
+    return Val_int(secp256k1_num_jacobi(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_num_cmp(value a, value b) {
+    return Val_int(secp256k1_num_cmp(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_num_eq(value a, value b) {
+    return Val_bool(secp256k1_num_eq(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_num_add(value r, value a, value b) {
+    secp256k1_num_add(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_sub(value r, value a, value b) {
+    secp256k1_num_sub(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_mul(value r, value a, value b) {
+    secp256k1_num_mul(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_mod(value r, value m) {
+    secp256k1_num_mod(Caml_ba_data_val(r), Caml_ba_data_val(m));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_shift(value r, value bits) {
+    secp256k1_num_shift(Caml_ba_data_val(r), Int_val(bits));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_num_is_zero(value a) {
+    return Val_bool(secp256k1_num_is_zero(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_num_is_one(value a) {
+    return Val_bool(secp256k1_num_is_one(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_num_is_neg(value a) {
+    return Val_bool(secp256k1_num_is_neg(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_num_negate(value r) {
+    secp256k1_num_negate(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_const (value r,
+                                          value d7, value d6, value d5, value d4,
+                                          value d3, value d2, value d1, value d0) {
+    secp256k1_scalar s = SECP256K1_SCALAR_CONST(Int64_val(d7), Int64_val(d6), Int64_val(d5), Int64_val(d4),
+                                                Int64_val(d3), Int64_val(d2), Int64_val(d1), Int64_val(d0));
+    memcpy(Caml_ba_data_val(r), &s, sizeof(secp256k1_scalar));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_const_bytecode (value * argv, int argn)
+{
+    return ml_secp256k1_scalar_const(argv[0], argv[1], argv[2], argv[3],
+                                     argv[4], argv[5], argv[6], argv[7],
+                                     argv[8]);
+}
+
+CAMLprim value ml_secp256k1_scalar_clear(value r) {
+    secp256k1_scalar_clear(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_get_bits(value a, value offset, value count) {
+    return Val_int(secp256k1_scalar_get_bits(Caml_ba_data_val(a), Int_val(offset), Int_val(count)));
+}
+
+CAMLprim value ml_secp256k1_scalar_get_bits_var(value a, value offset, value count) {
+    return Val_int(secp256k1_scalar_get_bits_var(Caml_ba_data_val(a), Int_val(offset), Int_val(count)));
+}
+
+CAMLprim value ml_secp256k1_scalar_set_b32(value r, value bin) {
+    int overflow;
+    secp256k1_scalar_set_b32(Caml_ba_data_val(r), Caml_ba_data_val(bin), &overflow);
+    return Val_bool(overflow);
+}
+
+CAMLprim value ml_secp256k1_scalar_set_int(value r, value v) {
+    secp256k1_scalar_set_int(Caml_ba_data_val(r), Int_val(v));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_get_b32(value bin, value a) {
+    secp256k1_scalar_get_b32(Caml_ba_data_val(bin), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_add(value r, value a, value b) {
+    return Val_int(secp256k1_scalar_add(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_scalar_cadd_bit(value r, value bit, value flag) {
+    secp256k1_scalar_cadd_bit(Caml_ba_data_val(r), Int_val(bit), Bool_val(flag));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_mul(value r, value a, value b) {
+    secp256k1_scalar_mul(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_shr_int(value r, value n) {
+    return Val_int(secp256k1_scalar_shr_int(Caml_ba_data_val(r), Int_val(n)));
+}
+
+CAMLprim value ml_secp256k1_scalar_sqr(value r, value a) {
+    secp256k1_scalar_sqr(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_inverse(value r, value a) {
+    secp256k1_scalar_inverse(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_inverse_var(value r, value a) {
+    secp256k1_scalar_inverse_var(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_negate(value r, value a) {
+    secp256k1_scalar_negate(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_is_zero(value r) {
+    return Val_bool(secp256k1_scalar_is_zero(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_scalar_is_one(value r) {
+    return Val_bool(secp256k1_scalar_is_one(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_scalar_is_even(value r) {
+    return Val_bool(secp256k1_scalar_is_even(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_scalar_is_high(value r) {
+    return Val_bool(secp256k1_scalar_is_high(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_scalar_cond_negate(value r, value flag) {
+    int ret = secp256k1_scalar_cond_negate(Caml_ba_data_val(r), Bool_val(flag));
+    return (ret == -1 ? Val_true : Val_false);
+}
+
+CAMLprim value ml_secp256k1_scalar_get_num(value r, value a) {
+    secp256k1_scalar_get_num(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_order_get_num(value r) {
+    secp256k1_scalar_order_get_num(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_scalar_eq(value a, value b) {
+    return Val_bool(secp256k1_scalar_eq(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_mul_shift_var(value r, value a, value b, value shift) {
+    secp256k1_scalar_mul_shift_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b), Int_val(shift));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_const (value r,
+                                      value d7, value d6, value d5, value d4,
+                                      value d3, value d2, value d1, value d0) {
+    secp256k1_fe fe = SECP256K1_FE_CONST(Int64_val(d7), Int64_val(d6), Int64_val(d5), Int64_val(d4),
+                                         Int64_val(d3), Int64_val(d2), Int64_val(d1), Int64_val(d0));
+    memcpy(Caml_ba_data_val(r), &fe, sizeof(secp256k1_fe));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_const_bytecode (value * argv, int argn)
+{
+    return ml_secp256k1_fe_const(argv[0], argv[1], argv[2], argv[3],
+                                 argv[4], argv[5], argv[6], argv[7],
+                                 argv[8]);
+}
+
+CAMLprim value ml_secp256k1_fe_storage_const (value r,
+                                              value d7, value d6, value d5, value d4,
+                                              value d3, value d2, value d1, value d0) {
+    secp256k1_fe_storage fes = SECP256K1_FE_STORAGE_CONST(Int64_val(d7), Int64_val(d6), Int64_val(d5), Int64_val(d4),
+                                                          Int64_val(d3), Int64_val(d2), Int64_val(d1), Int64_val(d0));
+    memcpy(Caml_ba_data_val(r), &fes, sizeof(secp256k1_fe_storage));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_storage_const_bytecode (value * argv, int argn)
+{
+    return ml_secp256k1_fe_storage_const(argv[0], argv[1], argv[2], argv[3],
+                                         argv[4], argv[5], argv[6], argv[7],
+                                         argv[8]);
+}
+
+CAMLprim value ml_secp256k1_fe_normalize(value r) {
+    secp256k1_fe_normalize(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_normalize_weak(value r) {
+    secp256k1_fe_normalize_weak(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_normalize_var(value r) {
+    secp256k1_fe_normalize_var(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_normalizes_to_zero(value r) {
+    return Val_bool(secp256k1_fe_normalizes_to_zero(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_fe_normalizes_to_zero_var(value r) {
+    return Val_bool(secp256k1_fe_normalizes_to_zero_var(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_fe_set_int(value r, value a) {
+    secp256k1_fe_set_int(Caml_ba_data_val(r), Int_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_clear(value r) {
+    secp256k1_fe_clear(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_is_zero(value r) {
+    return Val_bool(secp256k1_fe_is_zero(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_fe_is_odd(value r) {
+    return Val_bool(secp256k1_fe_is_odd(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_fe_equal(value a, value b) {
+    return Val_bool(secp256k1_fe_equal(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_fe_equal_var(value a, value b) {
+    return Val_bool(secp256k1_fe_equal_var(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_fe_cmp_var(value a, value b) {
+    return Val_int(secp256k1_fe_cmp_var(Caml_ba_data_val(a), Caml_ba_data_val(b)));
+}
+
+CAMLprim value ml_secp256k1_fe_set_b32(value r, value a) {
+    return Val_bool(secp256k1_fe_set_b32(Caml_ba_data_val(r), Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_fe_get_b32(value a, value r) {
+    secp256k1_fe_get_b32(Caml_ba_data_val(a), Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_negate(value r, value a, value m) {
+    secp256k1_fe_negate(Caml_ba_data_val(r), Caml_ba_data_val(a), Int_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_mul_int(value r, value a) {
+    secp256k1_fe_mul_int(Caml_ba_data_val(r), Int_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_add(value r, value a) {
+    secp256k1_fe_add(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_mul(value r, value a, value b) {
+    secp256k1_fe_mul(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_sqr(value r, value a) {
+    secp256k1_fe_sqr(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_sqrt(value r, value a) {
+    return Val_bool(secp256k1_fe_sqrt(Caml_ba_data_val(r), Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_fe_is_quad_var(value r) {
+    return Val_bool(secp256k1_fe_is_quad_var(Caml_ba_data_val(r)));
+}
+
+CAMLprim value ml_secp256k1_fe_inv(value r, value a) {
+    secp256k1_fe_inv(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_inv_var(value r, value a) {
+    secp256k1_fe_inv_var(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_inv_all_var(value r, value a, value len) {
+    secp256k1_fe_inv_all_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Long_val(len));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_to_storage(value r, value a) {
+    secp256k1_fe_to_storage(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_from_storage(value r, value a) {
+    secp256k1_fe_from_storage(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_storage_cmov(value r, value a, value flag) {
+    secp256k1_fe_storage_cmov(Caml_ba_data_val(r), Caml_ba_data_val(a), Bool_val(flag));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_fe_cmov(value r, value a, value flag) {
+    secp256k1_fe_cmov(Caml_ba_data_val(r), Caml_ba_data_val(a), Bool_val(flag));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_of_fields (value r, value x, value y, value infinity) {
+    secp256k1_ge *g = Caml_ba_data_val(r);
+    memcpy(&g->x, Caml_ba_data_val(x), sizeof(secp256k1_fe));
+    memcpy(&g->y, Caml_ba_data_val(y), sizeof(secp256k1_fe));
+    g->infinity = Bool_val(infinity);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_of_fields (value r, value x, value y, value z, value infinity) {
+    secp256k1_gej *g = Caml_ba_data_val(r);
+    memcpy(&g->x, Caml_ba_data_val(x), sizeof(secp256k1_fe));
+    memcpy(&g->y, Caml_ba_data_val(y), sizeof(secp256k1_fe));
+    memcpy(&g->z, Caml_ba_data_val(z), sizeof(secp256k1_fe));
+    g->infinity = Bool_val(infinity);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_storage_of_fields (value r, value x, value y) {
+    secp256k1_ge_storage *g = Caml_ba_data_val(r);
+    memcpy(&g->x, Caml_ba_data_val(x), sizeof(secp256k1_fe));
+    memcpy(&g->y, Caml_ba_data_val(y), sizeof(secp256k1_fe));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_set_xy(value r, value x, value y) {
+    secp256k1_ge_set_xy(Caml_ba_data_val(r), Caml_ba_data_val(x), Caml_ba_data_val(y));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_set_xquad(value r, value x) {
+    return Val_bool(secp256k1_ge_set_xquad(Caml_ba_data_val(r), Caml_ba_data_val(x)));
+}
+
+CAMLprim value ml_secp256k1_ge_set_xo_var(value r, value x, value odd) {
+    return Val_bool(secp256k1_ge_set_xo_var(Caml_ba_data_val(r), Caml_ba_data_val(x), Int_val(odd)));
+}
+
+CAMLprim value ml_secp256k1_ge_is_infinity(value a) {
+    return Val_bool(secp256k1_ge_is_infinity(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_ge_is_valid_var(value a) {
+    return Val_bool(secp256k1_ge_is_valid_var(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_ge_neg(value r, value a) {
+    secp256k1_ge_neg(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_set_gej(value r, value a) {
+    secp256k1_ge_set_gej(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_set_infinity(value r) {
+    secp256k1_gej_set_infinity(Caml_ba_data_val(r));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_set_ge(value r, value a) {
+    secp256k1_gej_set_ge(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_eq_x_var(value x, value a) {
+    return Val_int(secp256k1_gej_eq_x_var(Caml_ba_data_val(x), Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_gej_neg(value r, value a) {
+    secp256k1_gej_neg(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_is_infinity(value a) {
+    return Val_bool(secp256k1_gej_is_infinity(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_gej_has_quad_y_var(value a) {
+    return Val_bool(secp256k1_gej_has_quad_y_var(Caml_ba_data_val(a)));
+}
+
+CAMLprim value ml_secp256k1_gej_double_nonzero(value r, value a, value rzr) {
+    secp256k1_gej_double_nonzero(Caml_ba_data_val(r), Caml_ba_data_val(a), Is_block(rzr) ? Caml_ba_data_val(Field(rzr, 0)) : NULL);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_double_var(value r, value a, value rzr) {
+    secp256k1_gej_double_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Is_block(rzr) ? Caml_ba_data_val(Field(rzr, 0)) : NULL);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_add_var(value r, value a, value b, value rzr) {
+    secp256k1_gej_add_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b), Is_block(rzr) ? Caml_ba_data_val(Field(rzr, 0)) : NULL);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_add_ge(value r, value a, value b) {
+    secp256k1_gej_add_ge(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_add_ge_var(value r, value a, value b, value rzr) {
+    secp256k1_gej_add_ge_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b), Is_block(rzr) ? Caml_ba_data_val(Field(rzr, 0)) : NULL);
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_add_zinv_var(value r, value a, value b, value bzinv) {
+    secp256k1_gej_add_ge_var(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(b), Caml_ba_data_val(bzinv));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_clear(value a) {
+    secp256k1_gej_clear(Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_clear(value a) {
+    secp256k1_ge_clear(Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_to_storage(value r, value a) {
+    secp256k1_ge_to_storage(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_from_storage(value r, value a) {
+    secp256k1_ge_from_storage(Caml_ba_data_val(r), Caml_ba_data_val(a));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ge_storage_cmov(value r, value a, value flag) {
+    secp256k1_ge_storage_cmov(Caml_ba_data_val(r), Caml_ba_data_val(a), Bool_val(flag));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_gej_rescale(value r, value b) {
+    secp256k1_gej_rescale(Caml_ba_data_val(r), Caml_ba_data_val(b));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_ecmult_const(value r, value a, value q) {
+    secp256k1_ecmult_const(Caml_ba_data_val(r), Caml_ba_data_val(a), Caml_ba_data_val(q));
+    return Val_unit;
+}
+
+CAMLprim value ml_secp256k1_eckey_pubkey_parse(value elem, value pub, value size) {
+    return Val_bool(secp256k1_eckey_pubkey_parse(Caml_ba_data_val(elem), Caml_ba_data_val(pub), Long_val(size)));
+}
+
+CAMLprim value ml_secp256k1_eckey_pubkey_serialize(value elem, value pub, value size, value compressed) {
+    size_t sz = Long_val(size);
+    return (secp256k1_eckey_pubkey_serialize(Caml_ba_data_val(elem), Caml_ba_data_val(pub), &sz, Bool_val(compressed)) ? Val_long(sz) : Val_long(0));
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.h
new file mode 100644
index 000000000..91cdd3672
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1.h
@@ -0,0 +1,656 @@
+#ifndef SECP256K1_H
+#define SECP256K1_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#include <stddef.h>
+
+/* These rules specify the order of arguments in API calls:
+ *
+ * 1. Context pointers go first, followed by output arguments, combined
+ *    output/input arguments, and finally input-only arguments.
+ * 2. Array lengths always immediately the follow the argument whose length
+ *    they describe, even if this violates rule 1.
+ * 3. Within the OUT/OUTIN/IN groups, pointers to data that is typically generated
+ *    later go first. This means: signatures, public nonces, private nonces,
+ *    messages, public keys, secret keys, tweaks.
+ * 4. Arguments that are not data pointers go last, from more complex to less
+ *    complex: function pointers, algorithm names, messages, void pointers,
+ *    counts, flags, booleans.
+ * 5. Opaque data pointers follow the function pointer they are to be passed to.
+ */
+
+/** Opaque data structure that holds context information (precomputed tables etc.).
+ *
+ *  The purpose of context structures is to cache large precomputed data tables
+ *  that are expensive to construct, and also to maintain the randomization data
+ *  for blinding.
+ *
+ *  Do not create a new context object for each operation, as construction is
+ *  far slower than all other API calls (~100 times slower than an ECDSA
+ *  verification).
+ *
+ *  A constructed context can safely be used from multiple threads
+ *  simultaneously, but API call that take a non-const pointer to a context
+ *  need exclusive access to it. In particular this is the case for
+ *  secp256k1_context_destroy and secp256k1_context_randomize.
+ *
+ *  Regarding randomization, either do it once at creation time (in which case
+ *  you do not need any locking for the other calls), or use a read-write lock.
+ */
+typedef struct secp256k1_context_struct secp256k1_context;
+
+/** Opaque data structure that holds rewriteable "scratch space"
+ *
+ *  The purpose of this structure is to replace dynamic memory allocations,
+ *  because we target architectures where this may not be available. It is
+ *  essentially a resizable (within specified parameters) block of bytes,
+ *  which is initially created either by memory allocation or TODO as a pointer
+ *  into some fixed rewritable space.
+ *
+ *  Unlike the context object, this cannot safely be shared between threads
+ *  without additional synchronization logic.
+ */
+typedef struct secp256k1_scratch_space_struct secp256k1_scratch_space;
+
+/** Opaque data structure that holds a parsed and valid public key.
+ *
+ *  The exact representation of data inside is implementation defined and not
+ *  guaranteed to be portable between different platforms or versions. It is
+ *  however guaranteed to be 64 bytes in size, and can be safely copied/moved.
+ *  If you need to convert to a format suitable for storage, transmission, or
+ *  comparison, use secp256k1_ec_pubkey_serialize and secp256k1_ec_pubkey_parse.
+ */
+typedef struct {
+    unsigned char data[64];
+} secp256k1_pubkey;
+
+/** Opaque data structured that holds a parsed ECDSA signature.
+ *
+ *  The exact representation of data inside is implementation defined and not
+ *  guaranteed to be portable between different platforms or versions. It is
+ *  however guaranteed to be 64 bytes in size, and can be safely copied/moved.
+ *  If you need to convert to a format suitable for storage, transmission, or
+ *  comparison, use the secp256k1_ecdsa_signature_serialize_* and
+ *  secp256k1_ecdsa_signature_parse_* functions.
+ */
+typedef struct {
+    unsigned char data[64];
+} secp256k1_ecdsa_signature;
+
+/** A pointer to a function to deterministically generate a nonce.
+ *
+ * Returns: 1 if a nonce was successfully generated. 0 will cause signing to fail.
+ * Out:     nonce32:   pointer to a 32-byte array to be filled by the function.
+ * In:      msg32:     the 32-byte message hash being verified (will not be NULL)
+ *          key32:     pointer to a 32-byte secret key (will not be NULL)
+ *          algo16:    pointer to a 16-byte array describing the signature
+ *                     algorithm (will be NULL for ECDSA for compatibility).
+ *          data:      Arbitrary data pointer that is passed through.
+ *          attempt:   how many iterations we have tried to find a nonce.
+ *                     This will almost always be 0, but different attempt values
+ *                     are required to result in a different nonce.
+ *
+ * Except for test cases, this function should compute some cryptographic hash of
+ * the message, the algorithm, the key and the attempt.
+ */
+typedef int (*secp256k1_nonce_function)(
+    unsigned char *nonce32,
+    const unsigned char *msg32,
+    const unsigned char *key32,
+    const unsigned char *algo16,
+    void *data,
+    unsigned int attempt
+);
+
+# if !defined(SECP256K1_GNUC_PREREQ)
+#  if defined(__GNUC__)&&defined(__GNUC_MINOR__)
+#   define SECP256K1_GNUC_PREREQ(_maj,_min) \
+ ((__GNUC__<<16)+__GNUC_MINOR__>=((_maj)<<16)+(_min))
+#  else
+#   define SECP256K1_GNUC_PREREQ(_maj,_min) 0
+#  endif
+# endif
+
+# if (!defined(__STDC_VERSION__) || (__STDC_VERSION__ < 199901L) )
+#  if SECP256K1_GNUC_PREREQ(2,7)
+#   define SECP256K1_INLINE __inline__
+#  elif (defined(_MSC_VER))
+#   define SECP256K1_INLINE __inline
+#  else
+#   define SECP256K1_INLINE
+#  endif
+# else
+#  define SECP256K1_INLINE inline
+# endif
+
+#ifndef SECP256K1_API
+# if defined(_WIN32)
+#  ifdef SECP256K1_BUILD
+#   define SECP256K1_API __declspec(dllexport)
+#  else
+#   define SECP256K1_API
+#  endif
+# elif defined(__GNUC__) && defined(SECP256K1_BUILD)
+#  define SECP256K1_API __attribute__ ((visibility ("default")))
+# else
+#  define SECP256K1_API
+# endif
+#endif
+
+/**Warning attributes
+  * NONNULL is not used if SECP256K1_BUILD is set to avoid the compiler optimizing out
+  * some paranoid null checks. */
+# if defined(__GNUC__) && SECP256K1_GNUC_PREREQ(3, 4)
+#  define SECP256K1_WARN_UNUSED_RESULT __attribute__ ((__warn_unused_result__))
+# else
+#  define SECP256K1_WARN_UNUSED_RESULT
+# endif
+# if !defined(SECP256K1_BUILD) && defined(__GNUC__) && SECP256K1_GNUC_PREREQ(3, 4)
+#  define SECP256K1_ARG_NONNULL(_x)  __attribute__ ((__nonnull__(_x)))
+# else
+#  define SECP256K1_ARG_NONNULL(_x)
+# endif
+
+/** All flags' lower 8 bits indicate what they're for. Do not use directly. */
+#define SECP256K1_FLAGS_TYPE_MASK ((1 << 8) - 1)
+#define SECP256K1_FLAGS_TYPE_CONTEXT (1 << 0)
+#define SECP256K1_FLAGS_TYPE_COMPRESSION (1 << 1)
+/** The higher bits contain the actual data. Do not use directly. */
+#define SECP256K1_FLAGS_BIT_CONTEXT_VERIFY (1 << 8)
+#define SECP256K1_FLAGS_BIT_CONTEXT_SIGN (1 << 9)
+#define SECP256K1_FLAGS_BIT_COMPRESSION (1 << 8)
+
+/** Flags to pass to secp256k1_context_create. */
+#define SECP256K1_CONTEXT_VERIFY (SECP256K1_FLAGS_TYPE_CONTEXT | SECP256K1_FLAGS_BIT_CONTEXT_VERIFY)
+#define SECP256K1_CONTEXT_SIGN (SECP256K1_FLAGS_TYPE_CONTEXT | SECP256K1_FLAGS_BIT_CONTEXT_SIGN)
+#define SECP256K1_CONTEXT_NONE (SECP256K1_FLAGS_TYPE_CONTEXT)
+
+/** Flag to pass to secp256k1_ec_pubkey_serialize and secp256k1_ec_privkey_export. */
+#define SECP256K1_EC_COMPRESSED (SECP256K1_FLAGS_TYPE_COMPRESSION | SECP256K1_FLAGS_BIT_COMPRESSION)
+#define SECP256K1_EC_UNCOMPRESSED (SECP256K1_FLAGS_TYPE_COMPRESSION)
+
+/** Prefix byte used to tag various encoded curvepoints for specific purposes */
+#define SECP256K1_TAG_PUBKEY_EVEN 0x02
+#define SECP256K1_TAG_PUBKEY_ODD 0x03
+#define SECP256K1_TAG_PUBKEY_UNCOMPRESSED 0x04
+#define SECP256K1_TAG_PUBKEY_HYBRID_EVEN 0x06
+#define SECP256K1_TAG_PUBKEY_HYBRID_ODD 0x07
+
+/** Create a secp256k1 context object.
+ *
+ *  Returns: a newly created context object.
+ *  In:      flags: which parts of the context to initialize.
+ *
+ *  See also secp256k1_context_randomize.
+ */
+SECP256K1_API secp256k1_context* secp256k1_context_create(
+    unsigned int flags
+) SECP256K1_WARN_UNUSED_RESULT;
+
+/** Copies a secp256k1 context object.
+ *
+ *  Returns: a newly created context object.
+ *  Args:    ctx: an existing context to copy (cannot be NULL)
+ */
+SECP256K1_API secp256k1_context* secp256k1_context_clone(
+    const secp256k1_context* ctx
+) SECP256K1_ARG_NONNULL(1) SECP256K1_WARN_UNUSED_RESULT;
+
+/** Destroy a secp256k1 context object.
+ *
+ *  The context pointer may not be used afterwards.
+ *  Args:   ctx: an existing context to destroy (cannot be NULL)
+ */
+SECP256K1_API void secp256k1_context_destroy(
+    secp256k1_context* ctx
+);
+
+/** Set a callback function to be called when an illegal argument is passed to
+ *  an API call. It will only trigger for violations that are mentioned
+ *  explicitly in the header.
+ *
+ *  The philosophy is that these shouldn't be dealt with through a
+ *  specific return value, as calling code should not have branches to deal with
+ *  the case that this code itself is broken.
+ *
+ *  On the other hand, during debug stage, one would want to be informed about
+ *  such mistakes, and the default (crashing) may be inadvisable.
+ *  When this callback is triggered, the API function called is guaranteed not
+ *  to cause a crash, though its return value and output arguments are
+ *  undefined.
+ *
+ *  Args: ctx:  an existing context object (cannot be NULL)
+ *  In:   fun:  a pointer to a function to call when an illegal argument is
+ *              passed to the API, taking a message and an opaque pointer
+ *              (NULL restores a default handler that calls abort).
+ *        data: the opaque pointer to pass to fun above.
+ */
+SECP256K1_API void secp256k1_context_set_illegal_callback(
+    secp256k1_context* ctx,
+    void (*fun)(const char* message, void* data),
+    const void* data
+) SECP256K1_ARG_NONNULL(1);
+
+/** Set a callback function to be called when an internal consistency check
+ *  fails. The default is crashing.
+ *
+ *  This can only trigger in case of a hardware failure, miscompilation,
+ *  memory corruption, serious bug in the library, or other error would can
+ *  otherwise result in undefined behaviour. It will not trigger due to mere
+ *  incorrect usage of the API (see secp256k1_context_set_illegal_callback
+ *  for that). After this callback returns, anything may happen, including
+ *  crashing.
+ *
+ *  Args: ctx:  an existing context object (cannot be NULL)
+ *  In:   fun:  a pointer to a function to call when an internal error occurs,
+ *              taking a message and an opaque pointer (NULL restores a default
+ *              handler that calls abort).
+ *        data: the opaque pointer to pass to fun above.
+ */
+SECP256K1_API void secp256k1_context_set_error_callback(
+    secp256k1_context* ctx,
+    void (*fun)(const char* message, void* data),
+    const void* data
+) SECP256K1_ARG_NONNULL(1);
+
+/** Create a secp256k1 scratch space object.
+ *
+ *  Returns: a newly created scratch space.
+ *  Args: ctx:  an existing context object (cannot be NULL)
+ *  In:  init_size: initial amount of memory to allocate
+ *        max_size: maximum amount of memory to allocate
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT secp256k1_scratch_space* secp256k1_scratch_space_create(
+    const secp256k1_context* ctx,
+    size_t init_size,
+    size_t max_size
+) SECP256K1_ARG_NONNULL(1);
+
+/** Destroy a secp256k1 scratch space.
+ *
+ *  The pointer may not be used afterwards.
+ *  Args:   scratch: space to destroy
+ */
+SECP256K1_API void secp256k1_scratch_space_destroy(
+    secp256k1_scratch_space* scratch
+);
+
+/** Parse a variable-length public key into the pubkey object.
+ *
+ *  Returns: 1 if the public key was fully valid.
+ *           0 if the public key could not be parsed or is invalid.
+ *  Args: ctx:      a secp256k1 context object.
+ *  Out:  pubkey:   pointer to a pubkey object. If 1 is returned, it is set to a
+ *                  parsed version of input. If not, its value is undefined.
+ *  In:   input:    pointer to a serialized public key
+ *        inputlen: length of the array pointed to by input
+ *
+ *  This function supports parsing compressed (33 bytes, header byte 0x02 or
+ *  0x03), uncompressed (65 bytes, header byte 0x04), or hybrid (65 bytes, header
+ *  byte 0x06 or 0x07) format public keys.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_parse(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey* pubkey,
+    const unsigned char *input,
+    size_t inputlen
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Serialize a pubkey object into a serialized byte sequence.
+ *
+ *  Returns: 1 always.
+ *  Args:   ctx:        a secp256k1 context object.
+ *  Out:    output:     a pointer to a 65-byte (if compressed==0) or 33-byte (if
+ *                      compressed==1) byte array to place the serialized key
+ *                      in.
+ *  In/Out: outputlen:  a pointer to an integer which is initially set to the
+ *                      size of output, and is overwritten with the written
+ *                      size.
+ *  In:     pubkey:     a pointer to a secp256k1_pubkey containing an
+ *                      initialized public key.
+ *          flags:      SECP256K1_EC_COMPRESSED if serialization should be in
+ *                      compressed format, otherwise SECP256K1_EC_UNCOMPRESSED.
+ */
+SECP256K1_API int secp256k1_ec_pubkey_serialize(
+    const secp256k1_context* ctx,
+    unsigned char *output,
+    size_t *outputlen,
+    const secp256k1_pubkey* pubkey,
+    unsigned int flags
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Parse an ECDSA signature in compact (64 bytes) format.
+ *
+ *  Returns: 1 when the signature could be parsed, 0 otherwise.
+ *  Args: ctx:      a secp256k1 context object
+ *  Out:  sig:      a pointer to a signature object
+ *  In:   input64:  a pointer to the 64-byte array to parse
+ *
+ *  The signature must consist of a 32-byte big endian R value, followed by a
+ *  32-byte big endian S value. If R or S fall outside of [0..order-1], the
+ *  encoding is invalid. R and S with value 0 are allowed in the encoding.
+ *
+ *  After the call, sig will always be initialized. If parsing failed or R or
+ *  S are zero, the resulting sig value is guaranteed to fail validation for any
+ *  message and public key.
+ */
+SECP256K1_API int secp256k1_ecdsa_signature_parse_compact(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_signature* sig,
+    const unsigned char *input64
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Parse a DER ECDSA signature.
+ *
+ *  Returns: 1 when the signature could be parsed, 0 otherwise.
+ *  Args: ctx:      a secp256k1 context object
+ *  Out:  sig:      a pointer to a signature object
+ *  In:   input:    a pointer to the signature to be parsed
+ *        inputlen: the length of the array pointed to be input
+ *
+ *  This function will accept any valid DER encoded signature, even if the
+ *  encoded numbers are out of range.
+ *
+ *  After the call, sig will always be initialized. If parsing failed or the
+ *  encoded numbers are out of range, signature validation with it is
+ *  guaranteed to fail for every message and public key.
+ */
+SECP256K1_API int secp256k1_ecdsa_signature_parse_der(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_signature* sig,
+    const unsigned char *input,
+    size_t inputlen
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Serialize an ECDSA signature in DER format.
+ *
+ *  Returns: 1 if enough space was available to serialize, 0 otherwise
+ *  Args:   ctx:       a secp256k1 context object
+ *  Out:    output:    a pointer to an array to store the DER serialization
+ *  In/Out: outputlen: a pointer to a length integer. Initially, this integer
+ *                     should be set to the length of output. After the call
+ *                     it will be set to the length of the serialization (even
+ *                     if 0 was returned).
+ *  In:     sig:       a pointer to an initialized signature object
+ */
+SECP256K1_API int secp256k1_ecdsa_signature_serialize_der(
+    const secp256k1_context* ctx,
+    unsigned char *output,
+    size_t *outputlen,
+    const secp256k1_ecdsa_signature* sig
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Serialize an ECDSA signature in compact (64 byte) format.
+ *
+ *  Returns: 1
+ *  Args:   ctx:       a secp256k1 context object
+ *  Out:    output64:  a pointer to a 64-byte array to store the compact serialization
+ *  In:     sig:       a pointer to an initialized signature object
+ *
+ *  See secp256k1_ecdsa_signature_parse_compact for details about the encoding.
+ */
+SECP256K1_API int secp256k1_ecdsa_signature_serialize_compact(
+    const secp256k1_context* ctx,
+    unsigned char *output64,
+    const secp256k1_ecdsa_signature* sig
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Verify an ECDSA signature.
+ *
+ *  Returns: 1: correct signature
+ *           0: incorrect or unparseable signature
+ *  Args:    ctx:       a secp256k1 context object, initialized for verification.
+ *  In:      sig:       the signature being verified (cannot be NULL)
+ *           msg32:     the 32-byte message hash being verified (cannot be NULL)
+ *           pubkey:    pointer to an initialized public key to verify with (cannot be NULL)
+ *
+ * To avoid accepting malleable signatures, only ECDSA signatures in lower-S
+ * form are accepted.
+ *
+ * If you need to accept ECDSA signatures from sources that do not obey this
+ * rule, apply secp256k1_ecdsa_signature_normalize to the signature prior to
+ * validation, but be aware that doing so results in malleable signatures.
+ *
+ * For details, see the comments for that function.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ecdsa_verify(
+    const secp256k1_context* ctx,
+    const secp256k1_ecdsa_signature *sig,
+    const unsigned char *msg32,
+    const secp256k1_pubkey *pubkey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Convert a signature to a normalized lower-S form.
+ *
+ *  Returns: 1 if sigin was not normalized, 0 if it already was.
+ *  Args: ctx:    a secp256k1 context object
+ *  Out:  sigout: a pointer to a signature to fill with the normalized form,
+ *                or copy if the input was already normalized. (can be NULL if
+ *                you're only interested in whether the input was already
+ *                normalized).
+ *  In:   sigin:  a pointer to a signature to check/normalize (cannot be NULL,
+ *                can be identical to sigout)
+ *
+ *  With ECDSA a third-party can forge a second distinct signature of the same
+ *  message, given a single initial signature, but without knowing the key. This
+ *  is done by negating the S value modulo the order of the curve, 'flipping'
+ *  the sign of the random point R which is not included in the signature.
+ *
+ *  Forgery of the same message isn't universally problematic, but in systems
+ *  where message malleability or uniqueness of signatures is important this can
+ *  cause issues. This forgery can be blocked by all verifiers forcing signers
+ *  to use a normalized form.
+ *
+ *  The lower-S form reduces the size of signatures slightly on average when
+ *  variable length encodings (such as DER) are used and is cheap to verify,
+ *  making it a good choice. Security of always using lower-S is assured because
+ *  anyone can trivially modify a signature after the fact to enforce this
+ *  property anyway.
+ *
+ *  The lower S value is always between 0x1 and
+ *  0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0,
+ *  inclusive.
+ *
+ *  No other forms of ECDSA malleability are known and none seem likely, but
+ *  there is no formal proof that ECDSA, even with this additional restriction,
+ *  is free of other malleability. Commonly used serialization schemes will also
+ *  accept various non-unique encodings, so care should be taken when this
+ *  property is required for an application.
+ *
+ *  The secp256k1_ecdsa_sign function will by default create signatures in the
+ *  lower-S form, and secp256k1_ecdsa_verify will not accept others. In case
+ *  signatures come from a system that cannot enforce this property,
+ *  secp256k1_ecdsa_signature_normalize must be called before verification.
+ */
+SECP256K1_API int secp256k1_ecdsa_signature_normalize(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_signature *sigout,
+    const secp256k1_ecdsa_signature *sigin
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(3);
+
+/** An implementation of RFC6979 (using HMAC-SHA256) as nonce generation function.
+ * If a data pointer is passed, it is assumed to be a pointer to 32 bytes of
+ * extra entropy.
+ */
+SECP256K1_API extern const secp256k1_nonce_function secp256k1_nonce_function_rfc6979;
+
+/** A default safe nonce generation function (currently equal to secp256k1_nonce_function_rfc6979). */
+SECP256K1_API extern const secp256k1_nonce_function secp256k1_nonce_function_default;
+
+/** Create an ECDSA signature.
+ *
+ *  Returns: 1: signature created
+ *           0: the nonce generation function failed, or the private key was invalid.
+ *  Args:    ctx:    pointer to a context object, initialized for signing (cannot be NULL)
+ *  Out:     sig:    pointer to an array where the signature will be placed (cannot be NULL)
+ *  In:      msg32:  the 32-byte message hash being signed (cannot be NULL)
+ *           seckey: pointer to a 32-byte secret key (cannot be NULL)
+ *           noncefp:pointer to a nonce generation function. If NULL, secp256k1_nonce_function_default is used
+ *           ndata:  pointer to arbitrary data used by the nonce generation function (can be NULL)
+ *
+ * The created signature is always in lower-S form. See
+ * secp256k1_ecdsa_signature_normalize for more details.
+ */
+SECP256K1_API int secp256k1_ecdsa_sign(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_signature *sig,
+    const unsigned char *msg32,
+    const unsigned char *seckey,
+    secp256k1_nonce_function noncefp,
+    const void *ndata
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Verify an ECDSA secret key.
+ *
+ *  Returns: 1: secret key is valid
+ *           0: secret key is invalid
+ *  Args:    ctx: pointer to a context object (cannot be NULL)
+ *  In:      seckey: pointer to a 32-byte secret key (cannot be NULL)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_seckey_verify(
+    const secp256k1_context* ctx,
+    const unsigned char *seckey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2);
+
+/** Compute the public key for a secret key.
+ *
+ *  Returns: 1: secret was valid, public key stores
+ *           0: secret was invalid, try again
+ *  Args:   ctx:        pointer to a context object, initialized for signing (cannot be NULL)
+ *  Out:    pubkey:     pointer to the created public key (cannot be NULL)
+ *  In:     seckey:     pointer to a 32-byte private key (cannot be NULL)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_create(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *pubkey,
+    const unsigned char *seckey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Negates a private key in place.
+ *
+ *  Returns: 1 always
+ *  Args:   ctx:        pointer to a context object
+ *  In/Out: seckey:     pointer to the 32-byte private key to be negated (cannot be NULL)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_privkey_negate(
+    const secp256k1_context* ctx,
+    unsigned char *seckey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2);
+
+/** Negates a public key in place.
+ *
+ *  Returns: 1 always
+ *  Args:   ctx:        pointer to a context object
+ *  In/Out: pubkey:     pointer to the public key to be negated (cannot be NULL)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_negate(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *pubkey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2);
+
+/** Tweak a private key by adding tweak to it.
+ * Returns: 0 if the tweak was out of range (chance of around 1 in 2^128 for
+ *          uniformly random 32-byte arrays, or if the resulting private key
+ *          would be invalid (only when the tweak is the complement of the
+ *          private key). 1 otherwise.
+ * Args:    ctx:    pointer to a context object (cannot be NULL).
+ * In/Out:  seckey: pointer to a 32-byte private key.
+ * In:      tweak:  pointer to a 32-byte tweak.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_privkey_tweak_add(
+    const secp256k1_context* ctx,
+    unsigned char *seckey,
+    const unsigned char *tweak
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Tweak a public key by adding tweak times the generator to it.
+ * Returns: 0 if the tweak was out of range (chance of around 1 in 2^128 for
+ *          uniformly random 32-byte arrays, or if the resulting public key
+ *          would be invalid (only when the tweak is the complement of the
+ *          corresponding private key). 1 otherwise.
+ * Args:    ctx:    pointer to a context object initialized for validation
+ *                  (cannot be NULL).
+ * In/Out:  pubkey: pointer to a public key object.
+ * In:      tweak:  pointer to a 32-byte tweak.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_tweak_add(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *pubkey,
+    const unsigned char *tweak
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Tweak a private key by multiplying it by a tweak.
+ * Returns: 0 if the tweak was out of range (chance of around 1 in 2^128 for
+ *          uniformly random 32-byte arrays, or equal to zero. 1 otherwise.
+ * Args:   ctx:    pointer to a context object (cannot be NULL).
+ * In/Out: seckey: pointer to a 32-byte private key.
+ * In:     tweak:  pointer to a 32-byte tweak.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_privkey_tweak_mul(
+    const secp256k1_context* ctx,
+    unsigned char *seckey,
+    const unsigned char *tweak
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Tweak a public key by multiplying it by a tweak value.
+ * Returns: 0 if the tweak was out of range (chance of around 1 in 2^128 for
+ *          uniformly random 32-byte arrays, or equal to zero. 1 otherwise.
+ * Args:    ctx:    pointer to a context object initialized for validation
+ *                 (cannot be NULL).
+ * In/Out:  pubkey: pointer to a public key obkect.
+ * In:      tweak:  pointer to a 32-byte tweak.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_tweak_mul(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *pubkey,
+    const unsigned char *tweak
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Updates the context randomization to protect against side-channel leakage.
+ *  Returns: 1: randomization successfully updated
+ *           0: error
+ *  Args:    ctx:       pointer to a context object (cannot be NULL)
+ *  In:      seed32:    pointer to a 32-byte random seed (NULL resets to initial state)
+ *
+ * While secp256k1 code is written to be constant-time no matter what secret
+ * values are, it's possible that a future compiler may output code which isn't,
+ * and also that the CPU may not emit the same radio frequencies or draw the same
+ * amount power for all values.
+ *
+ * This function provides a seed which is combined into the blinding value: that
+ * blinding value is added before each multiplication (and removed afterwards) so
+ * that it does not affect function results, but shields against attacks which
+ * rely on any input-dependent behaviour.
+ *
+ * You should call this after secp256k1_context_create or
+ * secp256k1_context_clone, and may call this repeatedly afterwards.
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_context_randomize(
+    secp256k1_context* ctx,
+    const unsigned char *seed32
+) SECP256K1_ARG_NONNULL(1);
+
+/** Add a number of public keys together.
+ *  Returns: 1: the sum of the public keys is valid.
+ *           0: the sum of the public keys is not valid.
+ *  Args:   ctx:        pointer to a context object
+ *  Out:    out:        pointer to a public key object for placing the resulting public key
+ *                      (cannot be NULL)
+ *  In:     ins:        pointer to array of pointers to public keys (cannot be NULL)
+ *          n:          the number of public keys to add together (must be at least 1)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ec_pubkey_combine(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *out,
+    const secp256k1_pubkey * const * ins,
+    size_t n
+) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* SECP256K1_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_ecdh.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_ecdh.h
new file mode 100644
index 000000000..88492dc1a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_ecdh.h
@@ -0,0 +1,31 @@
+#ifndef SECP256K1_ECDH_H
+#define SECP256K1_ECDH_H
+
+#include "secp256k1.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/** Compute an EC Diffie-Hellman secret in constant time
+ *  Returns: 1: exponentiation was successful
+ *           0: scalar was invalid (zero or overflow)
+ *  Args:    ctx:        pointer to a context object (cannot be NULL)
+ *  Out:     result:     a 32-byte array which will be populated by an ECDH
+ *                       secret computed from the point and scalar
+ *  In:      pubkey:     a pointer to a secp256k1_pubkey containing an
+ *                       initialized public key
+ *           privkey:    a 32-byte scalar with which to multiply the point
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ecdh(
+  const secp256k1_context* ctx,
+  unsigned char *result,
+  const secp256k1_pubkey *pubkey,
+  const unsigned char *privkey
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* SECP256K1_ECDH_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_recovery.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_recovery.h
new file mode 100644
index 000000000..cf6c5ed7f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_recovery.h
@@ -0,0 +1,110 @@
+#ifndef SECP256K1_RECOVERY_H
+#define SECP256K1_RECOVERY_H
+
+#include "secp256k1.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/** Opaque data structured that holds a parsed ECDSA signature,
+ *  supporting pubkey recovery.
+ *
+ *  The exact representation of data inside is implementation defined and not
+ *  guaranteed to be portable between different platforms or versions. It is
+ *  however guaranteed to be 65 bytes in size, and can be safely copied/moved.
+ *  If you need to convert to a format suitable for storage or transmission, use
+ *  the secp256k1_ecdsa_signature_serialize_* and
+ *  secp256k1_ecdsa_signature_parse_* functions.
+ *
+ *  Furthermore, it is guaranteed that identical signatures (including their
+ *  recoverability) will have identical representation, so they can be
+ *  memcmp'ed.
+ */
+typedef struct {
+    unsigned char data[65];
+} secp256k1_ecdsa_recoverable_signature;
+
+/** Parse a compact ECDSA signature (64 bytes + recovery id).
+ *
+ *  Returns: 1 when the signature could be parsed, 0 otherwise
+ *  Args: ctx:     a secp256k1 context object
+ *  Out:  sig:     a pointer to a signature object
+ *  In:   input64: a pointer to a 64-byte compact signature
+ *        recid:   the recovery id (0, 1, 2 or 3)
+ */
+SECP256K1_API int secp256k1_ecdsa_recoverable_signature_parse_compact(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_recoverable_signature* sig,
+    const unsigned char *input64,
+    int recid
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Convert a recoverable signature into a normal signature.
+ *
+ *  Returns: 1
+ *  Out: sig:    a pointer to a normal signature (cannot be NULL).
+ *  In:  sigin:  a pointer to a recoverable signature (cannot be NULL).
+ */
+SECP256K1_API int secp256k1_ecdsa_recoverable_signature_convert(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_signature* sig,
+    const secp256k1_ecdsa_recoverable_signature* sigin
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3);
+
+/** Serialize an ECDSA signature in compact format (64 bytes + recovery id).
+ *
+ *  Returns: 1
+ *  Args: ctx:      a secp256k1 context object
+ *  Out:  output64: a pointer to a 64-byte array of the compact signature (cannot be NULL)
+ *        recid:    a pointer to an integer to hold the recovery id (can be NULL).
+ *  In:   sig:      a pointer to an initialized signature object (cannot be NULL)
+ */
+SECP256K1_API int secp256k1_ecdsa_recoverable_signature_serialize_compact(
+    const secp256k1_context* ctx,
+    unsigned char *output64,
+    int *recid,
+    const secp256k1_ecdsa_recoverable_signature* sig
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Create a recoverable ECDSA signature.
+ *
+ *  Returns: 1: signature created
+ *           0: the nonce generation function failed, or the private key was invalid.
+ *  Args:    ctx:    pointer to a context object, initialized for signing (cannot be NULL)
+ *  Out:     sig:    pointer to an array where the signature will be placed (cannot be NULL)
+ *  In:      msg32:  the 32-byte message hash being signed (cannot be NULL)
+ *           seckey: pointer to a 32-byte secret key (cannot be NULL)
+ *           noncefp:pointer to a nonce generation function. If NULL, secp256k1_nonce_function_default is used
+ *           ndata:  pointer to arbitrary data used by the nonce generation function (can be NULL)
+ */
+SECP256K1_API int secp256k1_ecdsa_sign_recoverable(
+    const secp256k1_context* ctx,
+    secp256k1_ecdsa_recoverable_signature *sig,
+    const unsigned char *msg32,
+    const unsigned char *seckey,
+    secp256k1_nonce_function noncefp,
+    const void *ndata
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+/** Recover an ECDSA public key from a signature.
+ *
+ *  Returns: 1: public key successfully recovered (which guarantees a correct signature).
+ *           0: otherwise.
+ *  Args:    ctx:        pointer to a context object, initialized for verification (cannot be NULL)
+ *  Out:     pubkey:     pointer to the recovered public key (cannot be NULL)
+ *  In:      sig:        pointer to initialized signature that supports pubkey recovery (cannot be NULL)
+ *           msg32:      the 32-byte message hash assumed to be signed (cannot be NULL)
+ */
+SECP256K1_API SECP256K1_WARN_UNUSED_RESULT int secp256k1_ecdsa_recover(
+    const secp256k1_context* ctx,
+    secp256k1_pubkey *pubkey,
+    const secp256k1_ecdsa_recoverable_signature *sig,
+    const unsigned char *msg32
+) SECP256K1_ARG_NONNULL(1) SECP256K1_ARG_NONNULL(2) SECP256K1_ARG_NONNULL(3) SECP256K1_ARG_NONNULL(4);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* SECP256K1_RECOVERY_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_wrap.c b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_wrap.c
new file mode 100644
index 000000000..477eca19a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/secp256k1_wrap.c
@@ -0,0 +1,224 @@
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/bigarray.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+
+#include "secp256k1.h"
+#include "secp256k1_recovery.h"
+
+/* Accessing the secp256k1_context * part of an OCaml custom block */
+#define Context_val(v) (*((secp256k1_context **) Data_custom_val(v)))
+
+static void context_destroy(value ctx) {
+    secp256k1_context_destroy (Context_val(ctx));
+}
+
+static struct custom_operations secp256k1_context_ops = {
+    .identifier = "secp256k1_context",
+    .finalize = context_destroy,
+    .compare = custom_compare_default,
+    .compare_ext = custom_compare_ext_default,
+    .hash = custom_hash_default,
+    .serialize = custom_serialize_default,
+    .deserialize = custom_deserialize_default
+};
+
+static value alloc_context (secp256k1_context *ctx) {
+    value ml_ctx = alloc_custom(&secp256k1_context_ops, sizeof(secp256k1_context *), 0, 1);
+    Context_val(ml_ctx) = ctx;
+    return ml_ctx;
+}
+
+CAMLprim value caml_secp256k1_context_create (value flags) {
+    CAMLparam1(flags);
+    secp256k1_context *ctx = secp256k1_context_create (Int_val(flags));
+    if (!ctx) caml_failwith("context_create");
+    CAMLreturn(alloc_context(ctx));
+}
+
+CAMLprim value caml_secp256k1_context_randomize (value ctx, value seed) {
+    return Val_bool(secp256k1_context_randomize(Context_val(ctx),
+                                                Caml_ba_data_val(seed)));
+}
+
+CAMLprim value caml_secp256k1_context_clone (value ctx) {
+    CAMLparam1(ctx);
+    secp256k1_context *new = secp256k1_context_clone (Context_val(ctx));
+    if (!new) caml_failwith("context_clone");
+    CAMLreturn(alloc_context(new));
+}
+
+CAMLprim value caml_secp256k1_ec_seckey_verify (value ctx, value sk) {
+    return Val_bool(secp256k1_ec_seckey_verify(Context_val(ctx),
+                                               Caml_ba_data_val(sk)));
+}
+
+CAMLprim value caml_secp256k1_ec_privkey_negate(value ctx, value sk) {
+    int ret = secp256k1_ec_privkey_negate(Context_val(ctx),
+                                          Caml_ba_data_val(sk));
+    return Val_unit;
+}
+
+CAMLprim value caml_secp256k1_ec_privkey_tweak_add(value ctx, value sk, value tweak) {
+    return Val_bool(secp256k1_ec_privkey_tweak_add(Context_val(ctx),
+                                                   Caml_ba_data_val(sk),
+                                                   Caml_ba_data_val(tweak)));
+}
+
+CAMLprim value caml_secp256k1_ec_privkey_tweak_mul(value ctx, value sk, value tweak) {
+    return Val_bool(secp256k1_ec_privkey_tweak_mul(Context_val(ctx),
+                                                   Caml_ba_data_val(sk),
+                                                   Caml_ba_data_val(tweak)));
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_create (value ctx, value buf, value sk) {
+    return Val_bool(secp256k1_ec_pubkey_create (Context_val(ctx),
+                                                Caml_ba_data_val(buf),
+                                                Caml_ba_data_val(sk)));
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_serialize (value ctx, value buf, value pk) {
+    size_t size = Caml_ba_array_val(buf)->dim[0];
+    unsigned int flags =
+        size == 33 ? SECP256K1_EC_COMPRESSED : SECP256K1_EC_UNCOMPRESSED;
+
+    secp256k1_ec_pubkey_serialize(Context_val(ctx),
+                                  Caml_ba_data_val(buf),
+                                  &size,
+                                  Caml_ba_data_val(pk),
+                                  flags);
+
+    return Val_int(size);
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_parse(value ctx, value buf, value pk) {
+    return Val_bool(secp256k1_ec_pubkey_parse(Context_val(ctx),
+                                              Caml_ba_data_val(buf),
+                                              Caml_ba_data_val(pk),
+                                              Caml_ba_array_val(pk)->dim[0]));
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_negate(value ctx, value pk) {
+    int ret = secp256k1_ec_pubkey_negate(Context_val(ctx),
+                                         Caml_ba_data_val(pk));
+    return Val_unit;
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_tweak_add(value ctx, value pk, value tweak) {
+    return Val_bool(secp256k1_ec_pubkey_tweak_add(Context_val(ctx),
+                                                  Caml_ba_data_val(pk),
+                                                  Caml_ba_data_val(tweak)));
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_tweak_mul(value ctx, value pk, value tweak) {
+    return Val_bool(secp256k1_ec_pubkey_tweak_mul(Context_val(ctx),
+                                                  Caml_ba_data_val(pk),
+                                                  Caml_ba_data_val(tweak)));
+}
+
+CAMLprim value caml_secp256k1_ec_pubkey_combine(value ctx, value out, value pks) {
+    int size = 0;
+    const secp256k1_pubkey* cpks[1024] = {0};
+
+    while(Field(pks, 1) != Val_unit) {
+        cpks[size] = Caml_ba_data_val(Field(pks, 0));
+        size++;
+        pks = Field(pks, 1);
+    }
+
+    return Val_int(secp256k1_ec_pubkey_combine(Context_val(ctx),
+                                               Caml_ba_data_val(out),
+                                               cpks,
+                                               size));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_signature_parse_compact (value ctx, value buf, value sig) {
+    return Val_bool(secp256k1_ecdsa_signature_parse_compact (Context_val(ctx),
+                                                             Caml_ba_data_val(buf),
+                                                             Caml_ba_data_val(sig)));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_signature_parse_der (value ctx, value buf, value sig) {
+    return Val_bool(secp256k1_ecdsa_signature_parse_der (Context_val(ctx),
+                                                         Caml_ba_data_val(buf),
+                                                         Caml_ba_data_val(sig),
+                                                         Caml_ba_array_val(sig)->dim[0]));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_signature_normalize(value ctx, value buf, value sig) {
+    return Val_bool(secp256k1_ecdsa_signature_normalize (Context_val(ctx),
+                                                         Caml_ba_data_val(buf),
+                                                         Caml_ba_data_val(sig)));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_verify (value ctx, value pubkey, value msg, value signature) {
+    return Val_bool(secp256k1_ecdsa_verify (Context_val(ctx),
+                                            Caml_ba_data_val(signature),
+                                            Caml_ba_data_val(msg),
+                                            Caml_ba_data_val(pubkey)));
+}
+
+
+CAMLprim value caml_secp256k1_ecdsa_sign (value ctx, value buf, value seckey, value msg) {
+    return Val_bool(secp256k1_ecdsa_sign (Context_val(ctx),
+                                          Caml_ba_data_val(buf),
+                                          Caml_ba_data_val(msg),
+                                          Caml_ba_data_val(seckey),
+                                          NULL, NULL));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_signature_serialize_der(value ctx, value buf, value signature) {
+    size_t size = Caml_ba_array_val(buf)->dim[0];
+    int ret = secp256k1_ecdsa_signature_serialize_der(Context_val(ctx),
+                                                      Caml_ba_data_val(buf),
+                                                      &size,
+                                                      Caml_ba_data_val(signature));
+
+    return (ret == 0 ? Val_int(ret) : Val_int(size));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_signature_serialize_compact(value ctx, value buf, value signature) {
+    secp256k1_ecdsa_signature_serialize_compact(Context_val(ctx),
+                                                Caml_ba_data_val(buf),
+                                                Caml_ba_data_val(signature));
+    return Val_unit;
+}
+
+CAMLprim value caml_secp256k1_ecdsa_recoverable_signature_parse_compact (value ctx, value buf, value signature, value recid) {
+    return Val_bool(secp256k1_ecdsa_recoverable_signature_parse_compact (Context_val(ctx),
+                                                                         Caml_ba_data_val(buf),
+                                                                         Caml_ba_data_val(signature),
+                                                                         Int_val(recid)));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_sign_recoverable (value ctx, value buf, value seckey, value msg) {
+    return Val_bool(secp256k1_ecdsa_sign_recoverable (Context_val(ctx),
+                                                      Caml_ba_data_val(buf),
+                                                      Caml_ba_data_val(msg),
+                                                      Caml_ba_data_val(seckey),
+                                                      NULL, NULL));
+}
+
+CAMLprim value caml_secp256k1_ecdsa_recoverable_signature_serialize_compact(value ctx, value buf, value signature) {
+    int recid;
+    secp256k1_ecdsa_recoverable_signature_serialize_compact(Context_val(ctx),
+                                                            Caml_ba_data_val(buf),
+                                                            &recid,
+                                                            Caml_ba_data_val(signature));
+    return Val_int(recid);
+}
+
+CAMLprim value caml_secp256k1_ecdsa_recoverable_signature_convert(value ctx, value buf, value signature) {
+    secp256k1_ecdsa_recoverable_signature_convert(Context_val(ctx),
+                                                   Caml_ba_data_val(buf),
+                                                   Caml_ba_data_val(signature));
+    return Val_unit;
+}
+
+CAMLprim value caml_secp256k1_ecdsa_recover(value ctx, value buf, value signature, value msg) {
+    return Val_bool(secp256k1_ecdsa_recover(Context_val(ctx),
+                                            Caml_ba_data_val(buf),
+                                            Caml_ba_data_val(signature),
+                                            Caml_ba_data_val(msg)));
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand.h
new file mode 100644
index 000000000..f1f9be077
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand.h
@@ -0,0 +1,38 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_TESTRAND_H
+#define SECP256K1_TESTRAND_H
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+/* A non-cryptographic RNG used only for test infrastructure. */
+
+/** Seed the pseudorandom number generator for testing. */
+SECP256K1_INLINE static void secp256k1_rand_seed(const unsigned char *seed16);
+
+/** Generate a pseudorandom number in the range [0..2**32-1]. */
+static uint32_t secp256k1_rand32(void);
+
+/** Generate a pseudorandom number in the range [0..2**bits-1]. Bits must be 1 or
+ *  more. */
+static uint32_t secp256k1_rand_bits(int bits);
+
+/** Generate a pseudorandom number in the range [0..range-1]. */
+static uint32_t secp256k1_rand_int(uint32_t range);
+
+/** Generate a pseudorandom 32-byte array. */
+static void secp256k1_rand256(unsigned char *b32);
+
+/** Generate a pseudorandom 32-byte array with long sequences of zero and one bits. */
+static void secp256k1_rand256_test(unsigned char *b32);
+
+/** Generate pseudorandom bytes with long sequences of zero and one bits. */
+static void secp256k1_rand_bytes_test(unsigned char *bytes, size_t len);
+
+#endif /* SECP256K1_TESTRAND_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand_impl.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand_impl.h
new file mode 100644
index 000000000..30a91e529
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/testrand_impl.h
@@ -0,0 +1,110 @@
+/**********************************************************************
+ * Copyright (c) 2013-2015 Pieter Wuille                              *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_TESTRAND_IMPL_H
+#define SECP256K1_TESTRAND_IMPL_H
+
+#include <stdint.h>
+#include <string.h>
+
+#include "testrand.h"
+#include "hash.h"
+
+static secp256k1_rfc6979_hmac_sha256 secp256k1_test_rng;
+static uint32_t secp256k1_test_rng_precomputed[8];
+static int secp256k1_test_rng_precomputed_used = 8;
+static uint64_t secp256k1_test_rng_integer;
+static int secp256k1_test_rng_integer_bits_left = 0;
+
+SECP256K1_INLINE static void secp256k1_rand_seed(const unsigned char *seed16) {
+    secp256k1_rfc6979_hmac_sha256_initialize(&secp256k1_test_rng, seed16, 16);
+}
+
+SECP256K1_INLINE static uint32_t secp256k1_rand32(void) {
+    if (secp256k1_test_rng_precomputed_used == 8) {
+        secp256k1_rfc6979_hmac_sha256_generate(&secp256k1_test_rng, (unsigned char*)(&secp256k1_test_rng_precomputed[0]), sizeof(secp256k1_test_rng_precomputed));
+        secp256k1_test_rng_precomputed_used = 0;
+    }
+    return secp256k1_test_rng_precomputed[secp256k1_test_rng_precomputed_used++];
+}
+
+static uint32_t secp256k1_rand_bits(int bits) {
+    uint32_t ret;
+    if (secp256k1_test_rng_integer_bits_left < bits) {
+        secp256k1_test_rng_integer |= (((uint64_t)secp256k1_rand32()) << secp256k1_test_rng_integer_bits_left);
+        secp256k1_test_rng_integer_bits_left += 32;
+    }
+    ret = secp256k1_test_rng_integer;
+    secp256k1_test_rng_integer >>= bits;
+    secp256k1_test_rng_integer_bits_left -= bits;
+    ret &= ((~((uint32_t)0)) >> (32 - bits));
+    return ret;
+}
+
+static uint32_t secp256k1_rand_int(uint32_t range) {
+    /* We want a uniform integer between 0 and range-1, inclusive.
+     * B is the smallest number such that range <= 2**B.
+     * two mechanisms implemented here:
+     * - generate B bits numbers until one below range is found, and return it
+     * - find the largest multiple M of range that is <= 2**(B+A), generate B+A
+     *   bits numbers until one below M is found, and return it modulo range
+     * The second mechanism consumes A more bits of entropy in every iteration,
+     * but may need fewer iterations due to M being closer to 2**(B+A) then
+     * range is to 2**B. The array below (indexed by B) contains a 0 when the
+     * first mechanism is to be used, and the number A otherwise.
+     */
+    static const int addbits[] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 1, 0};
+    uint32_t trange, mult;
+    int bits = 0;
+    if (range <= 1) {
+        return 0;
+    }
+    trange = range - 1;
+    while (trange > 0) {
+        trange >>= 1;
+        bits++;
+    }
+    if (addbits[bits]) {
+        bits = bits + addbits[bits];
+        mult = ((~((uint32_t)0)) >> (32 - bits)) / range;
+        trange = range * mult;
+    } else {
+        trange = range;
+        mult = 1;
+    }
+    while(1) {
+        uint32_t x = secp256k1_rand_bits(bits);
+        if (x < trange) {
+            return (mult == 1) ? x : (x % range);
+        }
+    }
+}
+
+static void secp256k1_rand256(unsigned char *b32) {
+    secp256k1_rfc6979_hmac_sha256_generate(&secp256k1_test_rng, b32, 32);
+}
+
+static void secp256k1_rand_bytes_test(unsigned char *bytes, size_t len) {
+    size_t bits = 0;
+    memset(bytes, 0, len);
+    while (bits < len * 8) {
+        int now;
+        uint32_t val;
+        now = 1 + (secp256k1_rand_bits(6) * secp256k1_rand_bits(5) + 16) / 31;
+        val = secp256k1_rand_bits(1);
+        while (now > 0 && bits < len * 8) {
+            bytes[bits / 8] |= val << (bits % 8);
+            now--;
+            bits++;
+        }
+    }
+}
+
+static void secp256k1_rand256_test(unsigned char *b32) {
+    secp256k1_rand_bytes_test(b32, 32);
+}
+
+#endif /* SECP256K1_TESTRAND_IMPL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/src/util.h b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/util.h
new file mode 100644
index 000000000..e0147500f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/src/util.h
@@ -0,0 +1,121 @@
+/**********************************************************************
+ * Copyright (c) 2013, 2014 Pieter Wuille                             *
+ * Distributed under the MIT software license, see the accompanying   *
+ * file COPYING or http://www.opensource.org/licenses/mit-license.php.*
+ **********************************************************************/
+
+#ifndef SECP256K1_UTIL_H
+#define SECP256K1_UTIL_H
+
+#if defined HAVE_CONFIG_H
+#include "libsecp256k1-config.h"
+#endif
+
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdio.h>
+
+typedef struct {
+    void (*fn)(const char *text, void* data);
+    const void* data;
+} secp256k1_callback;
+
+static SECP256K1_INLINE void secp256k1_callback_call(const secp256k1_callback * const cb, const char * const text) {
+    cb->fn(text, (void*)cb->data);
+}
+
+#ifdef DETERMINISTIC
+#define TEST_FAILURE(msg) do { \
+    fprintf(stderr, "%s\n", msg); \
+    abort(); \
+} while(0);
+#else
+#define TEST_FAILURE(msg) do { \
+    fprintf(stderr, "%s:%d: %s\n", __FILE__, __LINE__, msg); \
+    abort(); \
+} while(0)
+#endif
+
+#ifdef HAVE_BUILTIN_EXPECT
+#define EXPECT(x,c) __builtin_expect((x),(c))
+#else
+#define EXPECT(x,c) (x)
+#endif
+
+#ifdef DETERMINISTIC
+#define CHECK(cond) do { \
+    if (EXPECT(!(cond), 0)) { \
+        TEST_FAILURE("test condition failed"); \
+    } \
+} while(0)
+#else
+#define CHECK(cond) do { \
+    if (EXPECT(!(cond), 0)) { \
+        TEST_FAILURE("test condition failed: " #cond); \
+    } \
+} while(0)
+#endif
+
+/* Like assert(), but when VERIFY is defined, and side-effect safe. */
+#if defined(COVERAGE)
+#define VERIFY_CHECK(check)
+#define VERIFY_SETUP(stmt)
+#elif defined(VERIFY)
+#define VERIFY_CHECK CHECK
+#define VERIFY_SETUP(stmt) do { stmt; } while(0)
+#else
+#define VERIFY_CHECK(cond) do { (void)(cond); } while(0)
+#define VERIFY_SETUP(stmt)
+#endif
+
+static SECP256K1_INLINE void *checked_malloc(const secp256k1_callback* cb, size_t size) {
+    void *ret = malloc(size);
+    if (ret == NULL) {
+        secp256k1_callback_call(cb, "Out of memory");
+    }
+    return ret;
+}
+
+static SECP256K1_INLINE void *checked_realloc(const secp256k1_callback* cb, void *ptr, size_t size) {
+    void *ret = realloc(ptr, size);
+    if (ret == NULL) {
+        secp256k1_callback_call(cb, "Out of memory");
+    }
+    return ret;
+}
+
+/* Macro for restrict, when available and not in a VERIFY build. */
+#if defined(SECP256K1_BUILD) && defined(VERIFY)
+# define SECP256K1_RESTRICT
+#else
+# if (!defined(__STDC_VERSION__) || (__STDC_VERSION__ < 199901L) )
+#  if SECP256K1_GNUC_PREREQ(3,0)
+#   define SECP256K1_RESTRICT __restrict__
+#  elif (defined(_MSC_VER) && _MSC_VER >= 1400)
+#   define SECP256K1_RESTRICT __restrict
+#  else
+#   define SECP256K1_RESTRICT
+#  endif
+# else
+#  define SECP256K1_RESTRICT restrict
+# endif
+#endif
+
+#if defined(_WIN32)
+# define I64FORMAT "I64d"
+# define I64uFORMAT "I64u"
+#else
+# define I64FORMAT "lld"
+# define I64uFORMAT "llu"
+#endif
+
+#if defined(HAVE___INT128)
+# if defined(__GNUC__)
+#  define SECP256K1_GNUC_EXT __extension__
+# else
+#  define SECP256K1_GNUC_EXT
+# endif
+SECP256K1_GNUC_EXT typedef unsigned __int128 uint128_t;
+#endif
+
+#endif /* SECP256K1_UTIL_H */
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/test/dune b/vendors/tezos-modded/vendors/ocaml-secp256k1/test/dune
new file mode 100644
index 000000000..125c19b4a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/test/dune
@@ -0,0 +1,11 @@
+(executable
+ (name test)
+ (libraries hex libsecp256k1 alcotest))
+
+(alias
+ (name    runtest-secp256k1)
+ (action  (run %{exe:test.exe})))
+
+(alias
+ (name    runtest)
+ (deps    (alias runtest-secp256k1)))
diff --git a/vendors/tezos-modded/vendors/ocaml-secp256k1/test/test.ml b/vendors/tezos-modded/vendors/ocaml-secp256k1/test/test.ml
new file mode 100644
index 000000000..f95044bd3
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-secp256k1/test/test.ml
@@ -0,0 +1,134 @@
+open Libsecp256k1
+
+module Num = struct
+  open Internal
+  open Num
+  let basic () =
+    let z = zero () in
+    Alcotest.(check bool "Num.is_zero" true (is_zero z))
+
+  let runtest =
+    [ "basic", `Quick, basic ;
+    ]
+end
+
+module Scalar = struct
+  open Internal
+  open Scalar
+  let basic () =
+    let z = zero () in
+    Alcotest.(check bool "Scalar.is_zero" true (is_zero z)) ;
+    (* set_int z 1 ; *)
+    let z = const ~d0:1L () in
+    Alcotest.(check bool "Scalar.is_zero" false (is_zero z)) ;
+    Alcotest.(check bool "Scalar.is_even" false (is_even z)) ;
+    Alcotest.(check bool "Scalar.is_one" true (is_one z))
+
+  let runtest =
+    [ "basic", `Quick, basic ;
+    ]
+end
+
+module External = struct
+  open External
+  let buffer_of_hex s =
+    Cstruct.to_bigarray (Hex.to_cstruct (`Hex s))
+
+  let ctx = Context.create ()
+
+  let cstruct_testable =
+    Alcotest.testable Cstruct.hexdump_pp Cstruct.equal
+
+  let assert_eq_cstruct a b =
+    let a = Cstruct.of_bigarray a in
+    let b = Cstruct.of_bigarray b in
+    assert (Alcotest.equal cstruct_testable a b)
+
+  let test_signature_of_string () =
+    let sign_orig = buffer_of_hex
+        "3044022079BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F817980220294F14E883B3F525B5367756C2A11EF6CF84B730B36C17CB0C56F0AAB2C98589" in
+    let signature = Sign.read_der_exn ctx sign_orig in
+    let sign = Sign.to_bytes ~der:true ctx signature in
+    assert_eq_cstruct sign_orig sign
+
+  let test_valid_signature _ =
+    let msg = buffer_of_hex
+        "CF80CD8AED482D5D1527D7DC72FCEFF84E6326592848447D2DC0B0E87DFC9A90" in
+    let signature = Sign.read_der_exn ctx
+        (buffer_of_hex "3044022079BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F817980220294F14E883B3F525B5367756C2A11EF6CF84B730B36C17CB0C56F0AAB2C98589") in
+    let pk = Key.read_pk_exn ctx
+        (buffer_of_hex "040A629506E1B65CD9D2E0BA9C75DF9C4FED0DB16DC9625ED14397F0AFC836FAE595DC53F8B0EFE61E703075BD9B143BAC75EC0E19F82A2208CAEB32BE53414C40") in
+    assert (Sign.verify_exn ctx ~signature ~pk ~msg)
+
+  let test_invalid_signature _  =
+    let msg = buffer_of_hex
+        "CF80CD8AED482D5D1527D7DC72FCEFF84E6326592848447D2DC0B0E87DFC9A91" in
+    let signature = Sign.read_der_exn ctx
+        (buffer_of_hex "3044022079BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F817980220294F14E883B3F525B5367756C2A11EF6CF84B730B36C17CB0C56F0AAB2C98589") in
+    let pk = Key.read_pk_exn ctx
+        (buffer_of_hex "040a629506e1b65cd9d2e0ba9c75df9c4fed0db16dc9625ed14397f0afc836fae595dc53f8b0efe61e703075bd9b143bac75ec0e19f82a2208caeb32be53414c40") in
+    assert (not (Sign.verify_exn ctx ~signature ~pk ~msg))
+
+  let test_public_module _ =
+    let pubtrue =
+      buffer_of_hex "04c591a8ff19ac9c4e4e5793673b83123437e975285e7b442f4ee2654dffca5e2d2103ed494718c697ac9aebcfd19612e224db46661011863ed2fc54e71861e2a6" in
+    let pub = Key.read_pk_exn ctx pubtrue in
+    let pub_serialized = Key.to_bytes ~compress:false ctx pub in
+    assert_eq_cstruct pubtrue pub_serialized
+
+  let test_pubkey_creation _ =
+    let seckey = buffer_of_hex "67E56582298859DDAE725F972992A07C6C4FB9F62A8FFF58CE3CA926A1063530" in
+    let pubtrue = buffer_of_hex "04c591a8ff19ac9c4e4e5793673b83123437e975285e7b442f4ee2654dffca5e2d2103ed494718c697ac9aebcfd19612e224db46661011863ed2fc54e71861e2a6" in
+    let seckey = Key.read_sk_exn ctx seckey in
+    let pubkey = Key.neuterize_exn ctx seckey in
+    let buf_pk_comp = Cstruct.create 33 in
+    let buf_pk_uncomp = Cstruct.create 65 in
+    let nb_written = Key.write ~compress:true ctx buf_pk_comp.buffer pubkey in
+    assert (nb_written = 33) ;
+    let nb_written = Key.write ~compress:false ctx buf_pk_uncomp.buffer pubkey in
+    assert (nb_written = 65) ;
+    let nb_written = Key.write ~compress:true ctx buf_pk_uncomp.buffer ~pos:32 pubkey in
+    assert (nb_written = 33) ;
+    let pubkey_serialized = Key.to_bytes ~compress:false ctx pubkey in
+    assert_eq_cstruct pubtrue pubkey_serialized
+
+  let test_sign _ =
+    let msg =  buffer_of_hex "CF80CD8AED482D5D1527D7DC72FCEFF84E6326592848447D2DC0B0E87DFC9A90" in
+    let sk = Key.read_sk_exn ctx (buffer_of_hex "67E56582298859DDAE725F972992A07C6C4FB9F62A8FFF58CE3CA926A1063530") in
+    let validsign = Sign.read_der_exn ctx (buffer_of_hex "30440220182a108e1448dc8f1fb467d06a0f3bb8ea0533584cb954ef8da112f1d60e39a202201c66f36da211c087f3af88b50edf4f9bdaa6cf5fd6817e74dca34db12390c6e9") in
+    let sign = Sign.sign_exn ctx ~sk msg in
+    assert (Sign.equal sign validsign)
+
+  let test_recover _ =
+    let msg = buffer_of_hex "CF80CD8AED482D5D1527D7DC72FCEFF84E6326592848447D2DC0B0E87DFC9A90" in
+    let seckey = Key.read_sk_exn ctx (buffer_of_hex "67E56582298859DDAE725F972992A07C6C4FB9F62A8FFF58CE3CA926A1063530") in
+    let pubkey = Key.neuterize_exn ctx seckey in
+    let recoverable_sign = Sign.sign_recoverable_exn ctx ~sk:seckey msg in
+    let usual_sign = Sign.to_plain ctx recoverable_sign in
+    assert (Sign.verify_exn ctx ~pk:pubkey ~signature:usual_sign ~msg);
+    let recoverable_bytes = Sign.to_bytes ctx recoverable_sign in
+    let usual_sign' = Sign.read_exn ctx recoverable_bytes in
+    assert (Sign.equal usual_sign' usual_sign) ;
+    let recoverable_sign' = Sign.read_recoverable_exn ctx recoverable_bytes in
+    assert (Sign.equal recoverable_sign' recoverable_sign);
+    match Sign.recover ctx ~signature:recoverable_sign msg with
+    | Error _ -> assert false
+    | Ok recovered -> assert (Key.equal recovered pubkey)
+
+  let runtest = [
+    "signature_of_string", `Quick, test_signature_of_string ;
+    "valid_signature", `Quick, test_valid_signature ;
+    "invalid_signature", `Quick, test_invalid_signature ;
+    "public_module", `Quick, test_public_module ;
+    "pubkey_creation", `Quick, test_pubkey_creation ;
+    "sign", `Quick, test_sign ;
+    "recover", `Quick, test_recover ;
+  ]
+end
+
+let () =
+  Alcotest.run "secp256k1" [
+    "Num", Num.runtest ;
+    "Scalar", Scalar.runtest ;
+    "External", External.runtest ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/LICENSE.txt b/vendors/tezos-modded/vendors/ocaml-uecc/LICENSE.txt
new file mode 100644
index 000000000..ab099ae5a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/LICENSE.txt
@@ -0,0 +1,21 @@
+Copyright (c) 2014, Kenneth MacKay
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+ * Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/curve-specific.h b/vendors/tezos-modded/vendors/ocaml-uecc/src/curve-specific.h
new file mode 100644
index 000000000..0453b212c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/curve-specific.h
@@ -0,0 +1,1248 @@
+/* Copyright 2015, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#ifndef _UECC_CURVE_SPECIFIC_H_
+#define _UECC_CURVE_SPECIFIC_H_
+
+#define num_bytes_secp160r1 20
+#define num_bytes_secp192r1 24
+#define num_bytes_secp224r1 28
+#define num_bytes_secp256r1 32
+#define num_bytes_secp256k1 32
+
+#if (uECC_WORD_SIZE == 1)
+
+#define num_words_secp160r1 20
+#define num_words_secp192r1 24
+#define num_words_secp224r1 28
+#define num_words_secp256r1 32
+#define num_words_secp256k1 32
+
+#define BYTES_TO_WORDS_8(a, b, c, d, e, f, g, h) \
+    0x##a, 0x##b, 0x##c, 0x##d, 0x##e, 0x##f, 0x##g, 0x##h
+#define BYTES_TO_WORDS_4(a, b, c, d) 0x##a, 0x##b, 0x##c, 0x##d
+
+#elif (uECC_WORD_SIZE == 4)
+
+#define num_words_secp160r1 5
+#define num_words_secp192r1 6
+#define num_words_secp224r1 7
+#define num_words_secp256r1 8
+#define num_words_secp256k1 8
+
+#define BYTES_TO_WORDS_8(a, b, c, d, e, f, g, h) 0x##d##c##b##a, 0x##h##g##f##e
+#define BYTES_TO_WORDS_4(a, b, c, d) 0x##d##c##b##a
+
+#elif (uECC_WORD_SIZE == 8)
+
+#define num_words_secp160r1 3
+#define num_words_secp192r1 3
+#define num_words_secp224r1 4
+#define num_words_secp256r1 4
+#define num_words_secp256k1 4
+
+#define BYTES_TO_WORDS_8(a, b, c, d, e, f, g, h) 0x##h##g##f##e##d##c##b##a##ull
+#define BYTES_TO_WORDS_4(a, b, c, d) 0x##d##c##b##a##ull
+
+#endif /* uECC_WORD_SIZE */
+
+#if uECC_SUPPORTS_secp160r1 || uECC_SUPPORTS_secp192r1 || \
+    uECC_SUPPORTS_secp224r1 || uECC_SUPPORTS_secp256r1
+static void double_jacobian_default(uECC_word_t * X1,
+                                    uECC_word_t * Y1,
+                                    uECC_word_t * Z1,
+                                    uECC_Curve curve) {
+    /* t1 = X, t2 = Y, t3 = Z */
+    uECC_word_t t4[uECC_MAX_WORDS];
+    uECC_word_t t5[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+
+    if (uECC_vli_isZero(Z1, num_words)) {
+        return;
+    }
+
+    uECC_vli_modSquare_fast(t4, Y1, curve);   /* t4 = y1^2 */
+    uECC_vli_modMult_fast(t5, X1, t4, curve); /* t5 = x1*y1^2 = A */
+    uECC_vli_modSquare_fast(t4, t4, curve);   /* t4 = y1^4 */
+    uECC_vli_modMult_fast(Y1, Y1, Z1, curve); /* t2 = y1*z1 = z3 */
+    uECC_vli_modSquare_fast(Z1, Z1, curve);   /* t3 = z1^2 */
+
+    uECC_vli_modAdd(X1, X1, Z1, curve->p, num_words); /* t1 = x1 + z1^2 */
+    uECC_vli_modAdd(Z1, Z1, Z1, curve->p, num_words); /* t3 = 2*z1^2 */
+    uECC_vli_modSub(Z1, X1, Z1, curve->p, num_words); /* t3 = x1 - z1^2 */
+    uECC_vli_modMult_fast(X1, X1, Z1, curve);                /* t1 = x1^2 - z1^4 */
+
+    uECC_vli_modAdd(Z1, X1, X1, curve->p, num_words); /* t3 = 2*(x1^2 - z1^4) */
+    uECC_vli_modAdd(X1, X1, Z1, curve->p, num_words); /* t1 = 3*(x1^2 - z1^4) */
+    if (uECC_vli_testBit(X1, 0)) {
+        uECC_word_t l_carry = uECC_vli_add(X1, X1, curve->p, num_words);
+        uECC_vli_rshift1(X1, num_words);
+        X1[num_words - 1] |= l_carry << (uECC_WORD_BITS - 1);
+    } else {
+        uECC_vli_rshift1(X1, num_words);
+    }
+    /* t1 = 3/2*(x1^2 - z1^4) = B */
+
+    uECC_vli_modSquare_fast(Z1, X1, curve);                  /* t3 = B^2 */
+    uECC_vli_modSub(Z1, Z1, t5, curve->p, num_words); /* t3 = B^2 - A */
+    uECC_vli_modSub(Z1, Z1, t5, curve->p, num_words); /* t3 = B^2 - 2A = x3 */
+    uECC_vli_modSub(t5, t5, Z1, curve->p, num_words); /* t5 = A - x3 */
+    uECC_vli_modMult_fast(X1, X1, t5, curve);                /* t1 = B * (A - x3) */
+    uECC_vli_modSub(t4, X1, t4, curve->p, num_words); /* t4 = B * (A - x3) - y1^4 = y3 */
+
+    uECC_vli_set(X1, Z1, num_words);
+    uECC_vli_set(Z1, Y1, num_words);
+    uECC_vli_set(Y1, t4, num_words);
+}
+
+/* Computes result = x^3 + ax + b. result must not overlap x. */
+static void x_side_default(uECC_word_t *result, const uECC_word_t *x, uECC_Curve curve) {
+    uECC_word_t _3[uECC_MAX_WORDS] = {3}; /* -a = 3 */
+    wordcount_t num_words = curve->num_words;
+
+    uECC_vli_modSquare_fast(result, x, curve);                             /* r = x^2 */
+    uECC_vli_modSub(result, result, _3, curve->p, num_words);       /* r = x^2 - 3 */
+    uECC_vli_modMult_fast(result, result, x, curve);                       /* r = x^3 - 3x */
+    uECC_vli_modAdd(result, result, curve->b, curve->p, num_words); /* r = x^3 - 3x + b */
+}
+#endif /* uECC_SUPPORTS_secp... */
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+#if uECC_SUPPORTS_secp160r1 || uECC_SUPPORTS_secp192r1 || \
+    uECC_SUPPORTS_secp256r1 || uECC_SUPPORTS_secp256k1
+/* Compute a = sqrt(a) (mod curve_p). */
+static void mod_sqrt_default(uECC_word_t *a, uECC_Curve curve) {
+    bitcount_t i;
+    uECC_word_t p1[uECC_MAX_WORDS] = {1};
+    uECC_word_t l_result[uECC_MAX_WORDS] = {1};
+    wordcount_t num_words = curve->num_words;
+    
+    /* When curve->p == 3 (mod 4), we can compute
+       sqrt(a) = a^((curve->p + 1) / 4) (mod curve->p). */
+    uECC_vli_add(p1, curve->p, p1, num_words); /* p1 = curve_p + 1 */
+    for (i = uECC_vli_numBits(p1, num_words) - 1; i > 1; --i) {
+        uECC_vli_modSquare_fast(l_result, l_result, curve);
+        if (uECC_vli_testBit(p1, i)) {
+            uECC_vli_modMult_fast(l_result, l_result, a, curve);
+        }
+    }
+    uECC_vli_set(a, l_result, num_words);
+}
+#endif /* uECC_SUPPORTS_secp... */
+#endif /* uECC_SUPPORT_COMPRESSED_POINT */
+
+#if uECC_SUPPORTS_secp160r1
+
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+static void vli_mmod_fast_secp160r1(uECC_word_t *result, uECC_word_t *product);
+#endif
+
+static const struct uECC_Curve_t curve_secp160r1 = {
+    num_words_secp160r1,
+    num_bytes_secp160r1,
+    161, /* num_n_bits */
+    { BYTES_TO_WORDS_8(FF, FF, FF, 7F, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_4(FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(57, 22, 75, CA, D3, AE, 27, F9),
+        BYTES_TO_WORDS_8(C8, F4, 01, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, 01, 00, 00, 00) },
+    { BYTES_TO_WORDS_8(82, FC, CB, 13, B9, 8B, C3, 68),
+        BYTES_TO_WORDS_8(89, 69, 64, 46, 28, 73, F5, 8E),
+        BYTES_TO_WORDS_4(68, B5, 96, 4A),
+
+        BYTES_TO_WORDS_8(32, FB, C5, 7A, 37, 51, 23, 04),
+        BYTES_TO_WORDS_8(12, C9, DC, 59, 7D, 94, 68, 31),
+        BYTES_TO_WORDS_4(55, 28, A6, 23) },
+    { BYTES_TO_WORDS_8(45, FA, 65, C5, AD, D4, D4, 81),
+        BYTES_TO_WORDS_8(9F, F8, AC, 65, 8B, 7A, BD, 54),
+        BYTES_TO_WORDS_4(FC, BE, 97, 1C) },
+    &double_jacobian_default,
+#if uECC_SUPPORT_COMPRESSED_POINT
+    &mod_sqrt_default,
+#endif
+    &x_side_default,
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    &vli_mmod_fast_secp160r1
+#endif
+};
+
+uECC_Curve uECC_secp160r1(void) { return &curve_secp160r1; }
+
+#if (uECC_OPTIMIZATION_LEVEL > 0 && !asm_mmod_fast_secp160r1)
+/* Computes result = product % curve_p
+    see http://www.isys.uni-klu.ac.at/PDF/2001-0126-MT.pdf page 354
+    
+    Note that this only works if log2(omega) < log2(p) / 2 */
+static void omega_mult_secp160r1(uECC_word_t *result, const uECC_word_t *right);
+#if uECC_WORD_SIZE == 8
+static void vli_mmod_fast_secp160r1(uECC_word_t *result, uECC_word_t *product) {
+    uECC_word_t tmp[2 * num_words_secp160r1];
+    uECC_word_t copy;
+    
+    uECC_vli_clear(tmp, num_words_secp160r1);
+    uECC_vli_clear(tmp + num_words_secp160r1, num_words_secp160r1);
+
+    omega_mult_secp160r1(tmp, product + num_words_secp160r1 - 1); /* (Rq, q) = q * c */
+    
+    product[num_words_secp160r1 - 1] &= 0xffffffff;
+    copy = tmp[num_words_secp160r1 - 1];
+    tmp[num_words_secp160r1 - 1] &= 0xffffffff;
+    uECC_vli_add(result, product, tmp, num_words_secp160r1); /* (C, r) = r + q */
+    uECC_vli_clear(product, num_words_secp160r1);
+    tmp[num_words_secp160r1 - 1] = copy;
+    omega_mult_secp160r1(product, tmp + num_words_secp160r1 - 1); /* Rq*c */
+    uECC_vli_add(result, result, product, num_words_secp160r1); /* (C1, r) = r + Rq*c */
+
+    while (uECC_vli_cmp_unsafe(result, curve_secp160r1.p, num_words_secp160r1) > 0) {
+        uECC_vli_sub(result, result, curve_secp160r1.p, num_words_secp160r1);
+    }
+}
+
+static void omega_mult_secp160r1(uint64_t *result, const uint64_t *right) {
+    uint32_t carry;
+    unsigned i;
+    
+    /* Multiply by (2^31 + 1). */
+    carry = 0;
+    for (i = 0; i < num_words_secp160r1; ++i) {
+        uint64_t tmp = (right[i] >> 32) | (right[i + 1] << 32);
+        result[i] = (tmp << 31) + tmp + carry;
+        carry = (tmp >> 33) + (result[i] < tmp || (carry && result[i] == tmp));
+    }
+    result[i] = carry;
+}
+#else
+static void vli_mmod_fast_secp160r1(uECC_word_t *result, uECC_word_t *product) {
+    uECC_word_t tmp[2 * num_words_secp160r1];
+    uECC_word_t carry;
+    
+    uECC_vli_clear(tmp, num_words_secp160r1);
+    uECC_vli_clear(tmp + num_words_secp160r1, num_words_secp160r1);
+
+    omega_mult_secp160r1(tmp, product + num_words_secp160r1); /* (Rq, q) = q * c */
+    
+    carry = uECC_vli_add(result, product, tmp, num_words_secp160r1); /* (C, r) = r + q */
+    uECC_vli_clear(product, num_words_secp160r1);
+    omega_mult_secp160r1(product, tmp + num_words_secp160r1); /* Rq*c */
+    carry += uECC_vli_add(result, result, product, num_words_secp160r1); /* (C1, r) = r + Rq*c */
+
+    while (carry > 0) {
+        --carry;
+        uECC_vli_sub(result, result, curve_secp160r1.p, num_words_secp160r1);
+    }
+    if (uECC_vli_cmp_unsafe(result, curve_secp160r1.p, num_words_secp160r1) > 0) {
+        uECC_vli_sub(result, result, curve_secp160r1.p, num_words_secp160r1);
+    }
+}
+#endif
+
+#if uECC_WORD_SIZE == 1
+static void omega_mult_secp160r1(uint8_t *result, const uint8_t *right) {
+    uint8_t carry;
+    uint8_t i;
+    
+    /* Multiply by (2^31 + 1). */
+    uECC_vli_set(result + 4, right, num_words_secp160r1); /* 2^32 */
+    uECC_vli_rshift1(result + 4, num_words_secp160r1); /* 2^31 */
+    result[3] = right[0] << 7; /* get last bit from shift */
+    
+    carry = uECC_vli_add(result, result, right, num_words_secp160r1); /* 2^31 + 1 */
+    for (i = num_words_secp160r1; carry; ++i) {
+        uint16_t sum = (uint16_t)result[i] + carry;
+        result[i] = (uint8_t)sum;
+        carry = sum >> 8;
+    }
+}
+#elif uECC_WORD_SIZE == 4
+static void omega_mult_secp160r1(uint32_t *result, const uint32_t *right) {
+    uint32_t carry;
+    unsigned i;
+    
+    /* Multiply by (2^31 + 1). */
+    uECC_vli_set(result + 1, right, num_words_secp160r1); /* 2^32 */
+    uECC_vli_rshift1(result + 1, num_words_secp160r1); /* 2^31 */
+    result[0] = right[0] << 31; /* get last bit from shift */
+    
+    carry = uECC_vli_add(result, result, right, num_words_secp160r1); /* 2^31 + 1 */
+    for (i = num_words_secp160r1; carry; ++i) {
+        uint64_t sum = (uint64_t)result[i] + carry;
+        result[i] = (uint32_t)sum;
+        carry = sum >> 32;
+    }
+}
+#endif /* uECC_WORD_SIZE */
+#endif /* (uECC_OPTIMIZATION_LEVEL > 0 && !asm_mmod_fast_secp160r1) */
+
+#endif /* uECC_SUPPORTS_secp160r1 */
+
+#if uECC_SUPPORTS_secp192r1
+
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+static void vli_mmod_fast_secp192r1(uECC_word_t *result, uECC_word_t *product);
+#endif
+
+static const struct uECC_Curve_t curve_secp192r1 = {
+    num_words_secp192r1,
+    num_bytes_secp192r1,
+    192, /* num_n_bits */
+    { BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FE, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(31, 28, D2, B4, B1, C9, 6B, 14),
+        BYTES_TO_WORDS_8(36, F8, DE, 99, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(12, 10, FF, 82, FD, 0A, FF, F4),
+        BYTES_TO_WORDS_8(00, 88, A1, 43, EB, 20, BF, 7C),
+        BYTES_TO_WORDS_8(F6, 90, 30, B0, 0E, A8, 8D, 18),
+
+        BYTES_TO_WORDS_8(11, 48, 79, 1E, A1, 77, F9, 73),
+        BYTES_TO_WORDS_8(D5, CD, 24, 6B, ED, 11, 10, 63),
+        BYTES_TO_WORDS_8(78, DA, C8, FF, 95, 2B, 19, 07) },
+    { BYTES_TO_WORDS_8(B1, B9, 46, C1, EC, DE, B8, FE),
+        BYTES_TO_WORDS_8(49, 30, 24, 72, AB, E9, A7, 0F),
+        BYTES_TO_WORDS_8(E7, 80, 9C, E5, 19, 05, 21, 64) },
+    &double_jacobian_default,
+#if uECC_SUPPORT_COMPRESSED_POINT
+    &mod_sqrt_default,
+#endif
+    &x_side_default,
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    &vli_mmod_fast_secp192r1
+#endif
+};
+
+uECC_Curve uECC_secp192r1(void) { return &curve_secp192r1; }
+
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+/* Computes result = product % curve_p.
+   See algorithm 5 and 6 from http://www.isys.uni-klu.ac.at/PDF/2001-0126-MT.pdf */
+#if uECC_WORD_SIZE == 1
+static void vli_mmod_fast_secp192r1(uint8_t *result, uint8_t *product) {
+    uint8_t tmp[num_words_secp192r1];
+    uint8_t carry;
+    
+    uECC_vli_set(result, product, num_words_secp192r1);
+    
+    uECC_vli_set(tmp, &product[24], num_words_secp192r1);
+    carry = uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = tmp[1] = tmp[2] = tmp[3] = tmp[4] = tmp[5] = tmp[6] = tmp[7] = 0;
+    tmp[8] = product[24]; tmp[9] = product[25]; tmp[10] = product[26]; tmp[11] = product[27];
+    tmp[12] = product[28]; tmp[13] = product[29]; tmp[14] = product[30]; tmp[15] = product[31];
+    tmp[16] = product[32]; tmp[17] = product[33]; tmp[18] = product[34]; tmp[19] = product[35];
+    tmp[20] = product[36]; tmp[21] = product[37]; tmp[22] = product[38]; tmp[23] = product[39];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = tmp[8] = product[40];
+    tmp[1] = tmp[9] = product[41];
+    tmp[2] = tmp[10] = product[42];
+    tmp[3] = tmp[11] = product[43];
+    tmp[4] = tmp[12] = product[44];
+    tmp[5] = tmp[13] = product[45];
+    tmp[6] = tmp[14] = product[46];
+    tmp[7] = tmp[15] = product[47];
+    tmp[16] = tmp[17] = tmp[18] = tmp[19] = tmp[20] = tmp[21] = tmp[22] = tmp[23] = 0;
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    while (carry || uECC_vli_cmp_unsafe(curve_secp192r1.p, result, num_words_secp192r1) != 1) {
+        carry -= uECC_vli_sub(result, result, curve_secp192r1.p, num_words_secp192r1);
+    }
+}
+#elif uECC_WORD_SIZE == 4
+static void vli_mmod_fast_secp192r1(uint32_t *result, uint32_t *product) {
+    uint32_t tmp[num_words_secp192r1];
+    int carry;
+    
+    uECC_vli_set(result, product, num_words_secp192r1);
+    
+    uECC_vli_set(tmp, &product[6], num_words_secp192r1);
+    carry = uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = tmp[1] = 0;
+    tmp[2] = product[6];
+    tmp[3] = product[7];
+    tmp[4] = product[8];
+    tmp[5] = product[9];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = tmp[2] = product[10];
+    tmp[1] = tmp[3] = product[11];
+    tmp[4] = tmp[5] = 0;
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    while (carry || uECC_vli_cmp_unsafe(curve_secp192r1.p, result, num_words_secp192r1) != 1) {
+        carry -= uECC_vli_sub(result, result, curve_secp192r1.p, num_words_secp192r1);
+    }
+}
+#else
+static void vli_mmod_fast_secp192r1(uint64_t *result, uint64_t *product) {
+    uint64_t tmp[num_words_secp192r1];
+    int carry;
+    
+    uECC_vli_set(result, product, num_words_secp192r1);
+    
+    uECC_vli_set(tmp, &product[3], num_words_secp192r1);
+    carry = (int)uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = 0;
+    tmp[1] = product[3];
+    tmp[2] = product[4];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    tmp[0] = tmp[1] = product[5];
+    tmp[2] = 0;
+    carry += uECC_vli_add(result, result, tmp, num_words_secp192r1);
+    
+    while (carry || uECC_vli_cmp_unsafe(curve_secp192r1.p, result, num_words_secp192r1) != 1) {
+        carry -= uECC_vli_sub(result, result, curve_secp192r1.p, num_words_secp192r1);
+    }
+}
+#endif /* uECC_WORD_SIZE */
+#endif /* (uECC_OPTIMIZATION_LEVEL > 0) */
+
+#endif /* uECC_SUPPORTS_secp192r1 */
+
+#if uECC_SUPPORTS_secp224r1
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+static void mod_sqrt_secp224r1(uECC_word_t *a, uECC_Curve curve);
+#endif
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+static void vli_mmod_fast_secp224r1(uECC_word_t *result, uECC_word_t *product);
+#endif
+
+static const struct uECC_Curve_t curve_secp224r1 = {
+    num_words_secp224r1,
+    num_bytes_secp224r1,
+    224, /* num_n_bits */
+    { BYTES_TO_WORDS_8(01, 00, 00, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_4(FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(3D, 2A, 5C, 5C, 45, 29, DD, 13),
+        BYTES_TO_WORDS_8(3E, F0, B8, E0, A2, 16, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_4(FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(21, 1D, 5C, 11, D6, 80, 32, 34),
+        BYTES_TO_WORDS_8(22, 11, C2, 56, D3, C1, 03, 4A),
+        BYTES_TO_WORDS_8(B9, 90, 13, 32, 7F, BF, B4, 6B),
+        BYTES_TO_WORDS_4(BD, 0C, 0E, B7),
+
+        BYTES_TO_WORDS_8(34, 7E, 00, 85, 99, 81, D5, 44),
+        BYTES_TO_WORDS_8(64, 47, 07, 5A, A0, 75, 43, CD),
+        BYTES_TO_WORDS_8(E6, DF, 22, 4C, FB, 23, F7, B5),
+        BYTES_TO_WORDS_4(88, 63, 37, BD) },
+    { BYTES_TO_WORDS_8(B4, FF, 55, 23, 43, 39, 0B, 27),
+        BYTES_TO_WORDS_8(BA, D8, BF, D7, B7, B0, 44, 50),
+        BYTES_TO_WORDS_8(56, 32, 41, F5, AB, B3, 04, 0C),
+        BYTES_TO_WORDS_4(85, 0A, 05, B4) },
+    &double_jacobian_default,
+#if uECC_SUPPORT_COMPRESSED_POINT
+    &mod_sqrt_secp224r1,
+#endif
+    &x_side_default,
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    &vli_mmod_fast_secp224r1
+#endif
+};
+
+uECC_Curve uECC_secp224r1(void) { return &curve_secp224r1; }
+
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+/* Routine 3.2.4 RS;  from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+static void mod_sqrt_secp224r1_rs(uECC_word_t *d1,
+                                  uECC_word_t *e1,
+                                  uECC_word_t *f1,
+                                  const uECC_word_t *d0,
+                                  const uECC_word_t *e0,
+                                  const uECC_word_t *f0) {
+    uECC_word_t t[num_words_secp224r1];
+
+    uECC_vli_modSquare_fast(t, d0, &curve_secp224r1);                    /* t <-- d0 ^ 2 */
+    uECC_vli_modMult_fast(e1, d0, e0, &curve_secp224r1);                 /* e1 <-- d0 * e0 */
+    uECC_vli_modAdd(d1, t, f0, curve_secp224r1.p, num_words_secp224r1);  /* d1 <-- t  + f0 */
+    uECC_vli_modAdd(e1, e1, e1, curve_secp224r1.p, num_words_secp224r1); /* e1 <-- e1 + e1 */
+    uECC_vli_modMult_fast(f1, t, f0, &curve_secp224r1);                  /* f1 <-- t  * f0 */
+    uECC_vli_modAdd(f1, f1, f1, curve_secp224r1.p, num_words_secp224r1); /* f1 <-- f1 + f1 */
+    uECC_vli_modAdd(f1, f1, f1, curve_secp224r1.p, num_words_secp224r1); /* f1 <-- f1 + f1 */
+}
+
+/* Routine 3.2.5 RSS;  from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+static void mod_sqrt_secp224r1_rss(uECC_word_t *d1,
+                                   uECC_word_t *e1,
+                                   uECC_word_t *f1,
+                                   const uECC_word_t *d0,
+                                   const uECC_word_t *e0,
+                                   const uECC_word_t *f0,
+                                   const bitcount_t j) {
+    bitcount_t i;
+
+    uECC_vli_set(d1, d0, num_words_secp224r1); /* d1 <-- d0 */
+    uECC_vli_set(e1, e0, num_words_secp224r1); /* e1 <-- e0 */
+    uECC_vli_set(f1, f0, num_words_secp224r1); /* f1 <-- f0 */
+    for (i = 1; i <= j; i++) {
+        mod_sqrt_secp224r1_rs(d1, e1, f1, d1, e1, f1); /* RS (d1,e1,f1,d1,e1,f1) */
+    }
+}
+
+/* Routine 3.2.6 RM;  from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+static void mod_sqrt_secp224r1_rm(uECC_word_t *d2,
+                                  uECC_word_t *e2,
+                                  uECC_word_t *f2,
+                                  const uECC_word_t *c,
+                                  const uECC_word_t *d0,
+                                  const uECC_word_t *e0,
+                                  const uECC_word_t *d1,
+                                  const uECC_word_t *e1) {
+    uECC_word_t t1[num_words_secp224r1];
+    uECC_word_t t2[num_words_secp224r1];
+
+    uECC_vli_modMult_fast(t1, e0, e1, &curve_secp224r1); /* t1 <-- e0 * e1 */
+    uECC_vli_modMult_fast(t1, t1, c, &curve_secp224r1);  /* t1 <-- t1 * c */
+    /* t1 <-- p  - t1 */
+    uECC_vli_modSub(t1, curve_secp224r1.p, t1, curve_secp224r1.p, num_words_secp224r1);
+    uECC_vli_modMult_fast(t2, d0, d1, &curve_secp224r1);                 /* t2 <-- d0 * d1 */
+    uECC_vli_modAdd(t2, t2, t1, curve_secp224r1.p, num_words_secp224r1); /* t2 <-- t2 + t1 */
+    uECC_vli_modMult_fast(t1, d0, e1, &curve_secp224r1);                 /* t1 <-- d0 * e1 */
+    uECC_vli_modMult_fast(e2, d1, e0, &curve_secp224r1);                 /* e2 <-- d1 * e0 */
+    uECC_vli_modAdd(e2, e2, t1, curve_secp224r1.p, num_words_secp224r1); /* e2 <-- e2 + t1 */
+    uECC_vli_modSquare_fast(f2, e2, &curve_secp224r1);                   /* f2 <-- e2^2 */
+    uECC_vli_modMult_fast(f2, f2, c, &curve_secp224r1);                  /* f2 <-- f2 * c */
+    /* f2 <-- p  - f2 */
+    uECC_vli_modSub(f2, curve_secp224r1.p, f2, curve_secp224r1.p, num_words_secp224r1);
+    uECC_vli_set(d2, t2, num_words_secp224r1); /* d2 <-- t2 */
+}
+
+/* Routine 3.2.7 RP;  from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+static void mod_sqrt_secp224r1_rp(uECC_word_t *d1,
+                                  uECC_word_t *e1,
+                                  uECC_word_t *f1,
+                                  const uECC_word_t *c,
+                                  const uECC_word_t *r) {
+    wordcount_t i;
+    wordcount_t pow2i = 1;
+    uECC_word_t d0[num_words_secp224r1];
+    uECC_word_t e0[num_words_secp224r1] = {1}; /* e0 <-- 1 */
+    uECC_word_t f0[num_words_secp224r1];
+
+    uECC_vli_set(d0, r, num_words_secp224r1); /* d0 <-- r */
+    /* f0 <-- p  - c */
+    uECC_vli_modSub(f0, curve_secp224r1.p, c, curve_secp224r1.p, num_words_secp224r1);
+    for (i = 0; i <= 6; i++) {
+        mod_sqrt_secp224r1_rss(d1, e1, f1, d0, e0, f0, pow2i); /* RSS (d1,e1,f1,d0,e0,f0,2^i) */
+        mod_sqrt_secp224r1_rm(d1, e1, f1, c, d1, e1, d0, e0);  /* RM (d1,e1,f1,c,d1,e1,d0,e0) */
+        uECC_vli_set(d0, d1, num_words_secp224r1); /* d0 <-- d1 */
+        uECC_vli_set(e0, e1, num_words_secp224r1); /* e0 <-- e1 */
+        uECC_vli_set(f0, f1, num_words_secp224r1); /* f0 <-- f1 */
+        pow2i *= 2;
+    }
+}
+
+/* Compute a = sqrt(a) (mod curve_p). */
+/* Routine 3.2.8 mp_mod_sqrt_224; from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+static void mod_sqrt_secp224r1(uECC_word_t *a, uECC_Curve curve) {
+    bitcount_t i;
+    uECC_word_t e1[num_words_secp224r1];
+    uECC_word_t f1[num_words_secp224r1];
+    uECC_word_t d0[num_words_secp224r1];
+    uECC_word_t e0[num_words_secp224r1];
+    uECC_word_t f0[num_words_secp224r1];
+    uECC_word_t d1[num_words_secp224r1];
+
+    /* s = a; using constant instead of random value */
+    mod_sqrt_secp224r1_rp(d0, e0, f0, a, a);           /* RP (d0, e0, f0, c, s) */
+    mod_sqrt_secp224r1_rs(d1, e1, f1, d0, e0, f0);     /* RS (d1, e1, f1, d0, e0, f0) */
+    for (i = 1; i <= 95; i++) {
+        uECC_vli_set(d0, d1, num_words_secp224r1);          /* d0 <-- d1 */
+        uECC_vli_set(e0, e1, num_words_secp224r1);          /* e0 <-- e1 */
+        uECC_vli_set(f0, f1, num_words_secp224r1);          /* f0 <-- f1 */
+        mod_sqrt_secp224r1_rs(d1, e1, f1, d0, e0, f0); /* RS (d1, e1, f1, d0, e0, f0) */
+        if (uECC_vli_isZero(d1, num_words_secp224r1)) {     /* if d1 == 0 */
+                break;
+        }
+    }
+    uECC_vli_modInv(f1, e0, curve_secp224r1.p, num_words_secp224r1); /* f1 <-- 1 / e0 */
+    uECC_vli_modMult_fast(a, d0, f1, &curve_secp224r1);              /* a  <-- d0 / e0 */
+}
+#endif /* uECC_SUPPORT_COMPRESSED_POINT */
+
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+/* Computes result = product % curve_p
+   from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+#if uECC_WORD_SIZE == 1
+static void vli_mmod_fast_secp224r1(uint8_t *result, uint8_t *product) {
+    uint8_t tmp[num_words_secp224r1];
+    int8_t carry;
+
+    /* t */
+    uECC_vli_set(result, product, num_words_secp224r1);
+
+    /* s1 */
+    tmp[0] = tmp[1] = tmp[2] = tmp[3] = 0;
+    tmp[4] = tmp[5] = tmp[6] = tmp[7] = 0;
+    tmp[8] = tmp[9] = tmp[10] = tmp[11] = 0;
+    tmp[12] = product[28]; tmp[13] = product[29]; tmp[14] = product[30]; tmp[15] = product[31];
+    tmp[16] = product[32]; tmp[17] = product[33]; tmp[18] = product[34]; tmp[19] = product[35];
+    tmp[20] = product[36]; tmp[21] = product[37]; tmp[22] = product[38]; tmp[23] = product[39];
+    tmp[24] = product[40]; tmp[25] = product[41]; tmp[26] = product[42]; tmp[27] = product[43];
+    carry = uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* s2 */
+    tmp[12] = product[44]; tmp[13] = product[45]; tmp[14] = product[46]; tmp[15] = product[47];
+    tmp[16] = product[48]; tmp[17] = product[49]; tmp[18] = product[50]; tmp[19] = product[51];
+    tmp[20] = product[52]; tmp[21] = product[53]; tmp[22] = product[54]; tmp[23] = product[55];
+    tmp[24] = tmp[25] = tmp[26] = tmp[27] = 0;
+    carry += uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* d1 */
+    tmp[0]  = product[28]; tmp[1]  = product[29]; tmp[2]  = product[30]; tmp[3]  = product[31];
+    tmp[4]  = product[32]; tmp[5]  = product[33]; tmp[6]  = product[34]; tmp[7]  = product[35];
+    tmp[8]  = product[36]; tmp[9]  = product[37]; tmp[10] = product[38]; tmp[11] = product[39];
+    tmp[12] = product[40]; tmp[13] = product[41]; tmp[14] = product[42]; tmp[15] = product[43];
+    tmp[16] = product[44]; tmp[17] = product[45]; tmp[18] = product[46]; tmp[19] = product[47];
+    tmp[20] = product[48]; tmp[21] = product[49]; tmp[22] = product[50]; tmp[23] = product[51];
+    tmp[24] = product[52]; tmp[25] = product[53]; tmp[26] = product[54]; tmp[27] = product[55];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    /* d2 */
+    tmp[0]  = product[44]; tmp[1]  = product[45]; tmp[2]  = product[46]; tmp[3]  = product[47];
+    tmp[4]  = product[48]; tmp[5]  = product[49]; tmp[6]  = product[50]; tmp[7]  = product[51];
+    tmp[8]  = product[52]; tmp[9]  = product[53]; tmp[10] = product[54]; tmp[11] = product[55];
+    tmp[12] = tmp[13] = tmp[14] = tmp[15] = 0;
+    tmp[16] = tmp[17] = tmp[18] = tmp[19] = 0;
+    tmp[20] = tmp[21] = tmp[22] = tmp[23] = 0;
+    tmp[24] = tmp[25] = tmp[26] = tmp[27] = 0;
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp224r1.p, num_words_secp224r1);
+        } while (carry < 0);
+    } else {
+        while (carry || uECC_vli_cmp_unsafe(curve_secp224r1.p, result, num_words_secp224r1) != 1) {
+            carry -= uECC_vli_sub(result, result, curve_secp224r1.p, num_words_secp224r1);
+        }
+    }
+}
+#elif uECC_WORD_SIZE == 4
+static void vli_mmod_fast_secp224r1(uint32_t *result, uint32_t *product)
+{
+    uint32_t tmp[num_words_secp224r1];
+    int carry;
+
+    /* t */
+    uECC_vli_set(result, product, num_words_secp224r1);
+
+    /* s1 */
+    tmp[0] = tmp[1] = tmp[2] = 0;
+    tmp[3] = product[7];
+    tmp[4] = product[8];
+    tmp[5] = product[9];
+    tmp[6] = product[10];
+    carry = uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* s2 */
+    tmp[3] = product[11];
+    tmp[4] = product[12];
+    tmp[5] = product[13];
+    tmp[6] = 0;
+    carry += uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* d1 */
+    tmp[0] = product[7];
+    tmp[1] = product[8];
+    tmp[2] = product[9];
+    tmp[3] = product[10];
+    tmp[4] = product[11];
+    tmp[5] = product[12];
+    tmp[6] = product[13];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    /* d2 */
+    tmp[0] = product[11];
+    tmp[1] = product[12];
+    tmp[2] = product[13];
+    tmp[3] = tmp[4] = tmp[5] = tmp[6] = 0;
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp224r1.p, num_words_secp224r1);
+        } while (carry < 0);
+    } else {
+        while (carry || uECC_vli_cmp_unsafe(curve_secp224r1.p, result, num_words_secp224r1) != 1) {
+            carry -= uECC_vli_sub(result, result, curve_secp224r1.p, num_words_secp224r1);
+        }
+    }
+}
+#else
+static void vli_mmod_fast_secp224r1(uint64_t *result, uint64_t *product)
+{
+    uint64_t tmp[num_words_secp224r1];
+    int carry = 0;
+
+    /* t */
+    uECC_vli_set(result, product, num_words_secp224r1);
+    result[num_words_secp224r1 - 1] &= 0xffffffff;
+
+    /* s1 */
+    tmp[0] = 0;
+    tmp[1] = product[3] & 0xffffffff00000000ull;
+    tmp[2] = product[4];
+    tmp[3] = product[5] & 0xffffffff;
+    uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* s2 */
+    tmp[1] = product[5] & 0xffffffff00000000ull;
+    tmp[2] = product[6];
+    tmp[3] = 0;
+    uECC_vli_add(result, result, tmp, num_words_secp224r1);
+
+    /* d1 */
+    tmp[0] = (product[3] >> 32) | (product[4] << 32);
+    tmp[1] = (product[4] >> 32) | (product[5] << 32);
+    tmp[2] = (product[5] >> 32) | (product[6] << 32);
+    tmp[3] = product[6] >> 32;
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    /* d2 */
+    tmp[0] = (product[5] >> 32) | (product[6] << 32);
+    tmp[1] = product[6] >> 32;
+    tmp[2] = tmp[3] = 0;
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp224r1);
+
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp224r1.p, num_words_secp224r1);
+        } while (carry < 0);
+    } else {
+        while (uECC_vli_cmp_unsafe(curve_secp224r1.p, result, num_words_secp224r1) != 1) {
+            uECC_vli_sub(result, result, curve_secp224r1.p, num_words_secp224r1);
+        }
+    }
+}
+#endif /* uECC_WORD_SIZE */
+#endif /* (uECC_OPTIMIZATION_LEVEL > 0) */
+
+#endif /* uECC_SUPPORTS_secp224r1 */
+
+#if uECC_SUPPORTS_secp256r1
+
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+static void vli_mmod_fast_secp256r1(uECC_word_t *result, uECC_word_t *product);
+#endif
+
+static const struct uECC_Curve_t curve_secp256r1 = {
+    num_words_secp256r1,
+    num_bytes_secp256r1,
+    256, /* num_n_bits */
+    { BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(01, 00, 00, 00, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(51, 25, 63, FC, C2, CA, B9, F3),
+        BYTES_TO_WORDS_8(84, 9E, 17, A7, AD, FA, E6, BC),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(96, C2, 98, D8, 45, 39, A1, F4),
+        BYTES_TO_WORDS_8(A0, 33, EB, 2D, 81, 7D, 03, 77),
+        BYTES_TO_WORDS_8(F2, 40, A4, 63, E5, E6, BC, F8),
+        BYTES_TO_WORDS_8(47, 42, 2C, E1, F2, D1, 17, 6B),
+
+        BYTES_TO_WORDS_8(F5, 51, BF, 37, 68, 40, B6, CB),
+        BYTES_TO_WORDS_8(CE, 5E, 31, 6B, 57, 33, CE, 2B),
+        BYTES_TO_WORDS_8(16, 9E, 0F, 7C, 4A, EB, E7, 8E),
+        BYTES_TO_WORDS_8(9B, 7F, 1A, FE, E2, 42, E3, 4F) },
+    { BYTES_TO_WORDS_8(4B, 60, D2, 27, 3E, 3C, CE, 3B),
+        BYTES_TO_WORDS_8(F6, B0, 53, CC, B0, 06, 1D, 65),
+        BYTES_TO_WORDS_8(BC, 86, 98, 76, 55, BD, EB, B3),
+        BYTES_TO_WORDS_8(E7, 93, 3A, AA, D8, 35, C6, 5A) },
+    &double_jacobian_default,
+#if uECC_SUPPORT_COMPRESSED_POINT
+    &mod_sqrt_default,
+#endif
+    &x_side_default,
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    &vli_mmod_fast_secp256r1
+#endif
+};
+
+uECC_Curve uECC_secp256r1(void) { return &curve_secp256r1; }
+
+
+#if (uECC_OPTIMIZATION_LEVEL > 0 && !asm_mmod_fast_secp256r1)
+/* Computes result = product % curve_p
+   from http://www.nsa.gov/ia/_files/nist-routines.pdf */
+#if uECC_WORD_SIZE == 1
+static void vli_mmod_fast_secp256r1(uint8_t *result, uint8_t *product) {
+    uint8_t tmp[num_words_secp256r1];
+    int8_t carry;
+    
+    /* t */
+    uECC_vli_set(result, product, num_words_secp256r1);
+    
+    /* s1 */
+    tmp[0] = tmp[1] = tmp[2] = tmp[3] = 0;
+    tmp[4] = tmp[5] = tmp[6] = tmp[7] = 0;
+    tmp[8] = tmp[9] = tmp[10] = tmp[11] = 0;
+    tmp[12] = product[44]; tmp[13] = product[45]; tmp[14] = product[46]; tmp[15] = product[47];
+    tmp[16] = product[48]; tmp[17] = product[49]; tmp[18] = product[50]; tmp[19] = product[51];
+    tmp[20] = product[52]; tmp[21] = product[53]; tmp[22] = product[54]; tmp[23] = product[55];
+    tmp[24] = product[56]; tmp[25] = product[57]; tmp[26] = product[58]; tmp[27] = product[59];
+    tmp[28] = product[60]; tmp[29] = product[61]; tmp[30] = product[62]; tmp[31] = product[63];
+    carry = uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s2 */
+    tmp[12] = product[48]; tmp[13] = product[49]; tmp[14] = product[50]; tmp[15] = product[51];
+    tmp[16] = product[52]; tmp[17] = product[53]; tmp[18] = product[54]; tmp[19] = product[55];
+    tmp[20] = product[56]; tmp[21] = product[57]; tmp[22] = product[58]; tmp[23] = product[59];
+    tmp[24] = product[60]; tmp[25] = product[61]; tmp[26] = product[62]; tmp[27] = product[63];
+    tmp[28] = tmp[29] = tmp[30] = tmp[31] = 0;
+    carry += uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s3 */
+    tmp[0] = product[32]; tmp[1] = product[33]; tmp[2] = product[34]; tmp[3] = product[35];
+    tmp[4] = product[36]; tmp[5] = product[37]; tmp[6] = product[38]; tmp[7] = product[39];
+    tmp[8] = product[40]; tmp[9] = product[41]; tmp[10] = product[42]; tmp[11] = product[43];
+    tmp[12] = tmp[13] = tmp[14] = tmp[15] = 0;
+    tmp[16] = tmp[17] = tmp[18] = tmp[19] = 0;
+    tmp[20] = tmp[21] = tmp[22] = tmp[23] = 0;
+    tmp[24] = product[56]; tmp[25] = product[57]; tmp[26] = product[58]; tmp[27] = product[59];
+    tmp[28] = product[60]; tmp[29] = product[61]; tmp[30] = product[62]; tmp[31] = product[63];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s4 */
+    tmp[0] = product[36]; tmp[1] = product[37]; tmp[2] = product[38]; tmp[3] = product[39];
+    tmp[4] = product[40]; tmp[5] = product[41]; tmp[6] = product[42]; tmp[7] = product[43];
+    tmp[8] = product[44]; tmp[9] = product[45]; tmp[10] = product[46]; tmp[11] = product[47];
+    tmp[12] = product[52]; tmp[13] = product[53]; tmp[14] = product[54]; tmp[15] = product[55];
+    tmp[16] = product[56]; tmp[17] = product[57]; tmp[18] = product[58]; tmp[19] = product[59];
+    tmp[20] = product[60]; tmp[21] = product[61]; tmp[22] = product[62]; tmp[23] = product[63];
+    tmp[24] = product[52]; tmp[25] = product[53]; tmp[26] = product[54]; tmp[27] = product[55];
+    tmp[28] = product[32]; tmp[29] = product[33]; tmp[30] = product[34]; tmp[31] = product[35];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* d1 */
+    tmp[0] = product[44]; tmp[1] = product[45]; tmp[2] = product[46]; tmp[3] = product[47];
+    tmp[4] = product[48]; tmp[5] = product[49]; tmp[6] = product[50]; tmp[7] = product[51];
+    tmp[8] = product[52]; tmp[9] = product[53]; tmp[10] = product[54]; tmp[11] = product[55];
+    tmp[12] = tmp[13] = tmp[14] = tmp[15] = 0;
+    tmp[16] = tmp[17] = tmp[18] = tmp[19] = 0;
+    tmp[20] = tmp[21] = tmp[22] = tmp[23] = 0;
+    tmp[24] = product[32]; tmp[25] = product[33]; tmp[26] = product[34]; tmp[27] = product[35];
+    tmp[28] = product[40]; tmp[29] = product[41]; tmp[30] = product[42]; tmp[31] = product[43];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d2 */
+    tmp[0] = product[48]; tmp[1] = product[49]; tmp[2] = product[50]; tmp[3] = product[51];
+    tmp[4] = product[52]; tmp[5] = product[53]; tmp[6] = product[54]; tmp[7] = product[55];
+    tmp[8] = product[56]; tmp[9] = product[57]; tmp[10] = product[58]; tmp[11] = product[59];
+    tmp[12] = product[60]; tmp[13] = product[61]; tmp[14] = product[62]; tmp[15] = product[63];
+    tmp[16] = tmp[17] = tmp[18] = tmp[19] = 0;
+    tmp[20] = tmp[21] = tmp[22] = tmp[23] = 0;
+    tmp[24] = product[36]; tmp[25] = product[37]; tmp[26] = product[38]; tmp[27] = product[39];
+    tmp[28] = product[44]; tmp[29] = product[45]; tmp[30] = product[46]; tmp[31] = product[47];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d3 */
+    tmp[0] = product[52]; tmp[1] = product[53]; tmp[2] = product[54]; tmp[3] = product[55];
+    tmp[4] = product[56]; tmp[5] = product[57]; tmp[6] = product[58]; tmp[7] = product[59];
+    tmp[8] = product[60]; tmp[9] = product[61]; tmp[10] = product[62]; tmp[11] = product[63];
+    tmp[12] = product[32]; tmp[13] = product[33]; tmp[14] = product[34]; tmp[15] = product[35];
+    tmp[16] = product[36]; tmp[17] = product[37]; tmp[18] = product[38]; tmp[19] = product[39];
+    tmp[20] = product[40]; tmp[21] = product[41]; tmp[22] = product[42]; tmp[23] = product[43];
+    tmp[24] = tmp[25] = tmp[26] = tmp[27] = 0;
+    tmp[28] = product[48]; tmp[29] = product[49]; tmp[30] = product[50]; tmp[31] = product[51];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d4 */
+    tmp[0] = product[56]; tmp[1] = product[57]; tmp[2] = product[58]; tmp[3] = product[59];
+    tmp[4] = product[60]; tmp[5] = product[61]; tmp[6] = product[62]; tmp[7] = product[63];
+    tmp[8] = tmp[9] = tmp[10] = tmp[11] = 0;
+    tmp[12] = product[36]; tmp[13] = product[37]; tmp[14] = product[38]; tmp[15] = product[39];
+    tmp[16] = product[40]; tmp[17] = product[41]; tmp[18] = product[42]; tmp[19] = product[43];
+    tmp[20] = product[44]; tmp[21] = product[45]; tmp[22] = product[46]; tmp[23] = product[47];
+    tmp[24] = tmp[25] = tmp[26] = tmp[27] = 0;
+    tmp[28] = product[52]; tmp[29] = product[53]; tmp[30] = product[54]; tmp[31] = product[55];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp256r1.p, num_words_secp256r1);
+        } while (carry < 0);
+    } else {
+        while (carry || uECC_vli_cmp_unsafe(curve_secp256r1.p, result, num_words_secp256r1) != 1) {
+            carry -= uECC_vli_sub(result, result, curve_secp256r1.p, num_words_secp256r1);
+        }
+    }
+}
+#elif uECC_WORD_SIZE == 4
+static void vli_mmod_fast_secp256r1(uint32_t *result, uint32_t *product) {
+    uint32_t tmp[num_words_secp256r1];
+    int carry;
+    
+    /* t */
+    uECC_vli_set(result, product, num_words_secp256r1);
+    
+    /* s1 */
+    tmp[0] = tmp[1] = tmp[2] = 0;
+    tmp[3] = product[11];
+    tmp[4] = product[12];
+    tmp[5] = product[13];
+    tmp[6] = product[14];
+    tmp[7] = product[15];
+    carry = uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s2 */
+    tmp[3] = product[12];
+    tmp[4] = product[13];
+    tmp[5] = product[14];
+    tmp[6] = product[15];
+    tmp[7] = 0;
+    carry += uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s3 */
+    tmp[0] = product[8];
+    tmp[1] = product[9];
+    tmp[2] = product[10];
+    tmp[3] = tmp[4] = tmp[5] = 0;
+    tmp[6] = product[14];
+    tmp[7] = product[15];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s4 */
+    tmp[0] = product[9];
+    tmp[1] = product[10];
+    tmp[2] = product[11];
+    tmp[3] = product[13];
+    tmp[4] = product[14];
+    tmp[5] = product[15];
+    tmp[6] = product[13];
+    tmp[7] = product[8];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* d1 */
+    tmp[0] = product[11];
+    tmp[1] = product[12];
+    tmp[2] = product[13];
+    tmp[3] = tmp[4] = tmp[5] = 0;
+    tmp[6] = product[8];
+    tmp[7] = product[10];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d2 */
+    tmp[0] = product[12];
+    tmp[1] = product[13];
+    tmp[2] = product[14];
+    tmp[3] = product[15];
+    tmp[4] = tmp[5] = 0;
+    tmp[6] = product[9];
+    tmp[7] = product[11];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d3 */
+    tmp[0] = product[13];
+    tmp[1] = product[14];
+    tmp[2] = product[15];
+    tmp[3] = product[8];
+    tmp[4] = product[9];
+    tmp[5] = product[10];
+    tmp[6] = 0;
+    tmp[7] = product[12];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d4 */
+    tmp[0] = product[14];
+    tmp[1] = product[15];
+    tmp[2] = 0;
+    tmp[3] = product[9];
+    tmp[4] = product[10];
+    tmp[5] = product[11];
+    tmp[6] = 0;
+    tmp[7] = product[13];
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp256r1.p, num_words_secp256r1);
+        } while (carry < 0);
+    } else {
+        while (carry || uECC_vli_cmp_unsafe(curve_secp256r1.p, result, num_words_secp256r1) != 1) {
+            carry -= uECC_vli_sub(result, result, curve_secp256r1.p, num_words_secp256r1);
+        }
+    }
+}
+#else
+static void vli_mmod_fast_secp256r1(uint64_t *result, uint64_t *product) {
+    uint64_t tmp[num_words_secp256r1];
+    int carry;
+    
+    /* t */
+    uECC_vli_set(result, product, num_words_secp256r1);
+    
+    /* s1 */
+    tmp[0] = 0;
+    tmp[1] = product[5] & 0xffffffff00000000ull;
+    tmp[2] = product[6];
+    tmp[3] = product[7];
+    carry = (int)uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s2 */
+    tmp[1] = product[6] << 32;
+    tmp[2] = (product[6] >> 32) | (product[7] << 32);
+    tmp[3] = product[7] >> 32;
+    carry += uECC_vli_add(tmp, tmp, tmp, num_words_secp256r1);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s3 */
+    tmp[0] = product[4];
+    tmp[1] = product[5] & 0xffffffff;
+    tmp[2] = 0;
+    tmp[3] = product[7];
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* s4 */
+    tmp[0] = (product[4] >> 32) | (product[5] << 32);
+    tmp[1] = (product[5] >> 32) | (product[6] & 0xffffffff00000000ull);
+    tmp[2] = product[7];
+    tmp[3] = (product[6] >> 32) | (product[4] << 32);
+    carry += uECC_vli_add(result, result, tmp, num_words_secp256r1);
+    
+    /* d1 */
+    tmp[0] = (product[5] >> 32) | (product[6] << 32);
+    tmp[1] = (product[6] >> 32);
+    tmp[2] = 0;
+    tmp[3] = (product[4] & 0xffffffff) | (product[5] << 32);
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d2 */
+    tmp[0] = product[6];
+    tmp[1] = product[7];
+    tmp[2] = 0;
+    tmp[3] = (product[4] >> 32) | (product[5] & 0xffffffff00000000ull);
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d3 */
+    tmp[0] = (product[6] >> 32) | (product[7] << 32);
+    tmp[1] = (product[7] >> 32) | (product[4] << 32);
+    tmp[2] = (product[4] >> 32) | (product[5] << 32);
+    tmp[3] = (product[6] << 32);
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    /* d4 */
+    tmp[0] = product[7];
+    tmp[1] = product[4] & 0xffffffff00000000ull;
+    tmp[2] = product[5];
+    tmp[3] = product[6] & 0xffffffff00000000ull;
+    carry -= uECC_vli_sub(result, result, tmp, num_words_secp256r1);
+    
+    if (carry < 0) {
+        do {
+            carry += uECC_vli_add(result, result, curve_secp256r1.p, num_words_secp256r1);
+        } while (carry < 0);
+    } else {
+        while (carry || uECC_vli_cmp_unsafe(curve_secp256r1.p, result, num_words_secp256r1) != 1) {
+            carry -= uECC_vli_sub(result, result, curve_secp256r1.p, num_words_secp256r1);
+        }
+    }
+}
+#endif /* uECC_WORD_SIZE */
+#endif /* (uECC_OPTIMIZATION_LEVEL > 0 && !asm_mmod_fast_secp256r1) */
+
+#endif /* uECC_SUPPORTS_secp256r1 */
+
+#if uECC_SUPPORTS_secp256k1
+
+static void double_jacobian_secp256k1(uECC_word_t * X1,
+                                      uECC_word_t * Y1,
+                                      uECC_word_t * Z1,
+                                      uECC_Curve curve);
+static void x_side_secp256k1(uECC_word_t *result, const uECC_word_t *x, uECC_Curve curve);
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+static void vli_mmod_fast_secp256k1(uECC_word_t *result, uECC_word_t *product);
+#endif
+
+static const struct uECC_Curve_t curve_secp256k1 = {
+    num_words_secp256k1,
+    num_bytes_secp256k1,
+    256, /* num_n_bits */
+    { BYTES_TO_WORDS_8(2F, FC, FF, FF, FE, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(41, 41, 36, D0, 8C, 5E, D2, BF),
+        BYTES_TO_WORDS_8(3B, A0, 48, AF, E6, DC, AE, BA),
+        BYTES_TO_WORDS_8(FE, FF, FF, FF, FF, FF, FF, FF),
+        BYTES_TO_WORDS_8(FF, FF, FF, FF, FF, FF, FF, FF) },
+    { BYTES_TO_WORDS_8(98, 17, F8, 16, 5B, 81, F2, 59),
+        BYTES_TO_WORDS_8(D9, 28, CE, 2D, DB, FC, 9B, 02),
+        BYTES_TO_WORDS_8(07, 0B, 87, CE, 95, 62, A0, 55),
+        BYTES_TO_WORDS_8(AC, BB, DC, F9, 7E, 66, BE, 79),
+
+        BYTES_TO_WORDS_8(B8, D4, 10, FB, 8F, D0, 47, 9C),
+        BYTES_TO_WORDS_8(19, 54, 85, A6, 48, B4, 17, FD),
+        BYTES_TO_WORDS_8(A8, 08, 11, 0E, FC, FB, A4, 5D),
+        BYTES_TO_WORDS_8(65, C4, A3, 26, 77, DA, 3A, 48) },
+    { BYTES_TO_WORDS_8(07, 00, 00, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, 00, 00, 00, 00),
+        BYTES_TO_WORDS_8(00, 00, 00, 00, 00, 00, 00, 00) },
+    &double_jacobian_secp256k1,
+#if uECC_SUPPORT_COMPRESSED_POINT
+    &mod_sqrt_default,
+#endif
+    &x_side_secp256k1,
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    &vli_mmod_fast_secp256k1
+#endif
+};
+
+uECC_Curve uECC_secp256k1(void) { return &curve_secp256k1; }
+
+
+/* Double in place */
+static void double_jacobian_secp256k1(uECC_word_t * X1,
+                                      uECC_word_t * Y1,
+                                      uECC_word_t * Z1,
+                                      uECC_Curve curve) {
+    /* t1 = X, t2 = Y, t3 = Z */
+    uECC_word_t t4[num_words_secp256k1];
+    uECC_word_t t5[num_words_secp256k1];
+    
+    if (uECC_vli_isZero(Z1, num_words_secp256k1)) {
+        return;
+    }
+    
+    uECC_vli_modSquare_fast(t5, Y1, curve);   /* t5 = y1^2 */
+    uECC_vli_modMult_fast(t4, X1, t5, curve); /* t4 = x1*y1^2 = A */
+    uECC_vli_modSquare_fast(X1, X1, curve);   /* t1 = x1^2 */
+    uECC_vli_modSquare_fast(t5, t5, curve);   /* t5 = y1^4 */
+    uECC_vli_modMult_fast(Z1, Y1, Z1, curve); /* t3 = y1*z1 = z3 */
+    
+    uECC_vli_modAdd(Y1, X1, X1, curve->p, num_words_secp256k1); /* t2 = 2*x1^2 */
+    uECC_vli_modAdd(Y1, Y1, X1, curve->p, num_words_secp256k1); /* t2 = 3*x1^2 */
+    if (uECC_vli_testBit(Y1, 0)) {
+        uECC_word_t carry = uECC_vli_add(Y1, Y1, curve->p, num_words_secp256k1);
+        uECC_vli_rshift1(Y1, num_words_secp256k1);
+        Y1[num_words_secp256k1 - 1] |= carry << (uECC_WORD_BITS - 1);
+    } else {
+        uECC_vli_rshift1(Y1, num_words_secp256k1);
+    }
+    /* t2 = 3/2*(x1^2) = B */
+    
+    uECC_vli_modSquare_fast(X1, Y1, curve);                     /* t1 = B^2 */
+    uECC_vli_modSub(X1, X1, t4, curve->p, num_words_secp256k1); /* t1 = B^2 - A */
+    uECC_vli_modSub(X1, X1, t4, curve->p, num_words_secp256k1); /* t1 = B^2 - 2A = x3 */
+    
+    uECC_vli_modSub(t4, t4, X1, curve->p, num_words_secp256k1); /* t4 = A - x3 */
+    uECC_vli_modMult_fast(Y1, Y1, t4, curve);                   /* t2 = B * (A - x3) */
+    uECC_vli_modSub(Y1, Y1, t5, curve->p, num_words_secp256k1); /* t2 = B * (A - x3) - y1^4 = y3 */
+}
+
+/* Computes result = x^3 + b. result must not overlap x. */
+static void x_side_secp256k1(uECC_word_t *result, const uECC_word_t *x, uECC_Curve curve) {
+    uECC_vli_modSquare_fast(result, x, curve);                                /* r = x^2 */
+    uECC_vli_modMult_fast(result, result, x, curve);                          /* r = x^3 */
+    uECC_vli_modAdd(result, result, curve->b, curve->p, num_words_secp256k1); /* r = x^3 + b */
+}
+
+#if (uECC_OPTIMIZATION_LEVEL > 0 && !asm_mmod_fast_secp256k1)
+static void omega_mult_secp256k1(uECC_word_t *result, const uECC_word_t *right);
+static void vli_mmod_fast_secp256k1(uECC_word_t *result, uECC_word_t *product) {
+    uECC_word_t tmp[2 * num_words_secp256k1];
+    uECC_word_t carry;
+    
+    uECC_vli_clear(tmp, num_words_secp256k1);
+    uECC_vli_clear(tmp + num_words_secp256k1, num_words_secp256k1);
+    
+    omega_mult_secp256k1(tmp, product + num_words_secp256k1); /* (Rq, q) = q * c */
+    
+    carry = uECC_vli_add(result, product, tmp, num_words_secp256k1); /* (C, r) = r + q       */
+    uECC_vli_clear(product, num_words_secp256k1);
+    omega_mult_secp256k1(product, tmp + num_words_secp256k1); /* Rq*c */
+    carry += uECC_vli_add(result, result, product, num_words_secp256k1); /* (C1, r) = r + Rq*c */
+    
+    while (carry > 0) {
+        --carry;
+        uECC_vli_sub(result, result, curve_secp256k1.p, num_words_secp256k1);
+    }
+    if (uECC_vli_cmp_unsafe(result, curve_secp256k1.p, num_words_secp256k1) > 0) {
+        uECC_vli_sub(result, result, curve_secp256k1.p, num_words_secp256k1);
+    }
+}
+
+#if uECC_WORD_SIZE == 1
+static void omega_mult_secp256k1(uint8_t * result, const uint8_t * right) {
+    /* Multiply by (2^32 + 2^9 + 2^8 + 2^7 + 2^6 + 2^4 + 1). */
+    uECC_word_t r0 = 0;
+    uECC_word_t r1 = 0;
+    uECC_word_t r2 = 0;
+    wordcount_t k;
+    
+    /* Multiply by (2^9 + 2^8 + 2^7 + 2^6 + 2^4 + 1). */
+    muladd(0xD1, right[0], &r0, &r1, &r2);
+    result[0] = r0;
+    r0 = r1;
+    r1 = r2;
+    /* r2 is still 0 */
+    
+    for (k = 1; k < num_words_secp256k1; ++k) {
+        muladd(0x03, right[k - 1], &r0, &r1, &r2);
+        muladd(0xD1, right[k], &r0, &r1, &r2);
+        result[k] = r0;
+        r0 = r1;
+        r1 = r2;
+        r2 = 0;
+    }
+    muladd(0x03, right[num_words_secp256k1 - 1], &r0, &r1, &r2);
+    result[num_words_secp256k1] = r0;
+    result[num_words_secp256k1 + 1] = r1;
+    /* add the 2^32 multiple */
+    result[4 + num_words_secp256k1] =
+        uECC_vli_add(result + 4, result + 4, right, num_words_secp256k1); 
+}
+#elif uECC_WORD_SIZE == 4
+static void omega_mult_secp256k1(uint32_t * result, const uint32_t * right) {
+    /* Multiply by (2^9 + 2^8 + 2^7 + 2^6 + 2^4 + 1). */
+    uint32_t carry = 0;
+    wordcount_t k;
+    
+    for (k = 0; k < num_words_secp256k1; ++k) {
+        uint64_t p = (uint64_t)0x3D1 * right[k] + carry;
+        result[k] = (uint32_t) p;
+        carry = p >> 32;
+    }
+    result[num_words_secp256k1] = carry;
+    /* add the 2^32 multiple */
+    result[1 + num_words_secp256k1] =
+        uECC_vli_add(result + 1, result + 1, right, num_words_secp256k1); 
+}
+#else
+static void omega_mult_secp256k1(uint64_t * result, const uint64_t * right) {
+    uECC_word_t r0 = 0;
+    uECC_word_t r1 = 0;
+    uECC_word_t r2 = 0;
+    wordcount_t k;
+    
+    /* Multiply by (2^32 + 2^9 + 2^8 + 2^7 + 2^6 + 2^4 + 1). */
+    for (k = 0; k < num_words_secp256k1; ++k) {
+        muladd(0x1000003D1ull, right[k], &r0, &r1, &r2);
+        result[k] = r0;
+        r0 = r1;
+        r1 = r2;
+        r2 = 0;
+    }
+    result[num_words_secp256k1] = r0;
+}
+#endif /* uECC_WORD_SIZE */
+#endif /* (uECC_OPTIMIZATION_LEVEL > 0 &&  && !asm_mmod_fast_secp256k1) */
+
+#endif /* uECC_SUPPORTS_secp256k1 */
+
+#endif /* _UECC_CURVE_SPECIFIC_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/dune b/vendors/tezos-modded/vendors/ocaml-uecc/src/dune
new file mode 100644
index 000000000..2a6ad8d44
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/dune
@@ -0,0 +1,10 @@
+(library
+ (name        uecc)
+ (public_name uecc)
+ (synopsis "ECDH and ECDSA for 8-bit, 32-bit, and 64-bit processors.")
+ (c_names uECC uecc_stubs)
+ (c_flags (-O3
+           -DuECC_OPTIMIZATION_LEVEL=3
+           -DuECC_SQUARE_FUNC=1
+           -DuECC_VLI_NATIVE_LITTLE_ENDIAN=0))
+ (libraries bigstring))
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/platform-specific.h b/vendors/tezos-modded/vendors/ocaml-uecc/src/platform-specific.h
new file mode 100644
index 000000000..5cafd5d32
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/platform-specific.h
@@ -0,0 +1,69 @@
+/* Copyright 2015, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#ifndef _UECC_PLATFORM_SPECIFIC_H_
+#define _UECC_PLATFORM_SPECIFIC_H_
+
+#include "types.h"
+
+#if (defined(_WIN32) || defined(_WIN64))
+/* Windows */
+
+// use pragma syntax to prevent tweaking the linker script for getting CryptXYZ function
+#pragma comment(lib, "crypt32.lib")
+#pragma comment(lib, "advapi32.lib")
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#include <wincrypt.h>
+
+static int default_RNG(uint8_t *dest, unsigned size) {
+    HCRYPTPROV prov;
+    if (!CryptAcquireContext(&prov, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)) {
+        return 0;
+    }
+
+    CryptGenRandom(prov, size, (BYTE *)dest);
+    CryptReleaseContext(prov, 0);
+    return 1;
+}
+#define default_RNG_defined 1
+
+#elif (defined(__linux__) && (__GLIBC__ > 2 || __GLIBC_MINOR__ > 24)) || (defined __sun)
+/* Linux and Solaris */
+
+#include <sys/random.h>
+static int default_RNG(uint8_t* dest, unsigned size) {
+    ssize_t nb_written = getrandom(dest, size, 0);
+    return ((nb_written == size) ? 1 : 0);
+}
+#define default_RNG_defined 1
+
+#elif defined (__linux__) /* No glibc */
+#define _GNU_SOURCE
+#include <unistd.h>
+#include <sys/syscall.h>
+static int default_RNG(uint8_t* dest, unsigned size) {
+    int ret;
+    ret = syscall(SYS_getrandom, dest, size, 0);
+    if (ret != size)
+        return 0;
+    return 1;
+}
+#define default_RNG_defined 1
+
+#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
+#include <sys/param.h>
+#if defined(BSD)
+/* OSX and BSDs */
+
+#include <stdlib.h>
+static int default_RNG(uint8_t* dest, unsigned size) {
+    arc4random_buf(dest, size);
+    return 1;
+}
+#define default_RNG_defined 1
+#endif /* defined(BSD) */
+
+#endif /* platform */
+
+#endif /* _UECC_PLATFORM_SPECIFIC_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/types.h b/vendors/tezos-modded/vendors/ocaml-uecc/src/types.h
new file mode 100644
index 000000000..9ee81438f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/types.h
@@ -0,0 +1,108 @@
+/* Copyright 2015, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#ifndef _UECC_TYPES_H_
+#define _UECC_TYPES_H_
+
+#ifndef uECC_PLATFORM
+    #if __AVR__
+        #define uECC_PLATFORM uECC_avr
+    #elif defined(__thumb2__) || defined(_M_ARMT) /* I think MSVC only supports Thumb-2 targets */
+        #define uECC_PLATFORM uECC_arm_thumb2
+    #elif defined(__thumb__)
+        #define uECC_PLATFORM uECC_arm_thumb
+    #elif defined(__arm__) || defined(_M_ARM)
+        #define uECC_PLATFORM uECC_arm
+    #elif defined(__aarch64__)
+        #define uECC_PLATFORM uECC_arm64
+    #elif defined(__i386__) || defined(_M_IX86) || defined(_X86_) || defined(__I86__)
+        #define uECC_PLATFORM uECC_x86
+    #elif defined(__amd64__) || defined(_M_X64)
+        #define uECC_PLATFORM uECC_x86_64
+    #else
+        #define uECC_PLATFORM uECC_arch_other
+    #endif
+#endif
+
+#ifndef uECC_ARM_USE_UMAAL
+    #if (uECC_PLATFORM == uECC_arm) && (__ARM_ARCH >= 6)
+        #define uECC_ARM_USE_UMAAL 1
+    #elif (uECC_PLATFORM == uECC_arm_thumb2) && (__ARM_ARCH >= 6) && !__ARM_ARCH_7M__
+        #define uECC_ARM_USE_UMAAL 1
+    #else
+        #define uECC_ARM_USE_UMAAL 0
+    #endif
+#endif
+
+#ifndef uECC_WORD_SIZE
+    #if uECC_PLATFORM == uECC_avr
+        #define uECC_WORD_SIZE 1
+    #elif (uECC_PLATFORM == uECC_x86_64 || uECC_PLATFORM == uECC_arm64)
+        #define uECC_WORD_SIZE 8
+    #else
+        #define uECC_WORD_SIZE 4
+    #endif
+#endif
+
+#if (uECC_WORD_SIZE != 1) && (uECC_WORD_SIZE != 4) && (uECC_WORD_SIZE != 8)
+    #error "Unsupported value for uECC_WORD_SIZE"
+#endif
+
+#if ((uECC_PLATFORM == uECC_avr) && (uECC_WORD_SIZE != 1))
+    #pragma message ("uECC_WORD_SIZE must be 1 for AVR")
+    #undef uECC_WORD_SIZE
+    #define uECC_WORD_SIZE 1
+#endif
+
+#if ((uECC_PLATFORM == uECC_arm || uECC_PLATFORM == uECC_arm_thumb || \
+        uECC_PLATFORM ==  uECC_arm_thumb2) && \
+     (uECC_WORD_SIZE != 4))
+    #pragma message ("uECC_WORD_SIZE must be 4 for ARM")
+    #undef uECC_WORD_SIZE
+    #define uECC_WORD_SIZE 4
+#endif
+
+#if defined(__SIZEOF_INT128__) || ((__clang_major__ * 100 + __clang_minor__) >= 302)
+    #define SUPPORTS_INT128 1
+#else
+    #define SUPPORTS_INT128 0
+#endif
+
+typedef int8_t wordcount_t;
+typedef int16_t bitcount_t;
+typedef int8_t cmpresult_t;
+
+#if (uECC_WORD_SIZE == 1)
+
+typedef uint8_t uECC_word_t;
+typedef uint16_t uECC_dword_t;
+
+#define HIGH_BIT_SET 0x80
+#define uECC_WORD_BITS 8
+#define uECC_WORD_BITS_SHIFT 3
+#define uECC_WORD_BITS_MASK 0x07
+
+#elif (uECC_WORD_SIZE == 4)
+
+typedef uint32_t uECC_word_t;
+typedef uint64_t uECC_dword_t;
+
+#define HIGH_BIT_SET 0x80000000
+#define uECC_WORD_BITS 32
+#define uECC_WORD_BITS_SHIFT 5
+#define uECC_WORD_BITS_MASK 0x01F
+
+#elif (uECC_WORD_SIZE == 8)
+
+typedef uint64_t uECC_word_t;
+#if SUPPORTS_INT128
+typedef unsigned __int128 uECC_dword_t;
+#endif
+
+#define HIGH_BIT_SET 0x8000000000000000ull
+#define uECC_WORD_BITS 64
+#define uECC_WORD_BITS_SHIFT 6
+#define uECC_WORD_BITS_MASK 0x03F
+
+#endif /* uECC_WORD_SIZE */
+
+#endif /* _UECC_TYPES_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.c b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.c
new file mode 100644
index 000000000..fa078443d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.c
@@ -0,0 +1,1625 @@
+/* Copyright 2014, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#include "uECC.h"
+#include "uECC_vli.h"
+
+#ifndef uECC_RNG_MAX_TRIES
+    #define uECC_RNG_MAX_TRIES 64
+#endif
+
+#if uECC_ENABLE_VLI_API
+    #define uECC_VLI_API
+#else
+    #define uECC_VLI_API static
+#endif
+
+#define CONCATX(a, ...) a ## __VA_ARGS__
+#define CONCAT(a, ...) CONCATX(a, __VA_ARGS__)
+
+#define STRX(a) #a
+#define STR(a) STRX(a)
+
+#define EVAL(...)  EVAL1(EVAL1(EVAL1(EVAL1(__VA_ARGS__))))
+#define EVAL1(...) EVAL2(EVAL2(EVAL2(EVAL2(__VA_ARGS__))))
+#define EVAL2(...) EVAL3(EVAL3(EVAL3(EVAL3(__VA_ARGS__))))
+#define EVAL3(...) EVAL4(EVAL4(EVAL4(EVAL4(__VA_ARGS__))))
+#define EVAL4(...) __VA_ARGS__
+
+#define DEC_1  0
+#define DEC_2  1
+#define DEC_3  2
+#define DEC_4  3
+#define DEC_5  4
+#define DEC_6  5
+#define DEC_7  6
+#define DEC_8  7
+#define DEC_9  8
+#define DEC_10 9
+#define DEC_11 10
+#define DEC_12 11
+#define DEC_13 12
+#define DEC_14 13
+#define DEC_15 14
+#define DEC_16 15
+#define DEC_17 16
+#define DEC_18 17
+#define DEC_19 18
+#define DEC_20 19
+#define DEC_21 20
+#define DEC_22 21
+#define DEC_23 22
+#define DEC_24 23
+#define DEC_25 24
+#define DEC_26 25
+#define DEC_27 26
+#define DEC_28 27
+#define DEC_29 28
+#define DEC_30 29
+#define DEC_31 30
+#define DEC_32 31
+
+#define DEC(N) CONCAT(DEC_, N)
+
+#define SECOND_ARG(_, val, ...) val
+#define SOME_CHECK_0 ~, 0
+#define GET_SECOND_ARG(...) SECOND_ARG(__VA_ARGS__, SOME,)
+#define SOME_OR_0(N) GET_SECOND_ARG(CONCAT(SOME_CHECK_, N))
+
+#define EMPTY(...)
+#define DEFER(...) __VA_ARGS__ EMPTY()
+
+#define REPEAT_NAME_0() REPEAT_0
+#define REPEAT_NAME_SOME() REPEAT_SOME
+#define REPEAT_0(...)
+#define REPEAT_SOME(N, stuff) DEFER(CONCAT(REPEAT_NAME_, SOME_OR_0(DEC(N))))()(DEC(N), stuff) stuff
+#define REPEAT(N, stuff) EVAL(REPEAT_SOME(N, stuff))
+
+#define REPEATM_NAME_0() REPEATM_0
+#define REPEATM_NAME_SOME() REPEATM_SOME
+#define REPEATM_0(...)
+#define REPEATM_SOME(N, macro) macro(N) \
+    DEFER(CONCAT(REPEATM_NAME_, SOME_OR_0(DEC(N))))()(DEC(N), macro)
+#define REPEATM(N, macro) EVAL(REPEATM_SOME(N, macro))
+
+#include "platform-specific.h"
+
+#if (uECC_WORD_SIZE == 1)
+    #if uECC_SUPPORTS_secp160r1
+        #define uECC_MAX_WORDS 21 /* Due to the size of curve_n. */
+    #endif
+    #if uECC_SUPPORTS_secp192r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 24
+    #endif
+    #if uECC_SUPPORTS_secp224r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 28
+    #endif
+    #if (uECC_SUPPORTS_secp256r1 || uECC_SUPPORTS_secp256k1)
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 32
+    #endif
+#elif (uECC_WORD_SIZE == 4)
+    #if uECC_SUPPORTS_secp160r1
+        #define uECC_MAX_WORDS 6 /* Due to the size of curve_n. */
+    #endif
+    #if uECC_SUPPORTS_secp192r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 6
+    #endif
+    #if uECC_SUPPORTS_secp224r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 7
+    #endif
+    #if (uECC_SUPPORTS_secp256r1 || uECC_SUPPORTS_secp256k1)
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 8
+    #endif
+#elif (uECC_WORD_SIZE == 8)
+    #if uECC_SUPPORTS_secp160r1
+        #define uECC_MAX_WORDS 3
+    #endif
+    #if uECC_SUPPORTS_secp192r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 3
+    #endif
+    #if uECC_SUPPORTS_secp224r1
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 4
+    #endif
+    #if (uECC_SUPPORTS_secp256r1 || uECC_SUPPORTS_secp256k1)
+        #undef uECC_MAX_WORDS
+        #define uECC_MAX_WORDS 4
+    #endif
+#endif /* uECC_WORD_SIZE */
+
+#define BITS_TO_WORDS(num_bits) ((num_bits + ((uECC_WORD_SIZE * 8) - 1)) / (uECC_WORD_SIZE * 8))
+#define BITS_TO_BYTES(num_bits) ((num_bits + 7) / 8)
+
+struct uECC_Curve_t {
+    wordcount_t num_words;
+    wordcount_t num_bytes;
+    bitcount_t num_n_bits;
+    uECC_word_t p[uECC_MAX_WORDS];
+    uECC_word_t n[uECC_MAX_WORDS];
+    uECC_word_t G[uECC_MAX_WORDS * 2];
+    uECC_word_t b[uECC_MAX_WORDS];
+    void (*double_jacobian)(uECC_word_t * X1,
+                            uECC_word_t * Y1,
+                            uECC_word_t * Z1,
+                            uECC_Curve curve);
+#if uECC_SUPPORT_COMPRESSED_POINT
+    void (*mod_sqrt)(uECC_word_t *a, uECC_Curve curve);
+#endif
+    void (*x_side)(uECC_word_t *result, const uECC_word_t *x, uECC_Curve curve);
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    void (*mmod_fast)(uECC_word_t *result, uECC_word_t *product);
+#endif
+};
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+static void bcopy(uint8_t *dst,
+                  const uint8_t *src,
+                  unsigned num_bytes) {
+    while (0 != num_bytes) {
+        num_bytes--;
+        dst[num_bytes] = src[num_bytes];
+    }
+}
+#endif
+
+static cmpresult_t uECC_vli_cmp_unsafe(const uECC_word_t *left,
+                                       const uECC_word_t *right,
+                                       wordcount_t num_words);
+
+#if default_RNG_defined
+static uECC_RNG_Function g_rng_function = &default_RNG;
+#else
+static uECC_RNG_Function g_rng_function = 0;
+#endif
+
+void uECC_set_rng(uECC_RNG_Function rng_function) {
+    g_rng_function = rng_function;
+}
+
+uECC_RNG_Function uECC_get_rng(void) {
+    return g_rng_function;
+}
+
+int uECC_curve_private_key_size(uECC_Curve curve) {
+    return BITS_TO_BYTES(curve->num_n_bits);
+}
+
+int uECC_curve_public_key_size(uECC_Curve curve) {
+    return 2 * curve->num_bytes;
+}
+
+#if !asm_clear
+uECC_VLI_API void uECC_vli_clear(uECC_word_t *vli, wordcount_t num_words) {
+    wordcount_t i;
+    for (i = 0; i < num_words; ++i) {
+        vli[i] = 0;
+    }
+}
+#endif /* !asm_clear */
+
+/* Constant-time comparison to zero - secure way to compare long integers */
+/* Returns 1 if vli == 0, 0 otherwise. */
+uECC_VLI_API uECC_word_t uECC_vli_isZero(const uECC_word_t *vli, wordcount_t num_words) {
+    uECC_word_t bits = 0;
+    wordcount_t i;
+    for (i = 0; i < num_words; ++i) {
+        bits |= vli[i];
+    }
+    return (bits == 0);
+}
+
+/* Returns nonzero if bit 'bit' of vli is set. */
+uECC_VLI_API uECC_word_t uECC_vli_testBit(const uECC_word_t *vli, bitcount_t bit) {
+    return (vli[bit >> uECC_WORD_BITS_SHIFT] & ((uECC_word_t)1 << (bit & uECC_WORD_BITS_MASK)));
+}
+
+/* Counts the number of words in vli. */
+static wordcount_t vli_numDigits(const uECC_word_t *vli, const wordcount_t max_words) {
+    wordcount_t i;
+    /* Search from the end until we find a non-zero digit.
+       We do it in reverse because we expect that most digits will be nonzero. */
+    for (i = max_words - 1; i >= 0 && vli[i] == 0; --i) {
+    }
+
+    return (i + 1);
+}
+
+/* Counts the number of bits required to represent vli. */
+uECC_VLI_API bitcount_t uECC_vli_numBits(const uECC_word_t *vli, const wordcount_t max_words) {
+    uECC_word_t i;
+    uECC_word_t digit;
+
+    wordcount_t num_digits = vli_numDigits(vli, max_words);
+    if (num_digits == 0) {
+        return 0;
+    }
+
+    digit = vli[num_digits - 1];
+    for (i = 0; digit; ++i) {
+        digit >>= 1;
+    }
+
+    return (((bitcount_t)(num_digits - 1) << uECC_WORD_BITS_SHIFT) + i);
+}
+
+/* Sets dest = src. */
+#if !asm_set
+uECC_VLI_API void uECC_vli_set(uECC_word_t *dest, const uECC_word_t *src, wordcount_t num_words) {
+    wordcount_t i;
+    for (i = 0; i < num_words; ++i) {
+        dest[i] = src[i];
+    }
+}
+#endif /* !asm_set */
+
+/* Returns sign of left - right. */
+static cmpresult_t uECC_vli_cmp_unsafe(const uECC_word_t *left,
+                                       const uECC_word_t *right,
+                                       wordcount_t num_words) {
+    wordcount_t i;
+    for (i = num_words - 1; i >= 0; --i) {
+        if (left[i] > right[i]) {
+            return 1;
+        } else if (left[i] < right[i]) {
+            return -1;
+        }
+    }
+    return 0;
+}
+
+/* Constant-time comparison function - secure way to compare long integers */
+/* Returns one if left == right, zero otherwise. */
+uECC_VLI_API uECC_word_t uECC_vli_equal(const uECC_word_t *left,
+                                        const uECC_word_t *right,
+                                        wordcount_t num_words) {
+    uECC_word_t diff = 0;
+    wordcount_t i;
+    for (i = num_words - 1; i >= 0; --i) {
+        diff |= (left[i] ^ right[i]);
+    }
+    return (diff == 0);
+}
+
+uECC_VLI_API uECC_word_t uECC_vli_sub(uECC_word_t *result,
+                                      const uECC_word_t *left,
+                                      const uECC_word_t *right,
+                                      wordcount_t num_words);
+
+/* Returns sign of left - right, in constant time. */
+uECC_VLI_API cmpresult_t uECC_vli_cmp(const uECC_word_t *left,
+                                      const uECC_word_t *right,
+                                      wordcount_t num_words) {
+    uECC_word_t tmp[uECC_MAX_WORDS];
+    uECC_word_t neg = !!uECC_vli_sub(tmp, left, right, num_words);
+    uECC_word_t equal = uECC_vli_isZero(tmp, num_words);
+    return (!equal - 2 * neg);
+}
+
+/* Computes vli = vli >> 1. */
+#if !asm_rshift1
+uECC_VLI_API void uECC_vli_rshift1(uECC_word_t *vli, wordcount_t num_words) {
+    uECC_word_t *end = vli;
+    uECC_word_t carry = 0;
+
+    vli += num_words;
+    while (vli-- > end) {
+        uECC_word_t temp = *vli;
+        *vli = (temp >> 1) | carry;
+        carry = temp << (uECC_WORD_BITS - 1);
+    }
+}
+#endif /* !asm_rshift1 */
+
+/* Computes result = left + right, returning carry. Can modify in place. */
+#if !asm_add
+uECC_VLI_API uECC_word_t uECC_vli_add(uECC_word_t *result,
+                                      const uECC_word_t *left,
+                                      const uECC_word_t *right,
+                                      wordcount_t num_words) {
+    uECC_word_t carry = 0;
+    wordcount_t i;
+    for (i = 0; i < num_words; ++i) {
+        uECC_word_t sum = left[i] + right[i] + carry;
+        if (sum != left[i]) {
+            carry = (sum < left[i]);
+        }
+        result[i] = sum;
+    }
+    return carry;
+}
+#endif /* !asm_add */
+
+/* Computes result = left - right, returning borrow. Can modify in place. */
+#if !asm_sub
+uECC_VLI_API uECC_word_t uECC_vli_sub(uECC_word_t *result,
+                                      const uECC_word_t *left,
+                                      const uECC_word_t *right,
+                                      wordcount_t num_words) {
+    uECC_word_t borrow = 0;
+    wordcount_t i;
+    for (i = 0; i < num_words; ++i) {
+        uECC_word_t diff = left[i] - right[i] - borrow;
+        if (diff != left[i]) {
+            borrow = (diff > left[i]);
+        }
+        result[i] = diff;
+    }
+    return borrow;
+}
+#endif /* !asm_sub */
+
+#if !asm_mult || (uECC_SQUARE_FUNC && !asm_square) || \
+    (uECC_SUPPORTS_secp256k1 && (uECC_OPTIMIZATION_LEVEL > 0) && \
+        ((uECC_WORD_SIZE == 1) || (uECC_WORD_SIZE == 8)))
+static void muladd(uECC_word_t a,
+                   uECC_word_t b,
+                   uECC_word_t *r0,
+                   uECC_word_t *r1,
+                   uECC_word_t *r2) {
+#if uECC_WORD_SIZE == 8 && !SUPPORTS_INT128
+    uint64_t a0 = a & 0xffffffffull;
+    uint64_t a1 = a >> 32;
+    uint64_t b0 = b & 0xffffffffull;
+    uint64_t b1 = b >> 32;
+
+    uint64_t i0 = a0 * b0;
+    uint64_t i1 = a0 * b1;
+    uint64_t i2 = a1 * b0;
+    uint64_t i3 = a1 * b1;
+
+    uint64_t p0, p1;
+
+    i2 += (i0 >> 32);
+    i2 += i1;
+    if (i2 < i1) { /* overflow */
+        i3 += 0x100000000ull;
+    }
+
+    p0 = (i0 & 0xffffffffull) | (i2 << 32);
+    p1 = i3 + (i2 >> 32);
+
+    *r0 += p0;
+    *r1 += (p1 + (*r0 < p0));
+    *r2 += ((*r1 < p1) || (*r1 == p1 && *r0 < p0));
+#else
+    uECC_dword_t p = (uECC_dword_t)a * b;
+    uECC_dword_t r01 = ((uECC_dword_t)(*r1) << uECC_WORD_BITS) | *r0;
+    r01 += p;
+    *r2 += (r01 < p);
+    *r1 = r01 >> uECC_WORD_BITS;
+    *r0 = (uECC_word_t)r01;
+#endif
+}
+#endif /* muladd needed */
+
+#if !asm_mult
+uECC_VLI_API void uECC_vli_mult(uECC_word_t *result,
+                                const uECC_word_t *left,
+                                const uECC_word_t *right,
+                                wordcount_t num_words) {
+    uECC_word_t r0 = 0;
+    uECC_word_t r1 = 0;
+    uECC_word_t r2 = 0;
+    wordcount_t i, k;
+
+    /* Compute each digit of result in sequence, maintaining the carries. */
+    for (k = 0; k < num_words; ++k) {
+        for (i = 0; i <= k; ++i) {
+            muladd(left[i], right[k - i], &r0, &r1, &r2);
+        }
+        result[k] = r0;
+        r0 = r1;
+        r1 = r2;
+        r2 = 0;
+    }
+    for (k = num_words; k < num_words * 2 - 1; ++k) {
+        for (i = (k + 1) - num_words; i < num_words; ++i) {
+            muladd(left[i], right[k - i], &r0, &r1, &r2);
+        }
+        result[k] = r0;
+        r0 = r1;
+        r1 = r2;
+        r2 = 0;
+    }
+    result[num_words * 2 - 1] = r0;
+}
+#endif /* !asm_mult */
+
+#if uECC_SQUARE_FUNC
+
+#if !asm_square
+static void mul2add(uECC_word_t a,
+                    uECC_word_t b,
+                    uECC_word_t *r0,
+                    uECC_word_t *r1,
+                    uECC_word_t *r2) {
+#if uECC_WORD_SIZE == 8 && !SUPPORTS_INT128
+    uint64_t a0 = a & 0xffffffffull;
+    uint64_t a1 = a >> 32;
+    uint64_t b0 = b & 0xffffffffull;
+    uint64_t b1 = b >> 32;
+
+    uint64_t i0 = a0 * b0;
+    uint64_t i1 = a0 * b1;
+    uint64_t i2 = a1 * b0;
+    uint64_t i3 = a1 * b1;
+
+    uint64_t p0, p1;
+
+    i2 += (i0 >> 32);
+    i2 += i1;
+    if (i2 < i1)
+    { /* overflow */
+        i3 += 0x100000000ull;
+    }
+
+    p0 = (i0 & 0xffffffffull) | (i2 << 32);
+    p1 = i3 + (i2 >> 32);
+
+    *r2 += (p1 >> 63);
+    p1 = (p1 << 1) | (p0 >> 63);
+    p0 <<= 1;
+
+    *r0 += p0;
+    *r1 += (p1 + (*r0 < p0));
+    *r2 += ((*r1 < p1) || (*r1 == p1 && *r0 < p0));
+#else
+    uECC_dword_t p = (uECC_dword_t)a * b;
+    uECC_dword_t r01 = ((uECC_dword_t)(*r1) << uECC_WORD_BITS) | *r0;
+    *r2 += (p >> (uECC_WORD_BITS * 2 - 1));
+    p *= 2;
+    r01 += p;
+    *r2 += (r01 < p);
+    *r1 = r01 >> uECC_WORD_BITS;
+    *r0 = (uECC_word_t)r01;
+#endif
+}
+
+uECC_VLI_API void uECC_vli_square(uECC_word_t *result,
+                                  const uECC_word_t *left,
+                                  wordcount_t num_words) {
+    uECC_word_t r0 = 0;
+    uECC_word_t r1 = 0;
+    uECC_word_t r2 = 0;
+
+    wordcount_t i, k;
+
+    for (k = 0; k < num_words * 2 - 1; ++k) {
+        uECC_word_t min = (k < num_words ? 0 : (k + 1) - num_words);
+        for (i = min; i <= k && i <= k - i; ++i) {
+            if (i < k-i) {
+                mul2add(left[i], left[k - i], &r0, &r1, &r2);
+            } else {
+                muladd(left[i], left[k - i], &r0, &r1, &r2);
+            }
+        }
+        result[k] = r0;
+        r0 = r1;
+        r1 = r2;
+        r2 = 0;
+    }
+
+    result[num_words * 2 - 1] = r0;
+}
+#endif /* !asm_square */
+
+#else /* uECC_SQUARE_FUNC */
+
+#if uECC_ENABLE_VLI_API
+uECC_VLI_API void uECC_vli_square(uECC_word_t *result,
+                                  const uECC_word_t *left,
+                                  wordcount_t num_words) {
+    uECC_vli_mult(result, left, left, num_words);
+}
+#endif /* uECC_ENABLE_VLI_API */
+
+#endif /* uECC_SQUARE_FUNC */
+
+/* Computes result = (left + right) % mod.
+   Assumes that left < mod and right < mod, and that result does not overlap mod. */
+uECC_VLI_API void uECC_vli_modAdd(uECC_word_t *result,
+                                  const uECC_word_t *left,
+                                  const uECC_word_t *right,
+                                  const uECC_word_t *mod,
+                                  wordcount_t num_words) {
+    uECC_word_t carry = uECC_vli_add(result, left, right, num_words);
+    if (carry || uECC_vli_cmp_unsafe(mod, result, num_words) != 1) {
+        /* result > mod (result = mod + remainder), so subtract mod to get remainder. */
+        uECC_vli_sub(result, result, mod, num_words);
+    }
+}
+
+/* Computes result = (left - right) % mod.
+   Assumes that left < mod and right < mod, and that result does not overlap mod. */
+uECC_VLI_API void uECC_vli_modSub(uECC_word_t *result,
+                                  const uECC_word_t *left,
+                                  const uECC_word_t *right,
+                                  const uECC_word_t *mod,
+                                  wordcount_t num_words) {
+    uECC_word_t l_borrow = uECC_vli_sub(result, left, right, num_words);
+    if (l_borrow) {
+        /* In this case, result == -diff == (max int) - diff. Since -x % d == d - x,
+           we can get the correct result from result + mod (with overflow). */
+        uECC_vli_add(result, result, mod, num_words);
+    }
+}
+
+/* Computes result = product % mod, where product is 2N words long. */
+/* Currently only designed to work for curve_p or curve_n. */
+uECC_VLI_API void uECC_vli_mmod(uECC_word_t *result,
+                                uECC_word_t *product,
+                                const uECC_word_t *mod,
+                                wordcount_t num_words) {
+    uECC_word_t mod_multiple[2 * uECC_MAX_WORDS];
+    uECC_word_t tmp[2 * uECC_MAX_WORDS];
+    uECC_word_t *v[2] = {tmp, product};
+    uECC_word_t index;
+
+    /* Shift mod so its highest set bit is at the maximum position. */
+    bitcount_t shift = (num_words * 2 * uECC_WORD_BITS) - uECC_vli_numBits(mod, num_words);
+    wordcount_t word_shift = shift / uECC_WORD_BITS;
+    wordcount_t bit_shift = shift % uECC_WORD_BITS;
+    uECC_word_t carry = 0;
+    uECC_vli_clear(mod_multiple, word_shift);
+    if (bit_shift > 0) {
+        for(index = 0; index < (uECC_word_t)num_words; ++index) {
+            mod_multiple[word_shift + index] = (mod[index] << bit_shift) | carry;
+            carry = mod[index] >> (uECC_WORD_BITS - bit_shift);
+        }
+    } else {
+        uECC_vli_set(mod_multiple + word_shift, mod, num_words);
+    }
+
+    for (index = 1; shift >= 0; --shift) {
+        uECC_word_t borrow = 0;
+        wordcount_t i;
+        for (i = 0; i < num_words * 2; ++i) {
+            uECC_word_t diff = v[index][i] - mod_multiple[i] - borrow;
+            if (diff != v[index][i]) {
+                borrow = (diff > v[index][i]);
+            }
+            v[1 - index][i] = diff;
+        }
+        index = !(index ^ borrow); /* Swap the index if there was no borrow */
+        uECC_vli_rshift1(mod_multiple, num_words);
+        mod_multiple[num_words - 1] |= mod_multiple[num_words] << (uECC_WORD_BITS - 1);
+        uECC_vli_rshift1(mod_multiple + num_words, num_words);
+    }
+    uECC_vli_set(result, v[index], num_words);
+}
+
+/* Computes result = (left * right) % mod. */
+uECC_VLI_API void uECC_vli_modMult(uECC_word_t *result,
+                                   const uECC_word_t *left,
+                                   const uECC_word_t *right,
+                                   const uECC_word_t *mod,
+                                   wordcount_t num_words) {
+    uECC_word_t product[2 * uECC_MAX_WORDS];
+    uECC_vli_mult(product, left, right, num_words);
+    uECC_vli_mmod(result, product, mod, num_words);
+}
+
+uECC_VLI_API void uECC_vli_modMult_fast(uECC_word_t *result,
+                                        const uECC_word_t *left,
+                                        const uECC_word_t *right,
+                                        uECC_Curve curve) {
+    uECC_word_t product[2 * uECC_MAX_WORDS];
+    uECC_vli_mult(product, left, right, curve->num_words);
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    curve->mmod_fast(result, product);
+#else
+    uECC_vli_mmod(result, product, curve->p, curve->num_words);
+#endif
+}
+
+#if uECC_SQUARE_FUNC
+
+#if uECC_ENABLE_VLI_API
+/* Computes result = left^2 % mod. */
+uECC_VLI_API void uECC_vli_modSquare(uECC_word_t *result,
+                                     const uECC_word_t *left,
+                                     const uECC_word_t *mod,
+                                     wordcount_t num_words) {
+    uECC_word_t product[2 * uECC_MAX_WORDS];
+    uECC_vli_square(product, left, num_words);
+    uECC_vli_mmod(result, product, mod, num_words);
+}
+#endif /* uECC_ENABLE_VLI_API */
+
+uECC_VLI_API void uECC_vli_modSquare_fast(uECC_word_t *result,
+                                          const uECC_word_t *left,
+                                          uECC_Curve curve) {
+    uECC_word_t product[2 * uECC_MAX_WORDS];
+    uECC_vli_square(product, left, curve->num_words);
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    curve->mmod_fast(result, product);
+#else
+    uECC_vli_mmod(result, product, curve->p, curve->num_words);
+#endif
+}
+
+#else /* uECC_SQUARE_FUNC */
+
+#if uECC_ENABLE_VLI_API
+uECC_VLI_API void uECC_vli_modSquare(uECC_word_t *result,
+                                     const uECC_word_t *left,
+                                     const uECC_word_t *mod,
+                                     wordcount_t num_words) {
+    uECC_vli_modMult(result, left, left, mod, num_words);
+}
+#endif /* uECC_ENABLE_VLI_API */
+
+uECC_VLI_API void uECC_vli_modSquare_fast(uECC_word_t *result,
+                                          const uECC_word_t *left,
+                                          uECC_Curve curve) {
+    uECC_vli_modMult_fast(result, left, left, curve);
+}
+
+#endif /* uECC_SQUARE_FUNC */
+
+#define EVEN(vli) (!(vli[0] & 1))
+static void vli_modInv_update(uECC_word_t *uv,
+                              const uECC_word_t *mod,
+                              wordcount_t num_words) {
+    uECC_word_t carry = 0;
+    if (!EVEN(uv)) {
+        carry = uECC_vli_add(uv, uv, mod, num_words);
+    }
+    uECC_vli_rshift1(uv, num_words);
+    if (carry) {
+        uv[num_words - 1] |= HIGH_BIT_SET;
+    }
+}
+
+/* Computes result = (1 / input) % mod. All VLIs are the same size.
+   See "From Euclid's GCD to Montgomery Multiplication to the Great Divide" */
+uECC_VLI_API void uECC_vli_modInv(uECC_word_t *result,
+                                  const uECC_word_t *input,
+                                  const uECC_word_t *mod,
+                                  wordcount_t num_words) {
+    uECC_word_t a[uECC_MAX_WORDS], b[uECC_MAX_WORDS], u[uECC_MAX_WORDS], v[uECC_MAX_WORDS];
+    cmpresult_t cmpResult;
+
+    if (uECC_vli_isZero(input, num_words)) {
+        uECC_vli_clear(result, num_words);
+        return;
+    }
+
+    uECC_vli_set(a, input, num_words);
+    uECC_vli_set(b, mod, num_words);
+    uECC_vli_clear(u, num_words);
+    u[0] = 1;
+    uECC_vli_clear(v, num_words);
+    while ((cmpResult = uECC_vli_cmp_unsafe(a, b, num_words)) != 0) {
+        if (EVEN(a)) {
+            uECC_vli_rshift1(a, num_words);
+            vli_modInv_update(u, mod, num_words);
+        } else if (EVEN(b)) {
+            uECC_vli_rshift1(b, num_words);
+            vli_modInv_update(v, mod, num_words);
+        } else if (cmpResult > 0) {
+            uECC_vli_sub(a, a, b, num_words);
+            uECC_vli_rshift1(a, num_words);
+            if (uECC_vli_cmp_unsafe(u, v, num_words) < 0) {
+                uECC_vli_add(u, u, mod, num_words);
+            }
+            uECC_vli_sub(u, u, v, num_words);
+            vli_modInv_update(u, mod, num_words);
+        } else {
+            uECC_vli_sub(b, b, a, num_words);
+            uECC_vli_rshift1(b, num_words);
+            if (uECC_vli_cmp_unsafe(v, u, num_words) < 0) {
+                uECC_vli_add(v, v, mod, num_words);
+            }
+            uECC_vli_sub(v, v, u, num_words);
+            vli_modInv_update(v, mod, num_words);
+        }
+    }
+    uECC_vli_set(result, u, num_words);
+}
+
+/* ------ Point operations ------ */
+
+#include "curve-specific.h"
+
+/* Returns 1 if 'point' is the point at infinity, 0 otherwise. */
+#define EccPoint_isZero(point, curve) uECC_vli_isZero((point), (curve)->num_words * 2)
+
+/* Point multiplication algorithm using Montgomery's ladder with co-Z coordinates.
+From http://eprint.iacr.org/2011/338.pdf
+*/
+
+/* Modify (x1, y1) => (x1 * z^2, y1 * z^3) */
+static void apply_z(uECC_word_t * X1,
+                    uECC_word_t * Y1,
+                    const uECC_word_t * const Z,
+                    uECC_Curve curve) {
+    uECC_word_t t1[uECC_MAX_WORDS];
+
+    uECC_vli_modSquare_fast(t1, Z, curve);    /* z^2 */
+    uECC_vli_modMult_fast(X1, X1, t1, curve); /* x1 * z^2 */
+    uECC_vli_modMult_fast(t1, t1, Z, curve);  /* z^3 */
+    uECC_vli_modMult_fast(Y1, Y1, t1, curve); /* y1 * z^3 */
+}
+
+/* P = (x1, y1) => 2P, (x2, y2) => P' */
+static void XYcZ_initial_double(uECC_word_t * X1,
+                                uECC_word_t * Y1,
+                                uECC_word_t * X2,
+                                uECC_word_t * Y2,
+                                const uECC_word_t * const initial_Z,
+                                uECC_Curve curve) {
+    uECC_word_t z[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+    if (initial_Z) {
+        uECC_vli_set(z, initial_Z, num_words);
+    } else {
+        uECC_vli_clear(z, num_words);
+        z[0] = 1;
+    }
+
+    uECC_vli_set(X2, X1, num_words);
+    uECC_vli_set(Y2, Y1, num_words);
+
+    apply_z(X1, Y1, z, curve);
+    curve->double_jacobian(X1, Y1, z, curve);
+    apply_z(X2, Y2, z, curve);
+}
+
+/* Input P = (x1, y1, Z), Q = (x2, y2, Z)
+   Output P' = (x1', y1', Z3), P + Q = (x3, y3, Z3)
+   or P => P', Q => P + Q
+*/
+static void XYcZ_add(uECC_word_t * X1,
+                     uECC_word_t * Y1,
+                     uECC_word_t * X2,
+                     uECC_word_t * Y2,
+                     uECC_Curve curve) {
+    /* t1 = X1, t2 = Y1, t3 = X2, t4 = Y2 */
+    uECC_word_t t5[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+
+    uECC_vli_modSub(t5, X2, X1, curve->p, num_words); /* t5 = x2 - x1 */
+    uECC_vli_modSquare_fast(t5, t5, curve);                  /* t5 = (x2 - x1)^2 = A */
+    uECC_vli_modMult_fast(X1, X1, t5, curve);                /* t1 = x1*A = B */
+    uECC_vli_modMult_fast(X2, X2, t5, curve);                /* t3 = x2*A = C */
+    uECC_vli_modSub(Y2, Y2, Y1, curve->p, num_words); /* t4 = y2 - y1 */
+    uECC_vli_modSquare_fast(t5, Y2, curve);                  /* t5 = (y2 - y1)^2 = D */
+
+    uECC_vli_modSub(t5, t5, X1, curve->p, num_words); /* t5 = D - B */
+    uECC_vli_modSub(t5, t5, X2, curve->p, num_words); /* t5 = D - B - C = x3 */
+    uECC_vli_modSub(X2, X2, X1, curve->p, num_words); /* t3 = C - B */
+    uECC_vli_modMult_fast(Y1, Y1, X2, curve);                /* t2 = y1*(C - B) */
+    uECC_vli_modSub(X2, X1, t5, curve->p, num_words); /* t3 = B - x3 */
+    uECC_vli_modMult_fast(Y2, Y2, X2, curve);                /* t4 = (y2 - y1)*(B - x3) */
+    uECC_vli_modSub(Y2, Y2, Y1, curve->p, num_words); /* t4 = y3 */
+
+    uECC_vli_set(X2, t5, num_words);
+}
+
+/* Input P = (x1, y1, Z), Q = (x2, y2, Z)
+   Output P + Q = (x3, y3, Z3), P - Q = (x3', y3', Z3)
+   or P => P - Q, Q => P + Q
+*/
+static void XYcZ_addC(uECC_word_t * X1,
+                      uECC_word_t * Y1,
+                      uECC_word_t * X2,
+                      uECC_word_t * Y2,
+                      uECC_Curve curve) {
+    /* t1 = X1, t2 = Y1, t3 = X2, t4 = Y2 */
+    uECC_word_t t5[uECC_MAX_WORDS];
+    uECC_word_t t6[uECC_MAX_WORDS];
+    uECC_word_t t7[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+
+    uECC_vli_modSub(t5, X2, X1, curve->p, num_words); /* t5 = x2 - x1 */
+    uECC_vli_modSquare_fast(t5, t5, curve);                  /* t5 = (x2 - x1)^2 = A */
+    uECC_vli_modMult_fast(X1, X1, t5, curve);                /* t1 = x1*A = B */
+    uECC_vli_modMult_fast(X2, X2, t5, curve);                /* t3 = x2*A = C */
+    uECC_vli_modAdd(t5, Y2, Y1, curve->p, num_words); /* t5 = y2 + y1 */
+    uECC_vli_modSub(Y2, Y2, Y1, curve->p, num_words); /* t4 = y2 - y1 */
+
+    uECC_vli_modSub(t6, X2, X1, curve->p, num_words); /* t6 = C - B */
+    uECC_vli_modMult_fast(Y1, Y1, t6, curve);                /* t2 = y1 * (C - B) = E */
+    uECC_vli_modAdd(t6, X1, X2, curve->p, num_words); /* t6 = B + C */
+    uECC_vli_modSquare_fast(X2, Y2, curve);                  /* t3 = (y2 - y1)^2 = D */
+    uECC_vli_modSub(X2, X2, t6, curve->p, num_words); /* t3 = D - (B + C) = x3 */
+
+    uECC_vli_modSub(t7, X1, X2, curve->p, num_words); /* t7 = B - x3 */
+    uECC_vli_modMult_fast(Y2, Y2, t7, curve);                /* t4 = (y2 - y1)*(B - x3) */
+    uECC_vli_modSub(Y2, Y2, Y1, curve->p, num_words); /* t4 = (y2 - y1)*(B - x3) - E = y3 */
+
+    uECC_vli_modSquare_fast(t7, t5, curve);                  /* t7 = (y2 + y1)^2 = F */
+    uECC_vli_modSub(t7, t7, t6, curve->p, num_words); /* t7 = F - (B + C) = x3' */
+    uECC_vli_modSub(t6, t7, X1, curve->p, num_words); /* t6 = x3' - B */
+    uECC_vli_modMult_fast(t6, t6, t5, curve);                /* t6 = (y2+y1)*(x3' - B) */
+    uECC_vli_modSub(Y1, t6, Y1, curve->p, num_words); /* t2 = (y2+y1)*(x3' - B) - E = y3' */
+
+    uECC_vli_set(X1, t7, num_words);
+}
+
+/* result may overlap point. */
+static void EccPoint_mult(uECC_word_t * result,
+                          const uECC_word_t * point,
+                          const uECC_word_t * scalar,
+                          const uECC_word_t * initial_Z,
+                          bitcount_t num_bits,
+                          uECC_Curve curve) {
+    /* R0 and R1 */
+    uECC_word_t Rx[2][uECC_MAX_WORDS];
+    uECC_word_t Ry[2][uECC_MAX_WORDS];
+    uECC_word_t z[uECC_MAX_WORDS];
+    bitcount_t i;
+    uECC_word_t nb;
+    wordcount_t num_words = curve->num_words;
+
+    uECC_vli_set(Rx[1], point, num_words);
+    uECC_vli_set(Ry[1], point + num_words, num_words);
+
+    XYcZ_initial_double(Rx[1], Ry[1], Rx[0], Ry[0], initial_Z, curve);
+
+    for (i = num_bits - 2; i > 0; --i) {
+        nb = !uECC_vli_testBit(scalar, i);
+        XYcZ_addC(Rx[1 - nb], Ry[1 - nb], Rx[nb], Ry[nb], curve);
+        XYcZ_add(Rx[nb], Ry[nb], Rx[1 - nb], Ry[1 - nb], curve);
+    }
+
+    nb = !uECC_vli_testBit(scalar, 0);
+    XYcZ_addC(Rx[1 - nb], Ry[1 - nb], Rx[nb], Ry[nb], curve);
+
+    /* Find final 1/Z value. */
+    uECC_vli_modSub(z, Rx[1], Rx[0], curve->p, num_words); /* X1 - X0 */
+    uECC_vli_modMult_fast(z, z, Ry[1 - nb], curve);               /* Yb * (X1 - X0) */
+    uECC_vli_modMult_fast(z, z, point, curve);                    /* xP * Yb * (X1 - X0) */
+    uECC_vli_modInv(z, z, curve->p, num_words);            /* 1 / (xP * Yb * (X1 - X0)) */
+    /* yP / (xP * Yb * (X1 - X0)) */
+    uECC_vli_modMult_fast(z, z, point + num_words, curve);
+    uECC_vli_modMult_fast(z, z, Rx[1 - nb], curve); /* Xb * yP / (xP * Yb * (X1 - X0)) */
+    /* End 1/Z calculation */
+
+    XYcZ_add(Rx[nb], Ry[nb], Rx[1 - nb], Ry[1 - nb], curve);
+    apply_z(Rx[0], Ry[0], z, curve);
+
+    uECC_vli_set(result, Rx[0], num_words);
+    uECC_vli_set(result + num_words, Ry[0], num_words);
+}
+
+static uECC_word_t regularize_k(const uECC_word_t * const k,
+                                uECC_word_t *k0,
+                                uECC_word_t *k1,
+                                uECC_Curve curve) {
+    wordcount_t num_n_words = BITS_TO_WORDS(curve->num_n_bits);
+    bitcount_t num_n_bits = curve->num_n_bits;
+    uECC_word_t carry = uECC_vli_add(k0, k, curve->n, num_n_words) ||
+        (num_n_bits < ((bitcount_t)num_n_words * uECC_WORD_SIZE * 8) &&
+         uECC_vli_testBit(k0, num_n_bits));
+    uECC_vli_add(k1, k0, curve->n, num_n_words);
+    return carry;
+}
+
+static uECC_word_t EccPoint_compute_public_key(uECC_word_t *result,
+                                               uECC_word_t *private_key,
+                                               uECC_Curve curve) {
+    uECC_word_t tmp1[uECC_MAX_WORDS];
+    uECC_word_t tmp2[uECC_MAX_WORDS];
+    uECC_word_t *p2[2] = {tmp1, tmp2};
+    uECC_word_t carry;
+
+    /* Regularize the bitcount for the private key so that attackers cannot use a side channel
+       attack to learn the number of leading zeros. */
+    carry = regularize_k(private_key, tmp1, tmp2, curve);
+
+    EccPoint_mult(result, curve->G, p2[!carry], 0, curve->num_n_bits + 1, curve);
+
+    if (EccPoint_isZero(result, curve)) {
+        return 0;
+    }
+    return 1;
+}
+
+#if uECC_WORD_SIZE == 1
+
+uECC_VLI_API void uECC_vli_nativeToBytes(uint8_t *bytes,
+                                         int num_bytes,
+                                         const uint8_t *native) {
+    wordcount_t i;
+    for (i = 0; i < num_bytes; ++i) {
+        bytes[i] = native[(num_bytes - 1) - i];
+    }
+}
+
+uECC_VLI_API void uECC_vli_bytesToNative(uint8_t *native,
+                                         const uint8_t *bytes,
+                                         int num_bytes) {
+    uECC_vli_nativeToBytes(native, num_bytes, bytes);
+}
+
+#else
+
+uECC_VLI_API void uECC_vli_nativeToBytes(uint8_t *bytes,
+                                         int num_bytes,
+                                         const uECC_word_t *native) {
+    wordcount_t i;
+    for (i = 0; i < num_bytes; ++i) {
+        unsigned b = num_bytes - 1 - i;
+        bytes[i] = native[b / uECC_WORD_SIZE] >> (8 * (b % uECC_WORD_SIZE));
+    }
+}
+
+uECC_VLI_API void uECC_vli_bytesToNative(uECC_word_t *native,
+                                         const uint8_t *bytes,
+                                         int num_bytes) {
+    wordcount_t i;
+    uECC_vli_clear(native, (num_bytes + (uECC_WORD_SIZE - 1)) / uECC_WORD_SIZE);
+    for (i = 0; i < num_bytes; ++i) {
+        unsigned b = num_bytes - 1 - i;
+        native[b / uECC_WORD_SIZE] |=
+            (uECC_word_t)bytes[i] << (8 * (b % uECC_WORD_SIZE));
+    }
+}
+
+#endif /* uECC_WORD_SIZE */
+
+/* Generates a random integer in the range 0 < random < top.
+   Both random and top have num_words words. */
+uECC_VLI_API int uECC_generate_random_int(uECC_word_t *random,
+                                          const uECC_word_t *top,
+                                          wordcount_t num_words) {
+    uECC_word_t mask = (uECC_word_t)-1;
+    uECC_word_t tries;
+    bitcount_t num_bits = uECC_vli_numBits(top, num_words);
+
+    if (!g_rng_function) {
+        return 0;
+    }
+
+    for (tries = 0; tries < uECC_RNG_MAX_TRIES; ++tries) {
+        if (!g_rng_function((uint8_t *)random, num_words * uECC_WORD_SIZE)) {
+            return 0;
+	    }
+        random[num_words - 1] &= mask >> ((bitcount_t)(num_words * uECC_WORD_SIZE * 8 - num_bits));
+        if (!uECC_vli_isZero(random, num_words) &&
+		        uECC_vli_cmp(top, random, num_words) == 1) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+int uECC_make_key(uint8_t *public_key,
+                  uint8_t *private_key,
+                  uECC_Curve curve) {
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *_private = (uECC_word_t *)private_key;
+    uECC_word_t *_public = (uECC_word_t *)public_key;
+#else
+    uECC_word_t _private[uECC_MAX_WORDS];
+    uECC_word_t _public[uECC_MAX_WORDS * 2];
+#endif
+    uECC_word_t tries;
+
+    for (tries = 0; tries < uECC_RNG_MAX_TRIES; ++tries) {
+        if (!uECC_generate_random_int(_private, curve->n, BITS_TO_WORDS(curve->num_n_bits))) {
+            return 0;
+        }
+
+        if (EccPoint_compute_public_key(_public, _private, curve)) {
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+            uECC_vli_nativeToBytes(private_key, BITS_TO_BYTES(curve->num_n_bits), _private);
+            uECC_vli_nativeToBytes(public_key, curve->num_bytes, _public);
+            uECC_vli_nativeToBytes(
+                public_key + curve->num_bytes, curve->num_bytes, _public + curve->num_words);
+#endif
+            return 1;
+        }
+    }
+    return 0;
+}
+
+int uECC_shared_secret(const uint8_t *public_key,
+                       const uint8_t *private_key,
+                       uint8_t *secret,
+                       uECC_Curve curve) {
+    uECC_word_t _public[uECC_MAX_WORDS * 2];
+    uECC_word_t _private[uECC_MAX_WORDS];
+
+    uECC_word_t tmp[uECC_MAX_WORDS];
+    uECC_word_t *p2[2] = {_private, tmp};
+    uECC_word_t *initial_Z = 0;
+    uECC_word_t carry;
+    wordcount_t num_words = curve->num_words;
+    wordcount_t num_bytes = curve->num_bytes;
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) _private, private_key, num_bytes);
+    bcopy((uint8_t *) _public, public_key, num_bytes*2);
+#else
+    uECC_vli_bytesToNative(_private, private_key, BITS_TO_BYTES(curve->num_n_bits));
+    uECC_vli_bytesToNative(_public, public_key, num_bytes);
+    uECC_vli_bytesToNative(_public + num_words, public_key + num_bytes, num_bytes);
+#endif
+
+    /* Regularize the bitcount for the private key so that attackers cannot use a side channel
+       attack to learn the number of leading zeros. */
+    carry = regularize_k(_private, _private, tmp, curve);
+
+    /* If an RNG function was specified, try to get a random initial Z value to improve
+       protection against side-channel attacks. */
+    if (g_rng_function) {
+        if (!uECC_generate_random_int(p2[carry], curve->p, num_words)) {
+            return 0;
+        }
+        initial_Z = p2[carry];
+    }
+
+    EccPoint_mult(_public, _public, p2[!carry], initial_Z, curve->num_n_bits + 1, curve);
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) secret, (uint8_t *) _public, num_bytes);
+#else
+    uECC_vli_nativeToBytes(secret, num_bytes, _public);
+#endif
+    return !EccPoint_isZero(_public, curve);
+}
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+void uECC_compress(const uint8_t *public_key, uint8_t *compressed, uECC_Curve curve) {
+    wordcount_t i;
+    for (i = 0; i < curve->num_bytes; ++i) {
+        compressed[i+1] = public_key[i];
+    }
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    compressed[0] = 2 + (public_key[curve->num_bytes] & 0x01);
+#else
+    compressed[0] = 2 + (public_key[curve->num_bytes * 2 - 1] & 0x01);
+#endif
+}
+
+void uECC_decompress(const uint8_t *compressed, uint8_t *public_key, uECC_Curve curve) {
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *point = (uECC_word_t *)public_key;
+#else
+    uECC_word_t point[uECC_MAX_WORDS * 2];
+#endif
+    uECC_word_t *y = point + curve->num_words;
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy(public_key, compressed+1, curve->num_bytes);
+#else
+    uECC_vli_bytesToNative(point, compressed + 1, curve->num_bytes);
+#endif
+    curve->x_side(y, point, curve);
+    curve->mod_sqrt(y, curve);
+
+    if ((y[0] & 0x01) != (compressed[0] & 0x01)) {
+        uECC_vli_sub(y, curve->p, y, curve->num_words);
+    }
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+    uECC_vli_nativeToBytes(public_key, curve->num_bytes, point);
+    uECC_vli_nativeToBytes(public_key + curve->num_bytes, curve->num_bytes, y);
+#endif
+}
+#endif /* uECC_SUPPORT_COMPRESSED_POINT */
+
+int uECC_valid_point(const uECC_word_t *point, uECC_Curve curve) {
+    uECC_word_t tmp1[uECC_MAX_WORDS];
+    uECC_word_t tmp2[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+
+    /* The point at infinity is invalid. */
+    if (EccPoint_isZero(point, curve)) {
+        return 0;
+    }
+
+    /* x and y must be smaller than p. */
+    if (uECC_vli_cmp_unsafe(curve->p, point, num_words) != 1 ||
+            uECC_vli_cmp_unsafe(curve->p, point + num_words, num_words) != 1) {
+        return 0;
+    }
+
+    uECC_vli_modSquare_fast(tmp1, point + num_words, curve);
+    curve->x_side(tmp2, point, curve); /* tmp2 = x^3 + ax + b */
+
+    /* Make sure that y^2 == x^3 + ax + b */
+    return (int)(uECC_vli_equal(tmp1, tmp2, num_words));
+}
+
+int uECC_valid_public_key(const uint8_t *public_key, uECC_Curve curve) {
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *_public = (uECC_word_t *)public_key;
+#else
+    uECC_word_t _public[uECC_MAX_WORDS * 2];
+#endif
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+    uECC_vli_bytesToNative(_public, public_key, curve->num_bytes);
+    uECC_vli_bytesToNative(
+        _public + curve->num_words, public_key + curve->num_bytes, curve->num_bytes);
+#endif
+    return uECC_valid_point(_public, curve);
+}
+
+int uECC_compute_public_key(const uint8_t *private_key, uint8_t *public_key, uECC_Curve curve) {
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *_private = (uECC_word_t *)private_key;
+    uECC_word_t *_public = (uECC_word_t *)public_key;
+#else
+    uECC_word_t _private[uECC_MAX_WORDS];
+    uECC_word_t _public[uECC_MAX_WORDS * 2];
+#endif
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+    uECC_vli_bytesToNative(_private, private_key, BITS_TO_BYTES(curve->num_n_bits));
+#endif
+
+    /* Make sure the private key is in the range [1, n-1]. */
+    if (uECC_vli_isZero(_private, BITS_TO_WORDS(curve->num_n_bits))) {
+        return 0;
+    }
+
+    if (uECC_vli_cmp(curve->n, _private, BITS_TO_WORDS(curve->num_n_bits)) != 1) {
+        return 0;
+    }
+
+    /* Compute public key. */
+    if (!EccPoint_compute_public_key(_public, _private, curve)) {
+        return 0;
+    }
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+    uECC_vli_nativeToBytes(public_key, curve->num_bytes, _public);
+    uECC_vli_nativeToBytes(
+        public_key + curve->num_bytes, curve->num_bytes, _public + curve->num_words);
+#endif
+    return 1;
+}
+
+
+/* -------- ECDSA code -------- */
+
+static void bits2int(uECC_word_t *native,
+                     const uint8_t *bits,
+                     unsigned bits_size,
+                     uECC_Curve curve) {
+    unsigned num_n_bytes = BITS_TO_BYTES(curve->num_n_bits);
+    unsigned num_n_words = BITS_TO_WORDS(curve->num_n_bits);
+    int shift;
+    uECC_word_t carry;
+    uECC_word_t *ptr;
+
+    if (bits_size > num_n_bytes) {
+        bits_size = num_n_bytes;
+    }
+
+    uECC_vli_clear(native, num_n_words);
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) native, bits, bits_size);
+#else
+    uECC_vli_bytesToNative(native, bits, bits_size);
+#endif    
+    if (bits_size * 8 <= (unsigned)curve->num_n_bits) {
+        return;
+    }
+    shift = bits_size * 8 - curve->num_n_bits;
+    carry = 0;
+    ptr = native + num_n_words;
+    while (ptr-- > native) {
+        uECC_word_t temp = *ptr;
+        *ptr = (temp >> shift) | carry;
+        carry = temp << (uECC_WORD_BITS - shift);
+    }
+
+    /* Reduce mod curve_n */
+    if (uECC_vli_cmp_unsafe(curve->n, native, num_n_words) != 1) {
+        uECC_vli_sub(native, native, curve->n, num_n_words);
+    }
+}
+
+static int uECC_sign_with_k(const uint8_t *private_key,
+                            const uint8_t *message_hash,
+                            unsigned hash_size,
+                            uECC_word_t *k,
+                            uint8_t *signature,
+                            uECC_Curve curve) {
+
+    uECC_word_t tmp[uECC_MAX_WORDS];
+    uECC_word_t s[uECC_MAX_WORDS];
+    uECC_word_t *k2[2] = {tmp, s};
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *p = (uECC_word_t *)signature;
+#else
+    uECC_word_t p[uECC_MAX_WORDS * 2];
+#endif
+    uECC_word_t carry;
+    wordcount_t num_words = curve->num_words;
+    wordcount_t num_n_words = BITS_TO_WORDS(curve->num_n_bits);
+    bitcount_t num_n_bits = curve->num_n_bits;
+
+    /* Make sure 0 < k < curve_n */
+    if (uECC_vli_isZero(k, num_words) || uECC_vli_cmp(curve->n, k, num_n_words) != 1) {
+        return 0;
+    }
+
+    carry = regularize_k(k, tmp, s, curve);
+    EccPoint_mult(p, curve->G, k2[!carry], 0, num_n_bits + 1, curve);
+    if (uECC_vli_isZero(p, num_words)) {
+        return 0;
+    }
+
+    /* If an RNG function was specified, get a random number
+       to prevent side channel analysis of k. */
+    if (!g_rng_function) {
+        uECC_vli_clear(tmp, num_n_words);
+        tmp[0] = 1;
+    } else if (!uECC_generate_random_int(tmp, curve->n, num_n_words)) {
+        return 0;
+    }
+
+    /* Prevent side channel analysis of uECC_vli_modInv() to determine
+       bits of k / the private key by premultiplying by a random number */
+    uECC_vli_modMult(k, k, tmp, curve->n, num_n_words); /* k' = rand * k */
+    uECC_vli_modInv(k, k, curve->n, num_n_words);       /* k = 1 / k' */
+    uECC_vli_modMult(k, k, tmp, curve->n, num_n_words); /* k = 1 / k */
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN == 0
+    uECC_vli_nativeToBytes(signature, curve->num_bytes, p); /* store r */
+#endif
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) tmp, private_key, BITS_TO_BYTES(curve->num_n_bits));
+#else
+    uECC_vli_bytesToNative(tmp, private_key, BITS_TO_BYTES(curve->num_n_bits)); /* tmp = d */
+#endif
+
+    s[num_n_words - 1] = 0;
+    uECC_vli_set(s, p, num_words);
+    uECC_vli_modMult(s, tmp, s, curve->n, num_n_words); /* s = r*d */
+
+    bits2int(tmp, message_hash, hash_size, curve);
+    uECC_vli_modAdd(s, tmp, s, curve->n, num_n_words); /* s = e + r*d */
+    uECC_vli_modMult(s, s, k, curve->n, num_n_words);  /* s = (e + r*d) / k */
+    if (uECC_vli_numBits(s, num_n_words) > (bitcount_t)curve->num_bytes * 8) {
+        return 0;
+    }
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) signature + curve->num_bytes, (uint8_t *) s, curve->num_bytes);
+#else
+    uECC_vli_nativeToBytes(signature + curve->num_bytes, curve->num_bytes, s);
+#endif    
+    return 1;
+}
+
+int uECC_sign(const uint8_t *private_key,
+              const uint8_t *message_hash,
+              unsigned hash_size,
+              uint8_t *signature,
+              uECC_Curve curve) {
+    uECC_word_t k[uECC_MAX_WORDS];
+    uECC_word_t tries;
+
+    for (tries = 0; tries < uECC_RNG_MAX_TRIES; ++tries) {
+        if (!uECC_generate_random_int(k, curve->n, BITS_TO_WORDS(curve->num_n_bits))) {
+            return 0;
+        }
+
+        if (uECC_sign_with_k(private_key, message_hash, hash_size, k, signature, curve)) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
+/* Compute an HMAC using K as a key (as in RFC 6979). Note that K is always
+   the same size as the hash result size. */
+static void HMAC_init(const uECC_HashContext *hash_context, const uint8_t *K) {
+    uint8_t *pad = hash_context->tmp + 2 * hash_context->result_size;
+    unsigned i;
+    for (i = 0; i < hash_context->result_size; ++i)
+        pad[i] = K[i] ^ 0x36;
+    for (; i < hash_context->block_size; ++i)
+        pad[i] = 0x36;
+
+    hash_context->init_hash(hash_context);
+    hash_context->update_hash(hash_context, pad, hash_context->block_size);
+}
+
+static void HMAC_update(const uECC_HashContext *hash_context,
+                        const uint8_t *message,
+                        unsigned message_size) {
+    hash_context->update_hash(hash_context, message, message_size);
+}
+
+static void HMAC_finish(const uECC_HashContext *hash_context,
+                        const uint8_t *K,
+                        uint8_t *result) {
+    uint8_t *pad = hash_context->tmp + 2 * hash_context->result_size;
+    unsigned i;
+    for (i = 0; i < hash_context->result_size; ++i)
+        pad[i] = K[i] ^ 0x5c;
+    for (; i < hash_context->block_size; ++i)
+        pad[i] = 0x5c;
+
+    hash_context->finish_hash(hash_context, result);
+
+    hash_context->init_hash(hash_context);
+    hash_context->update_hash(hash_context, pad, hash_context->block_size);
+    hash_context->update_hash(hash_context, result, hash_context->result_size);
+    hash_context->finish_hash(hash_context, result);
+}
+
+/* V = HMAC_K(V) */
+static void update_V(const uECC_HashContext *hash_context, uint8_t *K, uint8_t *V) {
+    HMAC_init(hash_context, K);
+    HMAC_update(hash_context, V, hash_context->result_size);
+    HMAC_finish(hash_context, K, V);
+}
+
+/* Deterministic signing, similar to RFC 6979. Differences are:
+    * We just use H(m) directly rather than bits2octets(H(m))
+      (it is not reduced modulo curve_n).
+    * We generate a value for k (aka T) directly rather than converting endianness.
+
+   Layout of hash_context->tmp: <K> | <V> | (1 byte overlapped 0x00 or 0x01) / <HMAC pad> */
+int uECC_sign_deterministic(const uint8_t *private_key,
+                            const uint8_t *message_hash,
+                            unsigned hash_size,
+                            const uECC_HashContext *hash_context,
+                            uint8_t *signature,
+                            uECC_Curve curve) {
+    uint8_t *K = hash_context->tmp;
+    uint8_t *V = K + hash_context->result_size;
+    wordcount_t num_bytes = curve->num_bytes;
+    wordcount_t num_n_words = BITS_TO_WORDS(curve->num_n_bits);
+    bitcount_t num_n_bits = curve->num_n_bits;
+    uECC_word_t tries;
+    unsigned i;
+    for (i = 0; i < hash_context->result_size; ++i) {
+        V[i] = 0x01;
+        K[i] = 0;
+    }
+
+    /* K = HMAC_K(V || 0x00 || int2octets(x) || h(m)) */
+    HMAC_init(hash_context, K);
+    V[hash_context->result_size] = 0x00;
+    HMAC_update(hash_context, V, hash_context->result_size + 1);
+    HMAC_update(hash_context, private_key, num_bytes);
+    HMAC_update(hash_context, message_hash, hash_size);
+    HMAC_finish(hash_context, K, K);
+
+    update_V(hash_context, K, V);
+
+    /* K = HMAC_K(V || 0x01 || int2octets(x) || h(m)) */
+    HMAC_init(hash_context, K);
+    V[hash_context->result_size] = 0x01;
+    HMAC_update(hash_context, V, hash_context->result_size + 1);
+    HMAC_update(hash_context, private_key, num_bytes);
+    HMAC_update(hash_context, message_hash, hash_size);
+    HMAC_finish(hash_context, K, K);
+
+    update_V(hash_context, K, V);
+
+    for (tries = 0; tries < uECC_RNG_MAX_TRIES; ++tries) {
+        uECC_word_t T[uECC_MAX_WORDS];
+        uint8_t *T_ptr = (uint8_t *)T;
+        wordcount_t T_bytes = 0;
+        for (;;) {
+            update_V(hash_context, K, V);
+            for (i = 0; i < hash_context->result_size; ++i) {
+                T_ptr[T_bytes++] = V[i];
+                if (T_bytes >= num_n_words * uECC_WORD_SIZE) {
+                    goto filled;
+                }
+            }
+        }
+    filled:
+        if ((bitcount_t)num_n_words * uECC_WORD_SIZE * 8 > num_n_bits) {
+            uECC_word_t mask = (uECC_word_t)-1;
+            T[num_n_words - 1] &=
+                mask >> ((bitcount_t)(num_n_words * uECC_WORD_SIZE * 8 - num_n_bits));
+        }
+
+        if (uECC_sign_with_k(private_key, message_hash, hash_size, T, signature, curve)) {
+            return 1;
+        }
+
+        /* K = HMAC_K(V || 0x00) */
+        HMAC_init(hash_context, K);
+        V[hash_context->result_size] = 0x00;
+        HMAC_update(hash_context, V, hash_context->result_size + 1);
+        HMAC_finish(hash_context, K, K);
+
+        update_V(hash_context, K, V);
+    }
+    return 0;
+}
+
+static bitcount_t smax(bitcount_t a, bitcount_t b) {
+    return (a > b ? a : b);
+}
+
+int uECC_verify(const uint8_t *public_key,
+                const uint8_t *message_hash,
+                unsigned hash_size,
+                const uint8_t *signature,
+                uECC_Curve curve) {
+    uECC_word_t u1[uECC_MAX_WORDS], u2[uECC_MAX_WORDS];
+    uECC_word_t z[uECC_MAX_WORDS];
+    uECC_word_t sum[uECC_MAX_WORDS * 2];
+    uECC_word_t rx[uECC_MAX_WORDS];
+    uECC_word_t ry[uECC_MAX_WORDS];
+    uECC_word_t tx[uECC_MAX_WORDS];
+    uECC_word_t ty[uECC_MAX_WORDS];
+    uECC_word_t tz[uECC_MAX_WORDS];
+    const uECC_word_t *points[4];
+    const uECC_word_t *point;
+    bitcount_t num_bits;
+    bitcount_t i;
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    uECC_word_t *_public = (uECC_word_t *)public_key;
+#else
+    uECC_word_t _public[uECC_MAX_WORDS * 2];
+#endif    
+    uECC_word_t r[uECC_MAX_WORDS], s[uECC_MAX_WORDS];
+    wordcount_t num_words = curve->num_words;
+    wordcount_t num_n_words = BITS_TO_WORDS(curve->num_n_bits);
+
+    rx[num_n_words - 1] = 0;
+    r[num_n_words - 1] = 0;
+    s[num_n_words - 1] = 0;
+
+#if uECC_VLI_NATIVE_LITTLE_ENDIAN
+    bcopy((uint8_t *) r, signature, curve->num_bytes);
+    bcopy((uint8_t *) s, signature + curve->num_bytes, curve->num_bytes);
+#else
+    uECC_vli_bytesToNative(_public, public_key, curve->num_bytes);
+    uECC_vli_bytesToNative(
+        _public + num_words, public_key + curve->num_bytes, curve->num_bytes);
+    uECC_vli_bytesToNative(r, signature, curve->num_bytes);
+    uECC_vli_bytesToNative(s, signature + curve->num_bytes, curve->num_bytes);
+#endif
+
+    /* r, s must not be 0. */
+    if (uECC_vli_isZero(r, num_words) || uECC_vli_isZero(s, num_words)) {
+        return 0;
+    }
+
+    /* r, s must be < n. */
+    if (uECC_vli_cmp_unsafe(curve->n, r, num_n_words) != 1 ||
+            uECC_vli_cmp_unsafe(curve->n, s, num_n_words) != 1) {
+        return 0;
+    }
+
+    /* Calculate u1 and u2. */
+    uECC_vli_modInv(z, s, curve->n, num_n_words); /* z = 1/s */
+    u1[num_n_words - 1] = 0;
+    bits2int(u1, message_hash, hash_size, curve);
+    uECC_vli_modMult(u1, u1, z, curve->n, num_n_words); /* u1 = e/s */
+    uECC_vli_modMult(u2, r, z, curve->n, num_n_words); /* u2 = r/s */
+
+    /* Calculate sum = G + Q. */
+    uECC_vli_set(sum, _public, num_words);
+    uECC_vli_set(sum + num_words, _public + num_words, num_words);
+    uECC_vli_set(tx, curve->G, num_words);
+    uECC_vli_set(ty, curve->G + num_words, num_words);
+    uECC_vli_modSub(z, sum, tx, curve->p, num_words); /* z = x2 - x1 */
+    XYcZ_add(tx, ty, sum, sum + num_words, curve);
+    uECC_vli_modInv(z, z, curve->p, num_words); /* z = 1/z */
+    apply_z(sum, sum + num_words, z, curve);
+
+    /* Use Shamir's trick to calculate u1*G + u2*Q */
+    points[0] = 0;
+    points[1] = curve->G;
+    points[2] = _public;
+    points[3] = sum;
+    num_bits = smax(uECC_vli_numBits(u1, num_n_words),
+                    uECC_vli_numBits(u2, num_n_words));
+
+    point = points[(!!uECC_vli_testBit(u1, num_bits - 1)) |
+                   ((!!uECC_vli_testBit(u2, num_bits - 1)) << 1)];
+    uECC_vli_set(rx, point, num_words);
+    uECC_vli_set(ry, point + num_words, num_words);
+    uECC_vli_clear(z, num_words);
+    z[0] = 1;
+
+    for (i = num_bits - 2; i >= 0; --i) {
+        uECC_word_t index;
+        curve->double_jacobian(rx, ry, z, curve);
+
+        index = (!!uECC_vli_testBit(u1, i)) | ((!!uECC_vli_testBit(u2, i)) << 1);
+        point = points[index];
+        if (point) {
+            uECC_vli_set(tx, point, num_words);
+            uECC_vli_set(ty, point + num_words, num_words);
+            apply_z(tx, ty, z, curve);
+            uECC_vli_modSub(tz, rx, tx, curve->p, num_words); /* Z = x2 - x1 */
+            XYcZ_add(tx, ty, rx, ry, curve);
+            uECC_vli_modMult_fast(z, z, tz, curve);
+        }
+    }
+
+    uECC_vli_modInv(z, z, curve->p, num_words); /* Z = 1/Z */
+    apply_z(rx, ry, z, curve);
+
+    /* v = x1 (mod n) */
+    if (uECC_vli_cmp_unsafe(curve->n, rx, num_n_words) != 1) {
+        uECC_vli_sub(rx, rx, curve->n, num_n_words);
+    }
+
+    /* Accept only if v == r. */
+    return (int)(uECC_vli_equal(rx, r, num_words));
+}
+
+#if uECC_ENABLE_VLI_API
+
+unsigned uECC_curve_num_words(uECC_Curve curve) {
+    return curve->num_words;
+}
+
+unsigned uECC_curve_num_bytes(uECC_Curve curve) {
+    return curve->num_bytes;
+}
+
+unsigned uECC_curve_num_bits(uECC_Curve curve) {
+    return curve->num_bytes * 8;
+}
+
+unsigned uECC_curve_num_n_words(uECC_Curve curve) {
+    return BITS_TO_WORDS(curve->num_n_bits);
+}
+
+unsigned uECC_curve_num_n_bytes(uECC_Curve curve) {
+    return BITS_TO_BYTES(curve->num_n_bits);
+}
+
+unsigned uECC_curve_num_n_bits(uECC_Curve curve) {
+    return curve->num_n_bits;
+}
+
+const uECC_word_t *uECC_curve_p(uECC_Curve curve) {
+    return curve->p;
+}
+
+const uECC_word_t *uECC_curve_n(uECC_Curve curve) {
+    return curve->n;
+}
+
+const uECC_word_t *uECC_curve_G(uECC_Curve curve) {
+    return curve->G;
+}
+
+const uECC_word_t *uECC_curve_b(uECC_Curve curve) {
+    return curve->b;
+}
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+void uECC_vli_mod_sqrt(uECC_word_t *a, uECC_Curve curve) {
+    curve->mod_sqrt(a, curve);
+}
+#endif
+
+void uECC_vli_mmod_fast(uECC_word_t *result, uECC_word_t *product, uECC_Curve curve) {
+#if (uECC_OPTIMIZATION_LEVEL > 0)
+    curve->mmod_fast(result, product);
+#else
+    uECC_vli_mmod(result, product, curve->p, curve->num_words);
+#endif
+}
+
+void uECC_point_mult(uECC_word_t *result,
+                     const uECC_word_t *point,
+                     const uECC_word_t *scalar,
+                     uECC_Curve curve) {
+    uECC_word_t tmp1[uECC_MAX_WORDS];
+    uECC_word_t tmp2[uECC_MAX_WORDS];
+    uECC_word_t *p2[2] = {tmp1, tmp2};
+    uECC_word_t carry = regularize_k(scalar, tmp1, tmp2, curve);
+
+    EccPoint_mult(result, point, p2[!carry], 0, curve->num_n_bits + 1, curve);
+}
+
+#endif /* uECC_ENABLE_VLI_API */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.h b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.h
new file mode 100644
index 000000000..43a19d63c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC.h
@@ -0,0 +1,365 @@
+/* Copyright 2014, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#ifndef _UECC_H_
+#define _UECC_H_
+
+#include <stdint.h>
+
+/* Platform selection options.
+If uECC_PLATFORM is not defined, the code will try to guess it based on compiler macros.
+Possible values for uECC_PLATFORM are defined below: */
+#define uECC_arch_other 0
+#define uECC_x86        1
+#define uECC_x86_64     2
+#define uECC_arm        3
+#define uECC_arm_thumb  4
+#define uECC_arm_thumb2 5
+#define uECC_arm64      6
+#define uECC_avr        7
+
+/* If desired, you can define uECC_WORD_SIZE as appropriate for your platform (1, 4, or 8 bytes).
+If uECC_WORD_SIZE is not explicitly defined then it will be automatically set based on your
+platform. */
+
+/* Optimization level; trade speed for code size.
+   Larger values produce code that is faster but larger.
+   Currently supported values are 0 - 4; 0 is unusably slow for most applications.
+   Optimization level 4 currently only has an effect ARM platforms where more than one
+   curve is enabled. */
+#ifndef uECC_OPTIMIZATION_LEVEL
+    #define uECC_OPTIMIZATION_LEVEL 2
+#endif
+
+/* uECC_SQUARE_FUNC - If enabled (defined as nonzero), this will cause a specific function to be
+used for (scalar) squaring instead of the generic multiplication function. This can make things
+faster somewhat faster, but increases the code size. */
+#ifndef uECC_SQUARE_FUNC
+    #define uECC_SQUARE_FUNC 0
+#endif
+
+/* uECC_VLI_NATIVE_LITTLE_ENDIAN - If enabled (defined as nonzero), this will switch to native
+little-endian format for *all* arrays passed in and out of the public API. This includes public 
+and private keys, shared secrets, signatures and message hashes. 
+Using this switch reduces the amount of call stack memory used by uECC, since less intermediate
+translations are required. 
+Note that this will *only* work on native little-endian processors and it will treat the uint8_t
+arrays passed into the public API as word arrays, therefore requiring the provided byte arrays 
+to be word aligned on architectures that do not support unaligned accesses.
+IMPORTANT: Keys and signatures generated with uECC_VLI_NATIVE_LITTLE_ENDIAN=1 are incompatible
+with keys and signatures generated with uECC_VLI_NATIVE_LITTLE_ENDIAN=0; all parties must use
+the same endianness. */
+#ifndef uECC_VLI_NATIVE_LITTLE_ENDIAN
+    #define uECC_VLI_NATIVE_LITTLE_ENDIAN 0
+#endif
+
+/* Curve support selection. Set to 0 to remove that curve. */
+#ifndef uECC_SUPPORTS_secp160r1
+    #define uECC_SUPPORTS_secp160r1 1
+#endif
+#ifndef uECC_SUPPORTS_secp192r1
+    #define uECC_SUPPORTS_secp192r1 1
+#endif
+#ifndef uECC_SUPPORTS_secp224r1
+    #define uECC_SUPPORTS_secp224r1 1
+#endif
+#ifndef uECC_SUPPORTS_secp256r1
+    #define uECC_SUPPORTS_secp256r1 1
+#endif
+#ifndef uECC_SUPPORTS_secp256k1
+    #define uECC_SUPPORTS_secp256k1 1
+#endif
+
+/* Specifies whether compressed point format is supported.
+   Set to 0 to disable point compression/decompression functions. */
+#ifndef uECC_SUPPORT_COMPRESSED_POINT
+    #define uECC_SUPPORT_COMPRESSED_POINT 1
+#endif
+
+struct uECC_Curve_t;
+typedef const struct uECC_Curve_t * uECC_Curve;
+
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+#if uECC_SUPPORTS_secp160r1
+uECC_Curve uECC_secp160r1(void);
+#endif
+#if uECC_SUPPORTS_secp192r1
+uECC_Curve uECC_secp192r1(void);
+#endif
+#if uECC_SUPPORTS_secp224r1
+uECC_Curve uECC_secp224r1(void);
+#endif
+#if uECC_SUPPORTS_secp256r1
+uECC_Curve uECC_secp256r1(void);
+#endif
+#if uECC_SUPPORTS_secp256k1
+uECC_Curve uECC_secp256k1(void);
+#endif
+
+/* uECC_RNG_Function type
+The RNG function should fill 'size' random bytes into 'dest'. It should return 1 if
+'dest' was filled with random data, or 0 if the random data could not be generated.
+The filled-in values should be either truly random, or from a cryptographically-secure PRNG.
+
+A correctly functioning RNG function must be set (using uECC_set_rng()) before calling
+uECC_make_key() or uECC_sign().
+
+Setting a correctly functioning RNG function improves the resistance to side-channel attacks
+for uECC_shared_secret() and uECC_sign_deterministic().
+
+A correct RNG function is set by default when building for Windows, Linux, or OS X.
+If you are building on another POSIX-compliant system that supports /dev/random or /dev/urandom,
+you can define uECC_POSIX to use the predefined RNG. For embedded platforms there is no predefined
+RNG function; you must provide your own.
+*/
+typedef int (*uECC_RNG_Function)(uint8_t *dest, unsigned size);
+
+/* uECC_set_rng() function.
+Set the function that will be used to generate random bytes. The RNG function should
+return 1 if the random data was generated, or 0 if the random data could not be generated.
+
+On platforms where there is no predefined RNG function (eg embedded platforms), this must
+be called before uECC_make_key() or uECC_sign() are used.
+
+Inputs:
+    rng_function - The function that will be used to generate random bytes.
+*/
+void uECC_set_rng(uECC_RNG_Function rng_function);
+
+/* uECC_get_rng() function.
+
+Returns the function that will be used to generate random bytes.
+*/
+uECC_RNG_Function uECC_get_rng(void);
+
+/* uECC_curve_private_key_size() function.
+
+Returns the size of a private key for the curve in bytes.
+*/
+int uECC_curve_private_key_size(uECC_Curve curve);
+
+/* uECC_curve_public_key_size() function.
+
+Returns the size of a public key for the curve in bytes.
+*/
+int uECC_curve_public_key_size(uECC_Curve curve);
+
+/* uECC_make_key() function.
+Create a public/private key pair.
+
+Outputs:
+    public_key  - Will be filled in with the public key. Must be at least 2 * the curve size
+                  (in bytes) long. For example, if the curve is secp256r1, public_key must be 64
+                  bytes long.
+    private_key - Will be filled in with the private key. Must be as long as the curve order; this
+                  is typically the same as the curve size, except for secp160r1. For example, if the
+                  curve is secp256r1, private_key must be 32 bytes long.
+
+                  For secp160r1, private_key must be 21 bytes long! Note that the first byte will
+                  almost always be 0 (there is about a 1 in 2^80 chance of it being non-zero).
+
+Returns 1 if the key pair was generated successfully, 0 if an error occurred.
+*/
+int uECC_make_key(uint8_t *public_key, uint8_t *private_key, uECC_Curve curve);
+
+/* uECC_shared_secret() function.
+Compute a shared secret given your secret key and someone else's public key.
+Note: It is recommended that you hash the result of uECC_shared_secret() before using it for
+symmetric encryption or HMAC.
+
+Inputs:
+    public_key  - The public key of the remote party.
+    private_key - Your private key.
+
+Outputs:
+    secret - Will be filled in with the shared secret value. Must be the same size as the
+             curve size; for example, if the curve is secp256r1, secret must be 32 bytes long.
+
+Returns 1 if the shared secret was generated successfully, 0 if an error occurred.
+*/
+int uECC_shared_secret(const uint8_t *public_key,
+                       const uint8_t *private_key,
+                       uint8_t *secret,
+                       uECC_Curve curve);
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+/* uECC_compress() function.
+Compress a public key.
+
+Inputs:
+    public_key - The public key to compress.
+
+Outputs:
+    compressed - Will be filled in with the compressed public key. Must be at least
+                 (curve size + 1) bytes long; for example, if the curve is secp256r1,
+                 compressed must be 33 bytes long.
+*/
+void uECC_compress(const uint8_t *public_key, uint8_t *compressed, uECC_Curve curve);
+
+/* uECC_decompress() function.
+Decompress a compressed public key.
+
+Inputs:
+    compressed - The compressed public key.
+
+Outputs:
+    public_key - Will be filled in with the decompressed public key.
+*/
+void uECC_decompress(const uint8_t *compressed, uint8_t *public_key, uECC_Curve curve);
+#endif /* uECC_SUPPORT_COMPRESSED_POINT */
+
+/* uECC_valid_public_key() function.
+Check to see if a public key is valid.
+
+Note that you are not required to check for a valid public key before using any other uECC
+functions. However, you may wish to avoid spending CPU time computing a shared secret or
+verifying a signature using an invalid public key.
+
+Inputs:
+    public_key - The public key to check.
+
+Returns 1 if the public key is valid, 0 if it is invalid.
+*/
+int uECC_valid_public_key(const uint8_t *public_key, uECC_Curve curve);
+
+/* uECC_compute_public_key() function.
+Compute the corresponding public key for a private key.
+
+Inputs:
+    private_key - The private key to compute the public key for
+
+Outputs:
+    public_key - Will be filled in with the corresponding public key
+
+Returns 1 if the key was computed successfully, 0 if an error occurred.
+*/
+int uECC_compute_public_key(const uint8_t *private_key, uint8_t *public_key, uECC_Curve curve);
+
+/* uECC_sign() function.
+Generate an ECDSA signature for a given hash value.
+
+Usage: Compute a hash of the data you wish to sign (SHA-2 is recommended) and pass it in to
+this function along with your private key.
+
+Inputs:
+    private_key  - Your private key.
+    message_hash - The hash of the message to sign.
+    hash_size    - The size of message_hash in bytes.
+
+Outputs:
+    signature - Will be filled in with the signature value. Must be at least 2 * curve size long.
+                For example, if the curve is secp256r1, signature must be 64 bytes long.
+
+Returns 1 if the signature generated successfully, 0 if an error occurred.
+*/
+int uECC_sign(const uint8_t *private_key,
+              const uint8_t *message_hash,
+              unsigned hash_size,
+              uint8_t *signature,
+              uECC_Curve curve);
+
+/* uECC_HashContext structure.
+This is used to pass in an arbitrary hash function to uECC_sign_deterministic().
+The structure will be used for multiple hash computations; each time a new hash
+is computed, init_hash() will be called, followed by one or more calls to
+update_hash(), and finally a call to finish_hash() to produce the resulting hash.
+
+The intention is that you will create a structure that includes uECC_HashContext
+followed by any hash-specific data. For example:
+
+typedef struct SHA256_HashContext {
+    uECC_HashContext uECC;
+    SHA256_CTX ctx;
+} SHA256_HashContext;
+
+void init_SHA256(uECC_HashContext *base) {
+    SHA256_HashContext *context = (SHA256_HashContext *)base;
+    SHA256_Init(&context->ctx);
+}
+
+void update_SHA256(uECC_HashContext *base,
+                   const uint8_t *message,
+                   unsigned message_size) {
+    SHA256_HashContext *context = (SHA256_HashContext *)base;
+    SHA256_Update(&context->ctx, message, message_size);
+}
+
+void finish_SHA256(uECC_HashContext *base, uint8_t *hash_result) {
+    SHA256_HashContext *context = (SHA256_HashContext *)base;
+    SHA256_Final(hash_result, &context->ctx);
+}
+
+... when signing ...
+{
+    uint8_t tmp[32 + 32 + 64];
+    SHA256_HashContext ctx = {{&init_SHA256, &update_SHA256, &finish_SHA256, 64, 32, tmp}};
+    uECC_sign_deterministic(key, message_hash, &ctx.uECC, signature);
+}
+*/
+typedef struct uECC_HashContext {
+    void (*init_hash)(const struct uECC_HashContext *context);
+    void (*update_hash)(const struct uECC_HashContext *context,
+                        const uint8_t *message,
+                        unsigned message_size);
+    void (*finish_hash)(const struct uECC_HashContext *context, uint8_t *hash_result);
+    unsigned block_size; /* Hash function block size in bytes, eg 64 for SHA-256. */
+    unsigned result_size; /* Hash function result size in bytes, eg 32 for SHA-256. */
+    uint8_t *tmp; /* Must point to a buffer of at least (2 * result_size + block_size) bytes. */
+} uECC_HashContext;
+
+/* uECC_sign_deterministic() function.
+Generate an ECDSA signature for a given hash value, using a deterministic algorithm
+(see RFC 6979). You do not need to set the RNG using uECC_set_rng() before calling
+this function; however, if the RNG is defined it will improve resistance to side-channel
+attacks.
+
+Usage: Compute a hash of the data you wish to sign (SHA-2 is recommended) and pass it to
+this function along with your private key and a hash context. Note that the message_hash
+does not need to be computed with the same hash function used by hash_context.
+
+Inputs:
+    private_key  - Your private key.
+    message_hash - The hash of the message to sign.
+    hash_size    - The size of message_hash in bytes.
+    hash_context - A hash context to use.
+
+Outputs:
+    signature - Will be filled in with the signature value.
+
+Returns 1 if the signature generated successfully, 0 if an error occurred.
+*/
+int uECC_sign_deterministic(const uint8_t *private_key,
+                            const uint8_t *message_hash,
+                            unsigned hash_size,
+                            const uECC_HashContext *hash_context,
+                            uint8_t *signature,
+                            uECC_Curve curve);
+
+/* uECC_verify() function.
+Verify an ECDSA signature.
+
+Usage: Compute the hash of the signed data using the same hash as the signer and
+pass it to this function along with the signer's public key and the signature values (r and s).
+
+Inputs:
+    public_key   - The signer's public key.
+    message_hash - The hash of the signed data.
+    hash_size    - The size of message_hash in bytes.
+    signature    - The signature value.
+
+Returns 1 if the signature is valid, 0 if it is invalid.
+*/
+int uECC_verify(const uint8_t *public_key,
+                const uint8_t *message_hash,
+                unsigned hash_size,
+                const uint8_t *signature,
+                uECC_Curve curve);
+
+#ifdef __cplusplus
+} /* end of extern "C" */
+#endif
+
+#endif /* _UECC_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC_vli.h b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC_vli.h
new file mode 100644
index 000000000..864cc3335
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uECC_vli.h
@@ -0,0 +1,172 @@
+/* Copyright 2015, Kenneth MacKay. Licensed under the BSD 2-clause license. */
+
+#ifndef _UECC_VLI_H_
+#define _UECC_VLI_H_
+
+#include "uECC.h"
+#include "types.h"
+
+/* Functions for raw large-integer manipulation. These are only available
+   if uECC.c is compiled with uECC_ENABLE_VLI_API defined to 1. */
+#ifndef uECC_ENABLE_VLI_API
+    #define uECC_ENABLE_VLI_API 0
+#endif
+
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+
+#if uECC_ENABLE_VLI_API
+
+void uECC_vli_clear(uECC_word_t *vli, wordcount_t num_words);
+
+/* Constant-time comparison to zero - secure way to compare long integers */
+/* Returns 1 if vli == 0, 0 otherwise. */
+uECC_word_t uECC_vli_isZero(const uECC_word_t *vli, wordcount_t num_words);
+
+/* Returns nonzero if bit 'bit' of vli is set. */
+uECC_word_t uECC_vli_testBit(const uECC_word_t *vli, bitcount_t bit);
+
+/* Counts the number of bits required to represent vli. */
+bitcount_t uECC_vli_numBits(const uECC_word_t *vli, const wordcount_t max_words);
+
+/* Sets dest = src. */
+void uECC_vli_set(uECC_word_t *dest, const uECC_word_t *src, wordcount_t num_words);
+
+/* Constant-time comparison function - secure way to compare long integers */
+/* Returns one if left == right, zero otherwise */
+uECC_word_t uECC_vli_equal(const uECC_word_t *left,
+                           const uECC_word_t *right,
+                           wordcount_t num_words);
+
+/* Constant-time comparison function - secure way to compare long integers */
+/* Returns sign of left - right, in constant time. */
+cmpresult_t uECC_vli_cmp(const uECC_word_t *left, const uECC_word_t *right, wordcount_t num_words);
+
+/* Computes vli = vli >> 1. */
+void uECC_vli_rshift1(uECC_word_t *vli, wordcount_t num_words);
+
+/* Computes result = left + right, returning carry. Can modify in place. */
+uECC_word_t uECC_vli_add(uECC_word_t *result,
+                         const uECC_word_t *left,
+                         const uECC_word_t *right,
+                         wordcount_t num_words);
+
+/* Computes result = left - right, returning borrow. Can modify in place. */
+uECC_word_t uECC_vli_sub(uECC_word_t *result,
+                         const uECC_word_t *left,
+                         const uECC_word_t *right,
+                         wordcount_t num_words);
+
+/* Computes result = left * right. Result must be 2 * num_words long. */
+void uECC_vli_mult(uECC_word_t *result,
+                   const uECC_word_t *left,
+                   const uECC_word_t *right,
+                   wordcount_t num_words);
+
+/* Computes result = left^2. Result must be 2 * num_words long. */
+void uECC_vli_square(uECC_word_t *result, const uECC_word_t *left, wordcount_t num_words);
+
+/* Computes result = (left + right) % mod.
+   Assumes that left < mod and right < mod, and that result does not overlap mod. */
+void uECC_vli_modAdd(uECC_word_t *result,
+                     const uECC_word_t *left,
+                     const uECC_word_t *right,
+                     const uECC_word_t *mod,
+                     wordcount_t num_words);
+
+/* Computes result = (left - right) % mod.
+   Assumes that left < mod and right < mod, and that result does not overlap mod. */
+void uECC_vli_modSub(uECC_word_t *result,
+                     const uECC_word_t *left,
+                     const uECC_word_t *right,
+                     const uECC_word_t *mod,
+                     wordcount_t num_words);
+
+/* Computes result = product % mod, where product is 2N words long.
+   Currently only designed to work for mod == curve->p or curve_n. */
+void uECC_vli_mmod(uECC_word_t *result,
+                   uECC_word_t *product,
+                   const uECC_word_t *mod,
+                   wordcount_t num_words);
+
+/* Calculates result = product (mod curve->p), where product is up to
+   2 * curve->num_words long. */
+void uECC_vli_mmod_fast(uECC_word_t *result, uECC_word_t *product, uECC_Curve curve);
+
+/* Computes result = (left * right) % mod.
+   Currently only designed to work for mod == curve->p or curve_n. */
+void uECC_vli_modMult(uECC_word_t *result,
+                      const uECC_word_t *left,
+                      const uECC_word_t *right,
+                      const uECC_word_t *mod,
+                      wordcount_t num_words);
+
+/* Computes result = (left * right) % curve->p. */
+void uECC_vli_modMult_fast(uECC_word_t *result,
+                           const uECC_word_t *left,
+                           const uECC_word_t *right,
+                           uECC_Curve curve);
+
+/* Computes result = left^2 % mod.
+   Currently only designed to work for mod == curve->p or curve_n. */
+void uECC_vli_modSquare(uECC_word_t *result,
+                        const uECC_word_t *left,
+                        const uECC_word_t *mod,
+                        wordcount_t num_words);
+
+/* Computes result = left^2 % curve->p. */
+void uECC_vli_modSquare_fast(uECC_word_t *result, const uECC_word_t *left, uECC_Curve curve);
+
+/* Computes result = (1 / input) % mod.*/
+void uECC_vli_modInv(uECC_word_t *result,
+                     const uECC_word_t *input,
+                     const uECC_word_t *mod,
+                     wordcount_t num_words);
+
+#if uECC_SUPPORT_COMPRESSED_POINT
+/* Calculates a = sqrt(a) (mod curve->p) */
+void uECC_vli_mod_sqrt(uECC_word_t *a, uECC_Curve curve);
+#endif
+
+/* Converts an integer in uECC native format to big-endian bytes. */
+void uECC_vli_nativeToBytes(uint8_t *bytes, int num_bytes, const uECC_word_t *native);
+/* Converts big-endian bytes to an integer in uECC native format. */
+void uECC_vli_bytesToNative(uECC_word_t *native, const uint8_t *bytes, int num_bytes);
+
+unsigned uECC_curve_num_words(uECC_Curve curve);
+unsigned uECC_curve_num_bytes(uECC_Curve curve);
+unsigned uECC_curve_num_bits(uECC_Curve curve);
+unsigned uECC_curve_num_n_words(uECC_Curve curve);
+unsigned uECC_curve_num_n_bytes(uECC_Curve curve);
+unsigned uECC_curve_num_n_bits(uECC_Curve curve);
+
+const uECC_word_t *uECC_curve_p(uECC_Curve curve);
+const uECC_word_t *uECC_curve_n(uECC_Curve curve);
+const uECC_word_t *uECC_curve_G(uECC_Curve curve);
+const uECC_word_t *uECC_curve_b(uECC_Curve curve);
+
+int uECC_valid_point(const uECC_word_t *point, uECC_Curve curve);
+
+/* Multiplies a point by a scalar. Points are represented by the X coordinate followed by
+   the Y coordinate in the same array, both coordinates are curve->num_words long. Note
+   that scalar must be curve->num_n_words long (NOT curve->num_words). */
+void uECC_point_mult(uECC_word_t *result,
+                     const uECC_word_t *point,
+                     const uECC_word_t *scalar,
+                     uECC_Curve curve);
+
+/* Generates a random integer in the range 0 < random < top.
+   Both random and top have num_words words. */
+int uECC_generate_random_int(uECC_word_t *random,
+                             const uECC_word_t *top,
+                             wordcount_t num_words);
+
+#endif /* uECC_ENABLE_VLI_API */
+
+#ifdef __cplusplus
+} /* end of extern "C" */
+#endif
+
+#endif /* _UECC_VLI_H_ */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.ml b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.ml
new file mode 100644
index 000000000..97134ddfd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.ml
@@ -0,0 +1,250 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+type curve
+
+type secp160r1
+type secp192r1
+type secp224r1
+type secp256r1
+type secp256k1
+
+type _ t =
+  | Secp160r1 : curve -> secp160r1 t
+  | Secp192r1 : curve -> secp192r1 t
+  | Secp224r1 : curve -> secp224r1 t
+  | Secp256r1 : curve -> secp256r1 t
+  | Secp256k1 : curve -> secp256k1 t
+
+external curve : int -> curve = "uECC_curve_stub"
+external sk_size : curve -> int = "uECC_curve_private_key_size_stub" [@@noalloc]
+external pk_size : curve -> int = "uECC_curve_public_key_size_stub" [@@noalloc]
+
+let sk_sizes = Hashtbl.create 5
+let pk_sizes = Hashtbl.create 5
+
+let secp160r1 =
+  let c = curve 0 in
+  Hashtbl.add sk_sizes c (sk_size c) ;
+  Hashtbl.add pk_sizes c (pk_size c) ;
+  Secp160r1 c
+let secp192r1 =
+  let c = curve 1 in
+  Hashtbl.add sk_sizes c (sk_size c) ;
+  Hashtbl.add pk_sizes c (pk_size c) ;
+  Secp192r1 c
+let secp224r1 =
+  let c = curve 2 in
+  Hashtbl.add sk_sizes c (sk_size c) ;
+  Hashtbl.add pk_sizes c (pk_size c) ;
+  Secp224r1 c
+let secp256r1 =
+  let c = curve 3 in
+  Hashtbl.add sk_sizes c (sk_size c) ;
+  Hashtbl.add pk_sizes c (pk_size c) ;
+  Secp256r1 c
+let secp256k1 =
+  let c = curve 4 in
+  Hashtbl.add sk_sizes c (sk_size c) ;
+  Hashtbl.add pk_sizes c (pk_size c) ;
+  Secp256k1 c
+
+let to_curve : type a. a t -> curve = function
+  | Secp160r1 curve -> curve
+  | Secp192r1 curve -> curve
+  | Secp224r1 curve -> curve
+  | Secp256r1 curve -> curve
+  | Secp256k1 curve -> curve
+
+let sk_size : type a. a t -> int = function
+  | Secp160r1 curve -> Hashtbl.find sk_sizes curve
+  | Secp192r1 curve -> Hashtbl.find sk_sizes curve
+  | Secp224r1 curve -> Hashtbl.find sk_sizes curve
+  | Secp256r1 curve -> Hashtbl.find sk_sizes curve
+  | Secp256k1 curve -> Hashtbl.find sk_sizes curve
+
+let pk_size : type a. a t -> int = function
+  | Secp160r1 curve -> Hashtbl.find pk_sizes curve
+  | Secp192r1 curve -> Hashtbl.find pk_sizes curve
+  | Secp224r1 curve -> Hashtbl.find pk_sizes curve
+  | Secp256r1 curve -> Hashtbl.find pk_sizes curve
+  | Secp256k1 curve -> Hashtbl.find pk_sizes curve
+
+let compressed_size k =
+  pk_size k / 2 + 1
+
+external keypair :
+  Bigstring.t -> Bigstring.t -> curve -> bool = "uECC_make_key_stub" [@@noalloc]
+
+external pk_of_sk :
+  Bigstring.t -> Bigstring.t -> curve -> bool = "uECC_compute_public_key_stub" [@@noalloc]
+external valid_pk :
+  Bigstring.t -> curve -> bool = "uECC_valid_public_key_stub" [@@noalloc]
+
+external compress :
+  Bigstring.t -> Bigstring.t -> curve -> unit = "uECC_compress_stub" [@@noalloc]
+external decompress :
+  Bigstring.t -> Bigstring.t -> curve -> unit = "uECC_decompress_stub" [@@noalloc]
+
+type secret
+type public
+
+type (_, _) key =
+  | Sk : Bigstring.t * 'a t -> ('a, secret) key
+  | Pk : Bigstring.t * 'a t -> ('a, public) key
+
+let equal : type a b. (a, b) key -> (a, b) key -> bool = fun k1 k2 ->
+  match k1, k2 with
+  | Sk (sk, _), Sk (sk2, _) -> Bigstring.equal sk sk2
+  | Pk (pk, c), Pk (pk2, _) ->
+      let len = compressed_size c in
+      let cpk = Bigstring.create len in
+      let cpk2 = Bigstring.create len in
+      compress pk cpk (to_curve c) ;
+      compress pk2 cpk2 (to_curve c) ;
+      Bigstring.equal cpk cpk2
+
+let neuterize : type a b. (a, b) key -> (a, public) key = function
+  | Pk (pk, curve) -> Pk (pk, curve)
+  | Sk (sk, curve) ->
+      let pk = Bigstring.create (pk_size curve) in
+      let pk_computed_ok = pk_of_sk sk pk (to_curve curve) in
+      let pk_is_valid = valid_pk pk (to_curve curve) in
+      if not pk_computed_ok && pk_is_valid then
+        invalid_arg "Uecc.neuterize" ;
+      Pk (pk, curve)
+
+let pk_of_bytes :
+  type a. a t -> Bigstring.t ->
+  ((a, public) key) option = fun curve buf ->
+  match Bigstring.length buf with
+  | len when len = compressed_size curve ->
+      let c = to_curve curve in
+      let pk = Bigstring.create (pk_size curve) in
+      decompress buf pk c ;
+      if valid_pk pk c then Some (Pk (pk, curve))
+      else None
+  | len when len = pk_size curve + 1 ->
+      let c = to_curve curve in
+      let pk = Bigstring.create (pk_size curve) in
+      Bigstring.blit buf 1 pk 0 (len - 1) ;
+      if Bigstring.get buf 0 = '\004' && valid_pk pk c then
+        Some (Pk (pk, curve))
+      else None
+  | _ -> None
+
+let sk_of_bytes :
+  type a. a t -> Bigstring.t ->
+  ((a, secret) key * (a, public) key) option = fun curve buf ->
+  if Bigstring.length buf <> sk_size curve then None
+  else
+    let sk = Sk (Bigstring.copy buf, curve) in
+    try
+      let pk = neuterize sk in
+      Some (sk, pk)
+    with _ -> None
+
+let to_bytes :
+  type a b. ?compress:bool -> (a, b) key -> Bigstring.t =
+  fun ?compress:(comp=true) -> function
+    | Sk (sk, _) -> Bigstring.copy sk
+    | Pk (pk, c) ->
+        if comp then
+          let buf = Bigstring.create (compressed_size c) in
+          compress pk buf (to_curve c) ;
+          buf
+        else
+          let len = pk_size c in
+          let buf = Bigstring.create (len + 1) in
+          Bigstring.set buf 0 '\004' ;
+          Bigstring.blit pk 0 buf 1 len ;
+          buf
+
+let write_key :
+  type a b. ?compress:bool -> Bigstring.t -> (a, b) key -> int =
+  fun ?compress:(comp=true) buf -> function
+    | Sk (sk, _) ->
+        let len = Bigstring.length sk in
+        Bigstring.blit sk 0 buf 0 len ;
+        len
+    | Pk (pk, c) ->
+        if comp then begin
+          compress pk buf (to_curve c) ;
+          compressed_size c
+        end
+        else
+          let len = Bigstring.length pk in
+          Bigstring.set buf 0 '\004' ;
+          Bigstring.blit pk 0 buf 1 len ;
+          len + 1
+
+let keypair :
+  type a. a t -> ((a, secret) key * (a, public) key) option = fun t ->
+  let sk = Bigstring.create (sk_size t) in
+  let pk = Bigstring.create (pk_size t) in
+  match keypair pk sk (to_curve t) with
+  | true -> Some (Sk (sk, t), Pk (pk, t))
+  | false -> None
+
+external dh :
+  Bigstring.t -> Bigstring.t -> Bigstring.t -> curve -> bool =
+  "uECC_shared_secret_stub" [@@noalloc]
+
+let write_dh (Sk (sk, c)) (Pk (pk, _)) buf =
+  let secret_len = pk_size c / 2 in
+  if Bigstring.length buf < secret_len then 0
+  else
+    match dh pk sk buf (to_curve c) with
+    | true -> secret_len
+    | false -> 0
+
+let dh (Sk (sk, c)) (Pk (pk, _)) =
+  let secret = Bigstring.create (pk_size c / 2) in
+  match dh pk sk secret (to_curve c) with
+  | true -> Some secret
+  | false -> None
+
+(* external sign :
+ *   Bigstring.t -> Bigstring.t -> Bigstring.t -> curve -> bool =
+ *   "uECC_sign_stub" [@@noalloc] *)
+
+external verify :
+  Bigstring.t -> Bigstring.t -> Bigstring.t -> curve -> bool =
+  "uECC_verify_stub" [@@noalloc]
+
+let write_sign (Sk (_sk, _c)) _buf ~msg:_ =
+  failwith "Not implemented"
+(* if Bigstring.length buf < pk_size c then 0
+ * else
+ *   match sign sk msg buf (to_curve c) with
+ *   | true -> pk_size c
+ *   | false -> 0 *)
+
+let sign (Sk (_sk, _c)) _msg =
+  failwith "Not implemented"
+(* let signature = Bigstring.create (pk_size c) in
+ * match sign sk msg signature (to_curve c) with
+ * | true -> Some signature
+ * | false -> None *)
+
+let verify (Pk (pk, c)) ~msg ~signature =
+  if Bigstring.length signature <> pk_size c then false
+  else verify pk msg signature (to_curve c)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.mli b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.mli
new file mode 100644
index 000000000..f5dbe3015
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc.mli
@@ -0,0 +1,112 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  ---------------------------------------------------------------------------*)
+
+type secp160r1
+type secp192r1
+type secp224r1
+type secp256r1
+type secp256k1
+(** Kinds of ECC curves. *)
+
+type _ t
+(** Type of an ECC curve, parametrized by its kind. *)
+
+val secp160r1 : secp160r1 t
+val secp192r1 : secp192r1 t
+val secp224r1 : secp224r1 t
+val secp256r1 : secp256r1 t
+val secp256k1 : secp256k1 t
+(** Supported curves. *)
+
+val sk_size : _ t -> int
+(** [sk_size curve] is the size in bytes of secret keys from
+    [curve]. Typically the same as the curve size, (i.e. 32 bytes for
+    [secp256r1]) except for [secp160r1] which is 21 bytes. *)
+
+val pk_size : _ t -> int
+(** [pk_size curve] is the size in bytes of public keys from
+    [curve]. Equals to [2*curve_size]. *)
+
+val compressed_size : _ t -> int
+(** [compressed_size curve] is the size in bytes of compressed public
+    keys from [curve]. Equals to [pk_size curve/2+1]. *)
+
+type secret
+type public
+type (_, _) key
+(** Type of a key, parametrized by its curve and kind. *)
+
+val equal : ('a, 'b) key -> ('a, 'b) key -> bool
+(** [equal k1 k2] is [true] if [k1] is represented by the same bytes
+    as [k2], and [false] otherwise. *)
+
+val neuterize : ('a, _) key -> ('a, public) key
+(** [neuterize k] is [k] if [k] is public, or is the associated public
+    key of [k] if [k] is secret. *)
+
+val sk_of_bytes :
+  'a t -> Bigstring.t -> (('a, secret) key * ('a, public) key) option
+(** [sk_of_bytes curve buf] is [Some (sk, pk)] if [buf] contains a
+    valid serialization of a [curve] secret key, or [None] otherwise. *)
+
+val pk_of_bytes : 'a t -> Bigstring.t -> ('a, public) key option
+(** [pk_of_bytes curve buf] is [Some pk] if [buf] contains a valid
+    serialization of a [curve] public key, or [None] otherwise. *)
+
+val to_bytes : ?compress:bool -> (_, _) key -> Bigstring.t
+(** [to_bytes ?compress k] is a serialization of [k]. If [compress] is
+    [true] (the default) and [k] is a public key, the public key will
+    be in compressed format. *)
+
+val write_key : ?compress:bool -> Bigstring.t -> (_, _) key -> int
+(** [write_key buf k] writes [k] at [buf] and returns the number of
+    bytes actually written. *)
+
+val keypair : 'a t -> (('a, secret) key * ('a, public) key) option
+(** [keypair curve] is [Some (sk, pk)] where [sk] and [pk] is freshly
+    generated keypair for [curve] if everything went well, or [None]
+    otherwise. *)
+
+val dh : ('a, secret) key -> ('a, public) key -> Bigstring.t option
+(** [dh sk pk] is [Some buf] where [buf] contains a shared secret
+    value computed from your [sk] and someone else's [pk] if everything
+    went well, or [None] otherwise. *)
+
+val write_dh : ('a, secret) key -> ('a, public) key -> Bigstring.t -> int
+(** [write_dh sk pk buf] writes a shared secret value computed from your
+    [sk] and someone else's [pk] and returns the number of bytes
+    actually written (0 in the case of an error). *)
+
+val sign : (_, secret) key -> Bigstring.t -> Bigstring.t option
+(** [sign sk msg] is [Some signature] where [signature] is a valid
+    signature of [msg] with secret key [sk], or [None] if an error
+    occured. *)
+
+val write_sign :
+  (_, secret) key -> Bigstring.t -> msg:Bigstring.t -> int
+(** [write_sign sk ~msg buf] writes a signature of [msg] with [sk] to
+    [buf], and returns the number of bytes written (0 in the case of an
+    error). *)
+
+val verify :
+  (_, public) key -> msg:Bigstring.t -> signature:Bigstring.t -> bool
+(** [verify pk ~msg ~signature] is [true] if [signature] is a valid
+    signature of [msg] corresponding to [pk]. *)
+
+(*---------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  ---------------------------------------------------------------------------*)
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc_stubs.c b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc_stubs.c
new file mode 100644
index 000000000..c6f0126bc
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/src/uecc_stubs.c
@@ -0,0 +1,142 @@
+/* --------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff. All rights reserved.
+   Distributed under the ISC license, see terms at the end of the file.
+  --------------------------------------------------------------------------- */
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/bigarray.h>
+#include "uECC.h"
+
+#define Curve_val(v) (*((uECC_Curve *) Data_custom_val(v)))
+
+#define Gen_custom_block(SNAME, CNAME, MNAME)                           \
+    static int compare_##SNAME(value a, value b) {                      \
+        CNAME aa = MNAME(a), bb = MNAME(b);                             \
+        return (aa == bb ? 0 : (aa < bb ? -1 : 1));                     \
+    }                                                                   \
+                                                                        \
+    static struct custom_operations uecc_##SNAME##_ops = {		\
+        .identifier = "uecc_" #SNAME,					\
+        .finalize = custom_finalize_default,                            \
+        .compare = compare_##SNAME,                                     \
+        .compare_ext = custom_compare_ext_default,                      \
+        .hash = custom_hash_default,                                    \
+        .serialize = custom_serialize_default,                          \
+        .deserialize = custom_deserialize_default                       \
+    };                                                                  \
+                                                                        \
+    static value alloc_##SNAME (CNAME a) {                              \
+        value custom = alloc_custom(&uecc_##SNAME##_ops, sizeof(CNAME), 0, 1); \
+        MNAME(custom) = a;                                              \
+        return custom;                                                  \
+    }
+
+Gen_custom_block(curve, uECC_Curve, Curve_val)
+
+CAMLprim value uECC_curve_stub(value kind) {
+    CAMLparam1(kind);
+    CAMLlocal1(ret);
+
+    uECC_Curve c;
+    switch(Int_val(kind)) {
+    case 0:
+        c = uECC_secp160r1();
+        break;
+    case 1:
+        c = uECC_secp192r1();
+        break;
+    case 2:
+        c = uECC_secp224r1();
+        break;
+    case 3:
+        c = uECC_secp256r1();
+        break;
+    case 4:
+        c = uECC_secp256k1();
+        break;
+    }
+
+    ret = alloc_curve(c);
+    CAMLreturn(ret);
+}
+
+CAMLprim value uECC_curve_private_key_size_stub(value curve) {
+    return Val_int(uECC_curve_private_key_size(Curve_val(curve)));
+}
+
+CAMLprim value uECC_curve_public_key_size_stub(value curve) {
+    return Val_int(uECC_curve_public_key_size(Curve_val(curve)));
+}
+
+CAMLprim value uECC_make_key_stub(value pk, value sk, value curve) {
+    return Val_bool(uECC_make_key(Caml_ba_data_val(pk),
+                                  Caml_ba_data_val(sk),
+                                  Curve_val(curve)));
+}
+
+CAMLprim value uECC_valid_public_key_stub(value pk, value curve) {
+    return Val_bool(uECC_valid_public_key(Caml_ba_data_val(pk),
+                                          Curve_val(curve)));
+}
+
+CAMLprim value uECC_compute_public_key_stub(value sk, value pk, value curve) {
+    return Val_bool(uECC_compute_public_key(Caml_ba_data_val(sk),
+                                            Caml_ba_data_val(pk),
+                                            Curve_val(curve)));
+}
+
+CAMLprim value uECC_compress_stub(value pk, value cpk, value curve) {
+    uECC_compress(Caml_ba_data_val(pk),
+                  Caml_ba_data_val(cpk),
+                  Curve_val(curve));
+    return Val_unit;
+}
+
+CAMLprim value uECC_decompress_stub(value cpk, value pk, value curve) {
+    uECC_decompress(Caml_ba_data_val(cpk),
+                    Caml_ba_data_val(pk),
+                    Curve_val(curve));
+    return Val_unit;
+}
+
+CAMLprim value uECC_shared_secret_stub(value pk, value sk, value secret, value curve) {
+    return Val_bool(uECC_shared_secret(Caml_ba_data_val(pk),
+                                       Caml_ba_data_val(sk),
+                                       Caml_ba_data_val(secret),
+                                       Curve_val(curve)));
+}
+
+CAMLprim value uECC_sign_stub(value sk, value msg, value signature, value curve) {
+    return Val_bool(uECC_sign(Caml_ba_data_val(sk),
+                              Caml_ba_data_val(msg),
+                              Caml_ba_array_val(msg)->dim[0],
+                              Caml_ba_data_val(signature),
+                              Curve_val(curve)));
+}
+
+CAMLprim value uECC_verify_stub(value pk, value msg, value signature, value curve) {
+    return Val_bool(uECC_verify(Caml_ba_data_val(pk),
+                                Caml_ba_data_val(msg),
+                                Caml_ba_array_val(msg)->dim[0],
+                                Caml_ba_data_val(signature),
+                                Curve_val(curve)));
+}
+
+/* --------------------------------------------------------------------------
+   Copyright (c) 2017 Vincent Bernardoff
+
+   Permission to use, copy, modify, and/or distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+  --------------------------------------------------------------------------- */
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/test/dune b/vendors/tezos-modded/vendors/ocaml-uecc/test/dune
new file mode 100644
index 000000000..5d6e6661d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/test/dune
@@ -0,0 +1,22 @@
+(executable
+ (name test)
+ (modules Test)
+ (libraries alcotest uecc))
+
+(executable
+ (name test_vectors)
+ (modules Vectors Test_vectors)
+ (libraries cstruct hex alcotest uecc))
+
+(alias
+ (name    runtest-uecc)
+ (action  (run %{exe:test.exe})))
+
+(alias
+ (name    runtest-uecc-vectors)
+ (action  (run %{exe:test_vectors.exe})))
+
+(alias
+ (name    runtest)
+ (deps    (alias runtest-uecc)
+          (alias runtest-uecc-vectors)))
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/test/test.ml b/vendors/tezos-modded/vendors/ocaml-uecc/test/test.ml
new file mode 100644
index 000000000..b6757964d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/test/test.ml
@@ -0,0 +1,173 @@
+open Alcotest
+open Uecc
+
+let nb_iterations = 10
+
+let checki = check int
+
+let test_sksize () =
+  checki __LOC__ 21 (sk_size secp160r1) ;
+  checki __LOC__ 24 (sk_size secp192r1) ;
+  checki __LOC__ 28 (sk_size secp224r1) ;
+  checki __LOC__ 32 (sk_size secp256r1) ;
+  checki __LOC__ 32 (sk_size secp256k1) ;
+  ()
+
+let test_pksize () =
+  checki __LOC__ 40 (pk_size secp160r1) ;
+  checki __LOC__ 48 (pk_size secp192r1) ;
+  checki __LOC__ 56 (pk_size secp224r1) ;
+  checki __LOC__ 64 (pk_size secp256r1) ;
+  checki __LOC__ 64 (pk_size secp256k1) ;
+  ()
+
+let test_export_curve curve =
+  match keypair curve with
+  | None -> assert false
+  | Some (sk, pk) ->
+      let sk_bytes = to_bytes ~compress:false sk in
+      let pk_bytes = to_bytes ~compress:false pk in
+      checki __LOC__ (sk_size curve) (Bigstring.length sk_bytes) ;
+      checki __LOC__ (pk_size curve + 1) (Bigstring.length pk_bytes) ;
+      match sk_of_bytes curve sk_bytes,
+            pk_of_bytes curve pk_bytes with
+      | Some (sk', pk'), Some pk'' ->
+          assert (equal sk sk') ;
+          assert (equal pk pk') ;
+          assert (equal pk pk'') ;
+          assert (equal pk' pk') ;
+      | _ -> assert false
+
+let test_export_curve curve =
+  for _i = 0 to nb_iterations - 1 do
+    test_export_curve curve
+  done
+
+let test_export () =
+  test_export_curve secp160r1 ;
+  test_export_curve secp192r1 ;
+  test_export_curve secp224r1 ;
+  test_export_curve secp256r1 ;
+  test_export_curve secp256k1 ;
+  ()
+
+let test_export_curve_compressed curve =
+  match keypair curve with
+  | None -> assert false
+  | Some (sk, pk) ->
+      let sk_bytes = to_bytes sk in
+      let pk_bytes = to_bytes pk in
+      checki __LOC__ (sk_size curve) (Bigstring.length sk_bytes) ;
+      checki __LOC__ (compressed_size curve) (Bigstring.length pk_bytes) ;
+      match sk_of_bytes curve sk_bytes,
+            pk_of_bytes curve pk_bytes with
+      | Some (sk', pk'), Some pk'' ->
+          assert (equal sk sk') ;
+          assert (equal pk pk') ;
+          assert (equal pk pk'') ;
+          assert (equal pk' pk') ;
+      | _ -> assert false
+
+let test_export_curve_compressed curve =
+  for _i = 0 to nb_iterations - 1 do
+    test_export_curve_compressed curve
+  done
+
+let test_export_compressed () =
+  test_export_curve_compressed secp160r1 ;
+  test_export_curve_compressed secp192r1 ;
+  test_export_curve_compressed secp224r1 ;
+  test_export_curve_compressed secp256r1 ;
+  test_export_curve_compressed secp256k1 ;
+  ()
+
+let test_keypair_curve curve =
+  match keypair curve with
+  | None -> assert false
+  | Some (sk, pk) ->
+      assert (equal sk sk) ;
+      assert (equal pk pk) ;
+      let pk' = neuterize sk in
+      assert (equal pk pk')
+
+let test_keypair_curve curve =
+  for _i = 0 to nb_iterations - 1 do
+    test_keypair_curve curve
+  done
+
+let test_keypair () =
+  test_keypair_curve secp160r1 ;
+  test_keypair_curve secp192r1 ;
+  test_keypair_curve secp224r1 ;
+  test_keypair_curve secp256r1 ;
+  test_keypair_curve secp256k1 ;
+  ()
+
+let test_dh_curve curve =
+  match keypair curve, keypair curve with
+  | Some (sk, pk), Some (sk', pk') ->
+      begin match dh sk pk', dh sk' pk with
+        | Some secret, Some secret' ->
+            assert (Bigstring.equal secret secret')
+        | _ -> assert false
+      end
+  | _ -> assert false
+
+let test_dh_curve curve =
+  for _i = 0 to nb_iterations - 1 do
+    test_dh_curve curve
+  done
+
+let test_dh () =
+  test_dh_curve secp160r1 ;
+  test_dh_curve secp192r1 ;
+  test_dh_curve secp224r1 ;
+  test_dh_curve secp256r1 ;
+  test_dh_curve secp256k1 ;
+  ()
+
+let msg =
+  Bigstring.of_string "Voulez-vous coucher avec moi, ce soir ?"
+
+let test_sign_curve curve =
+  match keypair curve with
+  | None -> assert false
+  | Some (sk, pk) ->
+      let signature = Bigstring.create (pk_size curve) in
+      begin match write_sign sk signature ~msg with
+        | nb_written when nb_written = (pk_size curve) ->
+            assert (verify pk ~msg ~signature)
+        | _ -> assert false
+      end ;
+      match sign sk msg with
+      | None -> assert false
+      | Some signature ->
+          assert (verify pk ~msg ~signature)
+
+let test_sign_curve curve =
+  for _i = 0 to nb_iterations - 1 do
+    test_sign_curve curve
+  done
+
+let test_sign () =
+  test_sign_curve secp160r1 ;
+  test_sign_curve secp192r1 ;
+  test_sign_curve secp224r1 ;
+  test_sign_curve secp256r1 ;
+  test_sign_curve secp256k1 ;
+  ()
+
+let basic = [
+  "sksize", `Quick, test_sksize ;
+  "pksize", `Quick, test_pksize ;
+  "export", `Quick, test_export ;
+  "export_compressed", `Quick, test_export_compressed ;
+  "keypair", `Quick, test_keypair ;
+  "dh", `Quick, test_dh ;
+  (* "sign", `Quick, test_sign ; *)
+]
+
+let () =
+  Alcotest.run "uecc" [
+    "basic", basic ;
+  ]
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.c b/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.c
new file mode 100644
index 000000000..3eca7169b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.c
@@ -0,0 +1,151 @@
+#include <stdbool.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <assert.h>
+#include <openssl/bio.h>
+#include <openssl/err.h>
+#include <openssl/obj_mac.h>
+#include <openssl/bn.h>
+#include <openssl/ec.h>
+#include <openssl/sha.h>
+#include <openssl/opensslv.h>
+
+#define CURVE_P256 NID_X9_62_prime256v1
+BIO* err_bio;
+
+unsigned char msg[10][32];
+const unsigned char seed[] = "Tadam!!";
+const char sks[][65] =
+    { "D63FF7D5D8FB7334287CB397F824B3567178BB635CD2FAA8A34D0B1BC65FDAF2",
+      "9D585160C3AD171D7F4925F359C2B4C8992730DBAEE4D4D10B1E0E489CCA3404",
+      "62FAA069EE7286D027747656EC736F29D20E5BF827F1D531B1A9DE215AF876F3",
+      "2FE21C081FFA7CBD631E6F20B05B870D64A252A3B7E1A125C3D07E7B6BBFF41B",
+      "BC8CB5B05C306B5561CCBAAFE3777C267A8CDEFA6D00B5CE2E65578DEA030F3C",
+      "610B1C48263CFEA3AEF9C3EF7DE9D39899155BAD1EC66F50165453429032ED9C",
+      "36149C23680AD42DE8C516DE685A52411086EB9556244A83393FC10CEE12F7C5",
+      "0866AD7FBCE585B740799D508824A547E877CC5F7D64E121FF13016AAF74B734",
+      "8D05026AF08E9FFDDB2C485E1A0F1D093C34C5D77962BF31F1437CF0D44CE9D5",
+      "B495924045946A563F436F5408A68FA21B9782DFC56F44ED90B12130CF9D926A"
+    };
+
+const char pks[][67] =
+    { "02CA5364C4302C38E93F8A4850E61A8FE6C27E386D4541B898F4E74BE5E6DD0256",
+      "03D6008C2A656DD414C6869558A1E262F38BD5A142039FE84E750335C543B376B9",
+      "03812447C00050CA921B05A6097C3F29F4ADFF23C4DD6062CBB114DD5B917D1995",
+      "03BBF4A1B5DF7E66E1FFC67AD2778F5E3A78717027FEBFB940C0C3CFC73F052583",
+      "0276285EE239631F904401C2C2A22CEFDF7590546ED3AA4E2B2759F16DD7709D6B",
+      "03BD396999184DBCA1CBA0596A9BA2E973BFA1AF610F8458A1280DDCB9EAE9EA0E",
+      "023F35281E1AC1EA0589BA9D7FE7C21BA331D2A7A12B3EF2EFE20BEC6639283769",
+      "0345FFE8A13964727E2D27FD5471D8899CB3C3EE6EDDE81F2C8E19E2EA1FE98160",
+      "03DF08C9BE891DA811A86914C58B0BE798769FC756A2BD80878B33D9E7373D99A3",
+      "02823ACE5698ABE2F45C6C9BCB6920AA5183D0ECE663B6B93C213A02F4766CE6A5"
+    };
+
+void init_msgs() {
+    SHA256(seed, 32, msg[0]);
+    for (int i=1; i<10; i++) {
+        SHA256(msg[i-1], 32, msg[i]);
+    }
+}
+
+void test_encoding() {
+    char* hex;
+    EC_GROUP *g = EC_GROUP_new_by_curve_name(CURVE_P256);
+    EC_KEY *k = EC_KEY_new_by_curve_name(CURVE_P256);
+    if (!EC_KEY_generate_key(k)) goto error;
+    const EC_POINT *pk = EC_KEY_get0_public_key(k);
+    EC_POINT *pk2 = EC_POINT_new(g);
+    hex = EC_POINT_point2hex(g, pk, POINT_CONVERSION_COMPRESSED, NULL);
+    printf("Test: %s\n", hex);
+    if (hex == NULL) goto error;
+    if (EC_POINT_hex2point(g, hex, pk2, NULL) == NULL) goto error;
+    OPENSSL_free(hex);
+    if (EC_POINT_cmp(g, pk, pk2, NULL)) goto error;
+    return;
+
+ error:
+    ERR_print_errors(err_bio);
+    exit(EXIT_FAILURE);
+}
+
+void vectors_of_key(EC_GROUP *g, EC_KEY *k) {
+    const BIGNUM *sk = EC_KEY_get0_private_key(k);
+    const EC_POINT *pk = EC_KEY_get0_public_key(k);
+    if (sk == NULL) goto error;
+    if (pk == NULL) goto error;
+
+    char *sk_hex = BN_bn2hex(sk);
+    if (sk_hex == NULL) goto error;
+
+    char *pk_hex = EC_POINT_point2hex(g, pk, POINT_CONVERSION_COMPRESSED, NULL);
+    if (pk_hex == NULL) goto error;
+
+    printf("\"%s\", \"%s\";\n\n", sk_hex, pk_hex);
+
+    ECDSA_SIG *sig;
+    const BIGNUM *r, *s;
+    int valid;
+    for (int i=0; i<10; i++) {
+        sig = ECDSA_do_sign(msg[i], 32, k);
+        valid = ECDSA_do_verify(msg[i], 32, sig, k);
+        if (valid == -1) goto error;
+        assert(valid);
+        if (sig == NULL || r == NULL || s == NULL) goto error;
+        ECDSA_SIG_get0(sig, &r, &s);
+        printf("\"%s\", \"%s\";\n", BN_bn2hex(r), BN_bn2hex(s));
+    }
+    printf("\n");
+
+    OPENSSL_free(sk_hex);
+    OPENSSL_free(pk_hex);
+    return;
+
+ error:
+    ERR_print_errors(err_bio);
+    exit(EXIT_FAILURE);
+}
+
+int main(int argc, char** argv) {
+    EC_GROUP *group;
+    BIGNUM *sk;
+    EC_POINT *pk;
+    EC_KEY *k;
+
+    OPENSSL_init();
+    err_bio = BIO_new_fd(STDERR_FILENO, false);
+
+    /* for (int i=0; i<10; i++) test_encoding(); */
+    init_msgs();
+
+    for (int i=0; i<10; i++) {
+        printf("\"");
+        for (int j=0; j<32; j++)
+            printf("%02x", msg[i][j]);
+        printf("\";\n");
+    }
+
+    group = EC_GROUP_new_by_curve_name(CURVE_P256);
+    if (group == NULL) goto error;
+
+    k = EC_KEY_new_by_curve_name(CURVE_P256);
+    if (k == NULL) goto error;
+
+    for (int i=0; i<sizeof(sks)/sizeof(sks[0]); i++) {
+        /* if (!EC_KEY_generate_key(k)) goto error; */
+        sk = BN_new();
+        pk = EC_POINT_new(group);
+        if (sk == NULL) goto error;
+        if (!BN_hex2bn(&sk, sks[i])) goto error;
+        if (EC_POINT_hex2point(group, pks[i], pk, NULL) == NULL) goto error;
+        if (!EC_KEY_set_private_key(k, sk)) goto error;
+        if (!EC_KEY_set_public_key(k, pk)) goto error;
+        if (!EC_KEY_check_key(k)) goto error;
+        vectors_of_key(group, k);
+    }
+    return EXIT_SUCCESS;
+
+ error:
+    ERR_print_errors(err_bio);
+    return EXIT_FAILURE;
+}
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.ml b/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.ml
new file mode 100644
index 000000000..36fc1e8dd
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/test/test_vectors.ml
@@ -0,0 +1,33 @@
+open Uecc
+open Vectors
+
+let bigstring_of_hex hex_str =
+  Cstruct.(to_bigarray (of_hex hex_str))
+
+let msgs =
+  List.map bigstring_of_hex msgs
+
+let keys =
+  List.map begin fun (sk, pk) ->
+    match
+      sk_of_bytes secp256r1 (bigstring_of_hex sk),
+      pk_of_bytes secp256r1 (bigstring_of_hex pk) with
+    | Some (sk, pk), Some pk' when pk = pk' -> sk, pk
+    | _ -> failwith "invalid key"
+  end keys
+
+let sigs =
+  List.map begin fun block ->
+    List.map begin fun (r, s) ->
+      let r = bigstring_of_hex r in
+      let s = bigstring_of_hex s in
+      Bigstring.concat "" [r; s]
+    end block
+  end sigs
+
+let () =
+  List.iter2 begin fun (_sk, pk) sigs ->
+    List.iter2 begin fun msg signature ->
+      assert (verify pk ~msg ~signature)
+    end msgs sigs
+  end keys sigs
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/test/vectors.ml b/vendors/tezos-modded/vendors/ocaml-uecc/test/vectors.ml
new file mode 100644
index 000000000..d60cf2d6e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/test/vectors.ml
@@ -0,0 +1,157 @@
+let msgs = [
+  "c9bd5b35d48f71b48656c39e395e4d138a45df54b7c03fad7330f5fa3f42a44d";
+  "c2a49dc5141afdf02480dc2e9d7ec3f602ccc6cf322a0a9b481c80d37170713c";
+  "72e8b038fd5cbe8a3f2bb8e9ffc8f48f39143279210e8bfa0131445da9d76b93";
+  "6aeee423a44030de1632b7d4e42afc04473f9de218a11358016cd04a3dcc8593";
+  "ba52a5eb037ceecd38bad63d2f004a46bd3ab7f6632d5aa72fe7ee1275e8a704";
+  "bf49613ff391a12081cfca9ef682784aeeeb4c7774d8259627544e71b14ed15b";
+  "582f18a35c36b2403ea78d8b78515dbb8aef4e666ae1ef68795f0969a84e3f28";
+  "201b2e9fd3eac2e8c2ec737789551c052db59c9d8c90817c8af044a4de10c694";
+  "20ec8437edc2d7b208b281997199da0362c3b619c77853f4330d00a366cbceff";
+  "b404a9e26011d26f85e1ab3f327b90e582be990f664fc4af3924c9226b908828";
+]
+
+let keys = [
+  "D63FF7D5D8FB7334287CB397F824B3567178BB635CD2FAA8A34D0B1BC65FDAF2", "02CA5364C4302C38E93F8A4850E61A8FE6C27E386D4541B898F4E74BE5E6DD0256";
+  "9D585160C3AD171D7F4925F359C2B4C8992730DBAEE4D4D10B1E0E489CCA3404", "03D6008C2A656DD414C6869558A1E262F38BD5A142039FE84E750335C543B376B9";
+  "62FAA069EE7286D027747656EC736F29D20E5BF827F1D531B1A9DE215AF876F3", "03812447C00050CA921B05A6097C3F29F4ADFF23C4DD6062CBB114DD5B917D1995";
+  "2FE21C081FFA7CBD631E6F20B05B870D64A252A3B7E1A125C3D07E7B6BBFF41B", "03BBF4A1B5DF7E66E1FFC67AD2778F5E3A78717027FEBFB940C0C3CFC73F052583";
+  "BC8CB5B05C306B5561CCBAAFE3777C267A8CDEFA6D00B5CE2E65578DEA030F3C", "0276285EE239631F904401C2C2A22CEFDF7590546ED3AA4E2B2759F16DD7709D6B";
+  "610B1C48263CFEA3AEF9C3EF7DE9D39899155BAD1EC66F50165453429032ED9C", "03BD396999184DBCA1CBA0596A9BA2E973BFA1AF610F8458A1280DDCB9EAE9EA0E";
+  "36149C23680AD42DE8C516DE685A52411086EB9556244A83393FC10CEE12F7C5", "023F35281E1AC1EA0589BA9D7FE7C21BA331D2A7A12B3EF2EFE20BEC6639283769";
+  "0866AD7FBCE585B740799D508824A547E877CC5F7D64E121FF13016AAF74B734", "0345FFE8A13964727E2D27FD5471D8899CB3C3EE6EDDE81F2C8E19E2EA1FE98160";
+  "8D05026AF08E9FFDDB2C485E1A0F1D093C34C5D77962BF31F1437CF0D44CE9D5", "03DF08C9BE891DA811A86914C58B0BE798769FC756A2BD80878B33D9E7373D99A3";
+  "B495924045946A563F436F5408A68FA21B9782DFC56F44ED90B12130CF9D926A", "02823ACE5698ABE2F45C6C9BCB6920AA5183D0ECE663B6B93C213A02F4766CE6A5";
+]
+
+let sigs = [
+  [
+    "2993E89EF2190B133449447C014A358E44618224E52C27AC83B3468D615FC390", "7A398C8E09359F54E1E5301F0A70DA61BCA0EFC15F037A0A745B78D25F6ABD8F";
+    "6F89D730F8F95BA32776E7FA1363177615B5955405017AEF0DD7C2474850764E", "681DF8E9541892B165E350689246918B9713D9E4FF038C3689BC46375CFCB7B7";
+    "2FBE99E3C49C82B539885D522A8D3FA452C91D71D5221873C1402CBF659B5810", "48E56A7360224DC094BD396C4C25D626A21C932320A0DB0427FDBE14FAE20D72";
+    "0365BF5DDDE6D76843E2BA6AB9000A9E67F1B1FD844ACE78619FD19B22C06D8F", "640F70EA7D40E096D1EF5E5ECC93AE3E8494A671FA61BBAADE7CDE410DF73B23";
+    "F8CA27D6C8661F452E0A942646F9457EBBB611304E11449B4EB55CDEE5E13E5E", "E19853B34B666E4470C94BAE4C460CACA29DF19D3ADE3B4CB5E3E6B87353F348";
+    "97835322DE8AE0696FC3B589F022053260098BB3802316A10499DF256B4BF6B9", "329149ACE513F7DD5EFDE1109FC35F190EC164BFE128E1F4A21A13C731251AA2";
+    "93150473204DF1C253E9F9CF89B955B5C9A2772FD090283EA31E01CCB298C1F2", "4784653C85F5E9FA903F39074965C9EAD54924DCEA74399FDB47CA4E15D73789";
+    "4F4FD87427A8C38126F17AA48A24B4E0E6EE42B15F97C43186B67263082BC445", "771797C887D528E82459C8FF1AC44776D1ECC4405F06A01B823F8C51323A2F03";
+    "44DBE56BE142276D1511E358D0EE11758DA23A23AA1C22B5E24FED5EB4F4B020", "5347E75C9A51E0587E41B3753622FE477269989F2D148453DE600C8CD4B61481";
+    "D7090A223AAB6D9C78766BF7EE6DAABB1339E39081C8AA9DE01FA88A3E1D0C95", "82E0670D9EBFC897FFC64085F750D4AA0EA9CE0060B6CC7BD814BB3D3DBD45F3";
+
+  ];
+  [
+    "3E820E2D38508721A2C306453FCB4876C871EFF458B4D67A331B62E3D35F319C", "7F4DD16617A34FBD129E8559B54E6EB1B98966E3E7F1E16D4E98AD19D0C65101";
+    "A03A20058473B0A4FC2442EB9269FCA1B7925CCE81877D793AC103EF6CE16B9D", "8E4CD4B5BC3238579BDAD6C0A13922DE457157E1EA226F4A07EE214272FCD44E";
+    "3E0BB9EFD944C658EB65B5A00D729972982E1F8E49D0007B4F7B3481A137EF54", "27C564A6B4337DB8A39F188073CC3E5B5AE00E487228B4340C0FC5739F7C09A6";
+    "BCB837DB845BACE2C282D547D0338EB417603DD07E0CBB35E370183451057B74", "6236A33D34AD6A06BAD7D0CAF910A7B992225C63F1977ECABDC20F49F10CCD97";
+    "AB62075658B7D19A9752D7639FA5063E6D7BA08DE72E00A0C691DC352C9AD962", "53CBF8A896208D7A9D7A56CE57B08F2B00FEE748DF29A9F69B8AB61049DD3A8D";
+    "0B703E9133978DC668B2C9A6B30E5C12F3446557C6E68769C6B383D754A64D8E", "9DD1FCFA3566A53F76CDDFDFA525667E8057C84741B20E18261F36FA5FF4D3CA";
+    "A03EC5801603A87178421E778A835A9D1D7BFB985B06E308CE182B49930DC362", "C3FA50430B83CD0EF61B284F4526F29DEC8C239F00657DB6F5FC0660FC7D5314";
+    "41A7C97D65B52DB132B126689D0626776EC8B5C74BF9D95391CE0659FD04FDEF", "5A9EDA4E725A230B866DEFF2A97D8E29DE293CFC2083770DF66E80062268681D";
+    "4D86C9C9DAB4F772245602ED8A61CF29122F62012D2910818A057FA0C35D74E8", "5DD4E4349D55D5BC5A23D6B27150E2B31C4A0C5D4A62ED9FA3A48128CDBA6935";
+    "3D28C32230F49BC145C28D26DE67E52C5F77AC3D99E01374AC0CD5C19E0F650A", "BD6919C7223F762CA8EDF6A7B34D63BC443E55964ADF4D379A13AD2339D57BAD";
+
+  ];
+  [
+    "507397351356C48A03F5089F29F0DA00B18A5EBD8932BEB3840A79CAB9CAA6BE", "25AEBDE6E3376096A799B93C14A27A679DDE80EA6D465329D9DD3015EC2ADAA5";
+    "D0FF19A923126F55455749F7D2E9EAAB1EE9D0706FC3B08D91B41CF46C84A79E", "557AF9B6F31E429220E8530570FE0F53DF520EC126BCF707F058A74059878E26";
+    "BD5A17D5D54C538D0BFAF7D215BB1F3A18E6CA6802C13CF7CFB93401BE6F96A4", "D9435EB188209C731405B849CA6A1DC967106E3515DF3601D9EA183909737033";
+    "F9089078FF8984C3303E4ACEA87B634EDF3155AA3937B32B93C44CFB3DB37F49", "F7F2C39F9AA2D5AEC858C5DCB32CC7DE9C48561BA12BABAEAF567D279AAE93A3";
+    "9CF5D1F80AEC5BFB1A7F6323D2DC0CB752532B42B4BBA7711C50020018EC7A91", "5368DE5375DA38461C56FCBD39361A24F5AA5236B7026637B615B243FBBF8CED";
+    "5C978424C73A16A626F6D39C93DB9C4FFE0593CAF7FCC1BDB6C665D5884716E1", "549F39C22FB2C7C11FD4E5E5C935B5B3E00F9250AC2FD7C902682FDC9BEB2AF6";
+    "4A2D401DCFE0045E1482E55DFF978ECF8F092B9E2B17923ECB53DFFB9E4D6845", "D7B90591A06C0E15BB6B1F94BB46668FEA9AC408164CFB19DBFE63A93F0DF925";
+    "078ECDE5B62D62EE0A2197D416B992B3FD72551C1F297BE8BC490761F98A6753", "304756BA0880F4BF4AD0EBCED85F1B1A3056CB76FD2A725A00ADA58B9DAD3B81";
+    "819D67D2F813D0D0C7199DF4FDAF3907A0EFA2AEA1433F37F76914DB3D10D8D4", "52ECE5C1A4036AE515B9D7673EB5D7E2519039CBAB89AE65459E1634FC94E7F7";
+    "C513BA09A835EA0372460475BB230E3CE9FBA741E59457E6D6E7B860D5146429", "CAD294FFD63C5435E937C4646E92DA4A3B7415B9DF939FC41657A79544C6F563";
+
+  ];
+  [
+    "07EE2738ACD0E5DBF81CD1995A2C25E244A5E4B13BCEEB262319D45A1A7D25F0", "5B9535A7E2F6C7E715693902487594814E913DA664932907AC72141B2F13C0C1";
+    "7CF0D1E8706D799A504B709671E05B63FA2EEB97B4B28FB35DA285750EEC1F42", "DF3D1DF8BDF59857AB24793EA32439918C115CE06A830ABFE7B6320526543FAC";
+    "D0750F538A7BA5AFDE00C6B0635A669B5A665BAB5BD8EE268C22AEC860225F65", "6A3B718FB63972A47FA1BBE26842AA794C3E3CFDA29D0024B77897E844F66081";
+    "C543BEC86E4A0C941BED9EFE8B5C135A607D85A36B1354C715CEFEF46BB9A213", "9F94BC36487CC5A4FB2F3CAD6C4D20C36AEB467BC200E7F48064A240ADA8506F";
+    "F0D17C82EB1988899D50E36E08F26570C1E3DC097F823D6BC59C9D036CC8F494", "7031F03277228B4F18CECF5E41C8775DDD1B9D101257F5C06DF31EAF6A085B75";
+    "BF562B53CE096A96A76722E5276221754B3DE59C45B54E355F45E2F7B5D67A64", "85EE44C510A3D82F26036430289382463528FE67233E99F4AD3B52CF73D3E899";
+    "7136A26AD8BD50ADCDBE0D37E539ECB86E0BA04994AA394ACB466A8EB6A5EA99", "CC7B1F5A6139CA3A066538A4DFEC3A23FC4A5DB945928AAE3066D62F23594646";
+    "BF4BD3907E148D1CC5186C724DF00C089C2673FCC656B49D8FB04E41FF2A22FE", "D113D4133C649981EEBE54141244ABB5F144ABFF9CABC65AEF7EC181647B6761";
+    "94BF66B58F9635313967F1E2E8804061115C4055AED47E14017791C89F9EF451", "A0AA94298113085492DE2BEE64D240FF37E37FF31109AEF6DE5DE68694CC2C20";
+    "E6F108A5B5BB293EC37A83E9853C7DEB568748B462C3F90C1794340B374884B5", "975E5CE59081B057A2CAE2E551BDF5D940E3956C5D488C87DE30B0EDDFC9FFE7";
+
+  ];
+  [
+    "87AE66069ECE659874289C9F69EC172312C772EF692F50E8F10F9D1B80D706CE", "78B78757B9F23226E80B05D19EA4C3310DC55D22660457A84745BD654B5A5F6C";
+    "24ECEF6DDF05940AFB3D70CF88AD36458E6B6471315BD24C8679D8556CD8F618", "A83F0CBC0C6F0A902128780826028700765C38B8D912019E0BBA6588D47E6EAE";
+    "D0120B7384D80823C9BB7B201BC68A57493FB2DEE79205BFBCCF710ADADAE0BF", "B265B4D0F5B8D7A79789D97DE44C36CC79EE6E4A50F378784CFD0F8B9E13D4CD";
+    "CA8D7FF035A76E529002E61F0C40F9B288C930AE9A26C7E54082E4EFBA30702D", "8355D27C2B6DD9EE8E87CEF2CD409C057E9E5C963C9F489A6A7D1174D5687B89";
+    "7200EC9AC9866B3D0F91AE84F9F3CFD0240245B69B646FB797048B4189EE3B99", "DA34A221D2FD0DFA3C59525BFB08452DDED99DC3D917365681F0FE9BB659CC5B";
+    "EA5F8CA89E36D5AA0388733879F200518E37D14F2079D679A7F27870B82D6ED2", "8C3BEE0E463FCE7E5FB00550F31833E375B99AD7B93B4A6163B83A2C6BE635DF";
+    "CE3F5E660300555F80EF2BB599892170E0A647BDF8A908558817B9516394816C", "DA04E455428BABCC8A3F4EDD0E8BF2ECB8F93BEEBED571CF9327BF90609E1F97";
+    "B001141256BF0EBAC21E850C6FD0E987C0820D46C4149FB73FF3FD6AA38ACBE7", "030C7F191EB70A456681ECA6774462F791CF1056F8E3636FC73C8FBA79CA9357";
+    "DB6026D84FB431FEB8A298A3D9D3288026685849C557187E9031C8D48781DB3D", "BEDA43577F7EEF2C246A744532E4D4CACBBA9C8CF39E8FB2D408CAC8D5CAF022";
+    "8EC3FCBFDFA4754A46710761798A1CCB7DC7CF05A888D24BE39F10C7A3BA95D9", "6C6FBF49299663E4F4FA7CDB5BB2FFCA8C0A8B7F1FF432295E685670500D7A68";
+
+  ];
+  [
+    "C9B0DC51E678802F5DB12323D905E50B2AFB675E1D369C4827F906FBDF0D8949", "FD0EA9C356841E20F6404CB519AE7418F06413DC40346A64DDEC030CD6819648";
+    "BE73D8437105C6794B4EA52F245FB43B94E3AA7D866DE70225F95B0F31B045F7", "DBA6025C481A050F1028B7F16394B74ABDA295EA2DAFC12853992763E912BCA0";
+    "9E94DD39A0DABCD4D663E35DB91614E6CE80F4538E13950C64C01450F73DF17E", "A6CE7E4483D190AC7EAE12847AD6960A3C3C4A46D094F3B65DB6C91EC81B46AC";
+    "0C6CBE5D4093A307CC80948530E7993C2862A4FCAEB12291BEBB5050C6FD5C4E", "2A360057D9DEA3925672AE80C2DE3142856A45816F0D3459795B13DBB916FD82";
+    "7CF8A3B24334C98B261FD24754DB6150C7B6CC2CAB813253794DB34AAF6EB904", "C83FE889C70BD1D6F40B731C6794DBD1B88EBB0BD38C8C2D5EE0159E59E456C8";
+    "F5AC1083FA8DDA8F49F55EF11D103F4D5FA505A8E4DDDC9749A4DD270F320EDF", "7F6D18478A22AFFEE623020918E6E015F559296382BA333A2F3CB75FAFEC3D5E";
+    "23606BC51E67726A31E9711251F263163D61CAF44A6A8E3EC512A02CCA2A6B54", "2D04CC1E0FA9C036404536B04BFDF2A4B479F33B271BD3566D1A8DFC10A3811D";
+    "E97CC9407250EC79A8FD6DC9891D6862FEB6A5FEBDC98707D886784BE466B99D", "9BF45C29A9A737620C49FD3FE8DD563C66B1C89BD62DB1A514B68D9F08181475";
+    "8E4360EDE2A78AD86C5935C642EE129760F6C624259254AFDAD768AF58DBF1B2", "B8AB363775C7FC1CA935E82B6EB36128AB80A382889CC4393E62DBE6DF85B634";
+    "4DD37756E5F88605C4076D5C248514D9596B188F648B1095CBE4F471799E9ADB", "305886FB73BD2EFEC718C0922A53CFC0A7FE72D8A7341B72917278F705B2D146";
+
+  ];
+  [
+    "31548B4A01E9D18718DF760ECB31BAC5D74B26AA7A1584683BD9E14F3C150536", "57A4EFA6D545729770CF5EC6F8B9E5E8C00EB7A0A1E8989C3D3360FDD3F3A4E6";
+    "80E0BCC128735B3A34BB856F451A4DBA0E12DE7548CC228C255A1E45C29BCB50", "276DC10527F4DB8012ED993B051F36595AC306EB0D03756E26FA5A32DE8BADE6";
+    "91923E8F82A7F35520F2329877C779999B5E863EE1272FD7C0B07F9E9E357662", "A14421CD51A3FF5D226AA926FFC8610905C647283369F23EFCA0F74A9BAAEEB3";
+    "97B98135A092CD240420CBEFFA6CFACD1F27A7A0E780A16B819E7A2C8FD50D42", "A3675BFB5AF37B1F425B3AB9E49EC81330FCB2E762E76D575C956F83FDE98C35";
+    "9329AA31B749C2AD2A115D8C0413A5AD73277D33C8E1D74ECE5C619EAF4CE790", "881974CCA20FD68962EB906887B8112C99A2A516CF00A69668AC3C33F538937A";
+    "F1348E6C8D926A8B8EE8B270DE7BB176AE2E2C6AF9E35C9F6376398CFEBA0197", "0FF1E07819D76525518CDA34E8FA5887EE9C482C754660C649AA15ED9B282C9C";
+    "89F7E0826E6915E62E2CA5430827336103528DA7BE5D0C35517487FDF9FF2C07", "C810C80E82377008002446E8B8A2ADC6E1E2B091CB7FA4A762360F52EA0C4A01";
+    "53EFDB5EBF7605CA27AD917AA349E99FEA897583320780332D2D98ED746AAB7D", "2066D45C10C439B5D14855D633254B1D65A42745049345E7B3AC1D703EC556A4";
+    "90CF973EB2B15D45C19CB8BB29ED012CBDAD29CF35E8327F9948AF2293D58BF4", "58C9DDC28DA7CDD301E2AF3880B375A0F3671E77E569963292B21F3F4F8B1E16";
+    "A9AC7DAFA5DE5714B927986DC000B0C1CCDFEB40D222E3634ED06DB6AEC7F08F", "1848C7185F95E887A791C19ED5264071BEBCF4804328AA14435A06BE9EB55787";
+
+  ];
+  [
+    "878067F0A2458A197B6847E206109066EDE8FEC99697C9E4A784AB6657423721", "5C573EA8C9074F1BDC69893B0CA279FAFE22A56BBCA509CBB723265B80966923";
+    "2A09D9485CACC0BC7AB9A3A9060157DD94B76B3621D6EFF3EFD05971B83FEEA7", "88B9F0A77224E52D8F96258E6D177D834809B25BED401E1AB59A134307D286B1";
+    "3ECDA0DF6FF61A2AE3BDE7A3F8248CDCDA2A5DA6C9FF96D5C6EF2092AF082D34", "25A0E4935A2393FF2BE43A56E29D85C4B5583FE25F0BB9DCFE334C07AB0B8833";
+    "F780F7D3173D2F1796B0D1E20D89538B9BDB5046B7D94BDDB59F8F62BA11E804", "1F18785D7ED86C99F4DFC4DD0CC40EA1751881A659FBBEC5CB8CD298FE2CE5A7";
+    "F8FE0D9EFC1BC6781CA589979D28E0954C59FBA552DB641B6BA64EF501E5B71C", "09E34950D82BC4119E5D981E178EF1D63FAFBB80F0FE3E4B65F3F4F8DB6D46A5";
+    "46E2E2C12600E037EFD5CB884D7FF42B9C9F532DF5AC543B2E094B9423FE3EEE", "D2160CB8A9BE9348C5A47096553CD204F0F92A2F4E6FB64FABC5A7534C398414";
+    "90354579D0AC6E2EEA75D0A8BB09023142486BAC05E6C807E250139971A913C1", "54FF19E0D425B217E3EF490347B89A63D5B035455BC5A85C50B2795C7EA2471F";
+    "B52F2CC6B52CC6DF95C5277988FE221590C518B5445F57D0B9F3CFC83ACDD9CB", "2E1908340B89545A98C91CB78C0E743B07545D2ED1CCC952324FA630C67D9C6A";
+    "067BC3BE6660BA58A8512F0F3443E9F25C6FFA94698F827B9A95F8C098376EC2", "F0791A6254EFB6B2CD795F35699E42FA509A9204CC75F6F85047514110919A81";
+    "E3C2D7C2FFEA9B41E55982BDFBF48CE6FE77A415592E5F29B13B2F64A965C60A", "B270F9BBEA95956481D43FA076B4B4C1617C8251AEF4044C5EACA662CE5F1334";
+
+  ];
+  [
+    "1B014A18DFA49E768727825E757411D1E82EF2C53E3D8F264D0DED8929F097B8", "1A6953E71828514B2166F97FE5734BE9C45134A29DEEBF6435D9C977D4F3C065";
+    "0BC3BC37FC3146E76C0F7E27DA82286F86FF242DA9A361FFCCCF324144F5A61F", "8675179AA1E9C73AA296154C32CA51FC233414F83BD6A3332F7A1B100324FEDA";
+    "DA338DD14FA1316D4DFAEA85A7DD1C88E82240549F13E8437EDB9F1CC50642C2", "494E0B77E4E457BD1210D4D5A335589A8184473A453CDF60A800AC646EAA8E01";
+    "6463B9FAD5442512D48D54287413868F88C4976DAF770ECC32AB8246D3E4640D", "CDEA7D4E5F41FC4573E4E4CA1F8E8A69228D1CE70FBF0E058342E4B9CDDF4633";
+    "104A62A41AAA0F0BD8A9D1C16755C7CF13301CEDCEB9AABBE798B025FEDADCB4", "A68C528A453826F91DEDDBA195D0827C2DFF29CEF29A14AF6382827BFCBA883A";
+    "E583D91345F7E83E16E41B504DD7FD98558115A2F4021270B79317F07D1638E0", "1DA80828D384A17DB98EA2B976C514E86252076600C53D4E4978EF81874C95F3";
+    "AC8401515A9B5A5279EB71FAF379AE75230B0FDFA62CF57F01344372C004141C", "9DFFDF966DE197CB477FF818C2B39EE7ACEB017E528B7A7F6F6D98110DE71D5C";
+    "5CB89E053B3E0AC2EC4748D79D4A58550979E7641599611E3797E72654DFC491", "A6C3F6ED9CFC58CD6B76BA0D7E98FB5F905AB046ECFC70C50394A47B90859093";
+    "2DBD7FAAA92098766A06E1F24BD2D5AB8159AF24E22475C8FAE186D663E7E9E6", "BEDE654EC3844FCBB6CD15656118F172DD84ECE7D49F5D1263AC82E323D98C3D";
+    "A1F2FF766E8B53DE806E7A91A7AF490BD686269407E6F0D0FFDF93A9106D492C", "32F3780CC6D036222FC6CC2D5FA4709EBA196ACCDD7F1BF3160948576AE6D243";
+
+  ];
+  [
+    "F9C8200774C89174BC27F0E57973BBB883209858E8691FA953A0ED72298529F6", "E9642C624DAE2D39706B5771FBA3BE086F3D122DA05D7A418DA5FD08B47424DC";
+    "BDF9D6491CE56BE82FBA49BDE718969AA76A4625487BB3320C3414E88FBFEBC0", "8ECA982E184B8F480E6F6829BF009438BC50213E98E8CEC6F417FF111373A415";
+    "B8DC0289B3BB3053371BD01A378DF38B988DB7D2222619C54017E442CEEDC565", "DAA13E54F28EFE8DAEE7FFD39C6C156CAE4BCE542C17554A374B5C33126E6986";
+    "DCB0EAFE2B3AF6D2AAC927287FA6C2C3A634987EBEE92D05939C4D4CFDE5A0BD", "BBC289E1E59001237ED6116D9FB461816BDF17630BB5721BED7D881C6DA6E120";
+    "2DFE4059218CFD3BAD9A6DE6971519A83CE3856947E311A2DEC7EE310BAE4422", "5D8ABE63135C857B82FD49FC8B50E2BCFC9814500254E0CC2449ABAC5862A91A";
+    "4B3C3880B54B8201B0DC0E9F5608108A6EC3F28361DAFDA0819E9C075DF7F4C9", "E11224AD07E2DD2F724BDFEC63F3CA556B82C3C12ADD3DBBC58D7EA5BE0FCC4B";
+    "6B6795E354C247D01E8D9C5FD8223BFBC995D1C74C3A7A62532BEC1E328FF5AF", "771495A2204745D6129EBAB34EF707D61F28293E522A5CE1119A7EE279FBCFD4";
+    "EB524D039CC8EAFD7622952B83CB898CDEE43D71A0F79F02DC1F2600E5A5D207", "4275CEAF79D008173D906D8D58086A6E7B25F5744F72D8B7A593947736215144";
+    "92C1E9B91918D5BE76E81B05CFF9D444A192B9FA8ED09858F426BF6A0DF6297F", "E3CA3CF73B15C938A6A306BA790B1B39FE26FD9575A44303B2EA8CFE81A73B3A";
+    "1D510BC16CD4C978CD6498E716BAE437F11B519E5240F974C1C0B04F8176C728", "AD7FB5F7E80177416AA5CF1E80E082B326A574A4D523D90AEA45FED80134BA80";
+  ];
+]
diff --git a/vendors/tezos-modded/vendors/ocaml-uecc/uecc.opam b/vendors/tezos-modded/vendors/ocaml-uecc/uecc.opam
new file mode 100644
index 000000000..fb2a42294
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocaml-uecc/uecc.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+name: "uecc"
+version: "1.0"
+authors: "Vincent Bernardoff <vb@luminar.eu.org>"
+maintainer: "Vincent Bernardoff <vb@luminar.eu.org>"
+license: "ISC"
+homepage: "https://github.com/vbmithr/ocaml-uecc"
+synopsis: "Bindings for ECDH and ECDSA for 8-bit, 32-bit, and 64-bit processors"
+bug-reports: "https://github.com/vbmithr/ocaml-uecc/issues"
+dev-repo: "git://github.com/vbmithr/ocaml-uecc"
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "dune" {build & >= "1.0.1"}
+  "bigstring" {>= "0.1.1"}
+  "alcotest" {with-test & >= "0.8.1"}
+  "cstruct" {with-test & >= "3.2.1"}
+  "hex" {with-test}
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/LICENSE b/vendors/tezos-modded/vendors/ocplib-json-typed/LICENSE
new file mode 100644
index 000000000..66026b6e7
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/LICENSE
@@ -0,0 +1,859 @@
+As a special exception to the GNU Lesser General Public License, you
+may link, statically or dynamically, a "work that uses the Library"
+with a publicly distributed version of the Library to produce an
+executable file containing portions of the Library, and distribute
+that executable file under terms of your choice, without any of the
+additional requirements listed in clause 6 of the GNU Library General
+Public License.  By "a publicly distributed version of the Library",
+we mean either the unmodified Library as distributed by the copyright
+holder, or a modified version of the Library that is distributed under
+the conditions defined in clause 3 of the GNU Library General Public
+License.  This exception does not however invalidate any other reasons
+why the executable file might be covered by the GNU Lesser General
+Public License.
+
+
+                   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
+
+
+------------------------------------------------------------------------
+
+
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<http://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/Makefile b/vendors/tezos-modded/vendors/ocplib-json-typed/Makefile
new file mode 100644
index 000000000..d56625796
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/Makefile
@@ -0,0 +1,11 @@
+all:
+	dune build @install @runtest
+
+install:
+	dune install
+
+uninstall:
+	dune uninstall
+
+clean:
+	rm -rf _build *~ */*~
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/README.md b/vendors/tezos-modded/vendors/ocplib-json-typed/README.md
new file mode 100644
index 000000000..147d7858b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/README.md
@@ -0,0 +1,35 @@
+# ocplib-json-typed
+
+This library is a collection of type-aware JSON utilities for OCaml.
+
+  - `Json_encoding` contains an `'a encoding` type that represents
+    the JSON encoding of OCaml values of type `'a`, and a collection
+    of combinators to build them. These encodings can be used to
+    serialize / deserialize OCaml values to / from JSON
+    documents. JSON schemas can also be generated automatically to
+    produce documented, interoperable JSON formats.
+  - `Json_schema` contains an OCaml intermediate representation for
+    the JSON schema document grammar description language, along with
+    translators to / from the concrete JSON schema format.
+  - `Json_query` contains various utilities to manipulate, introspect
+    and update JSON data.
+  - `Json_repr` defines an abstraction over JSON representations.
+    This module is mainly useful when using the functorial interface of
+    the library, or if you use several JSON libraries in your program
+    and want to convert data from one JSON representation to another.
+
+The type of JSON documents handled by this library is directly
+compatible with `ezjsonm`, but converters are provided for `yojson`
+users, and an advanced functorial interface allows you to use any JSON
+representation. Two other representations are also provided.
+
+  - `Json_repr_browser` interfaces JavaScripts objects. It is
+    available only when compiling to JavaScript via
+    `js_of_ocaml`.
+    Provided by the extra package `ocplib-json-typed-browser`.
+  - `Json_repr_bson` is an implementation of a subset of BSON.
+    Provided by the extra package `ocplib-json-typed-bson`.
+
+Thanks to polymorphic variants, this library does not depend on any
+JSON library, so you are free to use whichever you want for printing
+and parsing.
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-browser.opam b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-browser.opam
new file mode 100644
index 000000000..1bd22b26f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-browser.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+name: "ocplib-json-typed-browser"
+version: "0.6"
+maintainer: "Benjamin Canou <benjamin@ocamlpro.com>"
+authors: "Benjamin Canou <benjamin@ocamlpro.com>"
+homepage: "https://github.com/ocamlpro/ocplib-json-typed"
+synopsis: "Libraries for reliable manipulation JSON objects (browser support)"
+bug-reports: "https://github.com/ocamlpro/ocplib-json-typed/issues"
+license: "LGPLv3 w/ linking exception"
+dev-repo: "git+https://github.com/ocamlpro/ocplib-json-typed.git"
+
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "ocaml" {>= "4.3.0"}
+  "dune" {build & >= "1.0.1"}
+  "ocplib-json-typed" {= "0.6" }
+  "js_of_ocaml" {>= "3.3.0"}
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-bson.opam b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-bson.opam
new file mode 100644
index 000000000..c5fb449b9
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed-bson.opam
@@ -0,0 +1,19 @@
+opam-version: "2.0"
+name: "ocplib-json-typed-bson"
+version: "0.6"
+maintainer: "Benjamin Canou <benjamin@ocamlpro.com>"
+authors: "Benjamin Canou <benjamin@ocamlpro.com>"
+homepage: "https://github.com/ocamlpro/ocplib-json-typed"
+synopsis: "Libraries for reliable manipulation JSON objects (BSON)"
+bug-reports: "https://github.com/ocamlpro/ocplib-json-typed/issues"
+license: "LGPLv3 w/ linking exception"
+dev-repo: "git+https://github.com/ocamlpro/ocplib-json-typed.git"
+
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "ocaml" {>= "4.3.0"}
+  "dune" {build & >= "1.0.1"}
+  "ocplib-json-typed" {= "0.6" }
+  "ocplib-endian" {>= "1.0"}
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed.opam b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed.opam
new file mode 100644
index 000000000..f566183ba
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/ocplib-json-typed.opam
@@ -0,0 +1,18 @@
+opam-version: "2.0"
+name: "ocplib-json-typed"
+version: "0.6"
+maintainer: "Benjamin Canou <benjamin@ocamlpro.com>"
+authors: "Benjamin Canou <benjamin@ocamlpro.com>"
+homepage: "https://github.com/ocamlpro/ocplib-json-typed"
+synopsis: "Libraries for reliable manipulation JSON objects"
+bug-reports: "https://github.com/ocamlpro/ocplib-json-typed/issues"
+license: "LGPLv3 w/ linking exception"
+dev-repo: "git+https://github.com/ocamlpro/ocplib-json-typed.git"
+
+build: [ "dune" "build" "-j" jobs "-p" name "@install" ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+depends: [
+  "ocaml" {>= "4.3.0"}
+  "dune" {build & >= "1.0.1"}
+  "uri" {>= "1.9.0" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/dune b/vendors/tezos-modded/vendors/ocplib-json-typed/src/dune
new file mode 100644
index 000000000..5a2a22a33
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/dune
@@ -0,0 +1,26 @@
+(library
+ (name        ocplib_json_typed)
+ (public_name ocplib-json-typed)
+ (flags (:standard -w -9))
+ (modules json_encoding json_query json_repr json_schema)
+ (synopsis "Reliable manipulation of JSON objects")
+ (libraries uri)
+ (wrapped false))
+
+(library
+ (name        ocplib_json_typed_bson)
+ (public_name ocplib-json-typed-bson)
+ (flags (:standard -w -9))
+ (modules json_repr_bson)
+ (synopsis "BSON representation of JSON documents")
+ (libraries ocplib-json-typed ocplib-endian)
+ (wrapped false))
+
+(library
+ (name        ocplib_json_typed_browser)
+ (public_name ocplib-json-typed-browser)
+ (flags (:standard -w -9 -open Js_of_ocaml))
+ (modules json_repr_browser)
+ (synopsis "Native browser representation of JSON documents")
+ (libraries ocplib-json-typed js_of_ocaml)
+ (wrapped false))
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.ml
new file mode 100644
index 000000000..8255818b1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.ml
@@ -0,0 +1,919 @@
+(* JSON structure description using dependently typed combinators. *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+exception Unexpected of string * string
+exception No_case_matched of exn list
+exception Bad_array_size of int * int
+exception Missing_field of string
+exception Unexpected_field of string
+exception Bad_schema of exn
+exception Cannot_destruct of (Json_query.path * exn)
+
+(*-- types and errors --------------------------------------------------------*)
+
+let unexpected kind expected =
+  let kind = match kind with
+    | `O [] -> "empty object"
+    | `A [] -> "empty array"
+    | `O _ -> "object"
+    | `A _ -> "array"
+    | `Null -> "null"
+    | `String _ -> "string"
+    | `Float _ -> "number"
+    | `Bool _ -> "boolean" in
+  Cannot_destruct ([], Unexpected (kind, expected))
+
+type 't repr_agnostic_custom =
+  { write : 'rt. (module Json_repr.Repr with type value = 'rt) -> 't -> 'rt ;
+    read : 'rf. (module Json_repr.Repr with type value = 'rf) -> 'rf -> 't }
+
+(* The GADT definition for encodings. This type must be kept internal
+    because it does not encode all invariants. Some properties are
+    checked at encoding construction time by smart constructors, since
+    checking them would either be impossible, or would make the type
+    too complex. In a few corners that involve custom encodings using
+    user defined functions, some properties cannot be checked until
+    construction/destruction time. If such a run time check fails, is
+    denotes a programmer error and an [Invalid_argument] exceptions is
+    thus raised. *)
+type _ encoding =
+  | Null : unit encoding
+  | Empty : unit encoding
+  | Ignore : unit encoding
+  | Option : 'a encoding -> 'a option encoding
+  | Constant : string -> unit encoding
+  | Int : 'a int_encoding -> 'a encoding
+  | Bool : bool encoding
+  | String : string encoding
+  | Float : bounds option -> float encoding
+  | Array : 'a encoding -> 'a array encoding
+  | Obj : 'a field -> 'a encoding
+  | Objs : 'a encoding * 'b encoding -> ('a * 'b) encoding
+  | Tup : 'a encoding -> 'a encoding
+  | Tups : 'a encoding * 'b encoding -> ('a * 'b) encoding
+  | Custom : 't repr_agnostic_custom * Json_schema.schema -> 't encoding
+  | Conv : ('a -> 'b) * ('b -> 'a) * 'b encoding * Json_schema.schema option -> 'a encoding
+  | Describe : { id: string ;
+                 title: string option ;
+                 description: string option ;
+                 encoding: 'a encoding } -> 'a encoding
+  | Mu : { id: string ;
+           title: string option ;
+           description: string option ;
+           self: ('a encoding -> 'a encoding) ;
+         }-> 'a encoding
+  | Union : 't case list -> 't encoding
+
+and 'a int_encoding =
+  { int_name : string ;
+    of_float : float -> 'a ;
+    to_float : 'a -> float ;
+    lower_bound : 'a ;
+    upper_bound : 'a }
+
+and bounds =
+  { float_name : string ;
+    minimum : float ;
+    maximum : float }
+
+and _ field =
+  | Req : { name: string ;
+            encoding:  'a encoding ;
+            title: string option ;
+            description: string option ;
+          } -> 'a field
+  | Opt : { name: string ;
+            encoding:  'a encoding ;
+            title: string option ;
+            description: string option ;
+          } -> 'a option field
+  | Dft : { name: string ;
+            encoding:  'a encoding ;
+            title: string option ;
+            description: string option ;
+            default: 'a ;
+          } -> 'a field
+
+and 't case =
+  | Case : { encoding : 'a encoding ;
+             proj : ('t -> 'a option) ;
+             inj : ('a -> 't) } -> 't case
+
+(*-- construct / destruct / schema over the main GADT forms ------------------*)
+
+module Make (Repr : Json_repr.Repr) = struct
+
+  let construct enc v =
+    let rec construct
+      : type t. t encoding -> t -> Repr.value
+      = function
+        | Null -> (fun () -> Repr.repr `Null)
+        | Empty -> (fun () -> Repr.repr (`O []))
+        | Ignore -> (fun () -> Repr.repr (`O []))
+        | Option t ->
+          (function
+            | None -> Repr.repr `Null
+            | Some v -> construct t v)
+        | Constant str -> (fun () -> Repr.repr (`String str))
+        | Int { int_name ; to_float ; lower_bound ; upper_bound } ->
+          (fun (i : t) ->
+             if i < lower_bound || i > upper_bound then
+               invalid_arg
+                 ("Json_encoding.construct: " ^ int_name ^ " out of range");
+             Repr.repr (`Float (to_float  i)))
+        | Bool -> (fun (b : t) -> Repr.repr (`Bool b))
+        | String -> (fun s -> Repr.repr (`String s))
+        | Float (Some { minimum ; maximum ; float_name }) ->
+          let err = "Json_encoding.construct: " ^ float_name ^ " out of range" in
+          (fun float ->
+             if float < minimum || float > maximum then invalid_arg err ;
+             Repr.repr (`Float float))
+        | Float None -> (fun float -> Repr.repr (`Float float))
+        | Describe { encoding = t } -> construct t
+        | Custom ({ write }, _) -> (fun (j : t) -> write (module Repr) j)
+        | Conv (ffrom, _, t, _) -> (fun v -> construct t (ffrom v))
+        | Mu { self } as enc -> construct (self enc)
+        | Array t ->
+          let w v = construct t v in
+          (fun arr -> Repr.repr (`A (Array.to_list (Array.map w arr))))
+        | Obj (Req { name = n ; encoding = t }) ->
+          let w v = construct t v in
+          (fun v -> Repr.repr (`O [ n, w v ]))
+        | Obj (Dft { name = n ; encoding = t ; default = d }) ->
+          let w v = construct t v in
+          (fun v -> Repr.repr (`O (if v <> d then [ n, w v ] else [])))
+        | Obj (Opt { name = n ; encoding = t }) ->
+          let w v = construct t v in
+          (function None -> Repr.repr (`O []) | Some v -> Repr.repr (`O [ n, w v ]))
+        | Objs (o1, o2) ->
+          let w1 v = construct o1 v in
+          let w2 v = construct o2 v in
+          (function (v1, v2) ->
+           match Repr.view (w1 v1), Repr.view (w2 v2) with
+           | `O l1, `O l2 -> Repr.repr (`O (l1 @ l2))
+           | `Null, `Null
+           | _ -> invalid_arg "Json_encoding.construct: consequence of bad merge_objs")
+        | Tup t ->
+          let w v = construct t v in
+          (fun v -> Repr.repr (`A [ w v ]))
+        | Tups (o1, o2) ->
+          let w1 v = construct o1 v in
+          let w2 v = construct o2 v in
+          (function (v1, v2) ->
+           match Repr.view (w1 v1), Repr.view (w2 v2) with
+           | `A l1, `A l2 -> Repr.repr (`A (l1 @ l2))
+           | _ -> invalid_arg "Json_encoding.construct: consequence of bad merge_tups")
+        | Union cases ->
+          (fun v ->
+             let rec do_cases = function
+               | [] -> invalid_arg "Json_encoding.construct: consequence of bad union"
+               | Case { encoding ; proj } :: rest ->
+                 match proj v with
+                 | Some v -> construct encoding v
+                 | None -> do_cases rest in
+             do_cases cases) in
+    construct enc v
+
+  let rec destruct
+    : type t. t encoding -> (Repr.value -> t)
+    = function
+      | Null -> (fun v -> match Repr.view v with `Null -> () | k -> raise (unexpected k "null"))
+      | Empty -> (fun v -> match Repr.view v with
+          | `O [] -> ()
+          | `O [ f, _] -> raise (Cannot_destruct ([], Unexpected_field f))
+          | k -> raise @@ unexpected k "an empty object")
+      | Ignore -> (fun v -> match Repr.view v with _ -> ())
+      | Option t -> (fun v -> match Repr.view v with
+          | `Null -> None
+          | _ -> Some (destruct t v))
+      | Constant str ->
+        (fun v ->
+           match Repr.view v with
+           | `String s when s = str -> ()
+           | x -> raise @@ unexpected x str)
+      | Int { int_name ; of_float ; to_float ; lower_bound ; upper_bound } ->
+        let lower_bound = to_float lower_bound in
+        let upper_bound = to_float upper_bound in
+        (fun v ->
+           match Repr.view v with
+           | `Float v ->
+             let rest, v = modf v in
+             if rest <> 0. then begin
+               let exn = Failure (int_name ^ " cannot have a fractional part") in
+               raise (Cannot_destruct ([], exn))
+             end ;
+             if v < lower_bound || v > upper_bound then begin
+               let exn = Failure (int_name ^ " out of range") in
+               raise (Cannot_destruct ([], exn))
+             end ;
+             of_float v
+           | k -> raise (unexpected k "number"))
+      | Bool -> (fun v -> match Repr.view v with `Bool b -> (b : t) | k -> raise (unexpected k "boolean"))
+      | String -> (fun v -> match Repr.view v with `String s -> s | k -> raise (unexpected k "string"))
+      | Float None -> (fun v -> match Repr.view v with `Float f -> f | k -> raise (unexpected k "float"))
+      | Float (Some { minimum ; maximum ; float_name }) ->
+        (fun v ->
+           match Repr.view v with
+           | `Float f ->
+             if f < minimum || f > maximum
+             then
+               let exn = Failure (float_name ^ " out of range") in
+               raise (Cannot_destruct ([], exn))
+             else f
+           | k -> raise (unexpected k "float"))
+      | Describe { encoding = t } -> destruct t
+      | Custom ({ read }, _) -> read (module Repr)
+      | Conv (_, fto, t, _) -> (fun v -> fto (destruct t v))
+      | Mu { self } as enc -> destruct (self enc)
+      | Array t ->
+        (fun v -> match Repr.view v with
+           | `O [] ->
+             (* Weak `Repr`s like BSON don't know the difference  *)
+             [||]
+           | `A cells ->
+             Array.mapi
+               (fun i cell ->
+                  try destruct t cell with Cannot_destruct (path, err) ->
+                    raise (Cannot_destruct (`Index i :: path, err)))
+               (Array.of_list cells)
+           | k -> raise @@ unexpected k "array")
+      | Obj _  as t ->
+        let d = destruct_obj t in
+        (fun v -> match Repr.view v with
+           | `O fields ->
+             let r, rest, ign = d fields in
+             begin match rest with
+               | (field, _) :: _ when not ign -> raise @@ Unexpected_field field
+               | _ -> r
+             end
+           | k -> raise @@ unexpected k "object")
+      | Objs _ as t ->
+        let d = destruct_obj t in
+        (fun v -> match Repr.view v with
+           | `O fields ->
+             let r, rest, ign = d fields in
+             begin match rest with
+               | (field, _) :: _ when not ign -> raise @@ Unexpected_field field
+               | _ -> r
+             end
+           | k -> raise @@ unexpected k "object")
+      | Tup _ as t ->
+        let r, i = destruct_tup 0 t in
+        (fun v -> match Repr.view v with
+           | `A cells ->
+             let cells = Array.of_list cells in
+             let len = Array.length cells in
+             if i <> Array.length cells then
+               raise (Cannot_destruct ([], Bad_array_size (len, i)))
+             else r cells
+           | k -> raise @@ unexpected k "array")
+      | Tups _ as t ->
+        let r, i = destruct_tup 0 t in
+        (fun v -> match Repr.view v with
+           | `A cells ->
+             let cells = Array.of_list cells in
+             let len = Array.length cells in
+             if i <> Array.length cells then
+               raise (Cannot_destruct ([], Bad_array_size (len, i)))
+             else r cells
+           | k -> raise @@ unexpected k "array")
+      | Union cases ->
+        (fun v ->
+           let rec do_cases errs = function
+             | [] -> raise (Cannot_destruct ([], No_case_matched (List.rev errs)))
+             | Case { encoding ; inj } :: rest ->
+               try inj (destruct encoding v) with
+                 err -> do_cases (err :: errs) rest in
+           do_cases [] cases)
+  and destruct_tup
+    : type t. int -> t encoding -> (Repr.value array -> t) * int
+    = fun i t -> match t with
+      | Tup t ->
+        (fun arr ->
+           (try destruct t arr.(i) with Cannot_destruct (path, err) ->
+              raise (Cannot_destruct (`Index i :: path, err)))), succ i
+      | Tups (t1, t2) ->
+        let r1, i = destruct_tup i t1 in
+        let r2, i = destruct_tup i t2 in
+        (fun arr -> r1 arr, r2 arr), i
+      | Conv (_, fto, t, _) ->
+        let r, i = destruct_tup i t in
+        (fun arr -> fto (r arr)), i
+      | Mu { self } as enc -> destruct_tup i (self enc)
+      | Describe { encoding } -> destruct_tup i encoding
+      | _ -> invalid_arg "Json_encoding.destruct: consequence of bad merge_tups"
+  and destruct_obj
+    : type t. t encoding -> (string * Repr.value) list -> t * (string * Repr.value) list * bool
+    = fun t ->
+      let rec assoc acc n = function
+        | [] -> raise Not_found
+        | (f, v) :: rest when n = f -> v, acc @ rest
+        | oth :: rest -> assoc (oth :: acc) n rest in
+      match t with
+      | Empty -> (fun fields -> (), fields, false)
+      | Ignore -> (fun fields -> (), fields, true)
+      | Obj (Req { name = n ; encoding = t }) ->
+        (fun fields ->
+           try
+             let v, rest = assoc [] n fields in
+             destruct t v, rest, false
+           with
+           | Not_found ->
+             raise (Cannot_destruct ([], Missing_field n))
+           | Cannot_destruct (path, err) ->
+             raise (Cannot_destruct (`Field n :: path, err)))
+      | Obj (Opt { name = n ; encoding = t }) ->
+        (fun fields ->
+           try
+             let v, rest = assoc [] n fields in
+             Some (destruct t v), rest, false
+           with
+           | Not_found -> None, fields, false
+           | Cannot_destruct (path, err) ->
+             raise (Cannot_destruct (`Field n :: path, err)))
+      | Obj (Dft { name = n ; encoding = t ; default = d }) ->
+        (fun fields ->
+           try
+             let v, rest = assoc [] n fields in
+             destruct t v, rest, false
+           with
+           | Not_found -> d, fields, false
+           | Cannot_destruct (path, err) ->
+             raise (Cannot_destruct (`Field n :: path, err)))
+      | Objs (o1, o2) ->
+        let d1 = destruct_obj o1 in
+        let d2 = destruct_obj o2 in
+        (fun fields ->
+           let r1, rest, ign1 = d1 fields in
+           let r2, rest, ign2 = d2 rest in
+           (r1, r2), rest, ign1 || ign2)
+      | Conv (_, fto, t, _) ->
+        let d = destruct_obj t in
+        (fun fields ->
+           let r, rest, ign = d fields in
+           fto r, rest, ign)
+      | Mu { self } as enc -> destruct_obj (self enc)
+      | Describe { encoding } -> destruct_obj encoding
+      | Union cases ->
+        (fun fields ->
+           let rec do_cases errs = function
+             | [] -> raise (Cannot_destruct ([], No_case_matched (List.rev errs)))
+             | Case { encoding ; inj } :: rest ->
+               try
+                 let r, rest, ign = destruct_obj encoding fields in
+                 inj r, rest, ign
+               with err -> do_cases (err :: errs) rest in
+           do_cases [] cases)
+      | _ -> invalid_arg "Json_encoding.destruct: consequence of bad merge_objs"
+
+  let custom write read ~schema =
+    let read
+      : type tf. (module Json_repr.Repr with type value = tf) -> tf -> 't
+      = fun (module Repr_f) repr ->
+        read (Json_repr.convert (module Repr_f) (module Repr) repr) in
+    let write
+      : type tf. (module Json_repr.Repr with type value = tf) -> 't -> tf
+      = fun (module Repr_f) v ->
+        Json_repr.convert (module Repr) (module Repr_f) (write v) in
+    Custom ({ read ; write }, schema)
+end
+
+module Ezjsonm_encoding = Make (Json_repr.Ezjsonm)
+
+let patch_description ?title ?description (elt : Json_schema.element) =
+  match title, description with
+  | None, None -> elt
+  | Some _, None -> { elt with title }
+  | None, Some _ -> { elt with description }
+  | Some _, Some _ -> { elt with title ; description }
+
+let schema ?definitions_path encoding =
+  let open Json_schema in
+  let sch = ref any in
+  let rec prod l1 l2 = match l1 with
+    | [] -> []
+    | (l1, b1) :: es ->
+      List.map (fun (l2, b2) -> l1 @ l2, b1 || b2) l2
+      @ prod es l2 in
+  let rec object_schema
+    : type t. t encoding -> ((string * element * bool * Json_repr.any option) list * bool) list
+    = function
+      | Conv (_, _, o, None) -> object_schema o
+      | Empty -> [ [], false ]
+      | Ignore -> [ [], true ]
+      | Obj (Req { name = n ; encoding = t ; title ; description }) ->
+          [ [ n, patch_description ?title ?description (schema t), true, None ], false ]
+      | Obj (Opt { name = n ; encoding = t ; title ; description }) ->
+          [ [ n, patch_description ?title ?description (schema t), false, None ], false ]
+      | Obj (Dft { name = n ; encoding = t ; title ; description ; default = d }) ->
+        let d = Json_repr.repr_to_any (module Json_repr.Ezjsonm) (Ezjsonm_encoding.construct t d) in
+        [ [ n, patch_description ?title ?description (schema t), false, Some d], false ]
+      | Objs (o1, o2) ->
+        prod (object_schema o1) (object_schema o2)
+      | Union [] ->
+        invalid_arg "Json_encoding.schema: empty union in object"
+      | Union cases ->
+        List.flatten
+          (List.map
+             (fun (Case { encoding = o }) -> object_schema o)
+             cases)
+      | Mu { self } as enc -> object_schema (self enc)
+      | Describe { encoding = t } -> object_schema t
+      | Conv (_, _, _, Some _) (* FIXME: We could do better *)
+      | _ -> invalid_arg "Json_encoding.schema: consequence of bad merge_objs"
+  and array_schema
+    : type t. t encoding -> element list
+    = function
+      | Conv (_, _, o, None) -> array_schema o
+      | Tup t -> [ schema t ]
+      | Tups (t1, t2) -> array_schema t1 @ array_schema t2
+      | Mu { self } as enc -> array_schema (self enc)
+      | Describe { encoding = t } -> array_schema t
+      | Conv (_, _, _, Some _) (* FIXME: We could do better *)
+      | _ -> invalid_arg "Json_encoding.schema: consequence of bad merge_tups"
+  and schema
+    : type t. t encoding -> element
+    = function
+      | Null -> element Null
+      | Empty -> element (Object { object_specs with additional_properties = None })
+      | Ignore -> element Any
+      | Option t ->
+        element (Combine (One_of, [schema t ; element Null]))
+      | Int { to_float ; lower_bound ; upper_bound } ->
+        let minimum = Some (to_float lower_bound, `Inclusive) in
+        let maximum = Some (to_float upper_bound, `Inclusive) in
+        element (Integer { multiple_of = None ; minimum ; maximum })
+      | Bool -> element Boolean
+      | Constant str ->
+        { (element (String string_specs)) with
+          enum = Some [ Json_repr.to_any (`String str) ] }
+      | String -> element (String string_specs)
+      | Float (Some { minimum ; maximum }) ->
+        element (Number { multiple_of = None ;
+                          minimum = Some (minimum, `Inclusive) ;
+                          maximum = Some (maximum, `Inclusive) })
+      | Float None -> element (Number numeric_specs)
+      | Describe { id = name ; title ; description ; encoding } ->
+          let open Json_schema in
+          let schema = patch_description ?title ?description (schema encoding) in
+          let s, def = add_definition ?definitions_path name schema !sch in
+          sch := fst (merge_definitions (!sch, s)) ;
+          def
+      | Custom (_, s) ->
+        sch := fst (merge_definitions (!sch, s)) ;
+        root s
+      | Conv (_, _, _, Some s) ->
+        sch := fst (merge_definitions (!sch, s)) ;
+        root s
+      | Conv (_, _, t, None) -> schema t
+      | Mu { id = name ; title ; description ; self = f } ->
+        let fake_schema =
+          if definition_exists ?definitions_path name !sch then
+            update (definition_ref ?definitions_path name) !sch
+          else
+            let sch, elt = add_definition ?definitions_path name (element Dummy) !sch in
+            update elt sch in
+        let fake_self =
+          Custom ({ write = (fun _ _ -> assert false) ;
+                    read = (fun _ -> assert false) },
+                  fake_schema) in
+        let root =
+          patch_description
+            ?title ?description
+            (schema (f fake_self)) in
+        let nsch, def = add_definition ?definitions_path name root !sch in
+        sch := nsch ; def
+      | Array t ->
+        element (Monomorphic_array (schema t, array_specs))
+      | Objs _ as o ->
+        begin match object_schema o with
+          | [ properties, ext ] ->
+            let additional_properties = if ext then Some (element Any) else None in
+            element (Object { object_specs with properties ; additional_properties })
+          | more ->
+            let elements =
+              List.map
+                (fun (properties, ext) ->
+                   let additional_properties = if ext then Some (element Any) else None in
+                   element (Object { object_specs with properties ; additional_properties }))
+                more in
+            element (Combine (One_of, elements))
+        end
+      | Obj _ as o ->
+        begin match object_schema o with
+          | [ properties, ext ] ->
+            let additional_properties = if ext then Some (element Any) else None in
+            element (Object { object_specs with properties ; additional_properties })
+          | more ->
+            let elements =
+              List.map
+                (fun (properties, ext) ->
+                   let additional_properties = if ext then Some (element Any) else None in
+                   element (Object { object_specs with properties ; additional_properties }))
+                more in
+            element (Combine (One_of, elements))
+        end
+      | Tup _ as t -> element (Array (array_schema t, array_specs))
+      | Tups _ as t -> element (Array (array_schema t, array_specs))
+      | Union cases -> (* FIXME: smarter merge *)
+        let elements =
+          List.map (fun (Case { encoding }) -> schema encoding) cases in
+        element (Combine (One_of, elements)) in
+  let schema = schema encoding in
+  update schema !sch
+
+(*-- utility wrappers over the GADT ------------------------------------------*)
+
+let req ?title ?description n t =
+  Req { name = n ; encoding = t ; title ; description }
+let opt ?title ?description n t =
+  Opt { name = n ; encoding = t ; title ; description }
+let dft ?title ?description n t d =
+  Dft { name = n ; encoding = t ; title ; description ; default = d }
+
+let mu name ?title ?description self = Mu { id = name ; title ; description ; self }
+let null = Null
+let int =
+  Int { int_name = "int" ;
+          of_float = int_of_float ;
+          to_float = float_of_int ;
+          (* cross-platform consistent OCaml ints *)
+          lower_bound = -(1 lsl 30) ;
+          upper_bound = (1 lsl 30) - 1 }
+let ranged_int ~minimum:lower_bound ~maximum:upper_bound name =
+  if Sys.word_size = 64
+  && (lower_bound < -(1 lsl 30)
+      || upper_bound > (1 lsl 30) - 1) then
+    invalid_arg "Json_encoding.ranged_int: bounds out of portable int31 range" ;
+  Int { int_name = name ;
+        of_float = int_of_float ;
+        to_float = float_of_int ;
+        lower_bound ;
+        upper_bound }
+
+let int53 =
+  Int { int_name = "int53" ;
+        of_float = Int64.of_float ;
+        to_float = Int64.to_float ;
+        lower_bound = Int64.neg (Int64.shift_left 1L 53) ;
+        upper_bound = Int64.shift_left 1L 53 }
+let ranged_int53 ~minimum:lower_bound ~maximum:upper_bound name =
+  if lower_bound < Int64.neg (Int64.shift_left 1L 53)
+  || upper_bound > Int64.shift_left 1L 53 then
+    invalid_arg "Json_encoding.ranged_int53: bounds out of JSON-representable integers" ;
+  Int { int_name = name ;
+        of_float = Int64.of_float ;
+        to_float = Int64.to_float ;
+        lower_bound ;
+        upper_bound }
+
+let int32 =
+  Int { int_name = "int32" ;
+        of_float = Int32.of_float ;
+        to_float = Int32.to_float ;
+        lower_bound = Int32.min_int ;
+        upper_bound = Int32.max_int }
+let ranged_int32 ~minimum:lower_bound ~maximum:upper_bound name =
+  Int { int_name = name ;
+        of_float = Int32.of_float ;
+        to_float = Int32.to_float ;
+        lower_bound ;
+        upper_bound }
+
+let ranged_float ~minimum ~maximum float_name =
+  Float (Some { minimum ; maximum ; float_name })
+
+let float = Float None
+let string = String
+let conv ffrom fto ?schema t =
+  Conv (ffrom, fto, t, schema)
+let bytes = Conv (Bytes.to_string, Bytes.of_string, string, None)
+let bool = Bool
+let array t = Array t
+let obj1 f1 = Obj f1
+let obj2 f1 f2 = Objs (Obj f1, Obj f2)
+let obj3 f1 f2 f3 =
+  conv
+    (fun (a, b, c) -> (a, (b, c)))
+    (fun (a, (b, c)) -> (a, b, c))
+    (Objs (Obj f1, Objs (Obj f2, Obj f3)))
+let obj4 f1 f2 f3 f4 =
+  conv
+    (fun (a, b, c, d) -> (a, (b, (c, d))))
+    (fun (a, (b, (c, d))) -> (a, b, c, d))
+    (Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Obj f4))))
+let obj5 f1 f2 f3 f4 f5 =
+  conv
+    (fun (a, b, c, d, e) -> (a, (b, (c, (d, e)))))
+    (fun (a, (b, (c, (d, e)))) -> (a, b, c, d, e))
+    (Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Obj f5)))))
+let obj6 f1 f2 f3 f4 f5 f6 =
+  conv
+    (fun (a, b, c, d, e, f) -> (a, (b, (c, (d, (e, f))))))
+    (fun (a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f))
+    (Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Objs (Obj f5, Obj f6))))))
+let obj7 f1 f2 f3 f4 f5 f6 f7 =
+  conv
+    (fun (a, b, c, d, e, f, g) -> (a, (b, (c, (d, (e, (f, g)))))))
+    (fun (a, (b, (c, (d, (e, (f, g)))))) -> (a, b, c, d, e, f, g))
+    (let rest = Objs (Obj f6, Obj f7) in
+     Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Objs (Obj f5, rest))))))
+let obj8 f1 f2 f3 f4 f5 f6 f7 f8 =
+  conv
+    (fun (a, b, c, d, e, f, g, h) -> (a, (b, (c, (d, (e, (f, (g, h))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, h))))))) -> (a, b, c, d, e, f, g, h))
+    (let rest = Objs (Obj f6, Objs (Obj f7, Obj f8)) in
+     Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Objs (Obj f5, rest))))))
+let obj9 f1 f2 f3 f4 f5 f6 f7 f8 f9 =
+  conv
+    (fun (a, b, c, d, e, f, g, h, i) -> (a, (b, (c, (d, (e, (f, (g, (h, i)))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, (h, i)))))))) -> (a, b, c, d, e, f, g, h, i))
+    (let rest = Objs (Obj f6, Objs (Obj f7, Objs (Obj f8, Obj f9))) in
+     Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Objs (Obj f5, rest))))))
+let obj10 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 =
+  conv
+    (fun (a, b, c, d, e, f, g, h, i, j) -> (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))) -> (a, b, c, d, e, f, g, h, i, j))
+    (let rest = Objs (Obj f6, Objs (Obj f7, Objs (Obj f8, Objs (Obj f9, Obj f10)))) in
+     Objs (Obj f1, Objs (Obj f2, Objs (Obj f3, Objs (Obj f4, Objs (Obj f5, rest))))))
+let tup1 f1 = Tup f1
+let tup2 f1 f2 = Tups (Tup f1, Tup f2)
+let tup3 f1 f2 f3 =
+  conv
+    (fun (a, b, c) -> (a, (b, c)))
+    (fun (a, (b, c)) -> (a, b, c))
+    (Tups (Tup f1, Tups (Tup f2, Tup f3)))
+let tup4 f1 f2 f3 f4 =
+  conv
+    (fun (a, b, c, d) -> (a, (b, (c, d))))
+    (fun (a, (b, (c, d))) -> (a, b, c, d))
+    (Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tup f4))))
+let tup5 f1 f2 f3 f4 f5 =
+  conv
+    (fun (a, b, c, d, e) -> (a, (b, (c, (d, e)))))
+    (fun (a, (b, (c, (d, e)))) -> (a, b, c, d, e))
+    (Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tup f5)))))
+let tup6 f1 f2 f3 f4 f5 f6 =
+  conv
+    (fun (a, b, c, d, e, f) -> (a, (b, (c, (d, (e, f))))))
+    (fun (a, (b, (c, (d, (e, f))))) -> (a, b, c, d, e, f))
+    (Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tups (Tup f5, Tup f6))))))
+let tup7 f1 f2 f3 f4 f5 f6 f7 =
+  conv
+    (fun (a, b, c, d, e, f, g) -> (a, (b, (c, (d, (e, (f, g)))))))
+    (fun (a, (b, (c, (d, (e, (f, g)))))) -> (a, b, c, d, e, f, g))
+    (let rest = Tups (Tup f6, Tup f7) in
+     Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tups (Tup f5, rest))))))
+let tup8 f1 f2 f3 f4 f5 f6 f7 f8 =
+  conv
+    (fun (a, b, c, d, e, f, g, h) -> (a, (b, (c, (d, (e, (f, (g, h))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, h))))))) -> (a, b, c, d, e, f, g, h))
+    (let rest = Tups (Tup f6, Tups (Tup f7, Tup f8)) in
+     Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tups (Tup f5, rest))))))
+let tup9 f1 f2 f3 f4 f5 f6 f7 f8 f9 =
+  conv
+    (fun (a, b, c, d, e, f, g, h, i) -> (a, (b, (c, (d, (e, (f, (g, (h, i)))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, (h, i)))))))) -> (a, b, c, d, e, f, g, h, i))
+    (let rest = Tups (Tup f6, Tups (Tup f7, Tups (Tup f8, Tup f9))) in
+     Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tups (Tup f5, rest))))))
+let tup10 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 =
+  conv
+    (fun (a, b, c, d, e, f, g, h, i, j) -> (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))))
+    (fun (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))) -> (a, b, c, d, e, f, g, h, i, j))
+    (let rest = Tups (Tup f6, Tups (Tup f7, Tups (Tup f8, Tups (Tup f9, Tup f10)))) in
+     Tups (Tup f1, Tups (Tup f2, Tups (Tup f3, Tups (Tup f4, Tups (Tup f5, rest))))))
+
+let repr_agnostic_custom { write ; read } ~schema =
+  Custom ({ write ; read }, schema)
+
+let constant s = Constant s
+
+let string_enum cases =
+  let schema =
+    let specs = Json_schema.({ pattern = None ; min_length = 0 ; max_length = None }) in
+    let enum = List.map (fun (s, _) -> Json_repr.(repr_to_any (module Ezjsonm)) (`String s)) cases in
+    Json_schema.(update { (element (String specs)) with enum = Some enum } any) in
+  let len = List.length cases in
+  let mcases = Hashtbl.create len
+  and rcases = Hashtbl.create len in
+  let cases_str = String.concat " " (List.map (fun x -> "'" ^ fst x ^ "'") cases) in
+  List.iter
+    (fun (s, c) ->
+       if Hashtbl.mem mcases s then
+         invalid_arg "Json_encoding.string_enum: duplicate case" ;
+       Hashtbl.add mcases s c ;
+       Hashtbl.add rcases c s)
+    cases ;
+  conv
+    (fun v -> try Hashtbl.find rcases v with Not_found ->
+        invalid_arg (Format.sprintf "Json_encoding.construct: consequence of non exhaustive Json_encoding.string_enum. Strings are: %s" cases_str))
+    (fun s ->
+       (try Hashtbl.find mcases s with Not_found ->
+          let rec orpat ppf = function
+            | [] -> assert false
+            | [ last, _ ] -> Format.fprintf ppf "%S" last
+            | [ prev, _ ; last, _ ] -> Format.fprintf ppf "%S or %S" prev last
+            | (prev, _) :: rem -> Format.fprintf ppf "%S , %a" prev orpat rem in
+          let unexpected = Format.asprintf "string value %S" s in
+          let expected = Format.asprintf "%a" orpat cases in
+          raise (Cannot_destruct ([], Unexpected (unexpected, expected)))))
+    ~schema
+    string
+
+let def id ?title ?description encoding =
+  Describe { id ; title ; description ; encoding }
+
+let assoc : type t. t encoding -> (string * t) list encoding = fun t ->
+  Ezjsonm_encoding.custom
+    (fun l -> `O (List.map (fun (n, v) -> n, Ezjsonm_encoding.construct t v) l))
+    (fun v -> match v with
+       | `O l ->
+         let destruct n t v = try
+             Ezjsonm_encoding.destruct t v
+           with Cannot_destruct (p, exn) -> raise (Cannot_destruct (`Field n :: p, exn)) in
+         List.map (fun (n, v) -> n, destruct n t v) l
+       | #Json_repr.ezjsonm as k -> raise (unexpected k "asssociative object"))
+    ~schema:(let s = schema t in
+     Json_schema.(update (element (Object { object_specs with additional_properties = Some (root s)})) s))
+
+let rec is_nullable: type t. t encoding -> bool = function
+  | Constant _ -> false
+  | Int _ -> false
+  | Float _ -> false
+  | Array _ -> false
+  | Empty -> false
+  | String -> false
+  | Bool -> false
+  | Obj _ -> false
+  | Tup _ -> false
+  | Objs _ -> false
+  | Tups _ -> false
+  | Null -> true
+  | Ignore -> true
+  | Option _ -> true
+  | Conv (_, _, t, _) -> is_nullable t
+  | Union cases ->
+    List.exists (fun (Case { encoding = t }) -> is_nullable t) cases
+  | Describe { encoding = t } -> is_nullable t
+  | Mu { self } as enc -> is_nullable (self enc)
+  | Custom (_, sch) -> Json_schema.is_nullable sch
+
+let option : type t. t encoding -> t option encoding = fun t ->
+  if is_nullable t then
+    invalid_arg "Json_encoding.option: cannot nest nullable encodings";
+  Option t
+
+let any_value =
+  let read repr v = Json_repr.repr_to_any repr v in
+  let write repr v = Json_repr.any_to_repr repr v in
+  Custom ({ read ; write }, Json_schema.any)
+
+let any_ezjson_value =
+  let read repr v = Json_repr.convert repr (module Json_repr.Ezjsonm) v in
+  let write repr v = Json_repr.convert (module Json_repr.Ezjsonm) repr v in
+  Custom ({ read ; write }, Json_schema.any)
+
+let any_document =
+  let read
+    : type tt. (module Json_repr.Repr with type value = tt) -> tt -> Json_repr.any
+    = fun (module Repr) v ->
+      match Repr.view v with
+      | `A _ | `O _ ->
+        Json_repr.repr_to_any (module Repr) v
+      | k -> raise @@ unexpected k "array or object" in
+  let write repr v = Json_repr.any_to_repr repr v in
+  Custom ({ read ; write }, Json_schema.any)
+
+let any_schema =
+  Ezjsonm_encoding.custom
+    Json_schema.to_json
+    (fun j -> try Json_schema.of_json j with err ->
+        raise (Cannot_destruct ([], Bad_schema err)))
+    ~schema:Json_schema.self
+
+let merge_tups t1 t2 =
+  let rec is_tup : type t. t encoding -> bool = function
+    | Tup _ -> true
+    | Tups _ (* by construction *) -> true
+    | Conv (_, _, t, None) -> is_tup t
+    | Mu { self } as enc -> is_tup (self enc)
+    | Describe { encoding = t } -> is_tup t
+    | _ -> false in
+  if is_tup t1 && is_tup t2 then
+    Tups (t1, t2)
+  else
+    invalid_arg "Json_encoding.merge_tups"
+
+let list t =
+  Conv (Array.of_list, Array.to_list, Array t, None)
+
+let merge_objs o1 o2 =
+  (* FIXME: check fields unicity *)
+  let rec is_obj : type t. t encoding -> bool = function
+    | Obj _ -> true
+    | Objs _ (* by construction *) -> true
+    | Conv (_, _, t, None) -> is_obj t
+    | Empty -> true
+    | Ignore -> true
+    | Union cases -> List.for_all (fun (Case { encoding = o }) -> is_obj o) cases
+    | Mu { self } as enc -> is_obj (self enc)
+    | Describe { encoding = t } -> is_obj t
+    | _ -> false in
+  if is_obj o1 && is_obj o2 then
+    Objs (o1, o2)
+  else
+    invalid_arg "Json_encoding.merge_objs"
+
+let empty =
+  Empty
+
+let unit =
+  Ignore
+
+let case encoding proj inj  =
+  Case { encoding ; proj ; inj }
+
+let union = function
+  | [] -> invalid_arg "Json_encoding.union"
+  | cases ->
+    (* FIXME: check mutual exclusion *)
+    Union cases
+
+let rec print_error ?print_unknown ppf = function
+  | Cannot_destruct ([], exn) ->
+    print_error ?print_unknown ppf exn
+  | Cannot_destruct (path, Unexpected (unex, ex)) ->
+    Format.fprintf ppf
+      "At %a, unexpected %s instead of %s"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      unex ex
+  | Cannot_destruct (path, No_case_matched errs) ->
+    Format.fprintf ppf
+      "@[<v 2>At %a, no case matched:@,%a@]"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      (Format.pp_print_list (print_error ?print_unknown)) errs
+  | Cannot_destruct (path, Bad_array_size (unex, ex)) ->
+    Format.fprintf ppf
+      "At %a, unexpected array of size %d instead of %d"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      unex ex
+  | Cannot_destruct (path, Missing_field n) ->
+    Format.fprintf ppf
+      "At %a, missing object field %s"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      n
+  | Cannot_destruct (path, Unexpected_field n) ->
+    Format.fprintf ppf
+      "At %a, unexpected object field %s"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      n
+  | Cannot_destruct (path, Bad_schema exn) ->
+    Format.fprintf ppf
+      "@[<v 2>At %a, bad custom schema:@,%a@]"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      (print_error ?print_unknown) exn
+  | Unexpected (unex, ex) ->
+    Format.fprintf ppf
+      "Unexpected %s instead of %s" unex ex
+  | No_case_matched errs ->
+    Format.fprintf ppf
+      "@[<v 2>No case matched:@,%a@]"
+      (Format.pp_print_list (print_error ?print_unknown)) errs
+  | Bad_array_size (unex, ex) ->
+    Format.fprintf ppf
+      "Unexpected array of size %d instead of %d" unex ex
+  | Missing_field n ->
+    Format.fprintf ppf
+      "Missing object field %s" n
+  | Unexpected_field n ->
+    Format.fprintf ppf
+      "Unexpected object field %s" n
+  | Bad_schema exn ->
+    Format.fprintf ppf
+      "@[<v 2>bad custom schema:@,%a@]"
+      (print_error ?print_unknown) exn
+  | Cannot_destruct (path, exn) ->
+    Format.fprintf ppf
+      "@[<v 2>At %a:@,%a@]"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      (print_error ?print_unknown) exn
+  | exn ->
+    Json_schema.print_error ?print_unknown ppf exn
+
+include Ezjsonm_encoding
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.mli
new file mode 100644
index 000000000..ad4607a8f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_encoding.mli
@@ -0,0 +1,499 @@
+(** JSON structure description using dependently typed combinators. *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** {2 Dependent types describing JSON document structures} *) (***************)
+
+(** An encoding between an OCaml data type (the parameter) and a
+    JSON representation. To be built using the predefined
+    combinators provided by this module.
+
+    For instance, here is an encoding, of type [(int * string)
+    encoding], mapping values of type [int * string] to JSON objects
+    with a field [code] of whose value is a number and a field
+    [message] whose value is a string.
+
+    [let enc = obj2 (req "code" int) (req "message" string)]
+
+    This encoding serves three purposes:
+
+      1. Output an OCaml value of type ['a] to an intermediate JSON
+         representation using {!construct}. To be printed to actual
+         JSON using an external library.
+      2. Input a JSON intermediate structure (already parsed with an external
+         library) to produce an OCaml value of type ['a].
+      3. Describe this encoding in JSON-schema format for inter-operability:
+         you describe the encoding of your internal types, and obtain
+         machine-readable descriptions of the formats as a byproduct.
+         Specific documentation combinators are provided for that purpose.
+
+    By default, this library provides functions that work on the
+    {!Json_repr.ezjsonm} data type, compatible with {!Ezjsonm.value}.
+    However, encodings are not tied with this representation.
+    See functor {!Make} and module {!Json_repr} for using another format. *)
+type 'a encoding
+
+(** {2 Constructors and destructors for {!Json_repr.ezjsonm}} *) (***************)
+
+(** Builds a json value from an OCaml value and an encoding.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val construct : 't encoding -> 't -> Json_repr.ezjsonm
+
+(** Reads an OCaml value from a JSON value and an encoding.
+    May raise [Cannot_destruct].
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val destruct : 't encoding -> Json_repr.ezjsonm -> 't
+
+(** {2 JSON type combinators for simple immediates} *) (***********************)
+
+(** An encoding of an OCaml unit by any (ignored) JSON. *)
+val unit : unit encoding
+
+(** An encoding of an OCaml unit by a JSON null. *)
+val null : unit encoding
+
+(** An encoding of an OCaml unit by an empty JSON object. *)
+val empty : unit encoding
+
+(** An encoding of an OCaml int by a JSON number.
+
+    When destructing, the JSON number cannot have a fractional part,
+    and must be between [-2^30] and [2^30-1] (these bounds are chosen
+    to be compatible with both 32-bit and 64bit native OCaml compilers
+    as well as JavaScript). When constructing, the value coming from
+    the OCaml world is assumed to be valid, otherwise an
+    [Invalid_argument] will be raised (can only happen on 64-bit systems).
+
+    Use {!int32} or {!int53} for a greater range.
+    Use {!ranged_int} to restrict to an interval. *)
+val int : int encoding
+
+(** An encoding of an OCaml int32 by a JSON number.
+
+    Must be a floating point without fractional part and between
+    [-2^31] and [2^31-1] when destructing. Never fails when
+    constructing, as all 32-bit integers are included in JSON numbers. *)
+val int32 : int32 encoding
+
+(** An encoding of a JSON-representable OCaml int64 by a JSON number.
+
+    Restricted to the [-2^53] to [2^53] range, as this is the limit of
+    representable integers in JSON numbers. Must be a floating point
+    without fractional part and in this range when destructing. When
+    constructing, the value coming from the OCaml world is assumed to
+    be in this range, otherwise an [Invalid_argument] will be raised. *)
+val int53 : int64 encoding
+
+(** An encoding of an OCaml int by a JSON number restricted to a specific range.
+
+    The bounds must be between [-2^30] and [2^30-1].
+
+    The inclusive bounds are checked when destructing. When
+    constructing, the value coming from the OCaml world is assumed to
+    be within the bounds, otherwise an [Invalid_argument] will be
+    raised. The string parameter is a name used to tweak the error
+    messages. *)
+val ranged_int : minimum: int -> maximum: int -> string -> int encoding
+
+(** An encoding of an OCaml int32 by a JSON number restricted to a specific range.
+
+    The bounds must be between [-2^31] and [2^31-1].
+
+    The inclusive bounds are checked when destructing. When
+    constructing, the value coming from the OCaml world is assumed to
+    be within the bounds, otherwise an [Invalid_argument] will be
+    raised. The string parameter is a name used to tweak the error
+    messages. *)
+val ranged_int32 : minimum: int32 -> maximum: int32 -> string -> int32 encoding
+
+(** An encoding of an OCaml int64 by a JSON number restricted to a specific range.
+
+    The bounds must be between [-2^53] and [2^53].
+
+    The inclusive bounds are checked when destructing. When
+    constructing, the value coming from the OCaml world is assumed to
+    be within the bounds, otherwise an [Invalid_argument] will be
+    raised. The string parameter is a name used to tweak the error
+    messages. *)
+val ranged_int53 : minimum: int64 -> maximum: int64 -> string -> int64 encoding
+
+(** An encoding of an OCaml boolean by a JSON one. *)
+val bool : bool encoding
+
+(** An encoding of an OCaml string by a JSON one. *)
+val string : string encoding
+
+(** An encoding of a closed set of OCaml values by JSON strings. *)
+val string_enum : (string * 'a) list -> 'a encoding
+
+(** An encoding of a constant string. *)
+val constant : string -> unit encoding
+
+(** An encoding of an OCaml mutable string by a JSON string. *)
+val bytes : bytes encoding
+
+(** An encoding of an OCaml float by a JSON number. *)
+val float : float encoding
+
+(** An encoding of an OCaml float by a JSON number with range constraints  *)
+val ranged_float : minimum:float -> maximum:float -> string -> float encoding
+
+(** An encoding of an OCaml option by a nullable JSON value. Raises
+    [Invalid_argument] when nesting options – i.e., when building ['a option
+    option encoding]. Also raises [Invalid_argument] when used on the encoding
+    of [null]. *)
+val option : 'a encoding -> 'a option encoding
+
+(** {2 JSON type combinators for objects} *) (*********************************)
+
+(** A first class handle to a JSON field. *)
+type 'a field
+
+(** A required field of a given its type. *)
+val req : ?title:string -> ?description:string -> string -> 't encoding -> 't field
+
+(** An optional field of a given type, using an OCaml [option]. *)
+val opt : ?title:string -> ?description:string -> string -> 't encoding -> 't option field
+
+(** An optional field of a given type, ommited when equal to a default value. *)
+val dft : ?title:string -> ?description:string -> string -> 't encoding -> 't -> 't field
+
+(** An encoding of an OCaml value by a singleton object. *)
+val obj1 :
+  'f1 field ->
+  'f1 encoding
+
+(** An encoding of an OCaml pair by a JSON object with two fields. *)
+val obj2 :
+  'f1 field -> 'f2 field ->
+  ('f1 * 'f2) encoding
+
+(** An encoding of an OCaml triple by a JSON object with three fields. *)
+val obj3 :
+  'f1 field -> 'f2 field -> 'f3 field ->
+  ('f1 * 'f2 * 'f3) encoding
+
+(** An encoding of an OCaml quadruple by a JSON object with four fields. *)
+val obj4 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+
+(** An encoding of an OCaml quintuple by a JSON object with five fields. *)
+val obj5 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+
+(** An encoding of an OCaml sextuple by a JSON object with six fields. *)
+val obj6 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+
+(** An encoding of an OCaml septuple by a JSON object with seven fields. *)
+val obj7 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+
+(** An encoding of an OCaml octuple by a JSON object with eight fields. *)
+val obj8 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+
+(** An encoding of an OCaml nonuple by a JSON object with nine fields. *)
+val obj9 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+
+(** An encoding of an OCaml decuple by a JSON object with ten fields. *)
+val obj10 :
+  'f1 field -> 'f2 field -> 'f3 field -> 'f4 field -> 'f5 field ->
+  'f6 field -> 'f7 field -> 'f8 field -> 'f9 field -> 'f10 field ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+(** Merge two object [encoding]s. For describing heavyweight objects with
+    a lot of fields. The ocaml type is a pair of tuples, but the JSON
+    object is flat. Both arguments must be object encodings,
+    otherwise a future {!construct}, {!destruct} or {!schema} will fail
+    with [Invalid_argument]. *)
+val merge_objs :
+  'o1 encoding -> 'o2 encoding -> ('o1 * 'o2) encoding
+
+(** {2 JSON type combinators for arrays} *) (**********************************)
+
+(** An encoding of an OCaml array by a JSON one. *)
+val array :
+  'a encoding ->
+  'a array encoding
+
+(** An encoding of an OCaml list by a JSON one. *)
+val list :
+  'a encoding ->
+  'a list encoding
+
+(** An encoding of an OCaml associative list by a JSON object. *)
+val assoc :
+  'a encoding ->
+  (string * 'a) list encoding
+
+(** An encoding of an OCaml value by a singleton array. *)
+val tup1 :
+  'f1 encoding ->
+  'f1 encoding
+
+(** An encoding of an OCaml pair by a JSON array with two cells. *)
+val tup2 :
+  'f1 encoding -> 'f2 encoding ->
+  ('f1 * 'f2) encoding
+
+(** An encoding of an OCaml triple by a JSON array with three cells. *)
+val tup3 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding ->
+  ('f1 * 'f2 * 'f3) encoding
+
+(** An encoding of an OCaml quadruple by a JSON array with four cells. *)
+val tup4 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4) encoding
+
+(** An encoding of an OCaml quintuple by a JSON array with five cells. *)
+val tup5 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5) encoding
+
+(** An encoding of an OCaml sextuple by a JSON array with six cells. *)
+val tup6 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  'f6 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6) encoding
+
+(** An encoding of an OCaml septuple by a JSON array with seven cells. *)
+val tup7 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  'f6 encoding -> 'f7 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7) encoding
+
+(** An encoding of an OCaml octuple by a JSON array with eight cells. *)
+val tup8 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  'f6 encoding -> 'f7 encoding -> 'f8 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8) encoding
+
+(** An encoding of an OCaml nonuple by a JSON array with nine cells. *)
+val tup9 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  'f6 encoding -> 'f7 encoding -> 'f8 encoding -> 'f9 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9) encoding
+
+(** An encoding of an OCaml decuple by a JSON array with ten cells. *)
+val tup10 :
+  'f1 encoding -> 'f2 encoding -> 'f3 encoding -> 'f4 encoding -> 'f5 encoding ->
+  'f6 encoding -> 'f7 encoding -> 'f8 encoding -> 'f9 encoding -> 'f10 encoding ->
+  ('f1 * 'f2 * 'f3 * 'f4 * 'f5 * 'f6 * 'f7 * 'f8 * 'f9 * 'f10) encoding
+
+(** Merge two tuple [encoding]s. For describing heavyweight arrays with a
+    lot of cells. The ocaml type is a pair of tuples, but the JSON
+    array is flat, with the elements of the first tuple before the
+    ones of the second. Both arguments must be tuple encodings,
+    otherwise a future {!construct}, {!destruct} or {!schema} will fail
+    with [Invalid_argument]. *)
+val merge_tups :
+  'a1 encoding ->
+  'a2 encoding ->
+  ('a1 * 'a2) encoding
+
+(** {2 JSON type combinators for unions} *) (**********************************)
+
+(** A case for describing union types using {!union} ans {!case}. *)
+type 't case
+
+(** To be used inside a {!union}. Takes a [encoding] for a specific
+    case, and a converter to and from a type common to all cases
+    (['t]). Usually, it consists in boxing / deboxing the specific
+    data in an OCaml sum type contructor. *)
+val case : 'a encoding -> ('t -> 'a option) -> ('a -> 't) -> 't case
+
+(** A utility to build destructors for custom encoded sum types. *)
+val union : 't case list -> 't encoding
+
+(** {2 JSON generic type combinators} *) (*************************************)
+
+(** A simple custom encoding using the {!Json_repr.ezjsonm}
+    intermediate representation for the conversion functions. The
+    resulting encoding is usable with any other instanciation of
+    functor {!Make}, internal conversions may be performed needed.
+    The second transformer function can
+    [raise (Cannot_destruct ([ (* location *)], exn))]
+    to indicate an error, which will be relocated correctly. *)
+val custom :
+  ('t -> Json_repr.ezjsonm) ->
+  (Json_repr.ezjsonm -> 't) ->
+  schema: Json_schema.schema ->
+  't encoding
+
+(** An encoding adapter, with an optional handwritten schema.
+    The second transformer function can [raise (Cannot_destruct ([], exn))]
+    to indicate an error, which will be relocated correctly. *)
+val conv :
+  ('a -> 'b) ->
+  ('b -> 'a) ->
+  ?schema: Json_schema.schema ->
+  'b encoding ->
+  'a encoding
+
+(** A fixpoint combinator. Links a recursive OCaml type to an internal
+    JSON schema reference, by allowing to use the encoding inside its
+    own definition. The first parameter is a path, that must be unique
+    and respect the format of {!Json_schema.add_definition}. It is
+    used to encode the recursivity as a named reference in the JSON
+    schema.
+
+    Here is an example to turn a standard OCaml list into either
+    ["nil"] for [[]] or [{"hd":hd,"tl":tl}] for [hd::tl].
+
+    {[ let reclist itemencoding =
+         mu "list" @@ fun self ->
+         union
+           [ case (string_enum [ "nil", () ])
+               (function [] -> Some () | _ :: _ -> None)
+               (fun () -> []) ;
+             case (obj2 (req "hd" itemencoding) (req "tl" self))
+               (function hd :: tl -> Some (hd, tl) | [] -> None)
+               (fun (hd, tl) -> hd :: tl) ]) ]} *)
+val mu :
+  string ->
+  ?title: string ->
+  ?description: string ->
+  ('a encoding -> 'a encoding) -> 'a encoding
+
+(** A raw JSON value in ezjsonm representation. *)
+val any_ezjson_value : Json_repr.ezjsonm encoding
+
+(** A valid JSON document (i.e. an array or object value). *)
+val any_document : Json_repr.any encoding
+
+(** The encoding of a JSON schema, linked to its OCaml definiton. *)
+val any_schema : Json_schema.schema encoding
+
+(** {2 Exporting [encoding]s as JSON schemas} *) (********************************)
+
+(** Describe an encoding in JSON schema format.
+    May raise {!Bad_schema}. *)
+val schema : ?definitions_path:string -> 't encoding -> Json_schema.schema
+
+(** Name a definition so its occurences can be shared in the JSON
+    schema.  The first parameter is a path, that must be unique and
+    respect the format of {!Json_schema.add_definition}. *)
+val def :
+  string ->
+  ?title:string ->
+  ?description:string ->
+  't encoding -> 't encoding
+
+(** {2 Errors} *) (************************************************************)
+
+(** Exception raised by destructors, with the location in the original
+    JSON structure and the specific error. *)
+exception Cannot_destruct of (Json_query.path * exn)
+
+(** Unexpected kind of data encountered (w/ the expectation). *)
+exception Unexpected of string * string
+
+(** Some {!union} couldn't be destructed, w/ the reasons for each {!case}. *)
+exception No_case_matched of exn list
+
+(** Array of unexpected size encountered  (w/ the expectation). *)
+exception Bad_array_size of int * int
+
+(** Missing field in an object. *)
+exception Missing_field of string
+
+(** Supernumerary field in an object. *)
+exception Unexpected_field of string
+
+(** Bad custom schema encountered. *)
+exception Bad_schema of exn
+
+(** Produces a human readable version of an error. *)
+val print_error
+  : ?print_unknown: (Format.formatter -> exn -> unit) ->
+  Format.formatter -> exn -> unit
+
+(** {2 Advanced interface for using a custom JSON representation} *) (**********)
+
+module Make (Repr : Json_repr.Repr) : sig
+
+  (** Same as {!construct} for a custom JSON representation. *)
+  val construct : 't encoding -> 't -> Repr.value
+
+  (** Same as {!destruct} for a custom JSON representation. *)
+  val destruct : 't encoding -> Repr.value -> 't
+
+  (** Same as {!custom} for a custom JSON representation. *)
+  val custom :
+    ('t -> Repr.value) -> (Repr.value -> 't) ->
+    schema: Json_schema.schema ->
+    't encoding
+
+end
+
+(** Custom encoders for an OCaml type, given both custom conversion
+    functions. The actual representation is not known in advance, so
+    the conversion functions have to examine / construct the JSON
+    value through the first class modules they are passed. The [read]
+    transformer function can [raise (Cannot_destruct ([], "message"))]
+    to indicate an error, which will be relocated correctly.
+
+    Here is an example of how to build such a value for a type ['t].
+
+    {[ let read
+         : type tf. (module Json_repr.Repr with type value = tf) -> tf -> 't
+         = fun (module Repr_f) repr ->
+           match Repr_f.view repr with
+           | `Null (* destruct the JSON using [Repr_f.view] *) ->
+             (* create a value of type 't *)
+           | _ ->
+             (* or fail with this wrapping exception *)
+             raise (Cannot_destruct ([ (* location *) ], (* exn *))) in
+       let write
+         : type tf. (module Json_repr.Repr with type value = tf) -> 't -> tf
+         = fun (module Repr_f) v ->
+           (* examine the value and produce a JSON using [Repr_f.repr] *)
+           Repr_f.repr `Null in
+       { read ; write } ]} *)
+type 't repr_agnostic_custom =
+  { write : 'rt. (module Json_repr.Repr with type value = 'rt) -> 't -> 'rt ;
+    read : 'rf. (module Json_repr.Repr with type value = 'rf) -> 'rf -> 't }
+
+(** A custom encoding, using custom encoders and a schema. *)
+val repr_agnostic_custom :
+  't repr_agnostic_custom ->
+  schema: Json_schema.schema ->
+  't encoding
+
+(** A raw JSON value in its original representation. *)
+val any_value : Json_repr.any encoding
+
+(** Returns [true] is the encoding might construct [null]. *)
+val is_nullable : 't encoding -> bool
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.ml
new file mode 100644
index 000000000..9faee5df8
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.ml
@@ -0,0 +1,269 @@
+(* Queries in JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+type path =
+  path_item list
+
+and path_item =
+  [ `Field of string
+  | `Index of int
+  | `Star | `Next ]
+
+exception Illegal_pointer_notation of string * int * string
+exception Unsupported_path_item of path_item * string
+exception Cannot_merge of path
+
+(*-- path operations -------------------------------------------------------*)
+
+let print_path_as_json_path ?(wildcards = true) ppf = function
+  | [] -> Format.fprintf ppf "/"
+  | nonempty ->
+    let rec print ppf = function
+      | [] -> ()
+      | `Field n :: rem -> Format.fprintf ppf "/%s%a" n print rem
+      | `Index n :: rem -> Format.fprintf ppf "[%d]%a" n print rem
+      | `Next :: rem when wildcards -> Format.fprintf ppf "-%a" print rem
+      | `Star :: rem when wildcards -> Format.fprintf ppf "*%a" print rem
+      | (`Next | `Star) :: _ ->
+        raise (Unsupported_path_item (`Star, "JSON path w/o wildcards")) in
+    print ppf nonempty
+
+let print_path_as_json_pointer ?(wildcards = true) ppf = function
+  | [] -> Format.fprintf ppf "/"
+  | nonempty ->
+    let rec print ppf = function
+      | [] -> ()
+      | `Field n :: rem -> Format.fprintf ppf "/%s%a" n print rem
+      | `Index n :: rem -> Format.fprintf ppf "/%d%a" n print rem
+      | `Next :: rem when wildcards -> Format.fprintf ppf "/-%a" print rem
+      | `Next :: _ -> raise (Unsupported_path_item (`Star, "JSON pointer w/o wildcards"))
+      | `Star :: _ -> raise (Unsupported_path_item (`Star, "JSON pointer")) in
+    print ppf nonempty
+
+let json_pointer_of_path ?wildcards path =
+  Format.asprintf "%a" (print_path_as_json_pointer ?wildcards) path
+
+let path_of_json_pointer ?(wildcards = true) str =
+  let buf = Buffer.create 100 in
+  let len = String.length str in
+  let rec slashes acc i =
+    if i >= len then List.rev acc
+    else if String.get str i = '/' then slashes acc (i + 1)
+    else item acc i
+  and item acc i =
+    if i >= len then List.rev (interp () :: acc)
+    else match String.get str i with
+      | '/' -> slashes (interp () :: acc) i
+      | '~' ->
+        if i + 1 >= len then
+          raise (Illegal_pointer_notation (str, i, "Unterminated escape sequence")) ;
+        begin match String.get str i with
+          | '0' -> Buffer.add_char buf '~'
+          | '1' -> Buffer.add_char buf '/'
+          | _illegal ->
+            raise (Illegal_pointer_notation (str, i + 1, "Illegal escape character")) end ;
+        item acc (i + 1)
+      | unescaped ->
+        Buffer.add_char buf unescaped ;
+        item acc (i + 1)
+  and interp () =
+    let field = Buffer.contents buf in
+    Buffer.clear buf ;
+    if field = "-" then
+      if wildcards then
+        `Next
+      else
+        raise (Unsupported_path_item (`Next, "JSON pointer w/o wildcards"))
+    else try `Index (int_of_string field) with
+      | _ -> `Field field in
+  if len = 0 then []
+  else if String.get str 0 <> '/' then
+    raise (Illegal_pointer_notation (str, 0, "Missing initial slash"))
+  else slashes [] 1
+
+(*-- queries ---------------------------------------------------------------*)
+
+module Make (Repr : Json_repr.Repr) = struct
+
+  let rec query path json = match path, Repr.view json with
+    | [], _ ->
+      json
+    | `Field n :: rempath, `O ((n', v) :: rem) ->
+      if n = n' then query rempath v else query path (Repr.repr (`O rem))
+    | `Index i :: rempath, `A cells ->
+      let i = if i < 0 then List.length cells - i  else i in
+      query rempath (List.nth cells i)
+    | `Star :: rempath, `O ((_, v) :: rem) ->
+      begin try query rempath v with Not_found -> query path (Repr.repr (`O rem)) end
+    | `Star :: rempath, `A (v :: rem) ->
+      begin try query rempath v with Not_found -> query path (Repr.repr (`A rem)) end
+    | _, _ -> raise Not_found
+
+  let query_all path json =
+    let res = ref [] in
+    let rec query path json = match path, Repr.view json with
+      | [], _ ->
+        res := json :: !res
+      | `Field n :: rempath, `O ((n', v) :: rem) ->
+        if n = n' then query rempath v else query path (Repr.repr (`O rem))
+      | `Index i :: rempath, `A cells ->
+        let i = if i < 0 then List.length cells - i  else i in
+        query rempath (List.nth cells i)
+      | `Star :: rempath, `O fields ->
+        List.iter (fun (_, v) -> query rempath v) fields
+      | `Star :: rempath, `A cells ->
+        List.iter (query rempath) cells
+      | _, _ -> () in
+    query path json ; !res
+
+  (*-- updates ---------------------------------------------------------------*)
+
+  let sort_fields =
+    List.sort (fun (l, _) (r, _) -> compare l r)
+
+  let equals l r =
+    let rec canon v = match Repr.view v with
+      | `O l -> Repr.repr (`O (List.map (fun (n, o) -> n, canon o) l |> sort_fields))
+      | `A l -> Repr.repr (`A (List.map canon l))
+      | _ -> v in
+    canon l = canon r
+
+  let merge l r =
+    let rec merge path l r =
+      match Repr.view l, Repr.view r with
+      | `O l, `O r -> Repr.repr (`O (merge_fields path [] (sort_fields (l @ r))))
+      | `Null, v | v, `Null -> Repr.repr v
+      | `A l, `A r -> Repr.repr (`A (merge_cells path 0 [] l r))
+      | _ -> if equals l r then l else raise (Cannot_merge (List.rev path))
+    and merge_cells path i acc l r = match l, r with
+      | [], rem | rem, [] -> List.rev_append acc rem
+      | l :: ls, r :: rs ->
+        let item = merge (`Index i :: path) l r in
+        merge_cells path (succ i) (item :: acc) ls rs
+    and merge_fields path acc = function
+      | (lf, lv) :: ((rf, rv) :: rem as rrem) ->
+        if lf = rf then
+          let item = merge (`Field lf :: path) lv rv in
+          merge_fields path ((lf, item) :: acc) rem
+        else
+          merge_fields path ((lf, lv) :: acc) rrem
+      | [ _ ] | [] as last -> last in
+    merge [] l r
+
+  let insert ?(merge = merge) path value root =
+    let revpath sub =
+      let rec loop acc = function
+        | l when l == sub -> List.rev acc
+        | item :: items -> loop (item :: acc) items
+        | [] -> (* absurd *) assert false
+      in loop [] path in
+    let merge path l r =
+      try merge l r with
+        Cannot_merge sub -> raise (Cannot_merge (revpath path @ sub)) in
+    let rec nulls acc n last =
+      if n <= 0 then
+        List.rev (last :: acc)
+      else
+        nulls (Repr.repr `Null :: acc) (pred n) last in
+    let rec insert ?root path =
+      let root = match root with None -> None | Some repr -> Some (Repr.view repr) in
+      match path, root with
+      (* create objects *)
+      | `Field n :: rempath, None ->
+        Repr.repr (`O [ (n, insert rempath) ])
+      | (`Index 0  | `Star | `Next) :: rempath, None ->
+        Repr.repr (`A [ insert rempath ])
+      | `Index i :: rempath, None ->
+        if i < 0 then raise (Cannot_merge (revpath path)) ;
+        Repr.repr (`A (nulls [] (max 0 (pred i)) (insert rempath)))
+      | [], None -> value
+      (* insert in existing *)
+      | [], Some value' ->
+        merge path value (Repr.repr value')
+      | `Field n :: rempath, Some (`O fields) ->
+        Repr.repr (`O (insert_fields [] n rempath fields))
+      | `Index i :: rempath, Some (`A cells) ->
+        let i = if i < 0 then List.length cells - i else i in
+        if i < 0 then raise (Cannot_merge (revpath path)) ;
+        Repr.repr (`A (insert_cells [] i rempath cells))
+      | `Next :: rempath, Some (`A cells) ->
+        Repr.repr (`A (List.rev_append (List.rev cells) [ insert rempath ]))
+      (* multiple insertions *)
+      | `Star :: rempath, Some (`A cells) ->
+        Repr.repr (`A (List.map (fun root -> insert ~root rempath) cells))
+      | `Star :: rempath, Some (`O fields) ->
+        Repr.repr (`O (List.map (fun (n, root) -> (n, insert ~root rempath)) fields))
+      | [ `Star ], Some root ->
+        merge path value (Repr.repr root)
+      (* FIXME: make explicit unhandled cases *)
+      | _, Some _ -> raise (Cannot_merge (revpath path))
+    and insert_fields acc n rempath fields = match fields with
+      | [] ->
+        List.rev ((n, insert rempath) :: acc)
+      | (n', root) :: rem when n = n' ->
+        List.rev_append ((n, insert ~root rempath) :: acc) rem
+      | other :: rem ->
+        insert_fields (other :: acc) n rempath rem
+    and insert_cells acc n rempath cells =
+      match cells, n with
+      | [], n ->
+        nulls acc n (insert rempath)
+      | root :: rem, 0 ->
+        List.rev_append ((insert ~root rempath) :: acc) rem
+      | other :: rem, n ->
+        insert_cells (other :: acc) (n - 1) rempath rem in
+    insert ~root path
+
+  let replace path value root =
+    insert ~merge:(fun value _prev -> value) path value root
+
+  let insert path value root =
+    insert path value root
+
+end
+
+let path_operator_name = function
+  | `Field _ -> "field access"
+  | `Index _ -> "array access"
+  | `Star -> "wildcard"
+  | `Next -> "array append"
+
+let print_error ?print_unknown ppf err = match err with
+  | Illegal_pointer_notation (notation, pos, msg) ->
+    Format.fprintf ppf
+      "@[<v 2>Illegal pointer notation@,At character %d of %S@,%s@]"
+      pos notation msg
+  | Unsupported_path_item (item, msg) ->
+    Format.fprintf ppf
+      "Path operator %s unsupported by %s"
+      (path_operator_name item) msg
+  | Cannot_merge [] ->
+    Format.fprintf ppf
+      "Unmergeable objects"
+  | Cannot_merge path ->
+    Format.fprintf ppf
+      "Unmergeable objects, incompatibility at %a"
+      (print_path_as_json_path ~wildcards:true) path
+  | exn ->
+    match print_unknown with
+    | Some print_unknown -> print_unknown ppf exn
+    | None ->
+      Format.fprintf ppf "Unhandled error %s" (Printexc.to_string exn)
+
+include Make (Json_repr.Ezjsonm)
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.mli
new file mode 100644
index 000000000..a30bf7d2b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_query.mli
@@ -0,0 +1,155 @@
+(** Queries in JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** {2 Paths in JSON documents} *) (*****************************************)
+
+(** An abstract type for paths into a JSON document.
+    A sequence of sub-tree selectors to descend into a JSON tree. *)
+type path = path_item list
+
+(** A JSON sub-tree selector.
+    Indendent from any concrete format (JSON pointer, JSON path, etc.)
+    The semantics depends on the use (selection, insertion, etc.) *)
+and path_item =
+  [ `Field of string
+  (** A field in an object. *)
+  | `Index of int
+  (** An index in an array. *)
+  | `Star
+  (** Any / every field or index. *)
+  | `Next
+    (** The next element after an array. *) ]
+
+(** Pretty prints a path in JSON pointer format (RFC6901).  May throw
+    {!Unsupported_path_item}. Use [~wildcards:false] to deactivate the
+    support of wildcard path items, which may lead to
+    {!Unsupported_path_item}. *)
+val print_path_as_json_pointer : ?wildcards: bool -> Format.formatter -> path -> unit
+
+(** Pretty prints a path in JSON path format. Use [~wildcards:false] to
+    deactivate the support of wildcard path items, which may lead to
+    {!Unsupported_path_item}. *)
+val print_path_as_json_path : ?wildcards: bool -> Format.formatter -> path -> unit
+
+(** Pretty prints a path in JSON pointer format into a fresh string.
+    May throw {!Unsupported_path_item}. Use [~wildcards:false] to
+    deactivate the support of wildcard path items, which may lead to
+    {!Unsupported_path_item}. *)
+val json_pointer_of_path : ?wildcards: bool -> path -> string
+
+(** Parses a path from a string in JSON pointer format.  May throw
+    {!Illegal_pointer_notation}. The string is expected to be ASCII
+    compatible, including UTF-8. Use [~wildcards:false] to deactivate
+    the support of wildcard path items, which may lead to
+    {!Unsupported_path_item}. *)
+val path_of_json_pointer : ?wildcards: bool -> string -> path
+
+(** {2 Querying JSON documents} *) (*******************************************)
+
+(** Extracts the value located at a given path. If multiple locations
+    satisfy the path (in presence of wildcard path items), the chosen
+    one is unspecified. May throw [Not_found].
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val query : path -> Json_repr.ezjsonm -> Json_repr.ezjsonm
+
+(** Extracts the values located at a given path (may be more than one
+    in presence of wildcard path items). The order is unspecified.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val query_all : path -> Json_repr.ezjsonm -> Json_repr.ezjsonm list
+
+(** Insert a value at a given path. If multiple locations satisfy the
+    path (in presence of wildcard path items), the chosen one is
+    unspecified. Will create parent objects or arrays if needed, for
+    instance inserting [3] at [/a/b/c] in [{}] will result in
+    [{"a":{"b":{"c":3}}}]. Inserting in an array at an index bigger
+    than the previous size will expand the array, filling potential
+    missing cells with [`Null]. Inserting in an array at [`Index n]
+    where [n] is negative inserts from the last element of the
+    array. If a value is inserted at a location where there is already
+    one, both are merged as if with {!merge}. May throw
+    {!Cannot_merge} if the path is incompatible with the original
+    object (such as inserting in a field of something which is not an
+    object) or if the value is to be merged with an incompatible
+    existing value.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val insert : path -> Json_repr.ezjsonm -> Json_repr.ezjsonm -> Json_repr.ezjsonm
+
+(** Same as {!insert}, except that if the path leads to a pre-existing
+    value, it is replaced with the new one instead of being merged.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val replace : path -> Json_repr.ezjsonm -> Json_repr.ezjsonm -> Json_repr.ezjsonm
+
+(** Merges two compatible JSON values. Merges [`Null] with any JSON
+    value. Merges two deeply equal values together. Merges two objects
+    by merging their common fields and adding all the others. Merges
+    two arrays by merging their common cells pairwise and adding the
+    remaining ones if one array is bigger than the other. May throw
+    {!Cannot_merge}.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val merge : Json_repr.ezjsonm -> Json_repr.ezjsonm -> Json_repr.ezjsonm
+
+(** {2 Errors} *) (**********************************************************)
+
+(** When two incompatible objects are unsuccessfully merged. Comes
+    with the path to the first incompatibility encountered.*)
+exception Cannot_merge of path
+
+(** An path litteral could not be parsed.  Comes with the original
+    string, the position and an explanation. *)
+exception Illegal_pointer_notation of string * int * string
+
+(** An operation was given a path containing an unsupported construct.
+    Comes with an explanation as its second argument. *)
+exception Unsupported_path_item of path_item * string
+
+(** Produces a human readable version of an error. *)
+val print_error
+  : ?print_unknown: (Format.formatter -> exn -> unit) ->
+  Format.formatter -> exn -> unit
+
+(** {2 Advanced interface for using a custom JSON representation} *) (**********)
+
+module Make (Repr : Json_repr.Repr) : sig
+
+  (** Same as {!query} for a custom JSON representation. *)
+  val query : path -> Repr.value -> Repr.value
+
+  (** Same as {!query_all} for a custom JSON representation. *)
+  val query_all : path -> Repr.value -> Repr.value list
+
+  (** Same as {!insert} for a custom JSON representation. *)
+  val insert : path -> Repr.value -> Repr.value -> Repr.value
+
+  (** Same as {!replace} for a custom JSON representation. *)
+  val replace : path -> Repr.value -> Repr.value -> Repr.value
+
+  (** Same as {!merge} for a custom JSON representation. *)
+  val merge : Repr.value -> Repr.value -> Repr.value
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.ml
new file mode 100644
index 000000000..12a235034
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.ml
@@ -0,0 +1,251 @@
+(* Representations of JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+type 'a view =
+  [ `O of (string * 'a) list
+  | `A of 'a list
+  | `Bool of bool
+  | `Float of float
+  | `String of string
+  | `Null ]
+
+type 'a repr_uid = 'a option ref
+(* This is used for limiting conversions. When a value is converted
+   from a representation to another, which mostly happens when using
+   the {!type:any} boxing, such as when writing custom encodings, the
+   original value is usually traversed using the [view] of the
+   original representation, and recreated using the [repr] of the
+   destination representation. When converting from a representation
+   to itself, we want to optimize out this transformation, that is a
+   deep copy, and just get the same value. For this, we have to prove
+   to OCaml that it is indeed a value from the same representation.
+   To do that, we use the following trick. Each representation has a
+   bucket, the uid below. When converting from the original
+   representation, we put the value in its bucket. Then, we check the
+   bucket of the destination, and if it happens to be occupied, we
+   find in it the original value, under the destination type. Voilà. *)
+let repr_uid () = ref None
+let eq_repr_uid
+  : 'a -> 'a repr_uid -> 'b repr_uid -> 'b option
+  = fun a ta tb -> tb := None ; ta := Some a ; !tb
+
+module type Repr = sig
+  type value
+  val view : value -> value view
+  val repr : value view -> value
+  val repr_uid : value repr_uid
+end
+
+module Ezjsonm = struct
+  type value =
+    [ `O of (string * value) list
+    | `A of value list
+    | `Bool of bool
+    | `Float of float
+    | `String of string
+    | `Null ]
+  let view v = v
+  let repr v = v
+  let repr_uid = repr_uid ()
+end
+
+type ezjsonm = Ezjsonm.value
+
+module Yojson = struct
+  type value =
+    [ `Bool of bool
+    | `Assoc of (string * value) list
+    | `Float of float
+    | `Int of int
+    | `Intlit of string
+    | `List of value list
+    | `Null
+    | `String of string
+    | `Tuple of value list
+    | `Variant of string * value option ]
+  let view = function
+    | `Intlit i -> `String i
+    | `Tuple l -> `A l
+    | `Variant (label, Some x) -> `A [ `String label ; x ]
+    | `Variant (label, None) -> `String label
+    | `Assoc l -> `O l
+    | `List l -> `A l
+    | `Int i -> `Float (float i)
+    | `Float f -> `Float f
+    | `String s -> `String s
+    | `Null -> `Null
+    | `Bool b -> `Bool b
+  let repr = function
+    | `O l -> `Assoc l
+    | `A l -> `List l
+    | `Bool b -> `Bool b
+    | `Float f -> `Float f
+    | `String s -> `String s
+    | `Null -> `Null
+  let repr_uid = repr_uid ()
+end
+
+type yojson = Yojson.value
+
+let convert
+  : type tt tf.
+    (module Repr with type value = tf) ->
+    (module Repr with type value = tt) ->
+    tf -> tt
+  = fun (module Repr_f) (module Repr_t) v ->
+    match eq_repr_uid v Repr_f.repr_uid Repr_t.repr_uid with
+    | Some r -> r
+    | None ->
+      let rec conv v = match Repr_f.view v with
+        | `Float _ | `Bool _ | `String _ | `Null as v -> Repr_t.repr v
+        | `A values -> Repr_t.repr (`A (List.map conv values))
+        | `O values -> Repr_t.repr (`O (List.map (fun (k, v) -> (k, conv v)) values)) in
+      conv v
+
+let pp_string ppf s =
+  Format.fprintf ppf "\"" ;
+  for i = 0 to String.length s - 1 do
+    match String.get s i with
+    | '\"' -> Format.fprintf ppf "\\\""
+    | '\n' -> Format.fprintf ppf "\\n"
+    | '\r' -> Format.fprintf ppf "\\r"
+    | '\b' -> Format.fprintf ppf "\\b"
+    | '\t' -> Format.fprintf ppf "\\t"
+    | '\\' -> Format.fprintf ppf "\\\\"
+    | '\x00' .. '\x1F' as c -> Format.fprintf ppf "\\u%04x" (Char.code c)
+    | c -> Format.fprintf ppf "%c" c
+  done ;
+  Format.fprintf ppf "\""
+
+let pp
+    ?(compact = false) ?(pp_string = pp_string)
+    (type value) (module Repr : Repr with type value = value) ppf (v : value) =
+  let rec pp_compact ppf v = match Repr.view v with
+    | `O l ->
+      let pp_sep ppf () =
+        Format.fprintf ppf "," in
+      let pp_field ppf (name, v) =
+        Format.fprintf ppf "%a:%a"
+          pp_string name
+          pp_compact v in
+      Format.fprintf ppf "{%a}"
+        (Format.pp_print_list ~pp_sep pp_field)
+        l
+    | `A l ->
+      let pp_sep ppf () =
+        Format.fprintf ppf "," in
+      Format.fprintf ppf "[%a]"
+        (Format.pp_print_list ~pp_sep pp_compact) l
+    | `Bool true -> Format.fprintf ppf "true"
+    | `Bool false -> Format.fprintf ppf "false"
+    | `Float f ->
+      let fract, intr = modf f in
+      if fract = 0.0 then
+        Format.fprintf ppf "%.0f" intr
+      else
+        Format.fprintf ppf "%g" f
+    | `String s -> pp_string ppf s
+    | `Null -> Format.fprintf ppf "null" in
+  let rec pp_box ppf v = match Repr.view v with
+    | `O [] -> Format.fprintf ppf "{}"
+    | `O l ->
+      let pp_sep ppf () =
+        Format.fprintf ppf ",@ " in
+      let pp_field ppf (name, v) =
+        Format.fprintf ppf "@[<hov 2>%a:@ %a@]"
+          pp_string name
+          pp_box v in
+      Format.fprintf ppf "@[<hov 2>{ %a }@]"
+        (Format.pp_print_list ~pp_sep pp_field)
+        l
+    | `A [] -> Format.fprintf ppf "[]"
+    | `A l ->
+      let pp_sep ppf () =
+        Format.fprintf ppf ",@ " in
+      Format.fprintf ppf "@[<hov 2>[ %a ]@]"
+        (Format.pp_print_list ~pp_sep pp_box) l
+    | _ -> pp_compact ppf v in
+  if compact then
+    pp_compact ppf v
+  else
+    pp_box ppf v
+
+let from_yojson non_basic =
+  (* Delete `Variant, `Tuple and `Intlit *)
+  let rec to_basic non_basic = match non_basic with
+    | `Intlit i -> `String i
+    | `Tuple l -> `List (List.map to_basic l)
+    | `Variant (label, Some x) -> `List [`String label; to_basic x]
+    | `Variant (label, None) -> `String label
+    | `Assoc l -> `Assoc (List.map (fun (key, value) -> (key, to_basic value)) l)
+    | `List l -> `List (List.map to_basic l)
+    | `Int i -> `Int i
+    | `Float f -> `Float f
+    | `String s -> `String s
+    | `Null -> `Null
+    | `Bool b -> `Bool b in
+  (* Rename `Assoc, `Int and `List *)
+  let rec to_value : 'a. _ -> ([> ezjsonm ] as 'a) = function
+    | `List l -> `A (List.map to_value l)
+    | `Assoc l -> `O (List.map (fun (key, value) -> (key, to_value value)) l)
+    | `Int i -> `Float (float_of_int i)
+    | `Float f -> `Float f
+    | `Null -> `Null
+    | `String s -> `String s
+    | `Bool b -> `Bool b in
+  to_basic (non_basic :> yojson) |> to_value
+
+let to_yojson json =
+  let rec aux : 'a. _ -> ([> yojson ] as 'a) = function
+    | `A values ->
+      `List (List.map aux values)
+    | `O values ->
+      `Assoc (List.map (fun (k, v) -> (k, aux v)) values)
+    | `Float f ->
+      let fract, intr = modf f in
+      let max_intf = float 0x3F_FF_FF_FF in
+      let min_intf = ~-. max_intf -. 1. in
+      if fract = 0.0 then
+        if intr >= min_intf && intr <= max_intf
+        then `Int (int_of_float intr)
+        else `Intlit (Printf.sprintf "%.0f" intr)
+      else `Float f
+    | `Bool b -> `Bool b
+    | `String s -> `String s
+    | `Null -> `Null
+  in aux (json :> ezjsonm)
+
+type any = Value_with_repr: (module Repr with type value = 'a) * 'a -> any
+
+let pp_any ?compact ?pp_string () ppf (Value_with_repr (repr, v)) =
+  pp ?compact ?pp_string repr ppf v
+
+let any_to_repr :
+  type tt. (module Repr with type value = tt) -> any -> tt =
+  fun repr_t (Value_with_repr (repr_f, v)) -> convert repr_f repr_t v
+
+let repr_to_any repr v =
+  Value_with_repr (repr, v)
+
+let from_any : 'a. any -> ([> ezjsonm] as 'a) = fun repr ->
+  let res = any_to_repr (module Ezjsonm) repr in
+  (res : ezjsonm :> [> ezjsonm])
+
+let to_any v =
+  Value_with_repr ((module Ezjsonm), (v :> ezjsonm))
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.mli
new file mode 100644
index 000000000..0a976f6bf
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr.mli
@@ -0,0 +1,167 @@
+(** Representations of JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** {2 Abstraction over JSON representations} *) (*****************************)
+
+(** The internal format used by the library. A common format to view
+    JSON structures from different representations. It only shows the
+    head of structures, hiding the contents of fields, so that the
+    conversion from another format or a stream can be done lazily. *)
+type 'a view =
+  [ `O of (string * 'a) list
+    (** An associative table (object). *)
+  | `A of 'a list
+    (** An (integer indexed) array. *)
+  | `Bool of bool
+    (** A JS boolean [true] or [false]. *)
+  | `Float of float
+    (** A floating point number (double precision). *)
+  | `String of string
+    (** An UTF-8 encoded string. *)
+  | `Null
+    (** The [null] constant. *) ]
+
+(** Each representation must provide a unique identifier, obtained via
+    the {!repr_uid} function. This identifier is used when converting
+    between representations, to optimize out a copy when converting
+    from a representation to itself. Beware that this optimization
+    relies only on this [uid] token. Converting between values of the
+    same type using two different representation modules with
+    different [uid]s will perform a copy. A practical way to ensure
+    that the optimization is made is to write your representations as
+    toplevel modules, and not inside functors. *)
+type 'a repr_uid
+
+(** See {!type:repr_uid}. *)
+val repr_uid : unit -> 'a repr_uid
+
+(** A view over a given implementation. *)
+module type Repr = sig
+
+  (** The implementation type. *)
+  type value
+
+  (** View a value in the common format. *)
+  val view : value -> value view
+
+  (** Builds a value from a view *)
+  val repr : value view -> value
+
+  (** See {!type:repr_uid}. *)
+  val repr_uid : value repr_uid
+
+end
+
+(** Convert a JSON value from one representation to another. *)
+val convert :
+  (module Repr with type value = 'tf) ->
+  (module Repr with type value = 'tt) ->
+  'tf -> 'tt
+
+(** Generic pretty-printer. If [compact] is set (by default), then the
+    output is not really pretty (no space is output). Ascii-compatible
+    string encoding is expected, as printing only escapes double
+    quotes and control characters. Use [pp_string] for more advanced
+    escaping. This function does not claim to be the best JSON pretty
+    printer, it is mostly a small utility. *)
+val pp :
+  ?compact: bool -> ?pp_string: (Format.formatter -> string -> unit) ->
+  (module Repr with type value = 'tf) ->
+  Format.formatter -> 'tf -> unit
+
+
+(** {2 Third party in-memory JSON document representations} *) (****************)
+
+(** A JSON value compatible with {!Ezjsonm.value}. *)
+type ezjsonm =
+  [ `O of (string * ezjsonm) list
+  (** An associative table (object). *)
+  | `A of ezjsonm list
+  (** An (integer indexed) array. *)
+  | `Bool of bool
+  (** A JS boolean [true] or [false]. *)
+  | `Float of float
+  (** A floating point number (double precision). *)
+  | `String of string
+  (** An UTF-8 encoded string. *)
+  | `Null
+  (** The [null] constant. *) ]
+
+(** A view over the {!type:ezjsonm} representation.*)
+module Ezjsonm : Repr with type value = ezjsonm
+
+(** A JSON value compatible with {!Yojson.Safe.json}. *)
+type yojson =
+  [ `Bool of bool
+  (** A JS boolean [true] of [false]. *)
+  | `Assoc of (string * yojson) list
+  (** JSON object. *)
+  | `Float of float
+  (** A floating point number (double precision). *)
+  | `Int of int
+  (** A number without decimal point or exponent. *)
+  | `Intlit of string
+  (** A number without decimal point or exponent, preserved as string. *)
+  | `List of yojson list
+  (** A JS array. *)
+  | `Null
+  (** The [null] constant. *)
+  | `String of string
+  (** An UTF-8 encoded string. *)
+  | `Tuple of yojson list
+  (** A tuple (non-standard). Syntax: ("abc", 123). *)
+  | `Variant of string * yojson option
+    (** A variant (non-standard). Syntax: <"Foo"> or <"Bar": 123>. *) ]
+
+(** A view over the {!yojson} representation.*)
+module Yojson : Repr with type value = yojson
+
+(** {2 Representation-agnostic JSON format} *) (********************************)
+
+(** A meta-representation for JSON values that can unify values of
+    different representations by boxing them with their corresponding
+    {!Repr} modules. *)
+type any = private Value_with_repr: (module Repr with type value = 'a) * 'a -> any
+
+(** Converts a boxed value from its intrinsic representation to the
+    one of the given {!Repr} module. Optimized if the internal
+    representation of the value actually is the requested one. *)
+val any_to_repr : (module Repr with type value = 'a) -> any -> 'a
+
+(** Boxes a value with a compatible {!Repr} module. *)
+val repr_to_any : (module Repr with type value = 'a) -> 'a -> any
+
+(** Pretty-printer for values of type {!any}. See {!pp} for details. *)
+val pp_any :
+  ?compact: bool -> ?pp_string: (Format.formatter -> string -> unit) -> unit ->
+  Format.formatter -> any -> unit
+
+(** {2 Predefined converters for {!type:ezjsonm}} *) (********************************)
+
+(** Conversion helper. *)
+val from_yojson : [< yojson ] -> [> ezjsonm ]
+
+(** Conversion helper. *)
+val to_yojson : [< ezjsonm] -> [> yojson ]
+
+(** Converts a boxed value from its representation to {!ezjsonm}. *)
+val from_any : any -> [> ezjsonm ]
+
+(** Boxes as {!ezjsonm} value. *)
+val to_any : [< ezjsonm] -> any
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.ml
new file mode 100644
index 000000000..d5245825e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.ml
@@ -0,0 +1,103 @@
+(* This file is part of Learn-OCaml.
+ *
+ * Copyright (C) 2016 OCamlPro.
+ *
+ * Learn-OCaml is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Affero General Public License as
+ * published by the Free Software Foundation, either version 3 of the
+ * License, or (at your option) any later version.
+ *
+ * Learn-OCaml is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Affero General Public License for more details.
+ *
+ * You should have received a copy of the GNU Affero General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
+
+module Repr = struct
+
+  (* Not for the faint of heart. *)
+
+  type value = unit Js.t
+
+  let repr = function
+    | `String s -> Js.Unsafe.coerce (Js.string s)
+    | `Float f -> Js.Unsafe.coerce (Obj.magic f)
+    | `Bool true -> Js.Unsafe.coerce Js._true
+    | `Bool false -> Js.Unsafe.coerce Js._false
+    | `Null -> Obj.magic Js.null (* Oh, nom nom nom! *)
+    | `O fields ->
+        let obj = Js.Unsafe.new_obj (Js.Unsafe.pure_js_expr "Object") [||] in
+        List.iter
+          (fun (n, v) -> Js.Unsafe.set obj (Js.string n) v)
+          fields ;
+        obj
+    | `A cells ->
+        Js.Unsafe.coerce (Js.array (Array.of_list cells))
+
+  let view v =
+    match Js.to_string (Js.typeof v) with
+    | "string" -> `String (Js.to_string (Js.Unsafe.coerce v))
+    | "number" -> `Float (Obj.magic v)
+    | "boolean" -> `Bool (Js.to_bool (Obj.magic v))
+    | "undefined" -> `Null (* Oh yeah! *)
+    | "object" ->
+        if v == Js.Unsafe.pure_js_expr "null" then
+          `Null
+        else if Js.instanceof v (Js.Unsafe.pure_js_expr "Array") then
+          let rec loop acc n =
+            if n < 0 then
+              `A acc
+            else
+              loop (Js.Unsafe.get v n :: acc) (n - 1)
+          in
+          loop [] (Js.Unsafe.get v (Js.string "length") - 1)
+        else
+          let fields : Js.js_string Js.t list =
+            Array.to_list @@ Js.to_array
+              (Js.Unsafe.fun_call
+                 (Js.Unsafe.js_expr
+                    "(function(o){\
+                    \  var p=[];\
+                    \  for(var n in o){if(o.hasOwnProperty(n)){p.push(n);}}\
+                    \  return p;\
+                     })")
+                 [| Js.Unsafe.inject v |]) in
+          `O (List.map
+                (fun f -> Js.to_string f, Js.Unsafe.get v f)
+                fields)
+    | _ -> invalid_arg "Json_repr_browser.Repr.view"
+
+  let repr_uid = Json_repr.repr_uid ()
+
+end
+
+type value = Repr.value
+
+let js_stringify ?indent obj =
+  Js.Unsafe.meth_call
+    (Js.Unsafe.variable "JSON")
+    "stringify"
+    (match indent with
+     | None ->
+       [| Js.Unsafe.inject obj |]
+     | Some indent ->
+       [| Js.Unsafe.inject obj ;
+          Js.Unsafe.inject Js.null ;
+          Js.Unsafe.inject indent |])
+
+let parse_js_string jsstr =
+  Js.Unsafe.meth_call
+    (Js.Unsafe.variable "JSON")
+    "parse"
+    [| Js.Unsafe.inject jsstr |]
+
+let stringify ?indent obj =
+  Js.to_string (js_stringify ?indent obj)
+
+let parse str =
+  parse_js_string (Js.string str)
+
+module Json_encoding = Json_encoding.Make (Repr)
+module Json_query = Json_query.Make (Repr)
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.mli
new file mode 100644
index 000000000..daaa21454
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_browser.mli
@@ -0,0 +1,46 @@
+(** Native browser representation of JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** An abstract type for native browser objects. *)
+type value
+
+(** A view over the browser representation.*)
+module Repr : Json_repr.Repr with type value = value
+
+(** Pre-instanciated {!Json_encoding.Make}. *)
+module Json_encoding : module type of Json_encoding.Make (Repr)
+
+(** Pre-instanciated {!Json_encoding.Make}. *)
+module Json_query : module type of Json_query.Make (Repr)
+
+(** Parse a JSON string using the native browser parser. *)
+val parse : string -> value
+
+(** Produce a JSON string using the native browser printer.
+
+    If indent is not present, everything is printed on a single line.
+    Otherwise, it is the number (up to 10) of spaces inserted at
+    beginning of lines for each indentation level. *)
+val stringify : ?indent: int -> value -> string
+
+(** Same as {!parse} with native browser strings. *)
+val parse_js_string : Js.js_string Js.t -> value
+
+(** Same as {!stringify} with native browser strings. *)
+val js_stringify : ?indent: int -> value -> Js.js_string Js.t
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.ml
new file mode 100644
index 000000000..6c7a0bb7d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.ml
@@ -0,0 +1,390 @@
+(* Representations of JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+open Json_repr
+
+module Repr = struct
+  type serialized =
+    { buffer : bytes ;
+      offset : int ;
+      length : int ;
+      array_field : bool }
+  and deserialized =
+    [ `O of (string * value) list
+    | `A of value list
+    | `Bool of bool
+    | `Float of float
+    | `String of string
+    | `Null ]
+  and node =
+    | Deserialized of deserialized
+    | Serialized of serialized
+    | Both of deserialized * serialized
+  and value =
+    { mutable node : node ;
+      conforming : bool ; (* when lazily deserializing the root *)
+      cache : bool (* when lazily deserializing *) }
+
+  module LEB = EndianBytes.LittleEndian_unsafe
+
+  exception Bson_decoding_error of string * bytes * int
+
+  let view root =
+    match root.node with
+    | Deserialized deserialized
+    | Both (deserialized, _) -> deserialized
+    | Serialized ({ buffer ; offset ; length ; array_field } as serialized) ->
+      let offset = ref offset in
+      let length = ref length in
+      let error fmt =
+        Format.ksprintf
+          (fun msg -> raise (Bson_decoding_error (msg, buffer, !offset)))
+          fmt in
+      let box node =
+        { node ; conforming = false ; cache = root.cache } in
+      let skip n =
+        offset := !offset + n ;
+        length := !length - n in
+      let read_float () =
+        if !length < 8 then
+          error "not enough data, double expected (8 bytes)" ;
+        let res = LEB.get_double buffer !offset in
+        skip 8 ;
+        res in
+      let read_string () =
+        if !length < 4 then
+          error "not enough data, string size tag expected (4 bytes)" ;
+        let strlen = Int32.to_int (LEB.get_int32 buffer !offset) - 1 in
+        skip 4 ;
+        if !length < strlen then
+          error "not enough data, string expected (%d bytes)" strlen ;
+        let res = Bytes.sub_string buffer !offset strlen in
+        skip strlen ;
+        if !length < 1 then
+          error "not enough data, string terminator expected (0x00)" ;
+        if LEB.get_int8 buffer !offset <> 0x00 then
+          error "string terminator expected (0x00)" ;
+        skip 1 ;
+        res in
+      let read_bool () =
+        if !length < 1 then
+          error "not enough data, bool expected (1 byte)" ;
+        let res = match LEB.get_int8 buffer !offset with
+          | 0x00 -> false
+          | 0x01 -> true
+          | byte -> error "invalid bool value (0x%02X)" byte in
+        skip 1 ;
+        res in
+      let read_field_name () =
+        let rec find_terminator len =
+          if !length = 0 then
+            error "not enough data, field name terminator expected (0x00)" ;
+          match LEB.get_int8 buffer !offset with
+          | 0x00 ->
+            skip (-len) ;
+            len
+          | _ ->
+            skip 1 ;
+            find_terminator (len + 1) in
+        let fieldlen = find_terminator 0 in
+        let res = Bytes.sub_string buffer !offset fieldlen in
+        skip (fieldlen + 1) ;
+        res in
+      let deserialized =
+        if !length < 5 then
+          error "not enough data for size and terminator" ;
+        let size = Int32.to_int (LEB.get_int32 buffer !offset) in
+        if size <> !length then
+          error "size tag inconsistent with actual data" ;
+        skip 4 ;
+        let tag = LEB.get_int8 buffer !offset in
+        if tag = 0x00 then begin
+          if !length = 1 then
+            `O []
+          else
+            error "early terminator" ;
+        end else if not root.conforming && tag land 0xF0 = 0x80 then begin
+          skip 1 ;
+          let res = match tag land 0x0F with
+            | 0x01 -> `Float (read_float ())
+            | 0x02 -> `String (read_string ())
+            | 0x08 -> `Bool (read_bool ())
+            | 0x0A -> `Null
+            | tag ->
+              error "unknown immediate tag (0x%02X)" tag in
+          if !length <> 1 then
+            error "not enough data, terminator expected (0x00)" ;
+          if LEB.get_int8 buffer !offset <> 0x00 then
+            error "terminator expected (0x00)" ;
+          skip 1 ;
+          res
+        end else begin
+          let rec loop acc =
+            let tag = LEB.get_int8 buffer !offset in
+            if tag = 0x00 then
+              if !length = 1 then
+                if array_field then
+                  try
+                    let rec to_array acc i = function
+                      | [] -> `A (List.rev acc)
+                      | (name, bson) :: rest ->
+                        if name = string_of_int i then
+                          to_array (bson :: acc) (i + 1) rest
+                        else raise Exit in
+                    to_array [] 0 (List.rev acc)
+                  with Exit ->
+                    error "invalid field names for array field"
+                else
+                  `O (List.rev acc)
+              else
+                error "early terminator"
+            else begin
+              skip 1 ;
+              match tag with
+              | 0x01 ->
+                let name = read_field_name () in
+                loop ((name, box (Deserialized (`Float (read_float ())))) :: acc)
+              | 0x02 ->
+                let name = read_field_name () in
+                loop ((name, box (Deserialized (`String (read_string ())))) :: acc)
+              | 0x08 ->
+                let name = read_field_name () in
+                loop ((name, box (Deserialized (`Bool (read_bool ())))) :: acc)
+              | 0x0A ->
+                let name = read_field_name () in
+                loop ((name, box (Deserialized (`Null))) :: acc)
+              | 0x03 | 0x04 ->
+                let name = read_field_name () in
+                if !length < 4 then
+                  error "not enough data, subdocument size tag expected (4 bytes)" ;
+                let doclen = Int32.to_int (LEB.get_int32 buffer !offset) in
+                if !length < doclen then
+                  error "not enough data, subdocument expected (%d bytes)" doclen ;
+                let serialized =
+                  { buffer ; length = doclen ; offset = !offset ;
+                    array_field = (tag = 0x04) } in
+                skip doclen ;
+                loop ((name, box (Serialized serialized)) :: acc)
+              | tag ->
+                error "unknown tag (0x%02X)" tag
+            end in
+          loop []
+        end in
+      if root.cache then begin
+        root.node <- Both (deserialized, serialized)
+      end else begin
+        root.node <- Deserialized deserialized
+      end ;
+      deserialized
+
+  let repr deserialized =
+    { node = (Deserialized deserialized) ;
+      conforming = false ;
+      cache = true }
+
+  let to_bytes ~cache ~conforming root =
+    match root.node with
+    | Serialized serialized
+    | Both (_, serialized) ->
+      if serialized.offset = 0
+      && serialized.length = Bytes.length serialized.buffer then
+        serialized.buffer
+      else
+        Bytes.sub serialized.buffer serialized.offset serialized.length
+    | Deserialized _ ->
+      let rec compute_size bson =
+        match bson.node with
+        | Serialized { length }
+        | Both (_, { length }) ->
+          length
+        | Deserialized deserialized ->
+          match deserialized with
+          | `Float _ -> 4 + 1 + 8 + 1
+          | `String str -> 4 + 1 + 4 + String.length str + 1 + 1
+          | `Bool _ -> 4 + 1 + 1 + 1
+          | `Null -> 4 + 1 + 1
+          | `O fields ->
+            let acc = List.fold_left
+                (fun acc (name, bson) ->
+                   let self = match view bson with
+                     | `Float _ -> 8
+                     | `String str -> 4 + String.length str + 1
+                     | `Bool _ -> 1
+                     | `Null -> 0
+                     | `O _ | `A _ -> compute_size bson in
+                   acc +  1 + String.length name + 1 + self)
+                0 fields in
+            4 + acc + 1
+          | `A cells ->
+            let acc, _ = List.fold_left
+                (fun (acc, i) bson ->
+                   let self = match view bson with
+                     | `Float _ -> 8
+                     | `String str -> 4 + String.length str + 1
+                     | `Bool _ -> 1
+                     | `Null -> 0
+                     | `O _ | `A _ -> compute_size bson in
+                   let rec digits acc i =
+                     if i <= 9 then (1 + acc)
+                     else digits (1 + acc) (i / 10) in
+                   (acc + 1 + digits 0 i + 1 + self, i + 1))
+                (0, 0) cells in
+            4 + acc + 1 in
+      let computed_size = compute_size root in
+      let result = Bytes.create computed_size in
+      let pos = ref 0 in
+      let (+=) r i = r := !r + i in
+      let reserve_size_stamp () =
+        let offset = !pos in
+        pos += 4 ;
+        fun () ->
+          LEB.set_int8 result !pos 0x00 ;
+          pos += 1 ;
+          let size = Int32.of_int (!pos - offset) in
+          LEB.set_int32 result offset size in
+      let rec serialize_toplevel conforming = function
+        | `Float _ | `String _ | `Bool _ | `Null | `A _ when conforming ->
+          raise (Invalid_argument "Json_repr.bson_to_bytes")
+        | `Float f ->
+          let update_size_stamp = reserve_size_stamp () in
+          LEB.set_int8 result !pos 0x81 ;
+          pos += 1 ;
+          LEB.set_double result !pos f ;
+          pos += 8 ;
+          update_size_stamp ()
+        | `String str ->
+          let update_size_stamp = reserve_size_stamp () in
+          LEB.set_int8 result !pos 0x82 ;
+          pos += 1 ;
+          let strlen = String.length str in
+          LEB.set_int32 result !pos Int32.(of_int (strlen + 1)) ;
+          pos += 4 ;
+          Bytes.blit_string str 0 result !pos strlen ;
+          pos += strlen ;
+          LEB.set_int8 result !pos 0x00 ;
+          pos += 1 ;
+          update_size_stamp ()
+        | `Bool b ->
+          let update_size_stamp = reserve_size_stamp () in
+          LEB.set_int8 result !pos 0x88 ;
+          pos += 1 ;
+          LEB.set_int8 result !pos (if b then 0x01 else 0x00) ;
+          pos += 1 ;
+          update_size_stamp ()
+        | `Null ->
+          let update_size_stamp = reserve_size_stamp () in
+          LEB.set_int8 result !pos 0x8A ;
+          pos += 1 ;
+          update_size_stamp ()
+        | `O _ | `A _ as fields_or_cells ->
+          let fields = match fields_or_cells with
+            | `O fields -> fields
+            | `A cells -> List.mapi (fun i v -> string_of_int i, v) cells in
+          let update_size_stamp = reserve_size_stamp () in
+          serialize_fields fields ;
+          update_size_stamp ()
+      and serialize_fields fields =
+        List.iter
+          (fun (name, bson) ->
+             LEB.set_int8 result !pos
+               (match view bson with
+                | `Float _ -> 0x01
+                | `String _ -> 0x02
+                | `Bool _ -> 0x08
+                | `Null -> 0x0A
+                | `O _ -> 0x03 ;
+                | `A _ -> 0x04) ;
+             pos += 1 ;
+             let strlen = String.length name in
+             Bytes.blit_string name 0 result !pos strlen ;
+             pos += strlen ;
+             LEB.set_int8 result !pos 0x00 ;
+             pos += 1 ;
+             begin match view bson with
+               | `Float f ->
+                 LEB.set_double result !pos f ;
+                 pos += 8 ;
+               | `String str ->
+                 let strlen = String.length str in
+                 LEB.set_int32 result !pos Int32.(of_int (strlen + 1)) ;
+                 pos += 4 ;
+                 Bytes.blit_string str 0 result !pos strlen ;
+                 pos += strlen ;
+                 LEB.set_int8 result !pos 0x00 ;
+                 pos += 1 ;
+               | `Bool b ->
+                 LEB.set_int8 result !pos (if b then 0x01 else 0x00) ;
+                 pos += 1 ;
+               | `Null -> ()
+               | `O _ | `A _ -> serialize false bson
+             end)
+          fields
+      and serialize conforming bson =
+        match bson.node with
+        | Serialized { buffer ; offset ; length }
+        | Both (_, { buffer ; offset ; length }) ->
+          Bytes.blit buffer offset result !pos length ;
+          pos := !pos + length
+        | Deserialized deserialized ->
+          let offset = !pos in
+          serialize_toplevel conforming deserialized ;
+          let length = !pos - offset in
+          if cache then begin
+            let serialized =
+              let array_field =
+                match deserialized with `A _ -> true | _ -> false in
+              { buffer = result ; offset ; length ; array_field  } in
+            bson.node <- Both (deserialized, serialized)
+          end in
+      serialize conforming root ;
+      result
+
+  let from_bytes ~laziness ~cache ~conforming buffer =
+    let serialized =
+      { offset = 0 ; length = Bytes.length buffer ; buffer ;
+        array_field = false } in
+    let root =
+      { node = Serialized serialized ; conforming ; cache } in
+    let rec traverse bson = match view bson with
+      | `O fields -> List.iter (fun (_, bson) -> traverse bson) fields
+      | `A cells -> List.iter traverse cells
+      | `Float _ | `String _ | `Bool _ | `Null -> () in
+    if not laziness then begin
+      (* a simple traversal will expand the structure as a side effect *)
+      traverse root
+    end ;
+    root
+
+  let repr_uid : value Json_repr.repr_uid = repr_uid ()
+
+end
+
+type bson = Repr.value
+
+exception Bson_decoding_error = Repr.Bson_decoding_error
+
+let bson_to_bytes ?(cache = true) ?(conforming = false) bson =
+  Repr.to_bytes ~cache ~conforming bson
+
+let bytes_to_bson ?(laziness = true) ?(cache = true) ?(conforming = false) ~copy buffer =
+  let buffer = if copy then Bytes.copy buffer else buffer in
+  Repr.from_bytes ~laziness ~cache ~conforming buffer
+
+module Json_encoding = Json_encoding.Make (Repr)
+module Json_query = Json_query.Make (Repr)
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.mli
new file mode 100644
index 000000000..592565cd0
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_repr_bson.mli
@@ -0,0 +1,100 @@
+(** BSON representation of JSON documents *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** A intermediate representation for BSON, a binary encoding for JSON.
+
+    Decoding and encoding is (optionally) done as lazily as possible.
+    First, the [view] function is able to unfold only one
+    level and not the whole structure. Also, serialized versions are
+    cached, so that later serializations of the same object are faster.
+
+    Notes:
+
+    1. Only JSON compatible BSON documents are supported.
+       BSON extensions are not supported (int32, int64, timestamp, etc.).
+    2. Arrays in BSON are stored inefficiently.
+       Prefer another binary format if you manipulate lots of arrays.
+    3. We differ from BSON to allow toplevel immediates.
+       For this, we produce a document with only one byte indicating
+       the kind of immediate followed by the immediate.
+       The byte is [0x80 lor (the corresponding BSON field kind)].
+    4. We differ from BSON to allow unambiguous toplevel arrays.
+       As with (3), the subdocument to be decoded as an array is
+       preceded with a 0x84.
+
+    Use the [conforming] flag to deactivates the extension from notes (3)
+    and (4). In this case, the toplevel value must be an object. *)
+type bson
+
+(** A view over the {!bson} representation.*)
+module Repr : Json_repr.Repr with type value = bson
+
+(** Pre-instanciated {!Json_encoding.Make}. *)
+module Json_encoding : module type of Json_encoding.Make (Repr)
+
+(** Pre-instanciated {!Json_encoding.Make}. *)
+module Json_query : module type of Json_query.Make (Repr)
+
+
+(** Serializes the intermediate BSON representation to actual BSON.
+
+    By default, [conforming] is [false], so that any value can be serialized,
+    including immediates (see {!type:bson}).
+
+    By default, [cache] is [true], so a future serialization of the
+    same data will be faster. The resulting bytes are stored in the
+    value. You may want to turn this off if these values have a long
+    lifespan, and that you care more about memory consumption than
+    serialization speed.
+
+    Will raise [Invalid_argument "Json_repr.bson_to_bytes"] when
+    [conforming] and trying to serialize a toplevel array or immediate. *)
+val bson_to_bytes :
+  ?cache: bool -> ?conforming: bool ->
+  bson -> bytes
+
+(** Bson decoding error, with a message, the BSON and an offset. *)
+exception Bson_decoding_error of string * bytes * int
+
+(** Creates a lazily unfolded representation for some BSON.
+    Because of the mutability of [bytes] and this laziness,
+    set the copy parameter to [true] if you are not sure that the
+    [bytes] will not be mutated in the future.
+
+    By default, [conforming] is [false], so that any value can be serialized,
+    including immediates (see {!type:bson}).
+
+    By default, [cache] is [true], so a future serialization of the
+    same data will be faster. The input bytes are stored in the
+    value. You may want to turn this off if these values have a long
+    lifespan, and that you care more about memory consumption than
+    serialization speed.
+
+    By default, [laziness] is [true]. If the data is a serialized
+    object, it means that only the field names are read, the field
+    values are eluded, and will be deserialized on demand when calling
+    [Repr.view]. This implies that {!Bson_decoding_error} may be
+    raised later. If set to [false], the whole structure is decoded
+    upfront, so any decoding error will happen at this point. This may
+    be preferable mostly when reading from untusted sources.
+
+    May raise {!Bson_decoding_error}. *)
+val bytes_to_bson :
+  ?laziness: bool -> ?cache: bool -> ?conforming: bool ->
+  copy: bool -> bytes -> bson
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.ml b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.ml
new file mode 100644
index 000000000..204dac109
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.ml
@@ -0,0 +1,1215 @@
+(* Abstract representation of JSON schemas. *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(* TODO: validator *)
+
+open Json_query
+
+(* The currently handled version *)
+let version = "http://json-schema.org/draft-04/schema#"
+
+(*-- types -----------------------------------------------------------------*)
+
+(* The root of a schema with the named definitions,
+   a precomputed ID-element map and a cache for external documents. *)
+type schema =
+  { root : element ;
+    source : Uri.t (* whose fragment should be empty *) ;
+    definitions : (path * element) list ;
+    ids : (string * element) list ;
+    world : schema list }
+
+and element =
+  { title : string option ;
+    description : string option ;
+    default : Json_repr.any option ;
+    enum : Json_repr.any list option ;
+    kind : element_kind ;
+    format : string option ;
+    id : string option }
+
+and element_kind =
+  | Object of object_specs
+  | Array of element list * array_specs
+  | Monomorphic_array of element * array_specs
+  | Combine of combinator * element list
+  | Def_ref of path
+  | Id_ref of string
+  | Ext_ref of Uri.t
+  | String of string_specs
+  | Integer of numeric_specs
+  | Number of numeric_specs
+  | Boolean | Null | Any
+  | Dummy
+
+and combinator =
+  | Any_of | One_of | All_of | Not
+
+and array_specs =
+  { min_items : int ;
+    max_items : int option ;
+    unique_items : bool ;
+    additional_items : element option }
+
+and numeric_specs =
+  { multiple_of : float option ;
+    minimum : (float * [ `Inclusive | `Exclusive ]) option ;
+    maximum : (float * [ `Inclusive | `Exclusive ]) option }
+
+and object_specs =
+  { properties : (string * element * bool * Json_repr.any option) list ;
+    pattern_properties : (string * element) list ;
+    additional_properties : element option ;
+    min_properties : int ;
+    max_properties : int option ;
+    schema_dependencies : (string * element) list ;
+    property_dependencies : (string * string list) list }
+
+and string_specs =
+  { pattern : string option ;
+    min_length : int ;
+    max_length : int option }
+
+(* box an element kind without any optional field *)
+let element kind =
+  { title = None ; description = None ; default = None ; kind ;
+    format = None ; enum = None ; id = None }
+
+(*-- equality --------------------------------------------------------------*)
+
+let option_map f = function None -> None | Some v -> Some (f v)
+
+let rec eq_element a b =
+  a.title = b.title &&
+  a.description = b.description &&
+  option_map Json_repr.from_any a.default =
+  option_map Json_repr.from_any b.default &&
+  option_map (List.map Json_repr.from_any) a.enum =
+  option_map (List.map Json_repr.from_any) b.enum &&
+  eq_kind a.kind b.kind &&
+  a.format = b.format &&
+  a.id = b.id
+
+and eq_kind a b = match a, b with
+  | Object aa, Object ab -> eq_object_specs aa ab
+  | Array (esa, sa), Array (esb, sb) ->
+    List.length esa = List.length esb &&
+    List.for_all2 eq_element esa esb &&
+    eq_array_specs sa sb
+  | Monomorphic_array (ea, sa), Monomorphic_array (eb, sb) ->
+    eq_element ea eb &&
+    eq_array_specs sa sb
+  | Combine (ca, esa), Combine (cb, esb) ->
+    ca = cb &&
+    List.length esa = List.length esb &&
+    List.for_all2 eq_element esa esb
+  | Def_ref pa, Def_ref pb -> pa = pb
+  | Id_ref ra, Id_ref rb -> ra = rb
+  | Ext_ref ra, Ext_ref rb -> ra = rb
+  | String sa, String sb -> sa = sb
+  | Integer na, Integer nb -> na = nb
+  | Number na, Number nb -> na = nb
+  | Boolean, Boolean -> true
+  | Null, Null -> true
+  | Any, Any -> true
+  | Dummy, Dummy -> true
+  | _ -> false
+
+and eq_object_specs a b =
+  a.min_properties = b.min_properties &&
+  a.max_properties = b.max_properties &&
+  List.sort compare a.property_dependencies =
+  List.sort compare b.property_dependencies &&
+  begin match a.additional_properties, b.additional_properties with
+    | Some a, Some b -> eq_element a b
+    | None, None -> true
+    | _, _ -> false
+  end &&
+  List.length a.pattern_properties =
+  List.length b.pattern_properties &&
+  List.for_all2
+    (fun (na, ea) (nb, eb) -> na = nb && eq_element ea eb)
+    (List.sort (fun (x, _) (y, _) -> compare x y) a.pattern_properties)
+    (List.sort (fun (x, _) (y, _) -> compare x y) b.pattern_properties) &&
+  List.length a.schema_dependencies =
+  List.length b.schema_dependencies &&
+  List.for_all2
+    (fun (na, ea) (nb, eb) -> na = nb && eq_element ea eb)
+    (List.sort (fun (x, _) (y, _) -> compare x y) a.schema_dependencies)
+    (List.sort (fun (x, _) (y, _) -> compare x y) b.schema_dependencies) &&
+  List.length a.properties =
+  List.length b.properties &&
+  List.for_all2
+    (fun (na, ea, ra, da) (nb, eb, rb, db) ->
+       na = nb && eq_element ea eb && ra = rb &&
+       option_map Json_repr.from_any da = option_map Json_repr.from_any db)
+    (List.sort (fun (x, _, _, _) (y, _, _, _) -> compare x y) a.properties)
+    (List.sort (fun (x, _, _, _) (y, _, _, _) -> compare x y) b.properties)
+
+and eq_array_specs a b =
+  a.min_items = b.min_items &&
+  a.max_items = b.max_items &&
+  a.unique_items = b.unique_items &&
+  match a.additional_items, b.additional_items with
+  | Some a, Some b -> eq_element a b
+  | None, None -> true
+  | _, _ -> false
+
+(*-- human readable output -------------------------------------------------*)
+
+let pp_string ppf s =
+  Json_repr.(pp (module Ezjsonm)) ppf (`String s)
+let pp_num ppf m =
+  if abs_float m < 1000. then
+    Format.fprintf ppf "%g" m
+  else
+    let pos, m =
+      if m < 0. then (false, ~-. m) else (true, m) in
+    if List.fold_left (fun acc d ->
+        if acc then acc else
+          let v = log (m +. d) /. log 2. in
+          if abs_float (ceil v -. v) < 0.00001 then begin
+            Format.fprintf ppf "%s2^%g" (if pos then "" else "-") v ;
+            if (pos && d < 0.) || (not pos && d > 0.) then
+              Format.fprintf ppf "+%g" (abs_float d) ;
+            if (pos && d > 0.) || (not pos && d < 0.) then
+              Format.fprintf ppf "-%g" (abs_float d) ;
+            true
+          end else false)
+        false [ -2. ; -1. ; 0. ; 1. ; 2. ] then () else
+      Format.fprintf ppf "%f" m
+let pp_numeric_specs ppf { multiple_of ; minimum ; maximum } =
+  Format.fprintf ppf "%a%a%a"
+    (fun ppf -> function None -> () | Some v -> Format.fprintf ppf "multiple of %g" v)
+    multiple_of
+    (fun ppf -> function
+       | (None, _, _) | (_, None, None) -> ()
+       | _ -> Format.fprintf ppf ", ")
+    (multiple_of, minimum, maximum)
+    (fun ppf -> function
+       | None, None -> ()
+       | minimum, maximum ->
+         Format.fprintf ppf "∈ %a, %a"
+           (fun ppf -> function
+              | None -> Format.fprintf ppf "]∞"
+              | Some (m, `Exclusive) -> Format.fprintf ppf "]%a" pp_num m
+              | Some (m, `Inclusive) -> Format.fprintf ppf "[%a" pp_num m)
+           minimum
+           (fun ppf -> function
+              | None -> Format.fprintf ppf "∞["
+              | Some (m, `Exclusive) -> Format.fprintf ppf "%a[" pp_num m
+              | Some (m, `Inclusive) -> Format.fprintf ppf "%a]" pp_num m)
+           maximum)
+    (minimum, maximum)
+let pp_path ppf = function
+  | [ `Field "definitions" ; `Field name ] -> Format.fprintf ppf "%s" name
+  | path -> Json_query.(print_path_as_json_path ~wildcards:true) ppf path
+let pp_desc element = match element with
+  | { title = None ; description = None } -> None
+  | { title = Some text ; description = None }
+  | { title = None ; description = Some text } ->
+    Some begin fun ppf () ->
+      Format.fprintf ppf "/* @[<hov 0>%a@] */"
+        Format.pp_print_text text
+    end
+  | { title = Some title ; description = Some description } ->
+    Some begin fun ppf () ->
+      Format.fprintf ppf "/* @[<v 0>@[<hov 0>%a@]@,@[<hov 0>%a@]@] */"
+        Format.pp_print_text title
+        Format.pp_print_text description
+    end
+let rec pp_element ppf element =
+  match element.id with
+  | Some id ->
+    Format.fprintf ppf "#%s" id
+  | None ->
+    match element.format with
+    | Some format ->
+      Format.fprintf ppf "%s" format
+    | None ->
+      match element.enum with
+      | Some cases ->
+        let pp_sep ppf () =
+          Format.fprintf ppf "@ | " in
+        Format.fprintf ppf "@[<hv 0>%a@]"
+          (Format.pp_print_list ~pp_sep (Json_repr.pp_any ~compact: false ()))
+          cases
+      | None ->
+        match pp_desc element with
+        | Some pp_desc ->
+          let stripped =
+            { element with title = None ; description = None } in
+          begin match element.kind with
+            | Combine _ ->
+              Format.fprintf ppf "%a@,%a"
+                pp_desc () pp_element stripped
+            | Object specs ->
+              Format.fprintf ppf "@[<v 2>{ %a@,%a }@]"
+                pp_desc () pp_object_contents specs
+            | _ ->
+              Format.fprintf ppf "%a@ %a" pp_element stripped pp_desc ()
+          end
+        | None ->
+          begin match element.kind with
+            | String { pattern = None ; min_length = 0 ; max_length = None} ->
+              Format.fprintf ppf "string"
+            | String { pattern = Some pat ; min_length = 0 ; max_length = None} ->
+              Format.fprintf ppf "/%s/" pat
+            | String { pattern ; min_length ; max_length } ->
+              Format.fprintf ppf "%a (%alength%a)"
+                (fun ppf -> function
+                   | None -> Format.fprintf ppf "string"
+                   | Some pat -> Format.fprintf ppf "/%s/" pat)
+                pattern
+                (fun ppf n -> if n > 0 then Format.fprintf ppf "%d <= " n)
+                min_length
+                (fun ppf -> function None -> () | Some m -> Format.fprintf ppf "<= %d" m)
+                max_length
+            | Integer { multiple_of = None ; minimum = None ; maximum = None } ->
+              Format.fprintf ppf "integer"
+            | Integer specs ->
+              Format.fprintf ppf "integer %a" pp_numeric_specs specs
+            | Number { multiple_of = None ; minimum = None ; maximum = None } ->
+              Format.fprintf ppf "number"
+            | Number specs ->
+              Format.fprintf ppf "number %a" pp_numeric_specs specs
+            | Id_ref id ->
+              Format.fprintf ppf "#%s" id
+            | Def_ref path ->
+              Format.fprintf ppf "$%a" pp_path path
+            | Ext_ref uri ->
+              Format.fprintf ppf "$%a" Uri.pp_hum uri
+            | Boolean ->
+              Format.fprintf ppf "boolean"
+            | Null ->
+              Format.fprintf ppf "null"
+            | Any ->
+              Format.fprintf ppf "any"
+            | Dummy -> assert false
+            | Combine (Not, [ elt ]) ->
+              Format.fprintf ppf "! %a" pp_element elt
+            | Combine (c, elts) ->
+              let pp_sep ppf () = match c with
+                | Any_of -> Format.fprintf ppf "@ | "
+                | One_of -> Format.fprintf ppf "@ || "
+                | All_of -> Format.fprintf ppf "@ && "
+                | _ -> assert false in
+              Format.fprintf ppf "@[<hv 0>%a@]"
+                (Format.pp_print_list ~pp_sep pp_element)
+                elts
+            | Object { properties = [] ;
+                       pattern_properties = [] ;
+                       additional_properties = None ;
+                       min_properties = 0 ;
+                       max_properties = Some 0 ;
+                       schema_dependencies = [] ;
+                       property_dependencies = [] } ->
+              Format.fprintf ppf "{}"
+            | Object specs ->
+              Format.fprintf ppf "@[<v 2>{ %a }@]"
+                pp_object_contents specs
+            | Array (_, { max_items = Some 0 })
+            | Monomorphic_array (_, { max_items = Some 0 }) ->
+              Format.fprintf ppf "[]"
+            | Array (elements, { additional_items }) ->
+              let pp_sep =
+                let first = ref true in
+                fun ppf () ->
+                  if !first then
+                    first := false
+                  else
+                    Format.fprintf ppf ",@ " in
+              Format.fprintf ppf "@[<hv 2>[ " ;
+              List.iter (fun elt ->
+                  Format.fprintf ppf "%a%a"
+                    pp_sep ()
+                    pp_element elt)
+                elements ;
+              begin match additional_items with
+                | None -> ()
+                | Some { kind = Any } ->
+                  Format.fprintf ppf "%a,@ ..." pp_sep ()
+                | Some elt ->
+                  Format.fprintf ppf "%a,@ %a ..."
+                    pp_sep ()
+                    pp_element elt
+              end ;
+              Format.fprintf ppf " ]@]"
+            | Monomorphic_array (elt, { additional_items = None }) ->
+              Format.fprintf ppf "[ %a ... ]"
+                pp_element elt
+            | Monomorphic_array (elt, { additional_items = Some { kind = Any } }) ->
+              Format.fprintf ppf "@[<hv 2>[ %a ...,@ ... ]@]"
+                pp_element elt
+            | Monomorphic_array (elt, { additional_items = Some add_elt }) ->
+              (* TODO: find a good way to print length *)
+              Format.fprintf ppf "@[<hv 2>[ %a ...,@ %a ... ]@]"
+                pp_element elt pp_element add_elt
+          end
+and pp_object_contents ppf
+    { properties ; pattern_properties ; additional_properties } =
+  (* TODO: find a good way to print length / dependencies *)
+  let pp_sep =
+    let first = ref true in
+    fun ppf () ->
+      if !first then
+        first := false
+      else
+        Format.fprintf ppf ",@ " in
+  List.iter (fun (name, elt, req, _) ->
+      Format.fprintf ppf "%a@[<hv 2>%a%s:@ %a@]"
+        pp_sep ()
+        pp_string name (if req then "" else "?")
+        pp_element elt)
+    properties ;
+  List.iter (fun (name, elt) ->
+      Format.fprintf ppf "%a@[<hv 2>/%s/:@ %a@]"
+        pp_sep ()
+        name
+        pp_element elt)
+    pattern_properties ;
+  begin match additional_properties with
+    | None -> ()
+    | Some { kind = Any } ->
+      Format.fprintf ppf "%a..." pp_sep ()
+    | Some elt ->
+      Format.fprintf ppf "%a@[<hv 2>*:@ %a@]"
+        pp_sep ()
+        pp_element elt
+  end
+let pp ppf schema =
+  Format.fprintf ppf "@[<v 0>" ;
+  pp_element ppf schema.root ;
+  List.iter (fun (path, elt) ->
+      match pp_desc elt with
+      | None ->
+        Format.fprintf ppf "@,@[<hv 2>$%a:@ %a@]"
+          pp_path path
+          pp_element elt
+      | Some pp_desc ->
+        let stripped =
+          { elt with title = None ; description = None } in
+        Format.fprintf ppf "@,@[<v 2>$%a:@,%a@,%a@]"
+          pp_path path
+          pp_desc ()
+          pp_element stripped)
+    schema.definitions ;
+  List.iter (fun (id, elt) ->
+      match pp_desc elt with
+      | None ->
+        Format.fprintf ppf "@,@[<hv 2>#%s:@ %a@]"
+          id
+          pp_element { elt with id = None }
+      | Some pp_desc ->
+        let stripped =
+          { elt with title = None ; description = None ; id = None } in
+        Format.fprintf ppf "@,@[<v 2>#%s:@,%a@,%a@]"
+          id
+          pp_desc ()
+          pp_element stripped)
+    schema.ids ;
+  Format.fprintf ppf "@]"
+
+(*-- errors ----------------------------------------------------------------*)
+
+exception Cannot_parse of path * exn
+exception Dangling_reference of Uri.t
+exception Bad_reference of string
+exception Unexpected of string * string
+exception Duplicate_definition of path * element * element
+
+let rec print_error ?print_unknown ppf = function
+  | Cannot_parse (path, exn) ->
+    Format.fprintf ppf
+      "@[<v 2>Schema parse error:@,At %a@,%a@]"
+      (Json_query.print_path_as_json_path ~wildcards:true) path
+      (print_error ?print_unknown) exn
+  | Dangling_reference uri ->
+    Format.fprintf ppf
+      "Dangling reference %s" (Uri.to_string uri)
+  | Bad_reference str ->
+    Format.fprintf ppf
+      "Illegal reference notation %s" str
+  | Unexpected (unex, ex) ->
+    Format.fprintf ppf
+      "Unexpected %s instead of %s" unex ex
+  | Duplicate_definition (name, elt, defelt) ->
+    Format.fprintf ppf
+      "@[<v 2>Duplicate definition %a@,\
+       To be inserted:@,\
+      \  @[<v 0>%a@]@,\
+       Already present:@,\
+      \  @[<v 0>%a@]@]"
+      (Json_query.print_path_as_json_pointer ~wildcards:false) name
+      pp_element elt
+      pp_element defelt
+  | exn ->
+    Json_query.print_error ?print_unknown ppf exn
+
+(*-- internal definition table handling ------------------------------------*)
+
+let find_definition name defs =
+  List.assoc name defs
+
+let definition_exists name defs =
+  List.mem_assoc name defs
+
+let insert_definition name elt defs =
+  let rec insert = function
+    | [] ->
+      [ (name, elt) ]
+    | (defname, _) as def :: rem when defname <> name ->
+      def :: insert rem
+    | (_, { kind = Dummy }) :: rem ->
+      (name, elt) :: rem
+    | (_, defelt) :: rem ->
+      if not (eq_element elt defelt) then
+        raise (Duplicate_definition (name, elt, defelt)) ;
+      (name, elt) :: rem in
+  insert defs
+
+module Make (Repr : Json_repr.Repr) = struct
+
+  module Query = Json_query.Make (Repr)
+  open Query
+
+  (*-- printer ---------------------------------------------------------------*)
+
+  let to_json schema =
+    (* functional JSON building combinators *)
+    let obj l = Repr.repr (`O l) in
+    let set_always f v =
+      [ f, Repr.repr v ] in
+    let set_if_some f v cb =
+      match v with None -> [] | Some v -> [ f, Repr.repr (cb v) ] in
+    let set_if_cons f v cb =
+      match v with [] -> [] | v -> [ f, Repr.repr (cb v) ] in
+    let set_if_neq f v v' cb =
+      if v <> v' then [ f, Repr.repr (cb v) ] else [] in
+    (* recursive encoder *)
+    let rec format_element
+        { title ; description ; default ; enum ; kind ; format } =
+      set_if_some "title" title (fun s -> `String s) @
+      set_if_some "description" description (fun s -> `String s) @
+      begin match kind with
+        | Object specs ->
+          let required = List.fold_left
+              (fun r (n, _, p, _) -> if p then Repr.repr (`String n) :: r else r)
+              [] specs.properties in
+          let properties =
+            List.map
+              (fun (n, elt, _, _) -> n, obj (format_element elt))
+              specs.properties in
+          set_always "type" (`String "object") @
+          set_always "properties" (`O properties) @
+          set_if_cons "required" required (fun l -> `A l) @
+          set_if_cons "patternProperties" specs.pattern_properties
+            (fun fs -> `O (List.map (fun (n, elt) -> n, obj (format_element elt)) fs)) @
+          set_if_neq "additionalProperties" specs.additional_properties (Some (element Any))
+            (function
+              | None -> `Bool false
+              | Some elt -> `O (format_element elt)) @
+          set_if_neq "minProperties" specs.min_properties 0
+            (fun i -> `Float (float i)) @
+          set_if_some "maxProperties" specs.max_properties
+            (fun i -> `Float (float i)) @
+          set_if_cons "schemaDependencies" specs.schema_dependencies
+            (fun fs -> `O (List.map (fun (n, elt) -> n, obj (format_element elt)) fs)) @
+          set_if_cons "propertyDependencies" specs.property_dependencies
+            (fun fs ->
+               let property_dependencies =
+                 let strings ls = List.map (fun s -> Repr.repr (`String s)) ls in
+                 List.map (fun (n, ls) -> n, Repr.repr (`A (strings ls))) fs in
+               `O property_dependencies)
+        | Array (elts, specs) ->
+          set_always "type" (`String "array") @
+          set_always "items" (`A (List.map (fun elt -> obj (format_element elt)) elts)) @
+          set_if_neq "minItems" specs.min_items 0 (fun i -> `Float (float i)) @
+          set_if_some "maxItems" specs.max_items (fun i -> `Float (float i)) @
+          set_if_neq "uniqueItems" specs.unique_items false (fun b -> `Bool b) @
+          set_if_neq "additionalItems"
+            specs.additional_items (Some (element Any))
+            (function
+              | None -> `Bool false
+              | Some elt -> `O (format_element elt))
+        | Monomorphic_array (elt, {min_items ; max_items ; unique_items }) ->
+          set_always "type" (`String "array") @
+          set_always "items" (`O (format_element elt)) @
+          set_if_neq "minItems"
+            min_items 0
+            (fun i -> `Float (float i)) @
+          set_if_some "maxItems"
+            max_items
+            (fun i -> `Float (float i)) @
+          set_if_neq "uniqueItems"
+            unique_items false
+            (fun b -> `Bool b)
+        | Combine (c, elts) ->
+          let combinator = function
+            | Any_of -> "anyOf"
+            | One_of -> "oneOf"
+            | All_of -> "allOf"
+            | Not -> "not" in
+          set_always (combinator c) (`A (List.map (fun elt -> obj (format_element elt)) elts))
+        | Def_ref path ->
+          set_always "$ref" (`String ("#" ^ (json_pointer_of_path path)))
+        | Id_ref name ->
+          set_always "$ref" (`String ("#" ^ name))
+        | Ext_ref uri ->
+          set_always "$ref" (`String (Uri.to_string uri))
+        | Integer specs ->
+          set_always "type" (`String "integer") @
+          set_if_some "multipleOf"
+            specs.multiple_of (fun v -> `Float v) @
+          (match specs.minimum with
+           | None -> []
+           | Some (v, `Inclusive) ->
+             [ "minimum", Repr.repr (`Float v) ]
+           | Some (v, `Exclusive) ->
+             [ "minimum", Repr.repr (`Float v) ;
+               "exclusiveMinimum", Repr.repr (`Bool true) ] ) @
+          (match specs.maximum with
+           | None -> []
+           | Some (v, `Inclusive) ->
+             [ "maximum", Repr.repr (`Float v) ]
+           | Some (v, `Exclusive) ->
+             [ "maximum", Repr.repr (`Float v) ;
+               "exclusiveMaximum", Repr.repr (`Bool true) ] )
+        | Number specs ->
+          set_always "type" (`String "number") @
+          set_if_some "multipleOf" specs.multiple_of (fun v -> `Float v) @
+          (match specs.minimum with
+           | None -> []
+           | Some (v, `Inclusive) ->
+             [ "minimum", Repr.repr (`Float v) ]
+           | Some (v, `Exclusive) ->
+             [ "minimum", Repr.repr (`Float v) ;
+               "exclusiveMinimum", Repr.repr (`Bool true) ] ) @
+          (match specs.maximum with
+           | None -> []
+           | Some (v, `Inclusive) ->
+             [ "maximum", Repr.repr (`Float v) ]
+           | Some (v, `Exclusive) ->
+             [ "maximum", Repr.repr (`Float v) ;
+               "exclusiveMaximum", Repr.repr (`Bool true) ] )
+        | String { pattern ; min_length ; max_length } ->
+          set_always "type" (`String "string") @
+          set_if_neq "minLength" min_length 0 (fun i -> `Float (float i)) @
+          set_if_some "maxLength" max_length (fun i -> `Float (float i)) @
+          set_if_some "pattern" pattern (fun s -> `String s)
+        | Boolean ->
+          set_always "type" (`String "boolean")
+        | Null ->
+          set_always "type" (`String "null")
+        | Dummy ->
+          invalid_arg "Json_schema.to_json: remaining dummy element"
+        | Any -> [] end @
+      set_if_some "default" default (fun j ->
+          Repr.view (Json_repr.any_to_repr (module Repr) j)) @
+      set_if_some "enum" enum (fun js ->
+          `A (List.map (Json_repr.any_to_repr (module Repr)) js)) @
+      set_if_some "format" format (fun s -> `String s) in
+    List.fold_left
+      (fun acc (n, elt) -> insert n (obj (format_element elt)) acc)
+      (obj (set_always "$schema" (`String version) @
+            format_element schema.root))
+      schema.definitions
+
+  let unexpected kind expected =
+    let kind =match kind with
+      | `O [] -> "empty object"
+      | `A [] -> "empty array"
+      | `O _ -> "object"
+      | `A _ -> "array"
+      | `Null -> "null"
+      | `String "" -> "empty string"
+      | `String _ -> "string"
+      | `Float _ -> "number"
+      | `Bool _ -> "boolean" in
+    Cannot_parse ([], Unexpected (kind, expected))
+
+  (*-- parser ----------------------------------------------------------------*)
+
+  let at_path p = function Cannot_parse (l, err) -> Cannot_parse (p @ l, err) | exn -> exn
+  let at_field n = at_path [ `Field n ]
+  let at_index i = at_path [ `Index i ]
+
+  let of_json json =
+    (* parser combinators *)
+    let opt_field obj n = match Repr.view obj with
+      | `O ls -> (try Some (List.assoc n ls) with Not_found -> None)
+      | _ -> None in
+    let opt_field_view obj n = match Repr.view obj with
+      | `O ls -> (try Some (Repr.view (List.assoc n ls)) with Not_found -> None)
+      | _ -> None in
+    let opt_string_field obj n = match opt_field_view obj n with
+      | Some (`String s) -> Some s
+      | Some k -> raise (at_field n @@ unexpected k "string")
+      | None -> None in
+    let opt_bool_field def obj n = match opt_field_view obj n with
+      | Some (`Bool b) -> b
+      | Some k -> raise (at_field n @@ unexpected k "bool")
+      | None -> def in
+    let opt_int_field obj n = match opt_field_view obj n with
+      | Some (`Float f) when (fst (modf f) = 0.
+                              && f <= 2. ** 53.
+                              && f >= -2. ** 53.) ->
+        Some f
+      | Some k -> raise (at_field n @@ unexpected k "integer")
+      | None -> None in
+    let opt_length_field obj n = match opt_field_view obj n with
+      | Some (`Float f) when (fst (modf f) = 0.
+                              && f <= 2. ** 30.
+                              && f >= 0.) ->
+        Some (int_of_float f)
+      | Some k -> raise (at_field n @@ unexpected k "length")
+      | None -> None in
+    let opt_float_field obj n = match opt_field_view obj n with
+      | Some (`Float f) -> Some f
+      | Some k -> raise (at_field n @@ unexpected k "number")
+      | None -> None in
+    let opt_array_field obj n = match opt_field_view obj n with
+      | Some (`A s) -> Some s
+      | Some k -> raise (at_field n @@ unexpected k "array")
+      | None -> None in
+    let opt_uri_field obj n = match opt_string_field obj n with
+      | None -> None
+      | Some uri ->
+        match Uri.canonicalize (Uri.of_string uri) with
+        | exception _ -> raise (Cannot_parse ([], Bad_reference (uri ^ " is not a valid URI")))
+        | uri -> Some uri in
+    (* local resolution of definitions *)
+    let schema_source = match opt_uri_field json "id" with
+      | Some uri -> Uri.with_fragment uri None
+      | None -> Uri.empty in
+    let collected_definitions = ref [] in
+    let collected_id_defs = ref [] in
+    let collected_id_refs = ref [] in
+    let rec collect_definition : Uri.t -> element_kind = fun uri ->
+      match Uri.host uri, Uri.fragment uri with
+      | Some _ (* Actually means: any of host, user or port is defined. *), _ ->
+        Ext_ref uri
+      | None, None ->
+        raise (Cannot_parse ([], Bad_reference (Uri.to_string uri ^ " has no fragment")))
+      | None, Some fragment when not (String.contains fragment '/') ->
+        collected_id_refs := fragment :: !collected_id_refs ;
+        Id_ref fragment
+      | None, Some fragment ->
+        let path =
+          try path_of_json_pointer ~wildcards:false fragment
+          with err -> raise (Cannot_parse ([], err)) in
+        try
+          let raw = query path json in
+          if not (definition_exists path !collected_definitions) then begin
+            (* dummy insertion so we don't recurse and we support cycles *)
+            collected_definitions := insert_definition path (element Dummy) !collected_definitions ;
+            let elt = try parse_element schema_source raw
+              with err -> raise (at_path path err) in
+            (* actual insertion *)
+            collected_definitions := insert_definition path elt !collected_definitions
+          end ;
+          Def_ref path
+        with Not_found -> raise (Cannot_parse ([], Dangling_reference uri))
+    (* recursive parser *)
+    and parse_element : Uri.t -> Repr.value -> element = fun source json ->
+      let id = opt_uri_field json "id" in
+      let id, source = match id with
+        | None -> None, source
+        | Some uri ->
+          let uri = Uri.canonicalize (Uri.resolve "http" source uri) in
+          Uri.fragment uri, Uri.with_fragment uri None in
+      (* We don't support inlined schemas, so we just drop elements with
+         external sources and replace them with external references. *)
+      if source <> schema_source then
+        element (Ext_ref (Uri.with_fragment source id))
+      else
+        let id = match id with
+          | None -> None
+          | Some id when String.contains id '/' ->
+            raise (at_field "id" @@ Cannot_parse ([], Bad_reference (id ^ " is not a valid ID")))
+          | Some id -> Some id in
+        (* We parse the various element syntaxes and combine them afterwards. *)
+        (* 1. An element with a known type field and associated fields. *)
+        let as_kind =
+          match opt_field_view json "type" with
+          | Some (`String name) ->
+            Some (element (parse_element_kind source json name))
+          | Some (`A [] as k) ->
+            raise (at_field "type" @@ unexpected k "type, type array or operator")
+          | Some (`A l) ->
+            let rec items i acc = function
+              | [] ->
+                let kind = Combine (Any_of, List.rev acc) in
+                Some (element kind)
+              | `String name :: tl ->
+                let kind = parse_element_kind source json name in
+                let case = element kind in
+                items (succ i) (case :: acc) tl
+              | k :: _ ->
+                raise (at_field "type" @@ at_index i @@ unexpected k "type")
+            in items 0 [] (List.map Repr.view l)
+          | Some k ->
+            raise (at_field "type" @@ unexpected k "type, type array or operator")
+          | None -> None in
+        (* 2. A reference *)
+        let as_ref =
+          match opt_uri_field json "$ref" with
+          | Some uri ->
+            let path = collect_definition uri in
+            Some (element path)
+          | None -> None in
+        (* 3. Combined schemas *)
+        let as_nary name combinator others =
+          let build = function
+            | [] -> None (* not found and no auxiliary case *)
+            | [ case ] -> Some case  (* one case -> simplify *)
+            | cases -> (* several cases build the combination node with empty options *)
+              let kind = Combine (combinator, cases) in
+              Some (element kind) in
+          match opt_field_view json name with
+          | Some (`A (_ :: _ as cases)) (* list of schemas *) ->
+            let rec items i acc = function
+              | elt :: tl ->
+                let elt = try parse_element source elt
+                  with err -> raise (at_field name @@ at_index i @@ err) in
+                items (succ i) (elt :: acc) tl
+              | [] ->
+                build (others @ List.rev acc)
+            in items 0 [] cases
+          | None -> build others
+          | Some k -> raise (at_field name @@ unexpected k "a list of elements") in
+        (* 4. Negated schema *)
+        let as_not =
+          match opt_field_view json "not" with
+          | None -> None
+          | Some elt ->
+            let elt = try parse_element source (Repr.repr elt)
+              with err -> raise (at_field "not" err) in
+            let kind = Combine (Not, [ elt ]) in
+            Some (element kind) in
+        (* parse optional fields *)
+        let title = opt_string_field json "title" in
+        let description = opt_string_field json "description" in
+        let default = match opt_field json "default" with
+          | Some v -> Some (Json_repr.repr_to_any (module Repr) v)
+          | None -> None in
+        let enum =match opt_array_field json "enum" with
+          | Some v -> Some (List.map (Json_repr.repr_to_any (module Repr)) v)
+          | None -> None in
+        let format = opt_string_field json "format" in (* TODO: check format ? *)
+        (* combine all specifications under a big conjunction *)
+        let as_one_of = as_nary "oneOf" One_of [] in
+        let as_any_of = as_nary "anyOf" Any_of [] in
+        let all = [ as_kind ; as_ref ; as_not ; as_one_of ; as_any_of ] in
+        let cases = List.flatten (List.map (function None -> [] | Some e -> [ e ]) all) in
+        let kind = match as_nary "allOf" All_of cases with
+          | None -> Any (* no type, ref or logical combination found *)
+          | Some { kind } -> kind in
+        (* add optional fields *)
+        { title ; description ; default ; format ; kind ; enum ; id }
+    and parse_element_kind  source json name =
+      let integer_specs json =
+        let multiple_of = opt_int_field json "multipleOf" in
+        let minimum =
+          if opt_bool_field false json "exclusiveMinimum" then
+            match opt_int_field json "minimum" with
+            | None ->
+              let err =
+                "minimum field required when exclusiveMinimum is true" in
+              raise (Failure err)
+            | Some v -> Some (v, `Inclusive)
+          else
+            match opt_int_field json "minimum" with
+            | None -> None
+            | Some v -> Some (v, `Exclusive) in
+        let maximum =
+          if opt_bool_field false json "exclusiveMaximum" then
+            match opt_int_field json "maximum" with
+            | None ->
+              let err =
+                "maximum field required when exclusiveMaximum is true" in
+              raise (Failure err)
+            | Some v -> Some (v, `Inclusive)
+          else
+            match opt_int_field json "maximum" with
+            | None -> None
+            | Some v -> Some (v, `Exclusive) in
+        { multiple_of ; minimum ; maximum} in
+      let numeric_specs json =
+        let multiple_of = opt_float_field json "multipleOf" in
+        let minimum =
+          if opt_bool_field false json "exclusiveMinimum" then
+            match opt_float_field json "minimum" with
+            | None ->
+              let err =
+                "minimum field required when exclusiveMinimum is true" in
+              raise (Failure err)
+            | Some v -> Some (v, `Inclusive)
+          else
+            match opt_float_field json "minimum" with
+            | None -> None
+            | Some v -> Some (v, `Exclusive) in
+        let maximum =
+          if opt_bool_field false json "exclusiveMaximum" then
+            match opt_float_field json "maximum" with
+            | None ->
+              let err =
+                "maximum field required when exclusiveMaximum is true" in
+              raise (Failure err)
+            | Some v -> Some (v, `Inclusive)
+          else
+            match opt_float_field json "maximum" with
+            | None -> None
+            | Some v -> Some (v, `Exclusive) in
+        { multiple_of ; minimum ; maximum} in
+      match name with
+      | "integer" ->
+        Integer (integer_specs json)
+      | "number" ->
+        Number (numeric_specs json)
+      | "boolean" -> Boolean
+      | "null" -> Null
+      | "string" ->
+        let specs =
+          let pattern = opt_string_field json "pattern" in
+          let min_length = opt_length_field json "minLength" in
+          let max_length = opt_length_field json "maxLength" in
+          let min_length = match min_length with None -> 0 | Some l -> l in
+          { pattern ; min_length ; max_length } in
+        String specs
+      | "array" ->
+        let specs =
+          let unique_items = opt_bool_field false json "uniqueItems" in
+          let min_items = opt_length_field json "minItems" in
+          let max_items = opt_length_field json "maxItems" in
+          let min_items = match min_items with None -> 0 | Some l -> l in
+          match opt_field_view json "additionalItems" with
+          | Some (`Bool true) ->
+            { min_items ; max_items ; unique_items ; additional_items = Some (element Any) }
+          | None | Some (`Bool false) ->
+            { min_items ; max_items ; unique_items ; additional_items = None }
+          | Some elt ->
+            let elt = try parse_element source (Repr.repr elt)
+              with err -> raise (at_field "additionalItems" err) in
+            { min_items ; max_items ; unique_items ; additional_items = Some elt } in
+        begin match opt_field_view json "items" with
+          | Some (`A elts) ->
+            let rec elements i acc = function
+              | [] ->
+                Array (List.rev acc, specs)
+              | elt :: tl ->
+                let elt = try parse_element source elt
+                  with err -> raise (at_field "items" @@ at_index i err) in
+                elements (succ i) (elt :: acc) tl
+            in elements 0 [] elts
+          | Some elt ->
+            let elt = try parse_element source (Repr.repr elt)
+              with err -> raise (at_field "items" err) in
+            Monomorphic_array (elt, specs)
+          | None ->
+            Monomorphic_array (element Any, specs) end
+      | "object" ->
+        let required =
+          match opt_array_field json "required" with
+          | None ->  []
+          | Some l ->
+            let rec items i acc = function
+              | `String s :: tl -> items (succ i) (s :: acc) tl
+              | [] -> List.rev acc
+              | k :: _ -> raise (at_field "required" @@ at_index i @@ unexpected k "string")
+            in items 0 [] (List.map Repr.view l) in
+        let properties =
+          match opt_field_view json "properties" with
+          | Some (`O props) ->
+            let rec items acc = function
+              | [] -> List.rev acc
+              | (n, elt) :: tl ->
+                let elt = try parse_element source elt
+                  with err -> raise (at_field "properties" @@ at_field n @@ err) in
+                let req = List.mem n required in
+                items ((n, elt, req, None) :: acc) tl (* XXX: fixme *)
+            in items [] props
+          | None -> []
+          | Some k -> raise (at_field "properties" @@ unexpected k "object") in
+        let additional_properties =
+          match opt_field_view json "additionalProperties" with
+          | Some (`Bool false) -> None
+          | None | Some (`Bool true) -> Some (element Any)
+          | Some elt ->
+            let elt = try parse_element source (Repr.repr elt)
+              with err -> raise (at_field "additionalProperties" err) in
+            Some elt in
+        let property_dependencies =
+          match opt_field_view json "propertyDependencies" with
+          | None -> []
+          | Some (`O l) ->
+            let rec sets sacc = function
+              | (n, `A l) :: tl ->
+                let rec strings j acc = function
+                  | [] -> sets ((n, List.rev acc) :: sacc) tl
+                  | `String s :: tl -> strings (succ j) (s :: acc) tl
+                  | k :: _ ->
+                    raise (at_field "propertyDependencies" @@
+                           at_field n @@
+                           at_index j @@
+                           unexpected k "string")
+                in strings 0 [] (List.map Repr.view l)
+              | (n, k) :: _ ->
+                raise (at_field "propertyDependencies" @@
+                       at_field n @@
+                       unexpected k "string array")
+              | [] -> List.rev sacc
+            in sets [] (List.map (fun (n, v) -> (n, Repr.view v)) l)
+          | Some k ->
+            raise (at_field "propertyDependencies" @@
+                   unexpected k "object") in
+        let parse_element_assoc field =
+          match opt_field_view json field with
+          | None -> []
+          | Some (`O props) ->
+            let rec items acc = function
+              | [] -> List.rev acc
+              | (n, elt) :: tl ->
+                let elt = try parse_element source elt
+                  with err -> raise (at_field field @@
+                                     at_field n err) in
+                items ((n, elt) :: acc) tl
+            in items [] props
+          | Some k -> raise (at_field field @@ unexpected k "object") in
+        let pattern_properties = parse_element_assoc "patternProperties" in
+        let schema_dependencies = parse_element_assoc "schemaDependencies" in
+        let min_properties =
+          match opt_length_field json "minProperties" with
+          | None -> 0
+          | Some l -> l in
+        let max_properties = opt_length_field json "maxProperties" in
+        Object { properties ; pattern_properties ;
+                 additional_properties ;
+                 min_properties ; max_properties ;
+                 schema_dependencies ; property_dependencies }
+      | n -> raise (Cannot_parse ([], Unexpected (n, "a known type"))) in
+    (* parse recursively from the root *)
+    let root = parse_element Uri.empty json in
+    (* force the addition of everything inside /definitions *)
+    (match Repr.view (query [ `Field "definitions" ] json) with
+     | `O all ->
+       let all = List.map (fun (n, _) -> Uri.of_string ("#/definitions/" ^ n)) all in
+       List.iter (fun uri -> collect_definition uri |> ignore) all
+     | _ -> ()
+     | exception  Not_found -> ()) ;
+    (* check the domain of IDs *)
+    List.iter
+      (fun id ->
+         if not (List.mem_assoc id !collected_id_defs) then
+           raise (Cannot_parse ([], Dangling_reference (Uri.(with_fragment empty (Some id))))))
+      !collected_id_refs ;
+    let ids = !collected_id_defs in
+    let source = schema_source in
+    let world = [] in
+    let definitions = !collected_definitions in
+    { root ; definitions ; source ; ids ; world }
+
+  (*-- creation and update ---------------------------------------------------*)
+
+  (* Checks that all local refs and ids are defined *)
+  let check_definitions root definitions =
+    let collected_id_defs = ref [] in
+    let collected_id_refs = ref [] in
+    let rec check ({ kind ; id } as elt) =
+      begin match id with
+        | None -> ()
+        | Some id -> collected_id_defs := (id, elt) :: !collected_id_defs end ;
+      begin match kind with
+        | Object { properties ; pattern_properties ;
+                   additional_properties ; schema_dependencies } ->
+          List.iter (fun (_, e, _, _) -> check e) properties ;
+          List.iter (fun (_, e) -> check e) pattern_properties ;
+          List.iter (fun (_, e) -> check e) schema_dependencies ;
+          (match additional_properties with Some e -> check e | None -> ())
+        | Array (es, { additional_items }) ->
+          List.iter check es ;
+          (match additional_items with Some e -> check e | None -> ())
+        | Monomorphic_array (e, { additional_items }) ->
+          check e ;
+          (match additional_items with Some e -> check e | None -> ())
+        | Combine (_, es) ->
+          List.iter check es
+        | Def_ref path ->
+          if not (definition_exists path definitions) then
+            let path = json_pointer_of_path path in
+            raise (Dangling_reference (Uri.(with_fragment empty) (Some path)))
+        | Id_ref id ->
+          collected_id_refs := id :: !collected_id_refs ;
+        | Ext_ref _ | String _ | Integer _ | Number _ | Boolean | Null | Any | Dummy -> ()
+      end in
+    (* check the root and definitions *)
+    check root ;
+    List.iter (fun (_, root) -> check root) definitions ;
+    (* check the domain of IDs *)
+    List.iter
+      (fun id ->
+         if not (List.mem_assoc id !collected_id_defs) then
+           raise (Dangling_reference (Uri.(with_fragment empty (Some id)))))
+      !collected_id_refs ;
+    !collected_id_defs
+
+  let create root =
+    let ids = check_definitions root [] in
+    { root ; definitions = [] ; world = [] ; ids ; source = Uri.empty }
+
+  let root { root } =
+    root
+
+  let update root sch =
+    let ids = check_definitions root sch.definitions in
+    { sch with root ; ids }
+
+  let any =
+    create (element Any)
+
+  let self =
+    { root = element (Ext_ref (Uri.of_string version)) ;
+      definitions = [] ; ids = [] ; world = [] ; source = Uri.empty }
+
+  (* remove unused definitions from the schema *)
+  let simplify schema =
+    let res = ref [] (* collected definitions *) in
+    let rec collect { kind } = match kind with
+      | Object { properties ; pattern_properties ;
+                 additional_properties ; schema_dependencies } ->
+        List.iter (fun (_, e, _, _) -> collect e) properties ;
+        List.iter (fun (_, e) -> collect e) pattern_properties ;
+        List.iter (fun (_, e) -> collect e) schema_dependencies ;
+        (match additional_properties with Some e -> collect e | None -> ())
+      | Array (es, { additional_items }) ->
+        List.iter collect es ;
+        (match additional_items with Some e -> collect e | None -> ())
+      | Monomorphic_array (e, { additional_items }) ->
+        collect e ;
+        (match additional_items with Some e -> collect e | None -> ())
+      | Combine (_, es) ->
+        List.iter collect es
+      | Def_ref path ->
+        let def = find_definition path schema.definitions in
+        res := insert_definition path def !res
+      | Ext_ref _ | Id_ref _ | String _ | Integer _ | Number _ | Boolean | Null | Any | Dummy -> ()
+    in
+    collect schema.root ;
+    { schema with definitions = !res }
+
+  let definition_path_of_name ?(definitions_path="/definitions/") name =
+    path_of_json_pointer ~wildcards:false @@
+    match String.get name 0 with
+    | exception _ -> raise (Bad_reference name)
+    | '/' -> name
+    | _ -> definitions_path ^ name
+
+  let find_definition ?definitions_path name schema =
+    let path = definition_path_of_name ?definitions_path name in
+    find_definition path schema.definitions
+
+  let definition_ref ?definitions_path name =
+    let path = definition_path_of_name ?definitions_path name in
+    element (Def_ref path)
+
+  let definition_exists ?definitions_path name schema =
+    let path = definition_path_of_name ?definitions_path name in
+    definition_exists path schema.definitions
+
+  let add_definition ?definitions_path name elt schema =
+    let path = definition_path_of_name ?definitions_path name in
+    (* check inside def *)
+    let definitions = insert_definition path elt schema.definitions in
+    { schema with definitions }, element (Def_ref path)
+
+  let merge_definitions (sa, sb) =
+    let rec sorted_merge = function
+      | ((na, da) as a) :: ((nb, db) as b) :: tl ->
+        if na = nb then
+          if da.kind = Dummy || db.kind = Dummy || eq_element da db then
+            (na, da) :: sorted_merge tl
+          else
+            raise (Duplicate_definition (na, da, db))
+        else
+          a :: sorted_merge (b :: tl)
+      | [] | [ _ ] as rem -> rem
+    in
+    let definitions =
+      sorted_merge (List.sort compare (sa.definitions @ sb.definitions)) in
+    { sa with definitions }, { sb with definitions }
+
+  let combine op schemas =
+    let rec combine sacc eacc = function
+      | [] -> update (element (Combine (op, eacc))) sacc
+      | s :: ss ->
+        let sacc, s = merge_definitions (sacc, s) in
+        combine sacc (s.root :: eacc) ss
+    in combine any [] schemas
+
+  let is_nullable { ids ; definitions ; root } =
+    let rec nullable { kind } = match kind with
+      | Null | Any -> true
+      | Object _
+      | Array _
+      | Monomorphic_array _
+      | Ext_ref _
+      | String _
+      | Integer _
+      | Number _
+      | Boolean -> false
+      | Combine (Not, [ elt ]) ->
+        not (nullable elt)
+      | Combine (All_of, elts) ->
+        List.for_all nullable elts
+      | Combine ((Any_of | One_of), elts) ->
+        List.exists nullable elts
+      | Def_ref path ->
+        nullable (List.assoc path definitions)
+      | Id_ref id ->
+        nullable (List.assoc id ids)
+      | Combine (Not, _) | Dummy -> assert false in
+    nullable root
+
+
+  (*-- default specs ---------------------------------------------------------*)
+
+  let array_specs =
+    { min_items = 0 ;
+      max_items = None ;
+      unique_items = false ;
+      additional_items = None }
+  let object_specs =
+    { properties = [] ;
+      pattern_properties = [] ;
+      additional_properties = Some (element Any) ;
+      min_properties = 0 ;
+      max_properties = None ;
+      schema_dependencies = [] ;
+      property_dependencies = [] }
+  let string_specs =
+    { pattern = None ;
+      min_length = 0 ;
+      max_length = None }
+  let numeric_specs =
+    { multiple_of = None ;
+      minimum = None ;
+      maximum = None }
+end
+
+include Make (Json_repr.Ezjsonm)
diff --git a/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.mli b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.mli
new file mode 100644
index 000000000..e4fce130e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-json-typed/src/json_schema.mli
@@ -0,0 +1,258 @@
+(** Abstract representation of JSON schemas as of version
+    [http://json-schema.org/draft-04/schema#]. *)
+
+(************************************************************************)
+(*  ocplib-json-typed                                                   *)
+(*                                                                      *)
+(*    Copyright 2014 OCamlPro                                           *)
+(*                                                                      *)
+(*  This file is distributed under the terms of the GNU Lesser General  *)
+(*  Public License as published by the Free Software Foundation; either *)
+(*  version 2.1 of the License, or (at your option) any later version,  *)
+(*  with the OCaml static compilation exception.                        *)
+(*                                                                      *)
+(*  ocplib-json-typed is distributed in the hope that it will be useful,*)
+(*  but WITHOUT ANY WARRANTY; without even the implied warranty of      *)
+(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       *)
+(*  GNU General Public License for more details.                        *)
+(*                                                                      *)
+(************************************************************************)
+
+(** {2 Abstract representation of schemas} *) (******************************)
+
+(** A JSON schema root. *)
+type schema
+
+(** A node in the schema, embeds all type-agnostic specs. *)
+and element =
+  { title : string option ;
+    (** An optional short description. *)
+    description : string option ;
+    (** An optional long description. *)
+    default : Json_repr.any option ;
+    (** A default constant to be substituted in case of a missing value. *)
+    enum : Json_repr.any list option ;
+    (** A valid value must equal one of these constants. *)
+    kind : element_kind ;
+    (** The type-specific part. *)
+    format : string option ;
+    (** predefined formats such as [date-time], [email], [ipv4], [ipv6], [uri]. *)
+    id : string option
+    (** An optional ID. *) }
+
+(** The type-specific part of schema nodes. *)
+and element_kind =
+  | Object of object_specs
+  (** The type of an object. *)
+  | Array of element list * array_specs
+  (** An fixed-length array with the types of its elements (a tuple). *)
+  | Monomorphic_array of element * array_specs
+  (** A variable-length array with the type of its children. *)
+  | Combine of combinator * element list
+  (** A mix of schemas using logical combinators. *)
+  | Def_ref of Json_query.path
+  (** A ref to an element from its path in the JSON representation. *)
+  | Id_ref of string
+  (** A ref to an element from its ID. *)
+  | Ext_ref of Uri.t
+  (** A ref to an external element. *)
+  | String of string_specs
+  (** A string (with optional characteristics). *)
+  | Integer of numeric_specs
+  (** An int (with optional characteristics). *)
+  | Number of numeric_specs
+  (** A float (with optional characteristics). *)
+  | Boolean  (** Any boolean. *)
+  | Null (** The null value. *)
+  | Any (** Any JSON value. *)
+  | Dummy
+  (** For building cyclic definitions, a definition bound to a dummy
+      will be considered absent for {!add_definition} but present
+      for {!update}. The idea is to insert a dummy definition, build a
+      cyclic structure using it for recursion, and finally update the
+      definition with the structure. *)
+
+(** Grammar combinators. *)
+and combinator =
+  | Any_of (** Logical OR n-ary combinator. *)
+  | One_of (** Logical XOR n-ary combinator. *)
+  | All_of (** Logical AND n-ary combinator. *)
+  | Not (** Logical NOT unary combinator. *)
+
+(** Parameters of the [Array] and [MonomorphicArray] type specifiers. *)
+and array_specs =
+  { min_items : int ;
+    (** The minimum number of elements. *)
+    max_items : int option ;
+    (** The maximum number of elements. *)
+    unique_items : bool ;
+    (** Teels if all elements must be different. *)
+    additional_items : element option ;
+    (** The type of additional items, if allowed. *) }
+
+(** Parameters of the [Integer] and [Number] type specifiers. *)
+and numeric_specs =
+  { multiple_of : float option ;
+    (** An optional divisor of valid values *)
+    minimum : (float * [ `Inclusive | `Exclusive ]) option ;
+    (** The optional lower bound of the numeric range *)
+    maximum : (float * [ `Inclusive | `Exclusive ]) option
+    (** The optional upper bound of the numeric range *) }
+
+(** Parameters of the [Object] type specifier. *)
+and object_specs =
+  { properties : (string * element * bool * Json_repr.any option) list ;
+    (** The names and types of properties, with a flag to indicate if
+        they are required ([true]) or optional. *)
+    pattern_properties : (string * element) list ;
+    (** Alternative definition of properties, matching field names
+        using regexps instead of constant strings. *)
+    additional_properties : element option ;
+    (** The type of additional properties, if allowed. *)
+    min_properties : int ;
+    (** The minimum number of properties. *)
+    max_properties : int option ;
+    (** The maximum number of properties. *)
+    schema_dependencies : (string * element) list ;
+    (** Additional schemas the value must verify if a property is
+        present (property, additional schema). *)
+    property_dependencies : (string * string list) list
+    (** Additional properties required whenever some property is
+        present (property, additional properties). *) }
+
+(** Parameters of the [String] type specifier. *)
+and string_specs =
+  { pattern : string option ;
+    (** A regexp the string must conform to. *)
+    min_length : int ;
+    (** The minimum string length. *)
+    max_length : int option
+    (** The maximum string length. *) }
+
+(** {2 Combinators to build schemas and elements} *) (*************************)
+
+(** Construct a naked element (all optional properties to None). *)
+val element : element_kind -> element
+
+(** Construct a schema from its root, without any definition ; the
+    element is checked not to contain any [Def] element. *)
+val create : element -> schema
+
+(** Extract the root element from an existing schema. *)
+val root : schema -> element
+
+(** Update a schema from its root, using the definitions from an
+    existing schema ; the element is checked to contain only valid
+    [Def] elements ; unused definitions are kept, see {!simplify}. *)
+val update : element -> schema -> schema
+
+(** Describes the implemented schema specification as a schema. *)
+val self : schema
+
+(** A completely generic schema, without any definition. *)
+val any : schema
+
+(** Combines several schemas. *)
+val combine : combinator -> schema list -> schema
+
+(** Tells is a schema accepts null. *)
+val is_nullable : schema -> bool
+
+(** {2 Named definitions} *) (***********************************************)
+
+(** Merges the definitions of two schemas if possible and returns the
+    updated schemas, so that their elements can be mixed without
+    introducing dangling references ; if two different definitions are
+    bound to the same path, {!Duplicate_definition} will be raised. *)
+val merge_definitions : schema * schema -> schema * schema
+
+(** Remove the definitions that are not present in the schema. *)
+val simplify : schema -> schema
+
+(** Adds a definition by its path. If the path is absolute (starting
+    with a ['/']), it is untouched. Otherwise, it is considered
+    relative to ["#/definitions"] as recommended by the standard. May
+    raise {!Duplicate_definition} if this path is already used or any
+    error raised by {!Json_repr.path_of_json_pointer} with
+    [~wildcards:false]. Returns the modified schema and the [Def_ref]
+    node that references this definition to be used in the schema. *)
+val add_definition : ?definitions_path:string -> string -> element -> schema -> schema * element
+
+(** Finds a definition by its path, may raise [Not_found].
+    See {!add_definition} for the name format.*)
+val find_definition : ?definitions_path:string -> string -> schema -> element
+
+(** Tells if a path leads to a definition.
+    See {!add_definition} for the name format. *)
+val definition_exists : ?definitions_path:string -> string -> schema -> bool
+
+(** Build a reference to a definition.
+    See {!add_definition} for the name format. *)
+val definition_ref : ?definitions_path:string -> string -> element
+
+(** {2 Predefined values} *) (***********************************************)
+
+(** Default Parameters of the [Array] and [MonomorphicArray] type specifiers. *)
+val array_specs : array_specs
+
+(** Default parameters of the [Object] type specifier. *)
+val object_specs : object_specs
+
+(** Default parameters of the [String] type specifier. *)
+val string_specs : string_specs
+
+(** Default parameters of the [Integer] and [Number] type specifiers. *)
+val numeric_specs : numeric_specs
+
+(** {2 JSON Serialization} *) (*********************************************)
+
+(** Formats a JSON schema as its JSON representation.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val to_json : schema -> Json_repr.ezjsonm
+
+(** Parse a JSON structure as a JSON schema, if possible.
+    May throw {!Cannot_parse}.
+
+    This function works with JSON data represented in the {!Json_repr.ezjsonm}
+    format. See functor {!Make} for using another representation. *)
+val of_json : Json_repr.ezjsonm -> schema
+
+(** Formats a JSON schema in human readable format. *)
+val pp : Format.formatter -> schema -> unit
+
+(** {2 Errors} *) (**********************************************************)
+
+(** An error happened during parsing.
+    May box one of the following exceptions, among others.. *)
+exception Cannot_parse of Json_query.path * exn
+
+(** A reference to a non-existent location was detected. *)
+exception Dangling_reference of Uri.t
+
+(** A reference litteral could not be understood. *)
+exception Bad_reference of string
+
+(** An unexpected kind of JSON value was encountered. *)
+exception Unexpected of string * string
+
+(** A non-[Dummy] definition appeared twice on insertion or merge. *)
+exception Duplicate_definition of Json_query.path * element * element
+
+(** Produces a human readable version of an error. *)
+val print_error
+  : ?print_unknown: (Format.formatter -> exn -> unit) ->
+  Format.formatter -> exn -> unit
+
+(** {2 Advanced interface for using a custom JSON representation} *) (**********)
+
+module Make (Repr : Json_repr.Repr) : sig
+
+  (** Same as {!to_json} for a custom JSON representation. *)
+  val to_json : schema -> Repr.value
+
+  (** Same as {!of_json} for a custom JSON representation. *)
+  val of_json : Repr.value -> schema
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/.gitignore b/vendors/tezos-modded/vendors/ocplib-resto/.gitignore
new file mode 100644
index 000000000..96c8644a2
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/.gitignore
@@ -0,0 +1,6 @@
+
+*~
+_build
+
+.merlin
+*.install
\ No newline at end of file
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/.ocp-indent b/vendors/tezos-modded/vendors/ocplib-resto/.ocp-indent
new file mode 100644
index 000000000..ef83851c8
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/.ocp-indent
@@ -0,0 +1 @@
+match_clause = 4
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/.travis.yml b/vendors/tezos-modded/vendors/ocplib-resto/.travis.yml
new file mode 100644
index 000000000..92f8349ae
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/.travis.yml
@@ -0,0 +1,12 @@
+language: c
+sudo: false
+services:
+  - docker
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh
+script: bash ./.travis-docker.sh
+env:
+  global:
+    - PACKAGE="ocplib-resto"
+  matrix:
+    - DISTRO=debian-stable OCAML_VERSION=4.03.0
+    - DISTRO=debian-stable OCAML_VERSION=4.02.3
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/CHANGES.md b/vendors/tezos-modded/vendors/ocplib-resto/CHANGES.md
new file mode 100644
index 000000000..fa8eec94c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/CHANGES.md
@@ -0,0 +1,3 @@
+### 0.2 (2017-11-21)
+
+* Switch to jbuilder
\ No newline at end of file
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/LICENSE b/vendors/tezos-modded/vendors/ocplib-resto/LICENSE
new file mode 100644
index 000000000..7cc1e80ee
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/LICENSE
@@ -0,0 +1,203 @@
+In the following, "ocplib-resto" refers to all files marked
+"Copyright OCamlPro" in this distribution.
+
+ocplib-resto is distributed under the terms of the
+GNU Lesser General Public License (LGPL) version 2.1 (included below).
+
+As a special exception to the GNU Lesser General Public License, you
+may link, statically or dynamically, a "work that uses ocplib-resto"
+with a publicly distributed version of ocplib-resto to produce an
+executable file containing portions of ocplib-resto, and distribute
+that executable file under terms of your choice, without any of the
+additional requirements listed in clause 6 of the GNU Lesser General
+Public License. By "a publicly distributed version of ocplib-resto",
+we mean either the unmodified ocplib-resto as distributed by OCamlPro,
+or a modified version of ocplib-resto that is distributed under the
+conditions defined in clause 2 of the GNU Lesser General Public
+License. This exception does not however invalidate any other reasons
+why the executable file might be covered by the GNU Lesser General
+Public License.
+
+----------------------------------------------------------------------
+
+GNU LESSER GENERAL PUBLIC LICENSE
+
+Version 2.1, February 1999
+
+Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL.  It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+Preamble
+
+The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users.
+
+This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below.
+
+When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things.
+
+To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it.
+
+For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights.
+
+We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library.
+
+To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others.
+
+Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license.
+
+Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs.
+
+When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library.
+
+We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances.
+
+For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License.
+
+In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system.
+
+Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library.
+
+The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run.
+
+TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you".
+
+A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables.
+
+The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".)
+
+"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library.
+
+Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does.
+
+1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library.
+
+You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.
+
+2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:
+
+    a) The modified work must itself be a software library.
+    b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change.
+    c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License.
+    d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful.
+
+    (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.
+
+3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices.
+
+Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy.
+
+This option is useful when you wish to copy part of the code of the Library into a program that is not a library.
+
+4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange.
+
+If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code.
+
+5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License.
+
+However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables.
+
+When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law.
+
+If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.)
+
+Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself.
+
+6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications.
+
+You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things:
+
+    a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.)
+    b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with.
+    c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution.
+    d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place.
+    e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy.
+
+For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.
+
+It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute.
+
+7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things:
+
+    a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above.
+    b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work.
+
+8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.
+
+9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it.
+
+10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License.
+
+11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.
+
+This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.
+
+12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License.
+
+13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation.
+
+14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.
+
+NO WARRANTY
+
+15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+END OF TERMS AND CONDITIONS
+
+How to Apply These Terms to Your New Libraries
+
+If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License).
+
+To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found.
+
+one line to give the library's name and an idea of what it does.
+Copyright (C) year  name of author
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names:
+
+Yoyodyne, Inc., hereby disclaims all copyright interest in
+the library `Frob' (a library for tweaking knobs) written
+by James Random Hacker.
+
+signature of Ty Coon, 1 April 1990
+Ty Coon, President of Vice
+
+That's all there is to it!
+
+--------------------------------------------------
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/Makefile b/vendors/tezos-modded/vendors/ocplib-resto/Makefile
new file mode 100644
index 000000000..359df937d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/Makefile
@@ -0,0 +1,13 @@
+
+all:
+	dune build --dev
+
+.PHONY: test
+test:
+	dune runtest --dev
+
+doc-html:
+	dune build @doc --dev
+
+clean:
+	dune clean
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/README.md b/vendors/tezos-modded/vendors/ocplib-resto/README.md
new file mode 100644
index 000000000..08e76f183
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/README.md
@@ -0,0 +1,9 @@
+# ocplib-resto (WIP)
+
+This is a minimal OCaml library for type-safe HTTP/JSON RPCs.
+
+This is based on a notion of service, *à la* Eliom, and it uses
+`ocplib-json-typed` for self-documenting JSON encoders.
+
+See `test_ezresto-directory/ezResto_test.ml`
+or `test_resto-directory/resto_test.ml` for example.`
\ No newline at end of file
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/dune
new file mode 100644
index 000000000..44efffd9b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/dune
@@ -0,0 +1,6 @@
+(library
+ (name ezresto_directory)
+ (public_name ocplib-ezresto-directory)
+ (libraries ocplib-ezresto ocplib-resto-directory)
+ (flags (:standard -safe-string))
+ (wrapped false))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.ml
new file mode 100644
index 000000000..0b81247ca
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.ml
@@ -0,0 +1,81 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Resto
+open Lwt.Infix
+
+open Resto_directory
+module Directory = Resto_directory.Make(Resto_json.Encoding)
+open Directory
+
+module Answer = Answer
+
+type step = Directory.step =
+  | Static of string
+  | Dynamic of Arg.descr
+  | DynamicTail of Arg.descr
+
+type conflict = Directory.conflict =
+  | CService of meth | CDir | CBuilder | CTail
+  | CTypes of Arg.descr * Arg.descr
+  | CType of Arg.descr * string list
+
+exception Conflict = Directory.Conflict
+
+type directory = unit Directory.directory
+let empty = empty
+let prefix path dir = (prefix path (map (fun _ -> Lwt.return_unit) dir))
+let merge = merge
+
+let register d s h = register d s h
+let register0 d s h = register0 d s h
+let register1 d s h = register1 d s h
+let register2 d s h = register2 d s h
+let register3 d s h = register3 d s h
+let register4 d s h = register4 d s h
+let register5 d s h = register5 d s h
+
+let register_dynamic_directory ?descr dir path builder =
+  register_dynamic_directory ?descr dir path
+    (fun p -> builder p >>= fun dir -> Lwt.return (map (fun _ -> Lwt.return_unit) dir))
+
+let register_dynamic_directory1 ?descr root s f =
+  register_dynamic_directory ?descr root s Curry.(curry (S Z) f)
+let register_dynamic_directory2 ?descr root s f =
+  register_dynamic_directory ?descr root s Curry.(curry (S (S Z)) f)
+let register_dynamic_directory3 ?descr root s f =
+  register_dynamic_directory ?descr root s Curry.(curry (S (S (S Z))) f)
+
+let register_describe_directory_service =
+  register_describe_directory_service
+
+type 'input input = 'input Service.input =
+  | No_input : unit input
+  | Input : 'input Json_encoding.encoding -> 'input input
+
+type ('q, 'i, 'o, 'e) types = ('q, 'i, 'o, 'e) Directory.types = {
+  query : 'q Resto.Query.t ;
+  input : 'i Service.input ;
+  output : 'o Json_encoding.encoding ;
+  error : 'e Json_encoding.encoding ;
+}
+
+type registered_service = Directory.registered_service =
+  | Service :
+      { types : ('q, 'i, 'o, 'e) types ;
+        handler : ('q -> 'i -> ('o, 'e) Answer.t Lwt.t) ;
+      } -> registered_service
+
+type lookup_error = Directory.lookup_error
+
+let lookup directory args query =
+  Directory.lookup directory () args query
+let allowed_methods dir path = Directory.allowed_methods dir () path
+let transparent_lookup = Directory.transparent_lookup
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.mli
new file mode 100644
index 000000000..277fe3268
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ezResto_directory.mli
@@ -0,0 +1,170 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open EzResto
+
+module Answer : sig
+
+  (** Return type for service handler *)
+  type ('o, 'e) t =
+    [ `Ok of 'o (* 200 *)
+    | `OkStream of 'o stream (* 200 *)
+    | `Created of string option (* 201 *)
+    | `No_content (* 204 *)
+    | `Unauthorized of 'e option (* 401 *)
+    | `Forbidden of 'e option (* 403 *)
+    | `Not_found of 'e option (* 404 *)
+    | `Conflict of 'e option (* 409 *)
+    | `Error of 'e option (* 500 *)
+    ]
+
+  and 'a stream = {
+    next: unit -> 'a option Lwt.t ;
+    shutdown: unit -> unit ;
+  }
+
+end
+
+(** Possible error while registring services. *)
+type step =
+  | Static of string
+  | Dynamic of Arg.descr
+  | DynamicTail of Arg.descr
+
+type conflict =
+  | CService of meth | CDir | CBuilder | CTail
+  | CTypes of Arg.descr * Arg.descr
+  | CType of Arg.descr * string list
+
+exception Conflict of step list * conflict
+
+(** Dispatch tree *)
+type directory
+
+(** Empty tree *)
+val empty: directory
+
+val prefix: 'a Path.t -> directory -> directory
+val merge: directory -> directory -> directory
+
+type 'input input =
+  | No_input : unit input
+  | Input : 'input Json_encoding.encoding -> 'input input
+
+type ('q, 'i, 'o, 'e) types = {
+  query : 'q Resto.Query.t ;
+  input : 'i input ;
+  output : 'o Json_encoding.encoding ;
+  error : 'e Json_encoding.encoding ;
+}
+
+type registered_service =
+  | Service :
+      { types : ('q, 'i, 'o, 'e) types ;
+        handler : ('q -> 'i -> ('o, 'e) Answer.t Lwt.t) ;
+      } -> registered_service
+
+type lookup_error =
+  [ `Not_found (* 404 *)
+  | `Method_not_allowed of meth list (* 405 *)
+  | `Cannot_parse_path of string list * Arg.descr * string (* 400 *)
+  ]
+
+(** Resolve a service. *)
+val lookup: directory -> meth -> string list -> (registered_service, [> lookup_error ]) result Lwt.t
+
+val allowed_methods:
+  directory -> string list ->
+  (meth list, [> lookup_error ]) result Lwt.t
+
+val transparent_lookup:
+  directory ->
+  ('meth, 'params, 'query, 'input, 'output, 'error) EzResto.service ->
+  'params -> 'query -> 'input -> [> ('output, 'error) Answer.t ] Lwt.t
+
+
+(** Registring handler in service tree. *)
+val register:
+  directory ->
+  ('meth, 'params, 'query, 'input, 'output, 'error) EzResto.service ->
+  ('params -> 'query -> 'input -> ('output, 'error) Answer.t Lwt.t) ->
+  directory
+
+(** Registring handler in service tree. Curryfied variant.  *)
+val register0:
+  directory ->
+  ('meth, unit, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+val register1:
+  directory ->
+  ('meth, unit * 'a, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('a -> 'q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+val register2:
+  directory ->
+  ('meth, (unit * 'a) * 'b, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('a -> 'b -> 'q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+val register3:
+  directory ->
+  ('meth, ((unit * 'a) * 'b) * 'c, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('a -> 'b -> 'c -> 'q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+val register4:
+  directory ->
+  ('meth, (((unit * 'a) * 'b) * 'c) * 'd, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+val register5:
+  directory ->
+  ('meth, ((((unit * 'a) * 'b) * 'c) * 'd) * 'e, 'q, 'i, 'o, 'e) EzResto.service ->
+  ('a -> 'b -> 'c -> 'd -> 'e -> 'q -> 'i -> ('o, 'e) Answer.t Lwt.t) ->
+  directory
+
+(** Registring dynamic subtree. *)
+val register_dynamic_directory:
+  ?descr:string ->
+  directory ->
+  'params Path.t ->
+  ('params -> directory Lwt.t) ->
+  directory
+
+(** Registring dynamic subtree. (Curryfied variant) *)
+val register_dynamic_directory1:
+  ?descr:string ->
+  directory ->
+  (unit * 'a) Path.t ->
+  ('a -> directory Lwt.t) ->
+  directory
+
+val register_dynamic_directory2:
+  ?descr:string ->
+  directory ->
+  ((unit * 'a) * 'b) Path.t ->
+  ('a -> 'b -> directory Lwt.t) ->
+  directory
+
+val register_dynamic_directory3:
+  ?descr:string ->
+  directory ->
+  (((unit * 'a) * 'b) * 'c) Path.t ->
+  ('a -> 'b -> 'c -> directory Lwt.t) ->
+  directory
+
+(** Registring a description service. *)
+val register_describe_directory_service:
+  directory -> EzResto.description_service -> directory
+
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ocplib-ezresto-directory.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ocplib-ezresto-directory.opam
new file mode 100644
index 000000000..bf74d1214
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/ocplib-ezresto-directory.opam
@@ -0,0 +1,23 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "ocplib-ezresto" {= "dev" }
+  "ocplib-resto-directory" {= "dev" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/dune
new file mode 100644
index 000000000..cf7925e64
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/dune
@@ -0,0 +1,12 @@
+(executable
+ (name ezResto_test)
+ (flags (:standard -safe-string))
+ (libraries ocplib-ezresto-directory lwt.unix))
+
+(alias
+ (name runtest_ezresto)
+ (action (run %{exe:ezResto_test.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_ezresto)))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml
new file mode 100644
index 000000000..5be2ca08d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezDirectory.ml
@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open EzServices
+include EzResto_directory
+
+let rec repeat i json =
+  if i <= 0 then []
+  else json :: repeat (i-1) json
+
+let dir = empty let dir =
+                  register1 dir repeat_service
+                    (fun i () json -> Lwt.return (`Ok (`A (repeat i json))))
+let dir =
+  register1 dir add_service
+    (fun i () j -> Lwt.return (`Ok (i+j)))
+let dir =
+  register2 dir alternate_add_service
+    (fun i j () () -> Lwt.return (`Ok (float_of_int i+.j)))
+let dir =
+  register dir alternate_add_service'
+    (fun (((), i),j) () () -> Lwt.return (`Ok (i+ int_of_float j)))
+let dir =
+  register_describe_directory_service
+    dir describe_service
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml
new file mode 100644
index 000000000..a3c344566
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezResto_test.ml
@@ -0,0 +1,113 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open EzServices
+open EzResto
+open EzDirectory
+open Lwt.Infix
+
+let () =
+  Lwt_main.run begin
+    allowed_methods dir ["foo";"3";"repeat"] >>= function
+    | Ok [`POST] -> Lwt.return_unit
+    | _ -> assert false
+  end
+
+let () =
+  Lwt_main.run begin
+    allowed_methods dir ["bar";"3";"4";"add"] >>= function
+    | Ok [`GET;`POST] -> Lwt.return_unit
+    | _ -> assert false
+  end
+
+module Test(Request : sig
+    val request:
+      ('meth, 'params, 'query, 'input, 'output, 'error) EzResto.service ->
+      'params  -> 'query -> 'input -> [> ('output, 'error) Answer.t ] Lwt.t
+  end) = struct
+
+  let () =
+    Lwt_main.run begin
+      Request.request describe_service ((), []) { Description.recurse = true } () >>= function
+      | `Ok dir ->
+          Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ;
+          Lwt.return_unit
+      | _ -> assert false
+    end
+
+  let () =
+    let test service args arg expected =
+      Lwt_main.run (Request.request service args () arg) = `Ok expected in
+    assert (test repeat_service ((), 3) (`A []) (`A (repeat 3 (`A [])))) ;
+    assert (test add_service ((), 2) 3 5) ;
+    assert (test alternate_add_service (((), 1), 2.5) () 3.5) ;
+    assert (test alternate_add_service' (((), 1), 2.) () 3) ;
+    ()
+end
+
+let split_path path =
+  let l = String.length path in
+  let rec do_slashes acc i =
+    if i >= l then
+      List.rev acc
+    else if String.get path i = '/' then
+      do_slashes acc (i + 1)
+    else
+      do_component acc i i
+  and do_component acc i j =
+    if j >= l then
+      if i = j then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if String.get path j = '/' then
+      do_slashes (String.sub path i (j - i) :: acc) j
+    else
+      do_component acc i (j + 1) in
+  do_slashes [] 0
+
+module Faked = Test(struct
+    (** Testing faked client/server communication. *)
+    let request (type i) (service: (_,_,_,i,_,_) service) params query (arg: i) =
+      let { meth ; uri ; input } = forge_request service params query in
+      Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ;
+      let path = split_path (Uri.path uri) in
+      let query =
+        List.map
+          (fun (n,vs) -> (n, String.concat "," vs))
+          (Uri.query uri) in
+      Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ;
+      let json =
+        match input with
+        | No_input -> `O []
+        | Input input -> Json_encoding.construct input arg in
+      lookup dir meth path >>= function
+      | Ok (Service s) -> begin
+          let query = Resto.Query.parse s.types.query query in
+          begin
+            match s.types.input with
+            | No_input -> s.handler query ()
+            | Input input ->
+                s.handler query @@ Json_encoding.destruct input json
+          end >>= function
+          | `Ok res ->
+              let json = Json_encoding.construct s.types.output res in
+              Lwt.return (`Ok (Json_encoding.destruct (output_encoding service) json))
+          | _ -> failwith "Unexpected lwt result (1)"
+        end
+      | _ -> failwith "Unexpected lwt result (2)"
+  end)
+
+module Transparent = Test(struct
+    let request x = transparent_lookup dir x
+  end)
+
+let () =
+  Printf.printf "\n### OK EzResto ###\n\n%!"
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml
new file mode 100644
index 000000000..4b5b9bee9
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto-directory/test/ezServices.ml
@@ -0,0 +1,55 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open EzResto
+
+(** Shared part *)
+
+let repeat_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.any_ezjson_value
+    ~output:Json_encoding.any_ezjson_value
+    ~error:Json_encoding.empty
+    Path.(root / "foo" /: Arg.int / "repeat")
+
+let add_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.int
+    ~output:Json_encoding.int
+    ~error:Json_encoding.empty
+    Path.(root / "foo" /: Arg.int / "add")
+
+let alternate_add_service =
+  get_service
+    ~query:Query.empty
+    ~output:Json_encoding.float
+    ~error:Json_encoding.empty
+    Path.(root / "bar" /: Arg.int /: Arg.float / "add")
+
+let alternate_add_service' =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.null
+    ~output:Json_encoding.int
+    ~error:Json_encoding.empty
+    Path.(root / "bar" /: Arg.int /: Arg.float / "add")
+
+let minus_service r =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.null
+    ~output:Json_encoding.float
+    ~error:Json_encoding.empty
+    Path.(r /: Arg.int / "minus")
+
+let describe_service =
+  description_service Path.(root / "describe")
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/dune
new file mode 100644
index 000000000..a4777745c
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/dune
@@ -0,0 +1,6 @@
+(library
+ (name ezresto)
+ (public_name ocplib-ezresto)
+ (libraries ocplib-resto-json)
+ (wrapped false)
+ (flags (:standard -safe-string)))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.ml
new file mode 100644
index 000000000..344a7496b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.ml
@@ -0,0 +1,53 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+
+open Resto
+module Service = Resto.MakeService(Resto_json.Encoding)
+open Service
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+module Arg = Arg
+module Path = struct
+  type 'params t = (unit, 'params) Path.path
+  type 'params path = (unit, 'params) Path.path
+  let root = Path.root
+  let add_suffix = Path.add_suffix
+  let add_arg = Path.add_arg
+  let (/) = add_suffix
+  let (/:) = add_arg
+end
+module Query = Query
+type ('meth, 'params, 'query, 'input, 'output, 'error) service =
+  ('meth, unit, 'params, 'query, 'input, 'output, 'error) Service.t
+let get_service = get_service
+let post_service = post_service
+let delete_service = delete_service
+let put_service = put_service
+let patch_service = patch_service
+type 'input input = 'input Service.input =
+  | No_input : unit input
+  | Input : 'input Json_encoding.encoding -> 'input input
+type 'input request = 'input Service.request = {
+  meth: meth ;
+  uri: Uri.t ;
+  input: 'input input ;
+}
+let forge_request = forge_request
+let query = query
+let input_encoding = input_encoding
+let output_encoding = output_encoding
+let error_encoding = error_encoding
+module Description = Resto.Description
+type description_service =
+  ([`GET], unit * string list, Description.request,
+   unit, Json_schema.schema Description.directory, unit) service
+let description_service ?description path =
+  description_service ?description Json_encoding.empty path
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.mli
new file mode 100644
index 000000000..ca378b905
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ezResto.mli
@@ -0,0 +1,165 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+
+(** Typed path argument. *)
+module Arg : sig
+
+  type 'a t = 'a Resto.Arg.arg
+  type 'a arg = 'a t
+  val make:
+    ?descr:string ->
+    name:string ->
+    destruct:(string -> ('a, string) result) ->
+    construct:('a -> string) ->
+    unit -> 'a arg
+
+  type descr = Resto.Arg.descr = {
+    name: string ;
+    descr: string option ;
+  }
+  val descr: 'a arg -> descr
+
+  val int: int arg
+  val int32: int32 arg
+  val int64: int64 arg
+  val float: float arg
+
+end
+
+(** Parametrized path to services. *)
+module Path : sig
+
+  type 'params t = (unit, 'params) Resto.Path.path
+  type 'params path = 'params t
+
+  val root: unit path
+
+  val add_suffix: 'params path -> string -> 'params path
+  val (/): 'params path -> string -> 'params path
+
+  val add_arg: 'params path -> 'a Arg.arg -> ('params * 'a) path
+  val (/:): 'params path -> 'a Arg.arg -> ('params * 'a) path
+
+end
+
+module Query : sig
+
+  type 'a t
+  type 'a query = 'a t
+
+  val empty: unit query
+
+  type ('a, 'b) field
+  val field:
+    ?descr: string ->
+    string -> 'a Arg.t -> 'a -> ('b -> 'a) -> ('b, 'a) field
+
+  type ('a, 'b, 'c) open_query
+  val query: 'b -> ('a, 'b, 'b) open_query
+  val (|+):
+    ('a, 'b, 'c -> 'd) open_query ->
+    ('a, 'c) field -> ('a, 'b, 'd) open_query
+  val seal: ('a, 'b, 'a) open_query -> 'a t
+
+  type untyped = (string * string) list
+  exception Invalid of string
+  val parse: 'a query -> untyped -> 'a
+
+end
+
+(** Services. *)
+type ('meth, 'params, 'query, 'input, 'output, 'error) service =
+  ('meth, unit, 'params, 'query, 'input, 'output, 'error) Resto.MakeService(Resto_json.Encoding).service
+
+val get_service:
+  ?description: string ->
+  query: 'query Query.t ->
+  output: 'output Json_encoding.encoding ->
+  error: 'error Json_encoding.encoding ->
+  'params Path.t ->
+  ([ `GET ], 'params, 'query, unit, 'output, 'error) service
+
+val post_service:
+  ?description: string ->
+  query: 'query Query.t ->
+  input: 'input Json_encoding.encoding ->
+  output: 'output Json_encoding.encoding ->
+  error: 'error Json_encoding.encoding ->
+  'params Path.t ->
+  ([ `POST ], 'params, 'query, 'input, 'output, 'error) service
+
+val delete_service:
+  ?description: string ->
+  query: 'query Query.t ->
+  output: 'output Json_encoding.encoding ->
+  error: 'error Json_encoding.encoding ->
+  'params Path.t ->
+  ([ `DELETE ], 'params, 'query, unit, 'output, 'error) service
+
+
+val put_service:
+  ?description: string ->
+  query: 'query Query.t ->
+  input: 'input Json_encoding.encoding ->
+  output: 'output Json_encoding.encoding ->
+  error: 'error Json_encoding.encoding ->
+  'params Path.t ->
+  ([ `PUT ], 'params, 'query, 'input, 'output, 'error) service
+
+val patch_service:
+  ?description: string ->
+  query: 'query Query.t ->
+  input: 'input Json_encoding.encoding ->
+  output: 'output Json_encoding.encoding ->
+  error: 'error Json_encoding.encoding ->
+  'params Path.t ->
+  ([ `PATCH ], 'params, 'query, 'input, 'output, 'error) service
+
+type 'input input =
+  | No_input : unit input
+  | Input : 'input Json_encoding.encoding -> 'input input
+
+type 'input request = {
+  meth: meth ;
+  uri: Uri.t ;
+  input: 'input input ;
+}
+
+val forge_request:
+  ('meth, 'params, 'query, 'input, 'output, 'error) service ->
+  ?base:Uri.t -> 'params -> 'query -> 'input request
+
+val query:
+  ('meth, 'params, 'query, 'input, 'output, 'error) service ->
+  'query Query.t
+
+val input_encoding:
+  ('meth, 'params, 'query, 'input, 'output, 'error) service ->
+  'input input
+
+val output_encoding:
+  ('meth, 'params, 'query, 'input, 'output, 'error) service ->
+  'output Json_encoding.encoding
+
+val error_encoding:
+  ('meth, 'params, 'query, 'input, 'output, 'error) service ->
+  'error Json_encoding.encoding
+
+module Description = Resto.Description
+
+type description_service =
+  ([`GET], unit * string list, Description.request,
+   unit, Json_schema.schema Description.directory, unit) service
+
+val description_service:
+  ?description:string -> unit Path.path -> description_service
+
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ocplib-ezresto.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ocplib-ezresto.opam
new file mode 100644
index 000000000..30b21df31
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_ezresto/ocplib-ezresto.opam
@@ -0,0 +1,23 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "ocplib-resto" {= "dev" }
+  "ocplib-resto-json" {= "dev" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.ml
new file mode 100644
index 000000000..03290f720
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.ml
@@ -0,0 +1,423 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+module Make (Encoding : Resto.ENCODING) = struct
+
+  open Cohttp
+
+  module Media_type = Media_type.Make(Encoding)
+  module Service = Resto.MakeService(Encoding)
+
+  type content_type = (string * string)
+  type raw_content = Cohttp_lwt.Body.t * content_type option
+  type content = Cohttp_lwt.Body.t * content_type option * Media_type.t option
+
+  type ('o, 'e) generic_rest_result =
+    [ `Ok of 'o option
+    | `Conflict of 'e
+    | `Error of 'e
+    | `Forbidden of 'e
+    | `Not_found of 'e
+    | `Unauthorized of 'e
+    | `Bad_request of string
+    | `Method_not_allowed of string list
+    | `Unsupported_media_type
+    | `Not_acceptable of string
+    | `Unexpected_status_code of Cohttp.Code.status_code * content
+    | `Connection_failed of string
+    | `OCaml_exception of string
+    | `Unauthorized_host of string option ]
+
+  type ('o, 'e) service_result =
+    [ ('o, 'e option) generic_rest_result
+    | `Unexpected_content_type of raw_content
+    | `Unexpected_content of (string * Media_type.t) * string
+    | `Unexpected_error_content_type of raw_content
+    | `Unexpected_error_content of (string * Media_type.t) * string ]
+
+  module type LOGGER = sig
+    type request
+    val log_empty_request: Uri.t -> request Lwt.t
+    val log_request:
+      ?media:Media_type.t -> 'a Encoding.t ->
+      Uri.t -> string -> request Lwt.t
+    val log_response:
+      request -> ?media:Media_type.t -> 'a Encoding.t ->
+      Cohttp.Code.status_code -> string Lwt.t Lazy.t -> unit Lwt.t
+  end
+
+  type logger = (module LOGGER)
+
+  let null_logger =
+    (module struct
+      type request = unit
+      let log_empty_request = (fun _ -> Lwt.return_unit)
+      let log_request = (fun ?media:_ _ _ _-> Lwt.return_unit)
+      let log_response = (fun _ ?media:_ _ _ _ -> Lwt.return_unit)
+    end : LOGGER)
+
+  let timings_logger ppf =
+    (module struct
+      type request = string * float
+      let log_empty_request uri =
+        let tzero = Unix.gettimeofday () in
+        Lwt.return (Uri.to_string uri, tzero)
+      let log_request ?media:_ _enc uri _body = log_empty_request uri
+      let log_response (uri, tzero) ?media:_ _enc _code _body =
+        let time = Unix.gettimeofday () -. tzero in
+        Format.fprintf ppf "Request to %s succeeded in %gs@." uri time ;
+        Lwt.return_unit
+    end : LOGGER)
+
+  let faked_media = {
+    Media_type.name = AnyMedia ;
+    q = None ;
+    pp = (fun _enc ppf s -> Format.fprintf ppf "@[<h 0>%a@]" Format.pp_print_text s) ;
+    construct = (fun _ -> assert false) ;
+    destruct = (fun _ -> assert false) ;
+  }
+
+  let full_logger ppf =
+    (module struct
+      let cpt = ref 0
+      type request = int * string
+      let log_empty_request uri =
+        let id = !cpt in
+        let uri = Uri.to_string uri in
+        incr cpt ;
+        Format.fprintf ppf ">>>>%d: %s@." id uri ;
+        Lwt.return (id, uri)
+      let log_request ?(media = faked_media) enc uri body =
+        let id = !cpt in
+        let uri = Uri.to_string uri in
+        incr cpt ;
+        Format.fprintf ppf "@[<v 2>>>>>%d: %s@,%a@]@." id uri (media.pp enc) body ;
+        Lwt.return (id, uri)
+      let log_response (id, _uri) ?(media = faked_media) enc code body =
+        Lazy.force body >>= fun body ->
+        Format.fprintf ppf "@[<v 2><<<<%d: %s@,%a@]@."
+          id (Cohttp.Code.string_of_status code) (media.pp enc) body ;
+        Lwt.return_unit
+    end : LOGGER)
+
+  let find_media received media_types =
+    match received with
+    | Some received ->
+        Media_type.find_media received media_types
+    | None ->
+        match media_types with
+        | [] -> None
+        | m :: _ -> Some m
+
+  let clone_body = function
+    | `Stream s -> `Stream (Lwt_stream.clone s)
+    | x -> x
+
+  type log = {
+    log:
+      'a. ?media:Media_type.t -> 'a Encoding.t -> Cohttp.Code.status_code ->
+      string Lwt.t Lazy.t -> unit Lwt.t ;
+  }
+
+  let internal_call meth (log : log) ?(headers = []) ?accept ?body ?media uri : (content, content) generic_rest_result Lwt.t =
+    let host =
+      match Uri.host uri, Uri.port uri with
+      | None, _ -> None
+      | Some host, None -> Some host
+      | Some host, Some port -> Some (host ^ ":" ^ string_of_int port) in
+    let init_headers =
+      match host with
+      | None -> Header.init ()
+      | Some host -> Header.replace (Header.init ()) "host" host in
+    let headers = List.fold_left (fun headers (header, value) ->
+        let header = String.lowercase_ascii header in
+        if header <> "host"
+        && (String.length header < 2
+            || String.sub header 0 2 <> "x-") then
+          invalid_arg
+            "Resto_cohttp.Client.call: \
+             only headers \"host\" or starting with \"x-\" are supported"
+        else Header.replace headers header value)
+        init_headers headers in
+    let body, headers =
+      match body, media with
+      | None, _ -> Cohttp_lwt.Body.empty, headers
+      | Some body, None ->
+          body, headers
+      | Some body, Some media ->
+          body, Header.add headers "content-type" (Media_type.name media) in
+    let headers =
+      match accept with
+      | None -> headers
+      | Some ranges ->
+          Header.add headers "accept" (Media_type.accept_header ranges) in
+    Lwt.catch begin fun () ->
+      let rec call_and_retry_on_502 attempt delay =
+        Cohttp_lwt_unix.Client.call
+          ~headers
+          (meth :> Code.meth) ~body uri >>= fun (response, ansbody) ->
+        let status = Response.status response in
+        match status with
+        | `Bad_gateway ->
+            let log_ansbody = clone_body ansbody in
+            log.log ~media:faked_media Encoding.untyped status
+              (lazy (Cohttp_lwt.Body.to_string log_ansbody >>= fun text ->
+                     Lwt.return @@ Format.sprintf
+                       "Attempt number %d/10, will retry after %g seconds.\n\
+                        Original body follows.\n\
+                        %s"
+                       attempt delay text)) >>= fun () ->
+            if attempt >= 10 then
+              Lwt.return (response, ansbody)
+            else
+              Lwt_unix.sleep delay >>= fun () ->
+              call_and_retry_on_502 (attempt + 1) (delay +. 0.1)
+        | _ ->
+            Lwt.return (response, ansbody) in
+      call_and_retry_on_502 1 0. >>= fun (response, ansbody) ->
+      let headers = Response.headers response in
+      let media_name =
+        match Header.get headers "content-type" with
+        | None -> None
+        | Some s ->
+            match Utils.split_path s with
+            | [x ; y] -> Some (x, y)
+            | _      -> None (* ignored invalid *) in
+      let media =
+        match accept with
+        | None -> None
+        | Some media_types -> find_media media_name media_types in
+      let status = Response.status response in
+      match status with
+      | `OK -> Lwt.return (`Ok (Some (ansbody, media_name, media)))
+      | `No_content -> Lwt.return (`Ok None)
+      | `Created ->
+          (* TODO handle redirection ?? *)
+          failwith "Resto_cohttp_client.generic_json_call: unimplemented"
+      | `Unauthorized -> Lwt.return (`Unauthorized (ansbody, media_name, media))
+      | `Forbidden when Cohttp.Header.mem headers "X-OCaml-Resto-CORS-Error" ->
+          Lwt.return (`Unauthorized_host host)
+      | `Forbidden -> Lwt.return (`Forbidden (ansbody, media_name, media))
+      | `Not_found -> Lwt.return (`Not_found (ansbody, media_name, media))
+      | `Conflict -> Lwt.return (`Conflict (ansbody, media_name, media))
+      | `Internal_server_error ->
+          if media_name = Some ("text", "ocaml.exception") then
+            Cohttp_lwt.Body.to_string ansbody >>= fun msg ->
+            Lwt.return (`OCaml_exception msg)
+          else
+            Lwt.return (`Error (ansbody, media_name, media))
+      | `Bad_request ->
+          Cohttp_lwt.Body.to_string ansbody >>= fun body ->
+          Lwt.return (`Bad_request body)
+      | `Method_not_allowed ->
+          let allowed = Cohttp.Header.get_multi headers "accept" in
+          Lwt.return (`Method_not_allowed allowed)
+      | `Unsupported_media_type ->
+          Lwt.return  `Unsupported_media_type
+      | `Not_acceptable ->
+          Cohttp_lwt.Body.to_string ansbody >>= fun body ->
+          Lwt.return (`Not_acceptable body)
+      | code ->
+          Lwt.return
+            (`Unexpected_status_code (code, (ansbody, media_name, media)))
+    end begin fun exn ->
+      let msg =
+        match exn with
+        | Unix.Unix_error (e, _, _) -> Unix.error_message e
+        | Failure msg -> msg
+        | Invalid_argument msg -> msg
+        | e -> Printexc.to_string e in
+      Lwt.return (`Connection_failed msg)
+    end
+
+  let handle_error log service (body, media_name, media) status f =
+    Cohttp_lwt.Body.is_empty body >>= fun empty ->
+    if empty then
+      log.log Encoding.untyped status (lazy (Lwt.return "")) >>= fun () ->
+      Lwt.return (f None)
+    else
+      match media with
+      | None ->
+          Lwt.return (`Unexpected_error_content_type (body, media_name))
+      | Some media ->
+          Cohttp_lwt.Body.to_string body >>= fun body ->
+          let error = Service.error_encoding service in
+          log.log ~media error status (lazy (Lwt.return body)) >>= fun () ->
+          match media.Media_type.destruct error body with
+          | Ok body -> Lwt.return (f (Some body))
+          | Error msg ->
+              Lwt.return (`Unexpected_error_content ((body, media), msg))
+
+  let prepare (type i)
+      media_types ?(logger = null_logger) ?base
+      (service : (_,_,_,_,i,_,_) Service.t) params query body =
+    let module Logger = (val logger : LOGGER) in
+    let media =
+      match Media_type.first_complete_media media_types with
+      | None -> invalid_arg "Resto_cohttp_client.call_service"
+      | Some (_, m) -> m in
+    let { Service.meth ; uri ; input } =
+      Service.forge_request ?base service params query in
+    begin
+      match input with
+      | Service.No_input ->
+          Logger.log_empty_request uri >>= fun log_request ->
+          Lwt.return (None, None, log_request)
+      | Service.Input input ->
+          let body = media.Media_type.construct input body in
+          Logger.log_request ~media input uri body >>= fun log_request ->
+          Lwt.return (Some (Cohttp_lwt.Body.of_string body),
+                      Some media,
+                      log_request)
+    end >>= fun (body, media, log_request) ->
+    let log = { log = fun ?media -> Logger.log_response log_request ?media } in
+    Lwt.return (log, meth, uri, body, media)
+
+  let call_service media_types
+      ?logger ?headers ?base service params query body =
+    prepare
+      media_types ?logger ?base
+      service params query body >>= fun (log, meth, uri, body, media) ->
+    begin
+      internal_call meth log ?headers ~accept:media_types ?body ?media uri >>= function
+      | `Ok None ->
+          log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->
+          Lwt.return (`Ok None)
+      | `Ok (Some (body, media_name, media)) -> begin
+          match media with
+          | None ->
+              Lwt.return (`Unexpected_content_type (body, media_name))
+          | Some media ->
+              Cohttp_lwt.Body.to_string body >>= fun body ->
+              let output = Service.output_encoding service in
+              log.log ~media output `OK (lazy (Lwt.return body)) >>= fun () ->
+              match media.destruct output body with
+              | Ok body -> Lwt.return (`Ok (Some body))
+              | Error msg ->
+                  Lwt.return (`Unexpected_content ((body, media), msg))
+        end
+      | `Conflict body ->
+          handle_error log service body `Conflict (fun v -> `Conflict v)
+      | `Error body ->
+          handle_error log service body `Internal_server_error (fun v -> `Error v)
+      | `Forbidden body ->
+          handle_error log service body `Forbidden (fun v -> `Forbidden v)
+      | `Not_found body ->
+          handle_error log service body `Not_found (fun v -> `Not_found v)
+      | `Unauthorized body ->
+          handle_error log service body `Unauthorized (fun v -> `Unauthorized v)
+      | `Bad_request _
+      | `Method_not_allowed _
+      | `Unsupported_media_type
+      | `Not_acceptable _
+      | `Unexpected_status_code _
+      | `Connection_failed _
+      | `OCaml_exception _
+      | `Unauthorized_host _ as err -> Lwt.return err
+    end >>= fun ans ->
+    Lwt.return (meth, uri, ans)
+
+  let call_streamed_service media_types
+      ?logger ?headers ?base service ~on_chunk ~on_close params query body =
+    prepare
+      media_types ?logger ?base
+      service params query body >>= fun (log, meth, uri, body, media) ->
+    begin
+      internal_call meth log ?headers ~accept:media_types ?body ?media uri >>= function
+      | `Ok None ->
+          on_close () ;
+          log.log Encoding.untyped `No_content (lazy (Lwt.return "")) >>= fun () ->
+          Lwt.return (`Ok None)
+      | `Ok (Some (body, media_name, media)) -> begin
+          match media with
+          | None ->
+              Lwt.return (`Unexpected_content_type (body, media_name))
+          | Some media ->
+              let stream = Cohttp_lwt.Body.to_stream body in
+              Lwt_stream.get stream >>= function
+              | None ->
+                  on_close () ;
+                  Lwt.return (`Ok None)
+              | Some chunk ->
+                  let buffer = Buffer.create 2048 in
+                  let output = Service.output_encoding service in
+                  let rec loop = function
+                    | None -> on_close () ; Lwt.return_unit
+                    | Some chunk ->
+                        Buffer.add_string buffer chunk ;
+                        let data = Buffer.contents buffer in
+                        log.log ~media output
+                          `OK (lazy (Lwt.return chunk)) >>= fun () ->
+                        match media.destruct output data with
+                        | Ok body ->
+                            Buffer.reset buffer ;
+                            on_chunk body ;
+                            Lwt_stream.get stream >>= loop
+                        | Error _msg ->
+                            Lwt_stream.get stream >>= loop in
+                  ignore (loop (Some chunk) : unit Lwt.t) ;
+                  Lwt.return (`Ok (Some (fun () ->
+                      ignore (Lwt_stream.junk_while (fun _ -> true) stream
+                              : unit Lwt.t) ;
+                      ())))
+        end
+      | `Conflict body ->
+          handle_error log service body `Conflict (fun v -> `Conflict v)
+      | `Error body ->
+          handle_error log service body `Internal_server_error (fun v -> `Error v)
+      | `Forbidden body ->
+          handle_error log service body `Forbidden (fun v -> `Forbidden v)
+      | `Not_found body ->
+          handle_error log service body `Not_found (fun v -> `Not_found v)
+      | `Unauthorized body ->
+          handle_error log service body `Unauthorized (fun v -> `Unauthorized v)
+      | `Bad_request _
+      | `Method_not_allowed _
+      | `Unsupported_media_type
+      | `Not_acceptable _
+      | `Unexpected_status_code _
+      | `Connection_failed _
+      | `OCaml_exception _
+      | `Unauthorized_host _ as err -> Lwt.return err
+    end >>= fun ans ->
+    Lwt.return (meth, uri, ans)
+
+  let generic_call meth ?(logger = null_logger) ?headers ?accept ?body ?media uri =
+    let module Logger = (val logger) in
+    begin match body with
+      | None->
+          Logger.log_empty_request uri
+      | Some (`Stream _) ->
+          Logger.log_request Encoding.untyped uri "<stream>"
+      | Some body ->
+          Cohttp_lwt.Body.to_string body >>= fun body ->
+          Logger.log_request ?media Encoding.untyped uri body
+    end >>= fun log_request ->
+    let log = { log = fun ?media -> Logger.log_response log_request ?media } in
+    internal_call meth log ?headers ?accept ?body ?media uri
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.mli
new file mode 100644
index 000000000..e3eb71f78
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/client.mli
@@ -0,0 +1,90 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Typed RPC services: client implementation. *)
+
+module Make (Encoding : Resto.ENCODING) : sig
+
+  module Service : (module type of (struct include Resto.MakeService(Encoding) end))
+
+  type content_type = (string * string)
+  type raw_content = Cohttp_lwt.Body.t * content_type option
+  type content =
+    Cohttp_lwt.Body.t * content_type option * Media_type.Make(Encoding).t option
+
+  type ('o, 'e) generic_rest_result =
+    [ `Ok of 'o option
+    | `Conflict of 'e
+    | `Error of 'e
+    | `Forbidden of 'e
+    | `Not_found of 'e
+    | `Unauthorized of 'e
+    | `Bad_request of string
+    | `Method_not_allowed of string list
+    | `Unsupported_media_type
+    | `Not_acceptable of string
+    | `Unexpected_status_code of Cohttp.Code.status_code * content
+    | `Connection_failed of string
+    | `OCaml_exception of string
+    | `Unauthorized_host of string option ]
+
+  module type LOGGER = sig
+    type request
+    val log_empty_request: Uri.t -> request Lwt.t
+    val log_request:
+      ?media:Media_type.Make(Encoding).t -> 'a Encoding.t ->
+      Uri.t -> string -> request Lwt.t
+    val log_response:
+      request -> ?media:Media_type.Make(Encoding).t -> 'a Encoding.t ->
+      Cohttp.Code.status_code -> string Lwt.t Lazy.t -> unit Lwt.t
+  end
+
+  type logger = (module LOGGER)
+
+  val null_logger: logger
+  val timings_logger: Format.formatter -> logger
+  val full_logger: Format.formatter -> logger
+
+  val generic_call:
+    [< Resto.meth ] ->
+    ?logger:logger ->
+    ?headers:(string * string) list ->
+    ?accept:Media_type.Make(Encoding).t list ->
+    ?body:Cohttp_lwt.Body.t ->
+    ?media:Media_type.Make(Encoding).t ->
+    Uri.t -> (content, content) generic_rest_result Lwt.t
+
+  type ('o, 'e) service_result =
+    [ ('o, 'e option) generic_rest_result
+    | `Unexpected_content_type of raw_content
+    | `Unexpected_content of (string * Media_type.Make(Encoding).t) * string
+    | `Unexpected_error_content_type of raw_content
+    | `Unexpected_error_content of (string * Media_type.Make(Encoding).t) * string ]
+
+  val call_service:
+    Media_type.Make(Encoding).t list ->
+    ?logger:logger ->
+    ?headers:(string * string) list ->
+    ?base:Uri.t ->
+    ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
+    'p -> 'q -> 'i -> (Resto.meth * Uri.t * ('o, 'e) service_result) Lwt.t
+
+  val call_streamed_service:
+    Media_type.Make(Encoding).t list ->
+    ?logger:logger ->
+    ?headers:(string * string) list ->
+    ?base:Uri.t ->
+    ([< Resto.meth ], unit, 'p, 'q, 'i, 'o, 'e) Service.t ->
+    on_chunk: ('o -> unit) ->
+    on_close: (unit -> unit) ->
+    'p -> 'q -> 'i ->
+    (Resto.meth * Uri.t * (unit -> unit, 'e) service_result) Lwt.t
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.ml
new file mode 100644
index 000000000..fcd313956
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.ml
@@ -0,0 +1,77 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  allowed_headers : string list ;
+  allowed_origins : string list ;
+}
+
+let default = { allowed_headers = [] ; allowed_origins = [] }
+
+let check_origin_matches origin allowed_origin =
+  String.equal "*" allowed_origin ||
+  String.equal allowed_origin origin ||
+  begin
+    let allowed_w_slash = allowed_origin ^ "/" in
+    let len_a_w_s = String.length allowed_w_slash in
+    let len_o = String.length origin in
+    (len_o >= len_a_w_s) &&
+    String.equal allowed_w_slash @@ String.sub origin 0 len_a_w_s
+  end
+
+let find_matching_origin allowed_origins origin =
+  let matching_origins =
+    List.filter (check_origin_matches origin) allowed_origins in
+  let compare_by_length_neg a b =
+    ~- (compare (String.length a) (String.length b)) in
+  let matching_origins_sorted =
+    List.sort compare_by_length_neg matching_origins in
+  match matching_origins_sorted with
+  | [] -> None
+  | x :: _ -> Some x
+
+let add_allow_origin headers cors origin_header =
+  match origin_header with
+  | None -> headers
+  | Some origin ->
+      match find_matching_origin cors.allowed_origins origin with
+      | None -> headers
+      | Some allowed_origin ->
+          Cohttp.Header.add headers
+            "Access-Control-Allow-Origin" allowed_origin
+
+let add_headers headers cors origin_header =
+  let cors_headers =
+    Cohttp.Header.add_multi headers
+      "Access-Control-Allow-Headers" cors.allowed_headers in
+  add_allow_origin cors_headers cors origin_header
+
+let check_host headers cors =
+  match Cohttp.Header.get headers "Host" with
+  | None -> List.mem "*" cors.allowed_origins
+  | Some host ->
+      match find_matching_origin cors.allowed_origins host with
+      | None -> false
+      | Some _ -> true
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.mli
new file mode 100644
index 000000000..f8d8c067f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/cors.mli
@@ -0,0 +1,39 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+type t = {
+  allowed_headers : string list ;
+  allowed_origins : string list ;
+}
+
+val default: t
+
+val add_allow_origin:
+  Cohttp.Header.t -> t -> string option -> Cohttp.Header.t
+
+val add_headers:
+  Cohttp.Header.t -> t -> string option -> Cohttp.Header.t
+
+val check_host: Cohttp.Header.t -> t -> bool
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/dune
new file mode 100644
index 000000000..28cd8af74
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/dune
@@ -0,0 +1,5 @@
+(library
+ (name resto_cohttp)
+ (public_name ocplib-resto-cohttp)
+ (libraries ocplib-resto-directory cohttp-lwt-unix)
+ (flags (:standard -safe-string)))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.ml
new file mode 100644
index 000000000..7515de1b1
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.ml
@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Make (Encoding : Resto.ENCODING) = struct
+
+  open Cohttp
+
+  type t = {
+    name: Cohttp.Accept.media_range ;
+    q: int option ;
+    pp: 'a. 'a Encoding.t -> Format.formatter -> string -> unit ;
+    construct: 'a. 'a Encoding.t -> 'a -> string ;
+    destruct: 'a. 'a Encoding.t -> string -> ('a, string) result ;
+  }
+
+  let name_of_media_type = function
+    | Accept.AnyMedia            -> "*/*"
+    | AnyMediaSubtype type_      -> type_ ^ "/*"
+    | MediaType (type_, subtype) -> type_ ^ "/" ^ subtype
+
+  let name { name ; _ } = name_of_media_type name
+
+  let rec has_complete_media = function
+    | [] -> false
+    | { name = MediaType _ ; _ } :: _ -> true
+    | _ :: l -> has_complete_media l
+
+  let rec first_complete_media = function
+    | [] -> None
+    | { name = MediaType (l,r) ; _ } as m :: _ -> Some ((l, r), m)
+    | _ :: l -> first_complete_media l
+
+  let matching_media (type_, subtype) = function
+    | Accept.AnyMedia       -> true
+    | AnyMediaSubtype type_'       -> type_' = type_
+    | MediaType (type_', subtype') -> type_' = type_ && subtype' = subtype
+
+  let rec find_media received = function
+    | [] -> None
+    | { name ; _ } as media :: _ when matching_media received name ->
+        Some media
+    | _ :: mts -> find_media received mts
+
+  (* Inspired from ocaml-webmachine *)
+
+  let media_match (_, (range, _)) media =
+    match media.name with
+    | AnyMedia | AnyMediaSubtype _ -> false
+    | MediaType (type_, subtype) ->
+        let open Accept in
+        match range with
+        | AnyMedia                     -> true
+        | AnyMediaSubtype type_'       -> type_' = type_
+        | MediaType (type_', subtype') -> type_' = type_ && subtype' = subtype
+
+  let resolve_accept_header provided header =
+    let ranges = Accept.(media_ranges header |> qsort) in
+    let rec loop = function
+      | [] -> None
+      | r :: rs ->
+          try
+            let media = List.find (media_match r) provided in
+            Some (name_of_media_type media.name, media)
+          with Not_found -> loop rs
+    in
+    loop ranges
+
+  let accept_header ranges =
+    let ranges =
+      List.map (fun r ->
+          let q = match r.q with None -> 1000 | Some i -> i in
+          (q, (r.name, []))) ranges in
+    (Accept.string_of_media_ranges ranges)
+
+  let acceptable_encoding ranges =
+    String.concat ", "
+      (List.map (fun f -> name_of_media_type f.name) ranges)
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.mli
new file mode 100644
index 000000000..9f9ef1d8b
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/media_type.mli
@@ -0,0 +1,33 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Make (Encoding : Resto.ENCODING) : sig
+
+  type t = {
+    name: Cohttp.Accept.media_range ;
+    q: int option ;
+    pp: 'a. 'a Encoding.t -> Format.formatter -> string -> unit ;
+    construct: 'a. 'a Encoding.t -> 'a -> string ;
+    destruct: 'a. 'a Encoding.t -> string -> ('a, string) result ;
+  }
+
+  val name: t -> string
+
+  val has_complete_media: t list -> bool
+  val first_complete_media: t list -> ((string * string) * t) option
+
+  val find_media: (string * string) -> t list -> t option
+
+  val resolve_accept_header: t list -> string option -> (string * t) option
+
+  val accept_header: t list -> string
+  val acceptable_encoding: t list -> string
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/ocplib-resto-cohttp.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/ocplib-resto-cohttp.opam
new file mode 100644
index 000000000..54032d2f4
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/ocplib-resto-cohttp.opam
@@ -0,0 +1,23 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "ocplib-resto-directory" {= "dev" }
+  "cohttp-lwt-unix" { >= "1.0.0" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.ml
new file mode 100644
index 000000000..7c02ae479
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.ml
@@ -0,0 +1,380 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 Lwt.Infix
+
+module ConnectionMap = Map.Make(Cohttp.Connection)
+
+module type LOGGING = sig
+
+  val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_info: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_notice: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val warn: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+
+  val lwt_debug: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_info: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_notice: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_warn: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+
+end
+
+module Make (Encoding : Resto.ENCODING)(Log : LOGGING) = struct
+
+  open Log
+  open Cohttp
+
+  module Service = Resto.MakeService(Encoding)
+  module Directory = Resto_directory.Make(Encoding)
+
+  module Media_type = Media_type.Make(Encoding)
+
+  type server = {
+    root : unit Directory.directory ;
+    mutable streams : (unit -> unit) ConnectionMap.t ;
+    cors : Cors.t ;
+    media_types : Media_type.t list ;
+    default_media_type : string * Media_type.t ;
+    stopper : unit Lwt.u ;
+    mutable worker : unit Lwt.t ;
+  }
+
+  let create_stream server con to_string s =
+    let running = ref true in
+    let stream =
+      Lwt_stream.from
+        (fun () ->
+           if not !running then
+             Lwt.return None
+           else
+             s.Resto_directory.Answer.next () >|= function
+             | None -> None
+             | Some x -> Some (to_string x)) in
+    let shutdown () =
+      running := false ;
+      s.shutdown () ;
+      server.streams <- ConnectionMap.remove con server.streams in
+    server.streams <- ConnectionMap.add con shutdown server.streams ;
+    stream
+
+  let (>>=?) m f =
+    m >>= function
+    | Ok x -> f x
+    | Error err -> Lwt.return_error err
+
+  let callback server ((_io, con) : Cohttp_lwt_unix.Server.conn) req body =
+    let uri = Request.uri req in
+    let path = Uri.pct_decode (Uri.path uri) in
+    lwt_log_info "(%s) receive request to %s"
+      (Connection.to_string con) path >>= fun () ->
+    let path = Utils.split_path path in
+    let req_headers = Request.headers req in
+    begin
+      match Request.meth req with
+      | #Resto.meth when server.cors.allowed_origins <> [] &&
+                         not (Cors.check_host req_headers server.cors) ->
+          let headers =
+            Cohttp.Header.init_with "X-OCaml-Resto-CORS-Error" "invalid host" in
+          Lwt.return_ok
+            (Response.make ~headers ~status:`Forbidden (),
+             Cohttp_lwt.Body.empty)
+      | #Resto.meth as meth -> begin
+          Directory.lookup server.root ()
+            meth path >>=? fun (Directory.Service s) ->
+          begin
+            match Header.get req_headers "content-type" with
+            | None -> Lwt.return_ok (snd server.default_media_type)
+            | Some content_type ->
+                match Utils.split_path content_type with
+                | [x ; y] -> begin
+                    match Media_type.find_media (x, y) server.media_types with
+                    | None ->
+                        Lwt.return_error (`Unsupported_media_type content_type)
+                    | Some media_type ->
+                        Lwt.return_ok media_type
+                  end
+                | _ ->
+                    Lwt.return_error (`Unsupported_media_type content_type)
+          end >>=? fun input_media_type ->
+          lwt_debug "(%s) input media type %s"
+            (Connection.to_string con)
+            (Media_type.name input_media_type) >>= fun () ->
+          begin
+            match Header.get req_headers "accept" with
+            | None -> Lwt.return_ok server.default_media_type
+            | Some accepted ->
+                match Media_type.resolve_accept_header
+                        server.media_types (Some accepted) with
+                | None -> Lwt.return_error `Not_acceptable
+                | Some media_type -> Lwt.return_ok media_type
+          end >>=? fun (output_content_type, output_media_type) ->
+          begin
+            match Resto.Query.parse s.types.query
+                    (List.map
+                       (fun (k, l) -> (k, String.concat "," l))
+                       (Uri.query uri)) with
+            | exception (Resto.Query.Invalid s) ->
+                Lwt.return_error (`Cannot_parse_query s)
+            | query -> Lwt.return_ok query
+          end >>=? fun query ->
+          lwt_debug "(%s) ouput media type %s"
+            (Connection.to_string con)
+            (Media_type.name output_media_type) >>= fun () ->
+          let output = output_media_type.construct s.types.output
+          and error = function
+            | None -> Cohttp_lwt.Body.empty, Transfer.Fixed 0L
+            | Some e ->
+                let s = output_media_type.construct s.types.error e in
+                Cohttp_lwt.Body.of_string s,
+                Transfer.Fixed (Int64.of_int (String.length s)) in
+          let headers = Header.init () in
+          let headers =
+            Header.add headers "content-type" output_content_type in
+          let headers = Cors.add_allow_origin
+              headers server.cors (Header.get req_headers "origin") in
+          begin
+            match s.types.input with
+            | Service.No_input ->
+                s.handler query () >>= Lwt.return_ok
+            | Service.Input input ->
+                Cohttp_lwt.Body.to_string body >>= fun body ->
+                match
+                  input_media_type.destruct input body
+                with
+                | Error s ->
+                    Lwt.return_error (`Cannot_parse_body s)
+                | Ok body ->
+                    s.handler query body >>= Lwt.return_ok
+          end >>=? function
+          | `Ok o ->
+              let body = output o in
+              let encoding =
+                Transfer.Fixed (Int64.of_int (String.length body)) in
+              Lwt.return_ok
+                (Response.make ~status:`OK ~encoding ~headers (),
+                 Cohttp_lwt.Body.of_string body)
+          | `OkStream o ->
+              let body = create_stream server con output o in
+              let encoding = Transfer.Chunked in
+              Lwt.return_ok
+                (Response.make ~status:`OK ~encoding ~headers (),
+                 Cohttp_lwt.Body.of_stream body)
+          | `Created s ->
+              let headers = Header.init () in
+              let headers =
+                match s with
+                | None -> headers
+                | Some s -> Header.add headers "location" s in
+              Lwt.return_ok
+                (Response.make ~status:`Created  ~headers (),
+                 Cohttp_lwt.Body.empty)
+          | `No_content ->
+              Lwt.return_ok
+                (Response.make ~status:`No_content (),
+                 Cohttp_lwt.Body.empty)
+          | `Unauthorized e ->
+              let body, encoding = error e in
+              let status = `Unauthorized in
+              Lwt.return_ok
+                (Response.make ~status ~encoding ~headers (), body)
+          | `Forbidden e ->
+              let body, encoding = error e in
+              let status = `Forbidden in
+              Lwt.return_ok
+                (Response.make ~status ~encoding ~headers (), body)
+          | `Not_found e ->
+              let body, encoding = error e in
+              let status = `Not_found in
+              Lwt.return_ok
+                (Response.make ~status ~encoding ~headers (), body)
+          | `Conflict e ->
+              let body, encoding = error e in
+              let status = `Conflict in
+              Lwt.return_ok
+                (Response.make ~status ~encoding ~headers (), body)
+          | `Error e ->
+              let body, encoding = error e in
+              let status = `Internal_server_error in
+              Lwt.return_ok
+                (Response.make ~status ~encoding ~headers (), body)
+        end
+      | `HEAD ->
+          (* TODO ??? *)
+          Lwt.return_error `Not_implemented
+      | `OPTIONS ->
+          let req_headers = Request.headers req in
+          let origin_header = Header.get req_headers "origin" in
+          begin
+            (* Default OPTIONS handler for CORS preflight *)
+            if origin_header = None then
+              Directory.allowed_methods server.root () path
+            else
+              match Header.get req_headers
+                      "Access-Control-Request-Method" with
+              | None ->
+                  Directory.allowed_methods server.root () path
+              | Some meth ->
+                  match Code.method_of_string meth with
+                  | #Resto.meth as meth ->
+                      Directory.lookup server.root () meth path >>=? fun _handler ->
+                      Lwt.return_ok [ meth ]
+                  | _ ->
+                      Lwt.return_error `Not_found
+          end >>=? fun cors_allowed_meths ->
+          lwt_log_info "(%s) RPC preflight"
+            (Connection.to_string con) >>= fun () ->
+          let headers = Header.init () in
+          let headers =
+            Header.add_multi headers
+              "Access-Control-Allow-Methods"
+              (List.map Resto.string_of_meth cors_allowed_meths) in
+          let headers = Cors.add_headers headers server.cors origin_header in
+          Lwt.return_ok
+            (Response.make ~flush:true ~status:`OK ~headers (),
+             Cohttp_lwt.Body.empty)
+      | _ ->
+          Lwt.return_error `Not_implemented
+    end >>= function
+    | Ok answer -> Lwt.return answer
+    | Error `Not_implemented ->
+        Lwt.return
+          (Response.make ~status:`Not_implemented (),
+           Cohttp_lwt.Body.empty)
+    | Error `Method_not_allowed methods ->
+        let headers = Header.init () in
+        let headers =
+          Header.add_multi headers "allow"
+            (List.map Resto.string_of_meth methods) in
+        Lwt.return
+          (Response.make ~status:`Method_not_allowed ~headers (),
+           Cohttp_lwt.Body.empty)
+    | Error `Cannot_parse_path (context, arg, value) ->
+        let headers = Header.init () in
+        let headers =
+          Header.add headers "content-type" "text/plain" in
+        Lwt.return
+          (Response.make ~status:`Bad_request ~headers (),
+           Format.kasprintf Cohttp_lwt.Body.of_string
+             "Failed to parsed an argument in path. After \"%s\", \
+              the value \"%s\" is not acceptable for type \"%s\""
+             (String.concat "/" context) value arg.name)
+    | Error `Cannot_parse_body s ->
+        let headers = Header.init () in
+        let headers =
+          Header.add headers "content-type" "text/plain" in
+        Lwt.return
+          (Response.make ~status:`Bad_request ~headers (),
+           Format.kasprintf Cohttp_lwt.Body.of_string
+             "Failed to parse the request body: %s" s)
+    | Error `Cannot_parse_query s ->
+        let headers = Header.init () in
+        let headers =
+          Header.add headers "content-type" "text/plain" in
+        Lwt.return
+          (Response.make ~status:`Bad_request ~headers (),
+           Format.kasprintf Cohttp_lwt.Body.of_string
+             "Failed to parse the query string: %s" s)
+    | Error `Not_acceptable ->
+        let accepted_encoding =
+          Media_type.acceptable_encoding server.media_types in
+        Lwt.return
+          (Response.make ~status:`Not_acceptable (),
+           Cohttp_lwt.Body.of_string accepted_encoding)
+    | Error `Unsupported_media_type _ ->
+        Lwt.return
+          (Response.make ~status:`Unsupported_media_type (),
+           Cohttp_lwt.Body.empty)
+    | Error `Not_found ->
+        Lwt.return
+          (Response.make ~status:`Not_found (),
+           Cohttp_lwt.Body.empty)
+
+  (* Promise a running RPC server. *)
+
+  let launch
+      ?(host="::")
+      ?(cors = Cors.default)
+      ~media_types
+      mode root =
+    let default_media_type =
+      match Media_type.first_complete_media media_types with
+      | None -> invalid_arg "Resto_directory_cohttp.launch(empty media type list)"
+      | Some ((l, r), m) -> l^"/"^r, m in
+    let stop, stopper = Lwt.wait () in
+    let server = {
+      root ;
+      streams = ConnectionMap.empty ;
+      cors ;
+      media_types ;
+      default_media_type ;
+      stopper ;
+      worker = Lwt.return_unit ;
+    } in
+    Conduit_lwt_unix.init ~src:host () >>= fun ctx ->
+    let ctx = Cohttp_lwt_unix.Net.init ~ctx () in
+    server.worker <- begin
+      let conn_closed (_, con) =
+        log_info "connection closed %s" (Connection.to_string con) ;
+        try ConnectionMap.find con server.streams ()
+        with Not_found -> ()
+      and on_exn = function
+        | Unix.Unix_error (Unix.EADDRINUSE, "bind", _) ->
+            log_error "RPC server port already taken, \
+                       the node will be shutdown" ;
+            exit 1
+        | Unix.Unix_error (ECONNRESET, _, _)
+        | Unix.Unix_error (EPIPE, _, _)  -> ()
+        | exn -> !Lwt.async_exception_hook exn
+      and callback (io, con) req body =
+        Lwt.catch
+          begin fun () -> callback server (io, con) req body end
+          begin function
+            | Not_found ->
+                let status = `Not_found in
+                let body = Cohttp_lwt.Body.empty in
+                Lwt.return (Response.make ~status (), body)
+            | exn ->
+                let headers = Header.init () in
+                let headers =
+                  Header.add headers "content-type" "text/ocaml.exception" in
+                let status = `Internal_server_error in
+                let body = Cohttp_lwt.Body.of_string (Printexc.to_string exn) in
+                Lwt.return (Response.make ~status ~headers (), body)
+          end
+      in
+      Cohttp_lwt_unix.Server.create ~stop ~ctx ~mode ~on_exn
+        (Cohttp_lwt_unix.Server.make ~callback ~conn_closed ())
+    end ;
+    Lwt.return server
+
+  let shutdown server =
+    Lwt.wakeup_later server.stopper () ;
+    server.worker >>= fun () ->
+    ConnectionMap.iter (fun _ f -> f ()) server.streams ;
+    Lwt.return_unit
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.mli
new file mode 100644
index 000000000..cc42ee45e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/server.mli
@@ -0,0 +1,46 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Typed RPC services: server implementation. *)
+
+module type LOGGING = sig
+
+  val debug: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_info: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_notice: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val warn: ('a, Format.formatter, unit, unit) format4 -> 'a
+  val log_error: ('a, Format.formatter, unit, unit) format4 -> 'a
+
+  val lwt_debug: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_info: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_notice: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_warn: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+  val lwt_log_error: ('a, Format.formatter, unit, unit Lwt.t) format4 -> 'a
+
+end
+
+module Make (Encoding : Resto.ENCODING) (Log : LOGGING) : sig
+
+  (** A handle on the server worker. *)
+  type server
+
+  (** Promise a running RPC server.*)
+  val launch :
+    ?host:string ->
+    ?cors:Cors.t ->
+    media_types:Media_type.Make(Encoding).t list ->
+    Conduit_lwt_unix.server ->
+    unit Resto_directory.Make(Encoding).t ->
+    server Lwt.t
+
+  (** Kill an RPC server. *)
+  val shutdown : server -> unit Lwt.t
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.ml
new file mode 100644
index 000000000..7a546d57f
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.ml
@@ -0,0 +1,45 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 split_path path =
+  let l = String.length path in
+  let rec do_slashes acc i =
+    if i >= l then
+      List.rev acc
+    else if String.get path i = '/' then
+      do_slashes acc (i + 1)
+    else
+      do_component acc i i
+  and do_component acc i j =
+    if j >= l then
+      if i = j then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if String.get path j = '/' then
+      do_slashes (String.sub path i (j - i) :: acc) j
+    else
+      do_component acc i (j + 1) in
+  do_slashes [] 0
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.mli
new file mode 100644
index 000000000..1f2e3d7ef
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-cohttp/utils.mli
@@ -0,0 +1,26 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* Open Source License                                                       *)
+(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
+(*                                                                           *)
+(* 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 split_path: string -> string list
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/dune
new file mode 100644
index 000000000..56ff97e7a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/dune
@@ -0,0 +1,7 @@
+(library
+ (name resto_directory)
+ (public_name ocplib-resto-directory)
+ (libraries lwt ocplib-resto)
+ (flags (:standard -safe-string))
+ (wrapped false))
+
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/ocplib-resto-directory.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/ocplib-resto-directory.opam
new file mode 100644
index 000000000..bc9d66003
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/ocplib-resto-directory.opam
@@ -0,0 +1,24 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "ocplib-resto" {= "dev" }
+  "ocplib-resto-json" {= "dev" & with-test }
+  "lwt" { >= "3.0.0" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml
new file mode 100644
index 000000000..888ec3f4d
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.ml
@@ -0,0 +1,728 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Resto
+
+let map_option f = function
+  | None -> None
+  | Some x -> Some (f x)
+
+let (>>=) = Lwt.bind
+let (>|=) = Lwt.(>|=)
+
+module Answer = struct
+
+  (** Return type for service handler *)
+  type ('o, 'e) t =
+    [ `Ok of 'o (* 200 *)
+    | `OkStream of 'o stream (* 200 *)
+    | `Created of string option (* 201 *)
+    | `No_content (* 204 *)
+    | `Unauthorized of 'e option (* 401 *)
+    | `Forbidden of 'e option (* 403 *)
+    | `Not_found of 'e option (* 404 *)
+    | `Conflict of 'e option (* 409 *)
+    | `Error of 'e option (* 500 *)
+    ]
+
+  and 'a stream = {
+    next: unit -> 'a option Lwt.t ;
+    shutdown: unit -> unit ;
+  }
+
+  let return x = Lwt.return (`Ok x)
+  let return_stream x = Lwt.return (`OkStream x)
+
+end
+
+module Make (Encoding : ENCODING) = struct
+
+  module Service = Resto.MakeService(Encoding)
+
+  module Curry = struct
+
+    type (_,_,_,_,_,_) conv =
+      | Z : (unit, 'g, 'g, unit, 'f, 'f) conv
+      | S : ('t, 'g, 'b * 's, 'rt, 'f, 'r) conv ->
+        ('t * 'b, 'g, 's, 'a * 'rt, 'a -> 'f, 'r) conv
+    let reverse
+      : type a c d e f. (a, c, unit, d, e, f) conv -> a -> c
+      = fun c v ->
+        let rec reverse
+          : type a c d e f g. (a, c, d, e, f, g) conv -> a -> d -> c
+          = fun c v acc ->
+            match c, v with
+            | Z, _ -> acc
+            | S c, (v, x) -> reverse c v (x, acc) in
+        reverse c v ()
+    let rec curry
+      : type a b c d e f. (a, b, c, d, e, f) conv -> e -> d -> f
+      = fun c f ->
+        match c with
+        | Z -> fun () -> f
+        | S c -> (fun (v, x) -> curry c (f v) x)
+    let curry c f =
+      let f = curry c f in
+      fun x -> f (reverse c x)
+
+  end
+
+  type step =
+    | Static of string
+    | Dynamic of Arg.descr
+    | DynamicTail of Arg.descr
+
+  type conflict =
+    | CService of meth
+    | CDir
+    | CBuilder
+    | CTail
+    | CTypes of Arg.descr * Arg.descr
+    | CType of Arg.descr * string list
+
+  exception Conflict of step list * conflict
+
+  open Resto.Internal
+
+  type lookup_error =
+    [ `Not_found (* 404 *)
+    | `Method_not_allowed of meth list (* 405 *)
+    | `Cannot_parse_path of string list * Arg.descr * string (* 400 *)
+    ]
+
+  type ('query, 'input, 'output, 'error) types
+    = ('query, 'input, 'output, 'error) Service.Internal.types
+    = {
+      query : 'query Resto.Query.t ;
+      input : 'input Service.input ;
+      output : 'output Encoding.t ;
+      error : 'error Encoding.t ;
+    }
+
+  type 'key t =
+    | Empty : 'key t
+    | Static : 'key static_directory -> 'key t
+    | Dynamic : string option * ('key -> 'key directory Lwt.t) -> 'key t
+    | DynamicTail : 'a arg * ('key * 'a list) t -> 'key t
+
+  and 'key directory = 'key t
+  and 'key static_directory = {
+    services : 'key registered_service_builder MethMap.t ;
+    subdirs : 'key static_subdirectories option
+  }
+
+  and _ static_subdirectories =
+    | Suffixes: 'key directory StringMap.t -> 'key static_subdirectories
+    | Arg: 'a Resto.Internal.arg * ('key * 'a) directory -> 'key static_subdirectories
+
+  and registered_service =
+    | Service :
+        { types : ('q, 'i, 'o, 'e) types ;
+          handler : ('q -> 'i -> ('o, 'e) Answer.t Lwt.t) ;
+        } -> registered_service
+
+  and 'key registered_service_builder = {
+    meth : Resto.meth ;
+    description : Encoding.schema Description.service ;
+    builder : 'key -> registered_service Lwt.t ;
+  }
+
+  let empty = Empty
+
+  let rec map_directory
+    : type a b.
+      (a -> b Lwt.t) -> b directory -> a directory
+    = fun f t ->
+      match t with
+      | Empty -> Empty
+      | Dynamic (descr, builder) ->
+          let builder a = f a >>= builder >|= map_directory f in
+          Dynamic (descr, builder)
+      | DynamicTail (arg, dir) ->
+          DynamicTail (arg, map_directory (fun (x, l) -> f x >|= fun x -> (x, l)) dir)
+      | Static dir ->
+          Static (map_static_directory f dir)
+
+  and map_static_directory
+    : type a b.
+      (a -> b Lwt.t) -> b static_directory -> a static_directory
+    = fun f t ->
+      { services = MethMap.map (map_registered_service f) t.services ;
+        subdirs = map_option (map_static_subdirectories f) t.subdirs ;
+      }
+
+  and map_static_subdirectories
+    : type a b.
+      (a -> b Lwt.t) -> b static_subdirectories -> a static_subdirectories
+    = fun f t ->
+      match t with
+      | Suffixes map ->
+          Suffixes (StringMap.map (map_directory f) map)
+      | Arg (arg, dir) ->
+          let dir = map_directory (fun (a, x) -> f a >|= fun a -> (a, x)) dir in
+          Arg (arg, dir)
+
+  and map_registered_service
+    : type a b.
+      (a -> b Lwt.t) -> b registered_service_builder -> a registered_service_builder
+    = fun f rs ->
+      { rs with builder = (fun p -> f p >>= fun p -> rs.builder p) }
+
+  let map = map_directory
+
+  let prefix
+    : type p pr. (pr, p) Path.path -> p directory -> pr directory
+    = fun path dir ->
+      let rec prefix
+        : type k pr. (pr, k) Resto.Internal.path -> k directory -> pr directory
+        = fun path dir ->
+          match path with
+          | Root -> dir
+          | Static (path, name) ->
+              let subdirs = Suffixes (StringMap.singleton name dir) in
+              prefix path (Static { subdirs = Some subdirs ;
+                                    services = MethMap.empty })
+          | Dynamic (path, arg) ->
+              let subdirs = Arg (arg, dir) in
+              prefix path (Static { subdirs = Some subdirs ;
+                                    services = MethMap.empty })
+          | DynamicTail _ ->
+              invalid_arg "RestoDirectory.prefix" in
+      prefix (Resto.Internal.to_path path) dir
+
+  let conflict steps kind = raise (Conflict (steps, kind))
+
+  let rec merge
+    : type p.
+      step list -> p directory -> p directory -> p directory
+    = fun path t1 t2 ->
+      match t1, t2 with
+      | Empty, t -> t
+      | t, Empty -> t
+      | Static n1, Static n2 ->
+          Static (merge_static_directory path n1 n2)
+      | Dynamic _, _
+      | _, Dynamic _ -> conflict path CBuilder
+      | DynamicTail _, _
+      | _, DynamicTail _ -> conflict path CTail
+
+  and merge_static_directory
+    : type p.
+      step list -> p static_directory -> p static_directory -> p static_directory
+    = fun path t1 t2 ->
+      let subdirs =
+        match t1.subdirs, t2.subdirs with
+        | None, None -> None
+        | None, Some dir | Some dir, None -> Some dir
+        | Some d1, Some d2 ->
+            match d1, d2 with
+            | Suffixes m1, Suffixes m2 ->
+                let merge =
+                  StringMap.fold
+                    (fun n t m ->
+                       let st =
+                         try StringMap.find n m with Not_found -> empty in
+                       StringMap.add n (merge (Static n :: path) st t) m) in
+                Some (Suffixes (merge m1 m2))
+            | Arg (arg1, subt1), Arg (arg2, subt2) ->
+                begin
+                  try let Eq = Ty.eq arg1.id arg2.id in
+                    let subt = merge (Dynamic arg1.descr :: path) subt1 subt2 in
+                    Some (Arg (arg1, subt))
+                  with Ty.Not_equal ->
+                    conflict path (CTypes (arg1.descr, arg2.descr))
+                end
+            | Arg (arg, _), Suffixes m ->
+                conflict path
+                  (CType (arg.descr, List.map fst (StringMap.bindings m)))
+            | Suffixes m, Arg (arg, _) ->
+                conflict path
+                  (CType (arg.descr, List.map fst (StringMap.bindings m))) in
+      let services =
+        MethMap.fold
+          begin fun meth s map ->
+            if MethMap.mem meth map then
+              conflict path (CService meth)
+            else
+              MethMap.add meth s map
+          end
+          t1.services t2.services in
+      { subdirs ; services }
+
+  let merge x y = merge [] x y
+
+  let rec describe_directory
+    : type a. recurse:bool -> ?arg:a ->
+    a directory -> Encoding.schema Description.directory Lwt.t
+    = fun ~recurse ?arg dir ->
+      match dir with
+      | Empty -> Lwt.return Description.Empty
+      | Dynamic (descr, builder) -> begin
+          match arg with
+          | None ->
+              Lwt.return (Dynamic descr : Encoding.schema Description.directory)
+          | Some arg ->
+              builder arg >>= fun dir -> describe_directory ~recurse dir
+        end
+      | DynamicTail ( _, dir) -> describe_directory ~recurse dir
+      | Static dir ->
+          describe_static_directory recurse dir >>= fun dir ->
+          Lwt.return (Static dir : Encoding.schema Description.directory)
+
+  and describe_static_directory
+    : type a.
+      bool -> a static_directory ->
+      Encoding.schema Description.static_directory Lwt.t
+    = fun recurse dir ->
+      let services = MethMap.map describe_service dir.services in
+      begin
+        if recurse then
+          match dir.subdirs with
+          | None -> Lwt.return_none
+          | Some subdirs ->
+              describe_static_subdirectories subdirs >>= fun dirs ->
+              Lwt.return (Some dirs)
+        else
+          Lwt.return_none
+      end >>= fun subdirs ->
+      Lwt.return ({ services ; subdirs } : Encoding.schema Description.static_directory)
+
+  and describe_static_subdirectories
+    : type a.
+      a static_subdirectories ->
+      Encoding.schema Description.static_subdirectories Lwt.t
+    = fun dir ->
+      match dir with
+      | Suffixes map ->
+          StringMap.fold (fun key dir map ->
+              map >>= fun map ->
+              describe_directory ~recurse:true dir >>= fun dir ->
+              Lwt.return (StringMap.add key dir map))
+            map (Lwt.return StringMap.empty) >>= fun map ->
+          Lwt.return (Suffixes map : Encoding.schema Description.static_subdirectories)
+      | Arg (arg, dir) ->
+          describe_directory ~recurse:true dir >>= fun dir ->
+          Lwt.return (Arg (arg.descr, dir)
+                      : Encoding.schema Description.static_subdirectories)
+
+  and describe_service
+    : type a.
+      a registered_service_builder -> Encoding.schema Description.service
+    = fun { description ; _ } -> description
+
+  and describe_query
+    : type a.
+      a Resto.Internal.query -> Description.query_item list
+    = fun (Fields (fields, _)) ->
+      let rec loop : type a b. (a, b) query_fields -> _ = function
+        | F0 -> []
+        | F1 (f, fs) ->
+            { Description.name = field_name f ;
+              description = field_description f ;
+              kind = field_kind f } :: loop fs in
+      loop fields
+
+
+  (****************************************************************************
+   * Lookup
+   ****************************************************************************)
+
+  type resolved_directory =
+      Dir: 'a static_directory * 'a -> resolved_directory
+
+  let rec resolve
+    : type a.
+      string list -> a directory -> a -> string list ->
+      (resolved_directory, _) result Lwt.t
+    = fun prefix dir args path ->
+      match path, dir with
+      | _, Empty -> Lwt.return_error `Not_found
+      | path, Dynamic (_, builder) ->
+          builder args >>= fun dir -> resolve prefix dir args path
+      | path, DynamicTail (arg, dir) -> begin
+          match
+            List.fold_right
+              (fun e acc ->
+                 match acc with
+                 | Error _ as err -> err
+                 | Ok (prefix, path) ->
+                     match arg.destruct e with
+                     | Ok s -> Ok (e :: prefix, s :: path)
+                     | Error msg ->
+                         Error (`Cannot_parse_path (List.rev (e :: prefix), arg.descr, msg)))
+
+              path (Ok (prefix, []))
+          with
+          | Ok (prefix, path) -> resolve prefix dir (args, path) []
+          | Error _ as err -> Lwt.return err
+        end
+      | [], Static sdir -> Lwt.return_ok (Dir (sdir, args))
+      | _name :: _path, Static { subdirs = None ; _ } ->
+          Lwt.return_error `Not_found
+      | name :: path,
+        Static { subdirs = Some (Suffixes static) ; _ } -> begin
+          match StringMap.find name static with
+          | exception Not_found -> Lwt.return_error `Not_found
+          | dir -> resolve (name :: prefix) dir args path
+        end
+      | name :: path, Static { subdirs = Some (Arg (arg, dir)) ; _ } ->
+          match arg.destruct name with
+          | Ok x -> resolve (name :: prefix) dir (args, x) path
+          | Error msg ->
+              Lwt.return_error @@
+              `Cannot_parse_path (List.rev (name :: prefix), arg.descr, msg)
+
+  let lookup
+    : type a.
+      a directory -> a -> meth -> string list ->
+      (registered_service, lookup_error) result Lwt.t
+    = fun dir args meth path ->
+      resolve [] dir args path >>= function
+      | Error _ as err -> Lwt.return err
+      | Ok (Dir (dir, args)) -> begin
+          match MethMap.find meth dir.services with
+          | exception Not_found -> begin
+              match MethMap.bindings dir.services with
+              | [] -> Lwt.return_error `Not_found
+              | l -> Lwt.return_error (`Method_not_allowed (List.map fst l))
+            end
+          | rs -> rs.builder args >>= Lwt.return_ok
+        end
+
+  let lookup =
+    (lookup
+     : _ -> _ -> _ -> _ -> (_, lookup_error) result Lwt.t
+     :> _ -> _ -> _ -> _ -> (_, [> lookup_error ]) result Lwt.t )
+
+  let allowed_methods
+    : type a.
+      a directory -> a -> string list ->
+      (Resto.meth list, lookup_error) result Lwt.t
+    = fun dir args path ->
+      resolve [] dir args path >>= function
+      | Error err -> Lwt.return_error err
+      | Ok (Dir (dir, _)) -> begin
+          match MethMap.bindings dir.services with
+          | [] -> Lwt.return_error `Not_found
+          | l -> Lwt.return_ok (List.map fst l)
+        end
+
+  let allowed_methods =
+    (allowed_methods
+     : _ -> _ -> _ -> (_, lookup_error) result Lwt.t
+     :> _ -> _ -> _ -> (_, [> lookup_error]) result Lwt.t)
+
+
+  let rec build_dynamic_dir : type p. p directory -> p -> p directory Lwt.t =
+    fun dir args ->
+      match dir with
+      | Dynamic (_, builder) ->
+          builder args >>= fun dir -> build_dynamic_dir dir args
+      | _ -> Lwt.return dir
+
+  let rec transparent_resolve
+    : type pr p.
+      pr directory -> (pr, p) path -> p -> p directory option Lwt.t
+    = fun dir path rargs ->
+      match path with
+      | Root -> Lwt.return_some dir
+      | Static (path, name) -> begin
+          transparent_resolve dir path rargs >>= function
+          | None -> Lwt.return_none
+          | Some dir ->
+              build_dynamic_dir dir rargs >>= function
+              | Dynamic (_,_) -> assert false (* should not happen. *)
+              | Static { subdirs = Some (Suffixes s) ; _ } ->
+                  Lwt.return_some (StringMap.find name s)
+              | Empty -> Lwt.return_none
+              | Static _ -> Lwt.return_none
+              | DynamicTail _ -> Lwt.return_none
+        end
+      | Dynamic (ipath, iarg) -> begin
+          transparent_resolve dir ipath (fst rargs) >>= function
+          | None -> Lwt.return_none
+          | Some dir ->
+              build_dynamic_dir dir (fst rargs) >>= function
+              | Dynamic (_, _) -> assert false (* should not happen. *)
+              | Static { subdirs = Some (Arg (arg, dir)) ; _ } -> begin
+                  match Ty.eq iarg.id arg.id with
+                  | exception Ty.Not_equal ->
+                      Lwt.return_none
+                  | Eq ->
+                      Lwt.return_some (dir : (_ * _) directory :> p directory)
+                end
+              | Empty -> Lwt.return_none
+              | Static _ -> Lwt.return_none
+              | DynamicTail _ -> Lwt.return_none
+        end
+      | DynamicTail (path, arg) -> begin
+          transparent_resolve dir path (fst rargs) >>= function
+          | None -> Lwt.return_none
+          | Some dir ->
+              build_dynamic_dir dir (fst rargs) >>= function
+              | Dynamic (_,_) -> assert false (* should not happen. *)
+              | DynamicTail (iarg, dir) -> begin
+                  match Ty.eq iarg.id arg.id with
+                  | exception Ty.Not_equal ->
+                      Lwt.return_none
+                  | Eq ->
+                      Lwt.return_some (dir : (_ * _) directory :> p directory)
+                end
+              | Empty -> Lwt.return_none
+              | Static _ -> Lwt.return_none
+        end
+
+  let transparent_lookup :
+    type prefix params query input output error.
+    prefix directory ->
+    (_, prefix, params, query, input, output, error) Service.t ->
+    params -> query -> input -> (output, error) Answer.t Lwt.t =
+    fun dir service params query body ->
+      let service = Service.Internal.to_service service in
+      transparent_resolve dir service.path params >>= function
+      | None -> Lwt.return (`Not_found None)
+      | Some (Static { services ; _ }) -> begin
+          try
+            (MethMap.find service.meth services).builder
+              params >>= fun (Service { handler ; types }) ->
+            match Service.Internal.eq types service.types with
+            | exception Service.Internal.Not_equal ->
+                Lwt.return (`Not_found None)
+            | Service.Internal.Eq ->
+                (handler query body
+                 : (_, _) Answer.t Lwt.t :> (output, error) Answer.t Lwt.t)
+          with Not_found -> Lwt.return (`Not_found None)
+        end
+      | Some _ -> Lwt.return (`Not_found None)
+
+  let transparent_lookup =
+    ( transparent_lookup
+      : _ -> (Resto.meth, _, _, _, _, _, _) Service.t ->
+      _ -> _ -> _ -> (_, _) Answer.t Lwt.t
+      :> _ -> ([< Resto.meth ], _, _, _, _, _, _) Service.t ->
+      _ -> _ -> _ -> [> (_, _) Answer.t ] Lwt.t)
+
+  let rec describe_rpath
+    : type a b. Description.path_item list ->
+      (a, b) path -> Description.path_item list
+    = fun acc path ->
+      match path with
+      | Root -> acc
+      | Static (rpath, name) ->
+          describe_rpath (PStatic name :: acc) rpath
+      | Dynamic (rpath, arg) ->
+          describe_rpath (PDynamic arg.descr :: acc) rpath
+      | DynamicTail (rpath, arg) ->
+          describe_rpath (PDynamicTail arg.descr :: acc) rpath
+
+  (****************************************************************************
+   * Registration
+   ****************************************************************************)
+
+  let rec step_of_path
+    : type p rk. (rk, p) path -> step list -> step list
+    = fun path acc ->
+      match path with
+      | Root -> acc
+      | Static (path, name) -> step_of_path path (Static name :: acc)
+      | Dynamic (path, arg) -> step_of_path path (Dynamic arg.descr :: acc)
+      | DynamicTail (path, arg) -> step_of_path path (DynamicTail arg.descr :: acc)
+  let step_of_path p = step_of_path p []
+
+  let conflict path kind = raise (Conflict (step_of_path path, kind))
+
+  let rec insert
+    : type k rk.
+      (rk, k) path -> rk directory -> k directory * (k directory -> rk directory)
+    = fun path dir ->
+      match path with
+      | Root -> dir, (fun x -> x)
+      | Static (subpath, name) -> begin
+          let subdir, rebuild = insert subpath dir in
+          let dirmap, services =
+            match subdir with
+            | Empty ->
+                StringMap.empty, MethMap.empty
+            | Static { subdirs = None ; services } ->
+                StringMap.empty, services
+            | Static { subdirs = Some (Suffixes m) ;
+                       services } ->
+                m, services
+            | Static { subdirs = Some (Arg (arg, _)) ; _ } ->
+                conflict path (CType (arg.descr, [name]))
+            | Dynamic _ -> conflict path CBuilder
+            | DynamicTail _ -> conflict path CTail in
+          let dir =
+            try StringMap.find name dirmap with Not_found -> empty in
+          let rebuild s =
+            let subdirs =
+              Some (Suffixes (StringMap.add name s dirmap)) in
+            rebuild (Static { subdirs ; services }) in
+          dir, rebuild
+        end
+      | Dynamic (subpath, arg) -> begin
+          let subdir, rebuild = insert subpath dir in
+          let dir, services =
+            match subdir with
+            | Empty ->
+                Empty, MethMap.empty
+            | Static { subdirs = None ; services } ->
+                Empty, services
+            | Static { subdirs = Some (Arg (arg', dir)) ;
+                       services } -> begin
+                try
+                  let Eq = Ty.eq arg.id arg'.id in
+                  (dir :> k directory), services
+                with Ty.Not_equal ->
+                  conflict path (CTypes (arg.descr, arg'.descr))
+              end
+            | Static { subdirs = Some (Suffixes m) ; _ } ->
+                conflict path
+                  (CType (arg.descr, List.map fst (StringMap.bindings m)))
+            | Dynamic _ -> conflict path CBuilder
+            | DynamicTail _ -> conflict path CTail
+          in
+          let rebuild s =
+            let subdirs = Some (Arg (arg, s)) in
+            rebuild (Static { subdirs ; services }) in
+          dir, rebuild
+        end
+      | DynamicTail (subpath, arg) -> begin
+          let subdir, rebuild = insert subpath dir in
+          match subdir with
+          | Empty ->
+              let rebuild s = rebuild (DynamicTail (arg, s)) in
+              empty, rebuild
+          | Static { subdirs = None ; services } ->
+              conflict path (CService (fst (MethMap.min_binding services)))
+          | Static { subdirs = Some (Arg (arg, _)) ; _ } ->
+              conflict path (CType (arg.descr, []))
+          | Static { subdirs = Some (Suffixes m) ; _ } ->
+              conflict path
+                (CType (arg.descr, List.map fst (StringMap.bindings m)))
+          | Dynamic _ -> conflict path CBuilder
+          | DynamicTail _ -> conflict path CTail
+        end
+
+  let register
+    : type p q i o e pr.
+      pr directory -> (_, pr, p, q, i, o, e) Service.t ->
+      (p -> q -> i -> (o, e) Answer.t Lwt.t) -> pr directory =
+    fun root s handler ->
+      let s = Service.Internal.to_service s in
+      let register
+        : type k. (pr, k) path -> (k -> q -> i -> (o, e) Answer.t Lwt.t) ->
+          pr directory =
+        fun path handler ->
+          let dir, insert = insert path root in
+          let rs =
+            let description : _ Description.service = {
+              meth = s.meth ;
+              path = describe_rpath [] path ;
+              description = s.description ;
+              query = describe_query (Resto.Internal.to_query s.types.query) ;
+              input = begin
+                match s.types.input with
+                | Service.No_input -> None
+                | Service.Input input -> Some (Encoding.schema input)
+              end ;
+              output = Encoding.schema s.types.output ;
+              error = Encoding.schema s.types.error ;
+            } in
+            let builder key = Lwt.return (Service {
+                types = s.types ;
+                handler = handler key ;
+              }) in
+            { meth = s.meth ; description ; builder } in
+          match dir with
+          | Empty ->
+              insert (Static { services = MethMap.singleton s.meth rs ;
+                               subdirs = None })
+          | Static ({ services ; _ } as dir)
+            when not (MethMap.mem s.meth services) ->
+              insert (Static { dir with services = MethMap.add s.meth rs services })
+          | Static _ -> conflict path (CService s.meth)
+          | Dynamic _ -> conflict path CBuilder
+          | DynamicTail _ -> conflict path CTail in
+      register s.path handler
+
+  let register =
+    (register
+     : _ -> (Resto.meth, _, _, _, _, _, _) Service.t ->
+     (_ -> _ -> _ -> (_, _) Answer.t Lwt.t) -> _
+     :> _ -> ([< Resto.meth ], _, _, _, _, _, _) Service.t ->
+     (_ -> _ -> _ -> [< (_, _) Answer.t ] Lwt.t) -> _)
+
+  let register_dynamic_directory
+    : type pr a pr.
+      ?descr:string ->
+      pr directory -> (pr, a) Path.path ->
+      (a -> a directory Lwt.t) -> pr directory =
+    fun ?descr root path builder ->
+      let path = Resto.Internal.to_path path in
+      let register
+        : type k. (pr, k) path -> (k -> k directory Lwt.t) -> pr directory =
+        fun path builder ->
+          let dir, insert = insert path root in
+          match dir with
+          | Empty ->
+              insert (Dynamic (descr, builder))
+          | Static ({ services ; subdirs = None }) ->
+              conflict path (CService (fst (MethMap.choose services)))
+          | Static ({ subdirs = Some _ ; _ }) -> conflict path CDir
+          | Dynamic _ -> conflict path CBuilder
+          | DynamicTail _ -> conflict path CTail in
+      register path builder
+
+  let register_describe_directory_service
+    : type pr.
+      pr directory ->
+      (pr, pr, _) Service.description_service ->
+      pr directory
+    = fun root service ->
+      let dir = ref root in
+      let lookup (args, path) { Description.recurse } () =
+        resolve [] root args path >>= function
+        | Error `Not_found
+        | Error `Cannot_parse_path _ ->
+            Lwt.return (`Not_found None)
+        | Ok (Dir (dir, arg)) ->
+            describe_directory ~recurse ~arg (Static dir) >>= function
+            | Static { services ; _ }
+              when not recurse && MethMap.is_empty services ->
+                Lwt.return (`Not_found None)
+            | d ->
+                Lwt.return (`Ok d)
+      in
+      dir := register root service lookup ;
+      !dir
+
+  (****************************************************************************
+   * Let's currify!
+   ****************************************************************************)
+
+  open Curry
+
+  let register0 root s f = register root s (curry Z f)
+  let register1 root s f = register root s (curry (S Z) f)
+  let register2 root s f = register root s (curry (S (S Z)) f)
+  let register3 root s f = register root s (curry (S (S (S Z))) f)
+  let register4 root s f = register root s (curry (S (S (S (S Z)))) f)
+  let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f)
+
+  let register_dynamic_directory1 ?descr root s f =
+    register_dynamic_directory ?descr root s (curry (S Z) f)
+  let register_dynamic_directory2 ?descr root s f =
+    register_dynamic_directory ?descr root s (curry (S (S Z)) f)
+  let register_dynamic_directory3 ?descr root s f =
+    register_dynamic_directory ?descr root s (curry (S (S (S Z))) f)
+
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.mli
new file mode 100644
index 000000000..f41c46f33
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/resto_directory.mli
@@ -0,0 +1,199 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Resto
+
+module Answer : sig
+
+  (** Return type for service handler *)
+  type ('o, 'e) t =
+    [ `Ok of 'o (* 200 *)
+    | `OkStream of 'o stream (* 200 *)
+    | `Created of string option (* 201 *)
+    | `No_content (* 204 *)
+    | `Unauthorized of 'e option (* 401 *)
+    | `Forbidden of 'e option (* 403 *)
+    | `Not_found of 'e option (* 404 *)
+    | `Conflict of 'e option (* 409 *)
+    | `Error of 'e option (* 500 *)
+    ]
+
+  and 'a stream = {
+    next: unit -> 'a option Lwt.t ;
+    shutdown: unit -> unit ;
+  }
+
+  val return: 'o -> ('o, 'e) t Lwt.t
+  val return_stream: 'o stream -> ('o, 'e) t Lwt.t
+
+end
+
+module Make (Encoding : ENCODING) : sig
+
+  module Service : (module type of (struct include Resto.MakeService(Encoding) end))
+
+  (** Possible error while registring services. *)
+  type step =
+    | Static of string
+    | Dynamic of Arg.descr
+    | DynamicTail of Arg.descr
+
+  type conflict =
+    | CService of meth | CDir | CBuilder | CTail
+    | CTypes of Arg.descr *
+                Arg.descr
+    | CType of Arg.descr * string list
+
+  type ('query, 'input, 'output, 'error) types = {
+    query : 'query Resto.Query.t ;
+    input : 'input Service.input ;
+    output : 'output Encoding.t ;
+    error : 'error Encoding.t ;
+  }
+
+  type registered_service =
+    | Service :
+        { types : ('q, 'i, 'o, 'e) types ;
+          handler : ('q -> 'i -> ('o, 'e) Answer.t Lwt.t) ;
+        } -> registered_service
+
+  (** Dispatch tree *)
+  type 'prefix t
+  type 'prefix directory = 'prefix t
+
+  type lookup_error =
+    [ `Not_found (* 404 *)
+    | `Method_not_allowed of meth list (* 405 *)
+    | `Cannot_parse_path of string list * Arg.descr * string (* 400 *)
+    ]
+
+  (** Resolve a service. *)
+  val lookup:
+    'prefix directory -> 'prefix ->
+    meth -> string list -> (registered_service, [> lookup_error ]) result Lwt.t
+
+  val allowed_methods:
+    'prefix directory -> 'prefix -> string list ->
+    (meth list, [> lookup_error ]) result Lwt.t
+
+  val transparent_lookup:
+    'prefix directory ->
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) Service.t ->
+    'params -> 'query -> 'input -> [> ('output, 'error) Answer.t ] Lwt.t
+
+  (** Empty tree *)
+  val empty: 'prefix directory
+
+  val map: ('a -> 'b Lwt.t) -> 'b directory -> 'a directory
+
+  val prefix: ('pr, 'p) Path.path -> 'p directory -> 'pr directory
+  val merge: 'a directory -> 'a directory -> 'a directory
+
+  exception Conflict of step list * conflict
+
+  (** Registring handler in service tree. *)
+  val register:
+    'prefix directory ->
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) Service.t ->
+    ('params -> 'query -> 'input -> [< ('output, 'error) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  (** Registring handler in service tree. Curryfied variant.  *)
+  val register0:
+    unit directory ->
+    ('m, unit, unit, 'q, 'i, 'o, 'e) Service.t ->
+    ('q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    unit directory
+
+  val register1:
+    'prefix directory ->
+    ('m, 'prefix, unit * 'a, 'q , 'i, 'o, 'e) Service.t ->
+    ('a -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  val register2:
+    'prefix directory ->
+    ('m, 'prefix, (unit * 'a) * 'b, 'q , 'i, 'o, 'e) Service.t ->
+    ('a -> 'b -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  val register3:
+    'prefix directory ->
+    ('m, 'prefix, ((unit * 'a) * 'b) * 'c, 'q , 'i, 'o, 'e) Service.t ->
+    ('a -> 'b -> 'c -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  val register4:
+    'prefix directory ->
+    ('m, 'prefix, (((unit * 'a) * 'b) * 'c) * 'd, 'q , 'i, 'o, 'e) Service.t ->
+    ('a -> 'b -> 'c -> 'd -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  val register5:
+    'prefix directory ->
+    ('m, 'prefix, ((((unit * 'a) * 'b) * 'c) * 'd) * 'f, 'q , 'i, 'o, 'e) Service.t ->
+    ('a -> 'b -> 'c -> 'd -> 'f -> 'q -> 'i -> [< ('o, 'e) Answer.t ] Lwt.t) ->
+    'prefix directory
+
+  (** Registring dynamic subtree. *)
+  val register_dynamic_directory:
+    ?descr:string ->
+    'prefix directory ->
+    ('prefix, 'a) Path.path -> ('a -> 'a directory Lwt.t) ->
+    'prefix directory
+
+  (** Registring dynamic subtree. (Curryfied variant) *)
+  val register_dynamic_directory1:
+    ?descr:string ->
+    'prefix directory ->
+    ('prefix, unit * 'a) Path.path ->
+    ('a -> (unit * 'a) directory Lwt.t) ->
+    'prefix directory
+
+  val register_dynamic_directory2:
+    ?descr:string ->
+    'prefix directory ->
+    ('prefix, (unit * 'a) * 'b) Path.path ->
+    ('a -> 'b -> ((unit * 'a) * 'b) directory Lwt.t) ->
+    'prefix directory
+
+  val register_dynamic_directory3:
+    ?descr:string ->
+    'prefix directory ->
+    ('prefix, ((unit * 'a) * 'b) * 'c) Path.path ->
+    ('a -> 'b -> 'c -> (((unit * 'a) * 'b) * 'c) directory Lwt.t) ->
+    'prefix directory
+
+  (** Registring a description service. *)
+  val register_describe_directory_service:
+    'prefix directory ->
+    ('prefix, 'prefix, 'error) Service.description_service ->
+    'prefix directory
+
+  val describe_directory:
+    recurse:bool ->
+    ?arg:'a ->
+    'a directory -> Encoding.schema Resto.Description.directory Lwt.t
+
+  (**/**)
+
+  module Curry: sig
+
+    type (_,_,_,_,_,_) conv =
+      | Z : (unit, 'g, 'g, unit, 'f, 'f) conv
+      | S : ('t, 'g, 'b * 's, 'rt, 'f, 'r) conv ->
+        ('t * 'b, 'g, 's, 'a * 'rt, 'a -> 'f, 'r) conv
+    val curry : ('a, 'b, unit, 'b, 'c, 'd) conv -> 'c -> 'a -> 'd
+
+  end
+
+  (**/**)
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/directory.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/directory.ml
new file mode 100644
index 000000000..107f60c54
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/directory.ml
@@ -0,0 +1,47 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Services
+
+include Resto_directory.Make(Resto_json.Encoding)
+
+let rec repeat i json =
+  if i <= 0 then []
+  else json :: repeat (i-1) json
+
+let dir = empty
+let dir =
+  register1 dir repeat_service
+    (fun i () json -> Lwt.return (`Ok (`A (repeat i json))))
+let dir =
+  register1 dir add_service
+    (fun i () j -> Lwt.return (`Ok (i+j)))
+let dir =
+  register2 dir alternate_add_service
+    (fun i j () () -> Lwt.return (`Ok (float_of_int i+.j)))
+let dir =
+  register dir alternate_add_service'
+    (fun (((),i),j) () () -> Lwt.return (`Ok (i+ int_of_float j)))
+let dir =
+  register dir dummy_service
+    (fun ((((((((),_a), _b), _c), _d), _e), _f), _g) () () -> Lwt.return (`Ok ()))
+
+let dir =
+  register_dynamic_directory1 dir prefix_dir1
+    (fun _ ->
+       let prefixed_dir = empty in
+       let prefixed_dir =
+         register2 prefixed_dir minus_service
+           (fun i j () () -> Lwt.return (`Ok (i -. float_of_int j))) in
+       Lwt.return prefixed_dir)
+
+let dir =
+  register_describe_directory_service
+    dir describe_service
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/dune
new file mode 100644
index 000000000..df50743d6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/dune
@@ -0,0 +1,12 @@
+(executable
+ (name resto_test)
+ (flags (:standard -safe-string))
+ (libraries ocplib-resto-directory ocplib-resto-json lwt.unix))
+
+(alias
+ (name runtest_resto)
+ (action (run %{exe:resto_test.exe})))
+
+(alias
+ (name runtest)
+ (deps (alias runtest_resto)))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml
new file mode 100644
index 000000000..fa095641e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/resto_test.ml
@@ -0,0 +1,135 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Services
+open Directory
+open Resto_directory
+open Lwt.Infix
+
+let () =
+  Lwt_main.run begin
+    allowed_methods dir () ["foo";"3";"repeat"] >>= function
+    | Ok [`POST] -> Lwt.return_unit
+    | _ -> assert false
+  end
+
+let () =
+  Lwt_main.run begin
+    allowed_methods dir () ["bar";"3";"4";"add"] >>= function
+    | Ok [`GET;`POST] -> Lwt.return_unit
+    | _ -> assert false
+  end
+
+module Test(Request : sig
+    val request:
+      ('meth, unit, 'params, 'query, 'input, 'output, 'error) Service.t ->
+      'params  -> 'query -> 'input -> [> ('output, 'error) Answer.t ] Lwt.t
+  end) = struct
+
+  let () =
+    Lwt_main.run begin
+      Request.request describe_service
+        ((), ["foo"; "3"]) { recurse = true } () >>= function
+      | `Ok dir ->
+          Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ;
+          Lwt.return_unit
+      | _ -> assert false
+    end
+
+  let () =
+    Lwt_main.run begin
+      Request.request describe_service
+        ((), ["bar"; "3" ; "2." ; "add"]) { recurse = false } () >>= function
+      | `Ok dir ->
+          Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ;
+          Lwt.return_unit ;
+      | _ -> assert false
+    end
+
+  let () =
+    Lwt_main.run begin
+      Request.request describe_service ((), []) { recurse = true } () >>= function
+      | `Ok dir ->
+          Format.printf "@[<v>%a@]@." Resto.Description.pp_print_directory dir ;
+          Lwt.return_unit ;
+      | _ -> assert false
+    end
+
+  let () =
+    let test service args arg expected =
+      Lwt_main.run (Request.request service args () arg) = (`Ok expected) in
+    assert (test repeat_service ((), 3) (`A []) (`A (repeat 3 (`A [])))) ;
+    assert (test add_service ((), 2) 3 5) ;
+    assert (test alternate_add_service (((), 1), 2.5) () 3.5) ;
+    assert (test real_minus_service1 (((), 2.5), 1) () 1.5) ;
+    assert (test alternate_add_service' (((), 1), 2.) () 3) ;
+    ()
+
+end
+
+let split_path path =
+  let l = String.length path in
+  let rec do_slashes acc i =
+    if i >= l then
+      List.rev acc
+    else if String.get path i = '/' then
+      do_slashes acc (i + 1)
+    else
+      do_component acc i i
+  and do_component acc i j =
+    if j >= l then
+      if i = j then
+        List.rev acc
+      else
+        List.rev (String.sub path i (j - i) :: acc)
+    else if String.get path j = '/' then
+      do_slashes (String.sub path i (j - i) :: acc) j
+    else
+      do_component acc i (j + 1) in
+  do_slashes [] 0
+
+module Faked = Test(struct
+    (** Testing faked client/server communication. *)
+    let request (type i) (service: (_,_,_,_,i,_,_) Service.t) params query arg =
+      let { Service.meth ; uri ; input } =
+        Service.forge_request service params query in
+      Format.eprintf "\nREQUEST: %a@." Uri.pp_hum uri ;
+      let path = split_path (Uri.path uri) in
+      let query =
+        List.map
+          (fun (n,vs) -> (n, String.concat "," vs))
+          (Uri.query uri) in
+      let json =
+        match input with
+        | Service.No_input -> `O []
+        | Service.Input input -> Json_encoding.construct input arg in
+      lookup dir () meth path >>= function
+      | Ok (Service s) -> begin
+          let query = Resto.Query.parse s.types.query query in
+          begin
+            match s.types.input with
+            | Service.No_input -> s.handler query ()
+            | Service.Input input ->
+                s.handler query @@ Json_encoding.destruct input json
+          end >>= function
+          | `Ok res ->
+              let json = Json_encoding.construct s.types.output res in
+              Lwt.return (`Ok (Json_encoding.destruct (Service.output_encoding service) json))
+          | _ -> failwith "Unexpected lwt result (1)"
+        end
+      | _ -> failwith "Unexpected lwt result (2)"
+  end)
+
+module Transparent = Test(struct
+    let request x = transparent_lookup dir x
+  end)
+
+let () =
+  Printf.printf "\n### OK Resto ###\n\n%!"
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/services.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/services.ml
new file mode 100644
index 000000000..c6aa06e5a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-directory/test/services.ml
@@ -0,0 +1,75 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+open Resto
+module Service = MakeService(Resto_json.Encoding)
+open Service
+
+(** Shared part *)
+
+let repeat_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.any_ezjson_value
+    ~output:Json_encoding.any_ezjson_value
+    ~error:Json_encoding.empty
+    Path.(root / "foo" /: Arg.int / "repeat")
+
+let add_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.int
+    ~output:Json_encoding.int
+    ~error:Json_encoding.empty
+    Path.(root / "foo" /: Arg.int / "add")
+
+let alternate_add_service =
+  get_service
+    ~query:Query.empty
+    ~output:Json_encoding.float
+    ~error:Json_encoding.empty
+    Path.(root / "bar" /: Arg.int /: Arg.float / "add")
+
+let alternate_add_service' =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.null
+    ~output:Json_encoding.int
+    ~error:Json_encoding.empty
+    Path.(root / "bar" /: Arg.int /: Arg.float / "add")
+
+let minus_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.null
+    ~output:Json_encoding.float
+    ~error:Json_encoding.empty
+    Path.(open_root /: Arg.int / "minus")
+
+let describe_service =
+  description_service Json_encoding.empty Path.(root / "describe")
+
+let dummy_service =
+  post_service
+    ~query:Query.empty
+    ~input:Json_encoding.null
+    ~output:Json_encoding.null
+    ~error:Json_encoding.empty
+    Path.(root / "a" / "path" / "long" / "enough" /
+          "for" / "<hov>" / "to" / "trigger"
+          /: Arg.float /: Arg.float /: Arg.float /: Arg.float
+          /: Arg.float /: Arg.float /: Arg.float)
+
+let prefix_dir1 = Path.(root / "tartine" /: Arg.float / "chaussure")
+
+
+(** Client only *)
+
+let real_minus_service1 = Service.prefix prefix_dir1 minus_service
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/dune
new file mode 100644
index 000000000..9c7d69280
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/dune
@@ -0,0 +1,6 @@
+(library
+ (name resto_json)
+ (public_name ocplib-resto-json)
+ (libraries ocplib-json-typed ocplib-json-typed-bson ocplib-resto)
+ (flags (:standard -safe-string))
+ (wrapped false))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/ocplib-resto-json.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/ocplib-resto-json.opam
new file mode 100644
index 000000000..1b7265a41
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/ocplib-resto-json.opam
@@ -0,0 +1,23 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "ocplib-resto" {= "dev" }
+  "ocplib-json-typed-bson" { >= "0.6" }
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.ml
new file mode 100644
index 000000000..b49fc7232
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.ml
@@ -0,0 +1,181 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Encoding = struct
+
+  include Json_encoding
+  type 'a t = 'a encoding
+  type schema = Json_schema.schema
+  let untyped = obj1 (req "untyped" string)
+  let conv f g t = conv ~schema:(schema t) f g t
+
+  module StringMap = Map.Make(String)
+
+  let arg_encoding =
+    let open Json_encoding in
+    conv
+      (fun {Resto.Arg.name; descr} -> (name, descr))
+      (fun (name, descr) -> {name; descr})
+      (obj2 (req "name" string) (opt "descr" string))
+
+  open Resto.Description
+
+  let meth_encoding =
+    Json_encoding.string_enum
+      [ "GET", `GET ;
+        "POST", `POST ;
+        "DELETE", `DELETE ;
+        "PUT", `PUT ;
+        "PATCH", `PATCH ]
+
+  let path_item_encoding =
+    let open Json_encoding in
+    union [
+      case string
+        (function PStatic s -> Some s | _ -> None)
+        (fun s -> PStatic s) ;
+      case arg_encoding
+        (function PDynamic s -> Some s | _ -> None)
+        (fun s -> PDynamic s) ;
+    ]
+
+  let query_kind_encoding =
+    let open Json_encoding in
+    union [
+      case
+        (obj1 (req "single" arg_encoding))
+        (function Single s -> Some s | _ -> None)
+        (fun s -> Single s) ;
+      case
+        (obj1 (req "optional" arg_encoding))
+        (function Optional s -> Some s | _ -> None)
+        (fun s -> Optional s) ;
+      case
+        (obj1 (req "flag" empty))
+        (function Flag -> Some () | _ -> None)
+        (fun () -> Flag) ;
+      case
+        (obj1 (req "multi" arg_encoding))
+        (function Multi s -> Some s | _ -> None)
+        (fun s -> Multi s) ;
+    ]
+
+  let query_item_encoding =
+    let open Json_encoding in
+    conv
+      (fun {name ; description ; kind} -> (name, description, kind))
+      (fun (name, description, kind) -> {name ; description ; kind})
+      (obj3
+         (req "name" string)
+         (opt "description" string)
+         (req "kind" query_kind_encoding))
+
+  let service_descr_encoding =
+    let open Json_encoding in
+    conv
+      (fun { meth ; path ; description ; query ; input ; output ; error } ->
+         (meth, path, description, query, input, output, error))
+      (fun (meth, path, description, query, input, output, error) ->
+         { meth ; path ; description ; query ; input ; output ; error })
+      (obj7
+         (req "meth" meth_encoding)
+         (req "path" (list path_item_encoding))
+         (opt "description" string)
+         (req "query" (list query_item_encoding))
+         (opt "input" any_schema)
+         (req "output" any_schema)
+         (req "erro" any_schema))
+
+  let directory_descr_encoding =
+    let open Json_encoding in
+    mu "service_tree" @@ fun directory_descr_encoding ->
+    let static_subdirectories_descr_encoding =
+      union [
+        case (obj1 (req  "suffixes"
+                      (list (obj2 (req "name" string)
+                               (req "tree" directory_descr_encoding)))))
+          (function Suffixes map ->
+             Some (Resto.StringMap.bindings map) | _ -> None)
+          (fun m ->
+             let add acc (n,t) = Resto.StringMap.add n t acc in
+             Suffixes (List.fold_left add Resto.StringMap.empty m)) ;
+        case (obj1 (req "dynamic_dispatch"
+                      (obj2
+                         (req "arg" arg_encoding)
+                         (req "tree" directory_descr_encoding))))
+          (function Arg (ty, tree) -> Some (ty, tree) | _ -> None)
+          (fun (ty, tree) -> Arg (ty, tree))
+      ] in
+
+    let static_directory_descr_encoding =
+      conv
+        (fun { services ; subdirs } ->
+           let find s =
+             try Some (Resto.MethMap.find s services) with Not_found -> None in
+           (find `GET, find `POST, find `DELETE,
+            find `PUT, find `PATCH, subdirs))
+        (fun (get, post, delete, put, patch, subdirs) ->
+           let add meth s services =
+             match s with
+             | None -> services
+             | Some s -> Resto.MethMap.add meth s services in
+           let services =
+             Resto.MethMap.empty
+             |> add `GET get
+             |> add `POST post
+             |> add `DELETE delete
+             |> add `PUT put
+             |> add `PATCH patch in
+           { services ; subdirs })
+        (obj6
+           (opt "get_service" service_descr_encoding)
+           (opt "post_service" service_descr_encoding)
+           (opt "delete_service" service_descr_encoding)
+           (opt "put_service" service_descr_encoding)
+           (opt "patch_service" service_descr_encoding)
+           (opt "subdirs" static_subdirectories_descr_encoding)) in
+    union [
+      case (obj1 (req "static" static_directory_descr_encoding))
+        (function Static descr -> Some descr | _ -> None)
+        (fun descr -> Static descr) ;
+      case (obj1 (req "dynamic" (option string)))
+        (function Dynamic descr -> Some descr | _ -> None)
+        (fun descr -> Dynamic descr) ;
+    ]
+
+  let description_request_encoding =
+    conv
+      (fun { recurse } -> recurse)
+      (function recurse -> { recurse })
+      (obj1 (dft "recursive" bool false))
+
+  let description_answer_encoding = directory_descr_encoding
+
+end
+
+module type VALUE = sig
+  type t
+  type 'a encoding
+  val construct: 'a encoding -> 'a -> t
+  val destruct: 'a encoding -> t -> 'a
+end
+
+module Ezjsonm = struct
+  type t = Json_repr.Ezjsonm.value
+  let construct = Json_encoding.construct
+  let destruct = Json_encoding.destruct
+end
+
+module Bson = struct
+  open Json_repr_bson
+  type t = Repr.value
+  let construct = Json_encoding.construct
+  let destruct = Json_encoding.destruct
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.mli
new file mode 100644
index 000000000..a3dc1213a
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto-json/resto_json.mli
@@ -0,0 +1,28 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+module Encoding : Resto.ENCODING
+  with type 'a t = 'a Json_encoding.encoding
+   and type schema = Json_schema.schema
+
+module type VALUE = sig
+  type t
+  type 'a encoding
+  val construct: 'a encoding -> 'a -> t
+  val destruct: 'a encoding -> t -> 'a
+end
+
+module Ezjsonm : VALUE
+  with type t = Json_repr.Ezjsonm.value
+   and type 'a encoding := 'a Encoding.t
+
+module Bson : VALUE
+  with type t = Json_repr_bson.bson
+   and type 'a encoding := 'a Encoding.t
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/dune b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/dune
new file mode 100644
index 000000000..7d22ee828
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/dune
@@ -0,0 +1,6 @@
+(library
+ (name resto)
+ (public_name ocplib-resto)
+ (flags (-w -30 -safe-string))
+ (libraries uri)
+ (wrapped false))
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/ocplib-resto.opam b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/ocplib-resto.opam
new file mode 100644
index 000000000..0714b768e
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/ocplib-resto.opam
@@ -0,0 +1,22 @@
+version: "dev"
+opam-version: "2.0"
+maintainer: "Grégoire Henry <gregoire.henry@tezos.com>"
+authors: "Grégoire Henry <gregoire.henry@tezos.com>"
+license: "LGPL-2.1-with-OCaml-exception"
+homepage: "https://github.com/OCamlPro/ocplib-resto"
+bug-reports: "https://github.com/OCamlPro/ocplib-resto/issues"
+dev-repo: "git+https://github.com/OCamlPro/ocplib-resto"
+synopsis: "A minimal OCaml library for type-safe HTTP/JSON RPCs"
+
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+run-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]
+
+depends: [
+  "ocamlfind" {build}
+  "dune" {build}
+  "uri"
+]
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.ml b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.ml
new file mode 100644
index 000000000..c463b25c6
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.ml
@@ -0,0 +1,738 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+
+let string_of_meth = function
+  | `GET -> "GET"
+  | `POST -> "POST"
+  | `DELETE -> "DELETE"
+  | `PUT -> "PUT"
+  | `PATCH -> "PATCH"
+
+let meth_of_string = function
+  | "GET" -> Some `GET
+  | "POST" -> Some `POST
+  | "DELETE" -> Some `DELETE
+  | "PUT" -> Some `PUT
+  | "PATCH" -> Some `PATCH
+  | _ -> None
+
+module MethMap = Map.Make(struct type t = meth let compare = compare end)
+module StringMap = Map.Make(String)
+
+type (_, _) eq = Eq : ('a, 'a) eq
+
+module Internal = struct
+
+  module Ty = struct
+
+    type 'a witness = ..
+    exception Not_equal
+    module type Ty = sig
+      type t val witness : t witness
+      val eq: 'a witness -> ('a, t) eq
+    end
+    type 'a id = (module Ty with type t = 'a)
+    let new_id (type a) () =
+      let module Ty = struct
+        type t = a
+        type 'a witness += Ty : t witness
+        let witness = Ty
+        let eq (type b) : b witness -> (b, t) eq =
+          function Ty -> Eq | _ -> raise Not_equal
+      end in
+      (module Ty : Ty with type t = a)
+    let eq : type a b. a id -> b id -> (a, b) eq =
+      fun (module TyA) (module TyB) ->  TyB.eq TyA.witness
+
+  end
+
+  type descr = {
+    name: string ;
+    descr: string option ;
+  }
+
+  type 'a arg = {
+    id: 'a Ty.id;
+    destruct: string -> ('a, string) result ;
+    construct: 'a -> string ;
+    descr: descr ;
+  }
+
+  let from_arg x = x
+  let to_arg x = x
+
+  type (_,_) path =
+    | Root : ('rkey, 'rkey) path
+    | Static : ('rkey, 'key) path * string -> ('rkey, 'key) path
+    | Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path
+    | DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path
+
+  let rec subst0 : type a b. (a, a) path -> (b, b) path = function
+    | Root -> Root
+    | Static (path, name) -> Static (subst0 path, name)
+    | Dynamic (path, arg) -> assert false (* impossible *)
+    | DynamicTail (path, arg) -> assert false (* impossible *)
+
+  let rec subst1 : type a b c. (a, a * c) path -> (b, b * c) path = function
+    | Root -> assert false (* impossible *)
+    | Static (path, name) -> Static (subst1 path, name)
+    | Dynamic (path, arg) -> Dynamic (subst0 path, arg)
+    | DynamicTail (path, arg) -> DynamicTail (subst0 path, arg)
+
+  let rec subst2 : type a b c d. (a, (a * c) * d) path -> (b, (b * c) * d) path = function
+    | Root -> assert false (* impossible *)
+    | Static (path, name) -> Static (subst2 path, name)
+    | Dynamic (path, arg) -> Dynamic (subst1 path, arg)
+    | DynamicTail (path, arg) -> DynamicTail (subst1 path, arg)
+
+  let rec subst3 : type a b c d e. (a, ((a * c) * d) * e) path -> (b, ((b * c) * d) * e) path = function
+    | Root -> assert false (* impossible *)
+    | Static (path, name) -> Static (subst3 path, name)
+    | Dynamic (path, arg) -> Dynamic (subst2 path, arg)
+    | DynamicTail (path, arg) -> DynamicTail (subst2 path, arg)
+
+  let from_path x = x
+  let to_path x = x
+
+  type 'a query =
+    (* inspired from Irmin.Ty.record. *)
+    | Fields: ('a, 'b) query_fields * 'b -> 'a query
+
+  and ('a, 'b) query_fields =
+    | F0: ('a, 'a) query_fields
+    | F1: ('a, 'b) query_field * ('a, 'c) query_fields ->
+      ('a, 'b -> 'c) query_fields
+
+  and ('a, 'b) query_field =
+    | Single : {
+        name : string ; description : string option ;
+        ty : 'b arg ; default : 'b ; get : 'a -> 'b ;
+      } -> ('a, 'b) query_field
+    | Opt : {
+        name : string ; description : string option ;
+        ty : 'b arg ; get : 'a -> 'b option ;
+      } -> ('a, 'b option) query_field
+    | Flag : {
+        name : string ; description : string option ;
+        get : 'a -> bool ;
+      } -> ('a, bool) query_field
+    | Multi : {
+        name : string ; description : string option ;
+        ty : 'b arg ; get : 'a -> 'b list ;
+      } -> ('a, 'b list) query_field
+
+  type query_kind =
+    | Single of descr
+    | Optional of descr
+    | Flag
+    | Multi of descr
+
+  let field_name (type t) : (_,t) query_field -> _ = function
+    | Single { name } -> name
+    | Opt { name } -> name
+    | Flag { name } -> name
+    | Multi { name } -> name
+  let field_description (type t) : (_,t) query_field -> _ = function
+    | Single { description } -> description
+    | Opt { description } -> description
+    | Flag { description } -> description
+    | Multi { description } -> description
+  let field_kind (type t) : (_,t) query_field -> query_kind = function
+    | Single { ty ; _ } -> Single ty.descr
+    | Opt { ty ; _ } -> Optional ty.descr
+    | Flag _ -> Flag
+    | Multi { ty ; _ } -> Multi ty.descr
+
+  let from_query x = x
+  let to_query x = x
+
+end
+
+open Internal
+
+module Arg = struct
+
+  type descr = Internal.descr = {
+    name: string ;
+    descr: string option ;
+  }
+  type 'a t = 'a Internal.arg
+  type 'a arg = 'a t
+
+  let make ?descr ~name ~destruct ~construct () =
+    let id = Ty.new_id () in
+    let descr = { name ; descr } in
+    { descr ; id ; construct ; destruct }
+
+  let like arg ?descr name =
+    { arg with id = Ty.new_id () ; descr = { name ; descr } }
+
+  let descr (ty: 'a arg) = ty.descr
+
+  let ignore : unit arg =
+    let destruct _ = Ok () in
+    let construct () = "" in
+    make ~name:"unit" ~destruct ~construct ()
+  let bool : bool arg =
+    let bool_of_string s =
+      match String.lowercase_ascii s with
+      | "false" | "no" -> Ok false
+      | _ -> Ok true in
+    let string_of_bool = function
+      | true -> "yes"
+      | false -> "no" in
+    make ~name:"bool" ~destruct:bool_of_string ~construct:string_of_bool ()
+  let int =
+    let int_of_string s =
+      try Ok (int_of_string s)
+      with Failure _ ->
+        Error (Printf.sprintf "Cannot parse integer value: %S." s) in
+    make ~name:"int" ~destruct:int_of_string ~construct:string_of_int ()
+  let float =
+    let float_of_string s =
+      try Ok (float_of_string s)
+      with Failure _ ->
+        Error (Printf.sprintf "Cannot parse float value: %S." s) in
+    make ~name:"float" ~destruct:float_of_string ~construct:string_of_float ()
+  let int32 =
+    let int32_of_string s =
+      try Ok (Int32.of_string s)
+      with Failure _ ->
+        Error (Printf.sprintf "Cannot parse int32 value: %S." s) in
+    make ~name:"int32" ~destruct:int32_of_string ~construct:Int32.to_string ()
+  let int64 =
+    let int64_of_string s =
+      try Ok (Int64.of_string s)
+      with Failure _ ->
+        Error (Printf.sprintf "Cannot parse int64 value: %S." s) in
+    make ~name:"int64" ~destruct:int64_of_string ~construct:Int64.to_string ()
+  let string =
+    make ~name:"string" ~destruct:(fun x -> Ok x) ~construct:(fun x -> x) ()
+
+  let eq a1 a2 =
+    try Some (Ty.eq a1.id a2.id)
+    with Internal.Ty.Not_equal -> None
+
+end
+
+module Path = struct
+
+  type ('a, 'b) t = ('a, 'b) Internal.path
+  type ('a, 'b) path = ('a, 'b) Internal.path
+
+  type 'prefix context = ('prefix, 'prefix) path
+
+  let root = Root
+  let open_root = Root
+
+  let add_suffix (type p pr) (path : (p, pr) path) name =
+    match path with
+    | DynamicTail _ -> invalid_arg "Resto.Path.add_suffix"
+    | path -> Static (path, name)
+
+  let add_arg (type p pr) (path : (p, pr) path)  arg =
+    match path with
+    | DynamicTail _ -> invalid_arg "Resto.Path.add_arg"
+    | path -> Dynamic (path, arg)
+
+  let add_final_args (type p pr) (path : (p, pr) path)  arg =
+    match path with
+    | DynamicTail _ -> invalid_arg "Resto.Path.add_final_arg"
+    | path -> DynamicTail (path, arg)
+
+  let prefix
+    : type p pr a. (pr, a) path -> (a, p) path -> (pr, p) path
+    = fun p1 p2 ->
+      let rec prefix
+        : type pr a k.
+          (pr, a) path -> (a, k) path -> (pr, k) path
+        = fun p1 p2 ->
+          match p2 with
+          | Root -> p1
+          | Static (path, name) -> add_suffix (prefix p1 path) name
+          | Dynamic (path, arg) -> add_arg (prefix p1 path) arg
+          | DynamicTail (path, arg) -> add_final_args (prefix p1 path) arg
+      in
+      match p1 with
+      | DynamicTail _ -> invalid_arg "Resto.Path.prefix"
+      | _ -> prefix p1 p2
+
+  let (/) = add_suffix
+  let (/:) = add_arg
+  let (/:*) = add_final_args
+
+  let subst0 = Internal.subst0
+  let subst1 = Internal.subst1
+  let subst2 = Internal.subst2
+  let subst3 = Internal.subst3
+
+end
+
+module Query = struct
+
+  type 'a t = 'a Internal.query
+  type 'a query = 'a Internal.query
+  type ('a, 'b) field = ('a, 'b) Internal.query_field
+
+  type ('a, 'b, 'c) open_query =
+    ('a, 'c) query_fields -> 'b * ('a, 'b) query_fields
+
+  let field ?descr name ty default get : (_,_) query_field =
+    Single { name; description = descr ; ty ; default ; get }
+
+  let opt_field ?descr name ty get : (_,_) query_field =
+    Opt { name; description = descr ; ty ; get }
+
+  let flag ?descr name get : (_,_) query_field =
+    Flag { name; description = descr ; get }
+
+  let multi_field ?descr name ty get : (_,_) query_field =
+    Multi { name; description = descr ; ty ; get }
+
+  let query : 'b -> ('a, 'b, 'b) open_query =
+    fun c fs -> c, fs
+
+  let app : type a b c d.
+    (a, b, c -> d) open_query -> (a, c) query_field -> (a, b, d) open_query
+    = fun r f fs ->
+      let c, fs = r (F1 (f, fs)) in
+      c, fs
+
+  let seal : type a b. (a, b, a) open_query -> a t =
+    fun r ->
+      let c, fs = r F0 in
+      Fields (fs, c)
+
+  let (|+) = app
+
+  let empty = Fields (F0 , ())
+
+  type 'a efield = Field: ('a, 'b) query_field -> 'a efield
+  let fold_fields (type fs) ~f ~init fs =
+    let rec loop : type f. _ -> (fs, f) query_fields -> _ = fun acc -> function
+      | F0 -> acc
+      | F1 (field, fs) -> loop (f acc (Field field)) fs in
+    loop init fs
+
+  type 'a parsed_field =
+    | Parsed: ('a, 'b) query_field * 'b option -> 'a parsed_field
+
+  let rec rebuild
+    : type fs f. _ -> (fs, f) query_fields -> f -> fs
+    = fun map fs f ->
+      match fs with
+      | F0 -> f
+      | F1 (Single field, fs) -> begin
+          match StringMap.find field.name map with
+          | Parsed (Single field', v) ->
+              let Eq = Ty.eq field.ty.id field'.ty.id in
+              let v = match v with None -> field.default | Some v -> v in
+              rebuild map fs (f v)
+          | Parsed _ -> assert false
+        end
+      | F1 (Opt field, fs) -> begin
+          match StringMap.find field.name map with
+          | Parsed (Opt field', v) ->
+              let Eq = Ty.eq field.ty.id field'.ty.id in
+              let v = match v with None -> None | Some v -> v in
+              rebuild map fs (f v)
+          | Parsed _ -> assert false
+        end
+      | F1 (Flag field, fs) -> begin
+          match StringMap.find field.name map with
+          | Parsed (Flag _, v) ->
+              let v = match v with None -> false | Some v -> v in
+              rebuild map fs (f v)
+          | Parsed _ -> assert false
+        end
+      | F1 (Multi field, fs) -> begin
+          match StringMap.find field.name map with
+          | Parsed (Multi field', v) ->
+              let Eq = Ty.eq field.ty.id field'.ty.id in
+              let v = match v with None -> [] | Some v -> v in
+              rebuild map fs (f v)
+          | Parsed _ -> assert false
+        end
+
+  exception Invalid of string
+  type untyped = (string * string) list
+  let parse (Fields (fs, f)) =
+    let fields =
+      fold_fields
+        ~f:(fun map (Field f) ->
+            StringMap.add (field_name f) (Parsed (f, None)) map)
+        ~init:StringMap.empty
+        fs in
+    fun query ->
+      let fail fmt = Format.kasprintf (fun s -> raise (Invalid s)) fmt in
+      let fields =
+        List.fold_left
+          begin fun fields (name, value) ->
+            match StringMap.find name fields with
+            | exception Not_found -> fields
+            | (Parsed (Single f, Some _)) ->
+                fail "Duplicate argument '%s' in query string." name
+            | (Parsed (Opt f, Some _)) ->
+                fail "Duplicate argument '%s' in query string." name
+            | (Parsed (Flag f, Some _)) ->
+                fail "Duplicate argument '%s' in query string." name
+            | (Parsed (Single f, None)) -> begin
+                match f.ty.destruct value with
+                | Error error ->
+                    fail "Failed to parse argument '%s' (%S): %s"
+                      name value error
+                | Ok v -> StringMap.add name (Parsed (Single f, Some v)) fields
+              end
+            | (Parsed (Opt f, None)) -> begin
+                match f.ty.destruct value with
+                | Error error ->
+                    fail "Failed to parse argument '%s' (%S): %s"
+                      name value error
+                | Ok v -> StringMap.add name (Parsed (Opt f, Some (Some v))) fields
+              end
+            | (Parsed (Flag f, None)) -> begin
+                let v =
+                  match String.lowercase_ascii value with
+                  | "no" | "false" -> false
+                  | _ -> true
+                in
+                StringMap.add name (Parsed (Flag f, Some v)) fields
+              end
+            | (Parsed (Multi f, previous)) -> begin
+                match f.ty.destruct value with
+                | Error error ->
+                    fail "Failed to parse argument '%s' (%S): %s"
+                      name value error
+                | Ok v ->
+                    let v =
+                      match previous with
+                      | None -> [v]
+                      | Some l -> v :: l in
+                    StringMap.add name (Parsed (Multi f, Some v)) fields
+              end
+          end
+          fields query in
+      rebuild fields fs f
+
+end
+
+module Description = struct
+
+  type request = {
+    recurse: bool ;
+  }
+
+  let request_query =
+    let open Query in
+    query (fun recurse -> { recurse })
+    |+ field "recurse" Arg.bool false (fun t -> t.recurse)
+    |> seal
+
+  type nonrec query_kind = query_kind =
+    | Single of Arg.descr
+    | Optional of Arg.descr
+    | Flag
+    | Multi of Arg.descr
+
+  type 'schema service = {
+    description: string option ;
+    path: path_item list ;
+    meth: meth ;
+    query: query_item list ;
+    input: 'schema option ;
+    output: 'schema ;
+    error: 'schema ;
+  }
+
+  and path_item =
+    | PStatic of string
+    | PDynamic of Arg.descr
+    | PDynamicTail of Arg.descr
+
+  and query_item = {
+    name: string ;
+    description: string option ;
+    kind: query_kind ;
+  }
+
+  type 'schema directory =
+    | Empty
+    | Static of 'schema static_directory
+    | Dynamic of string option
+
+  and 'schema static_directory = {
+    services: 'schema service MethMap.t ;
+    subdirs: 'schema static_subdirectories option ;
+  }
+
+  and 'schema static_subdirectories =
+    | Suffixes of 'schema directory Map.Make(String).t
+    | Arg of Arg.descr * 'schema directory
+
+  let rec pp_print_directory ppf =
+    let open Format in
+    function
+    | Empty ->
+        fprintf ppf "<empty>"
+    | Static dir ->
+        fprintf ppf "@[%a@]" pp_print_static_directory dir
+    | Dynamic None ->
+        fprintf ppf "<dyntree>"
+    | Dynamic (Some descr) ->
+        fprintf ppf "<dyntree> : %s" descr
+
+  and pp_print_static_directory ppf =
+    let open Format in
+    function
+    | { services ; subdirs = None } when MethMap.is_empty services ->
+        fprintf ppf "{}"
+    | { services ; subdirs = None } ->
+        fprintf ppf "@[<v>%a@]"
+          pp_print_dispatch_services services
+    | { services ; subdirs = Some subdirs } when MethMap.is_empty services ->
+        fprintf ppf "%a"
+          pp_print_static_subdirectories subdirs
+    | { services ; subdirs = Some subdirs } ->
+        fprintf ppf "@[<v>%a@ %a@]"
+          pp_print_dispatch_services services
+          pp_print_static_subdirectories subdirs
+
+  and pp_print_static_subdirectories ppf =
+    let open Format in
+    function
+    | Suffixes map ->
+        let print_binding ppf (name, tree) =
+          fprintf ppf "@[<hov 2>%s:@ %a@]"
+            name pp_print_directory tree in
+        fprintf ppf "@[<v>%a@]"
+          (pp_print_list ~pp_sep:pp_print_cut print_binding)
+          (StringMap.bindings map)
+    | Arg (arg, tree) ->
+        fprintf ppf "@[<hov 2>[:%s:]@ @[%a@]@]"
+          (arg.name) pp_print_directory tree
+
+  and pp_print_dispatch_services ppf services =
+    MethMap.iter
+      begin fun meth s ->
+        match s with
+        | { description = None ; meth ; _ } ->
+            Format.fprintf ppf "<%s>" (string_of_meth meth)
+        | { description = Some descr ; meth ; _ } ->
+            Format.fprintf ppf "<%s> : %s" (string_of_meth meth) descr
+      end
+      services
+
+end
+
+module type ENCODING = sig
+  type 'a t
+  type schema
+  val unit : unit t
+  val untyped : string t
+  val conv : ('a -> 'b) -> ('b -> 'a) -> 'b t -> 'a t
+  val schema : ?definitions_path:string -> 'a t -> schema
+  val description_request_encoding : Description.request t
+  val description_answer_encoding : schema Description.directory t
+end
+
+module MakeService(Encoding : ENCODING) = struct
+
+  module Internal = struct
+    include Internal
+    type ('query, 'input, 'output, 'error) types = {
+      query : 'query query ;
+      input : 'input input ;
+      output : 'output Encoding.t ;
+      error : 'error Encoding.t ;
+    }
+    and _ input =
+      | No_input : unit input
+      | Input : 'input Encoding.t -> 'input input
+    type (+'meth, 'prefix, 'params, 'query,
+          'input, 'output, 'error) iservice = {
+      description : string option ;
+      meth : 'meth ;
+      path : ('prefix, 'params) path ;
+      types : ('query, 'input, 'output, 'error) types ;
+    } constraint 'meth = [< meth ]
+    let from_service x = x
+    let to_service x = x
+
+    type (_, _) eq =
+      | Eq : (('query, 'input, 'output, 'error) types,
+              ('query, 'input, 'output, 'error) types) eq
+    exception Not_equal
+    let eq :
+      type query1 input1 output1 error1  query2 input2 output2 error2.
+      (query1, input1, output1, error1) types ->
+      (query2, input2, output2, error2) types ->
+      ((query1, input1, output1, error1) types,
+       (query2, input2, output2, error2) types) eq
+      = fun x y ->
+        if Obj.magic x == Obj.magic y then
+          Obj.magic Eq (* FIXME *)
+        else
+          raise Not_equal
+
+  end
+  include Internal
+  open Path
+
+  type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t =
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) Internal.iservice
+  type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service =
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t
+
+  let get_service ?description ~query ~output ~error path =
+    let input = No_input in
+    { meth = `GET ; description ; path ;
+      types = { query ; input ; output ; error } }
+
+  let post_service ?description ~query ~input ~output ~error path =
+    let input = Input input in
+    { meth = `POST ; description ; path ;
+      types = { query ; input ; output ; error } }
+
+  let delete_service ?description ~query ~output ~error path =
+    let input = No_input in
+    { meth = `DELETE ; description ; path ;
+      types = { query ; input ; output ; error } }
+
+  let put_service ?description ~query ~input ~output ~error path =
+    let input = Input input in
+    { meth = `PUT ; description ; path ;
+      types = { query ; input ; output ; error } }
+
+  let patch_service ?description ~query ~input ~output ~error path =
+    let input = Input input in
+    { meth = `PATCH ; description ; path ;
+      types = { query ; input ; output ; error } }
+
+  let prefix path s = { s with path = Path.prefix path s.path }
+  let subst0 s = { s with path = Internal.subst0 s.path }
+  let subst1 s = { s with path = Internal.subst1 s.path }
+  let subst2 s = { s with path = Internal.subst2 s.path }
+  let subst3 s = { s with path = Internal.subst3 s.path }
+
+  let meth = fun { meth } -> meth
+
+  let query
+    : type pr p i q o e.
+      (_, pr, p, q, i, o, e) service -> q Query.t
+    = fun { types } -> types.query
+
+  let input_encoding
+    : type pr p i q o e.
+      (_, pr , p, q, i, o, e) service -> i input
+    = fun { types } -> types.input
+
+  let output_encoding
+    : type pr p i q o e.
+      (_, pr, p, q, i, o, e) service -> o Encoding.t
+    = fun { types } -> types.output
+
+  let error_encoding
+    : type pr p i q o e.
+      (_, pr, p, q, i, o, e) service -> e Encoding.t
+    = fun { types } -> types.error
+
+  type ('prefix, 'params, 'error) description_service =
+    ([ `GET ], 'prefix, 'params * string list, Description.request,
+     unit, Encoding.schema Description.directory, 'error) service
+
+  let description_service ?description error path =
+    let description =
+      match description with
+      | Some descr -> descr
+      | None -> "<TODO>"
+    in
+    get_service
+      ~description
+      ~query:Description.request_query
+      ~output:Encoding.description_answer_encoding
+      ~error
+      Path.(path /:* Arg.string)
+
+  type 'input request = {
+    meth: meth ;
+    uri: Uri.t ;
+    input: 'input input ;
+  }
+
+  let forge_request_args
+    : type pr p. (pr, p) path -> p -> string list
+    = fun path args ->
+      let rec forge_request_args
+        : type k. (pr, k) path -> k -> string list -> string list
+        = fun path args acc ->
+          match path, args with
+          | Root, _ ->
+              acc
+          | Static (path, name), args ->
+              forge_request_args path args (name :: acc)
+          | Dynamic (path, arg), (args, x) ->
+              forge_request_args path args (arg.construct x :: acc)
+          | DynamicTail (path, arg), (args, xs) ->
+              forge_request_args path args
+                (List.fold_right (fun x acc -> arg.construct x :: acc) xs acc) in
+      forge_request_args path args []
+
+  let forge_request_query
+    : type q. q query -> q -> (string * string) list
+    = fun (Fields (fields, _)) q ->
+      let rec loop : type t. (q, t) query_fields -> _ = function
+        | F0 -> []
+        | F1 (Single { name ; ty ; get ; _ }, fields) ->
+            (name, ty.construct (get q)) :: loop fields
+        | F1 (Opt { name ; ty ; get ; _ }, fields) -> begin
+            match get q with
+            | None -> loop fields
+            | Some v -> (name, ty.construct v) :: loop fields
+          end
+        | F1 (Flag { name ; get ; _ }, fields) -> begin
+            match get q with
+            | false -> loop fields
+            | true -> (name, "true") :: loop fields
+          end
+        | F1 (Multi { name ; ty ; get ; _ }, fields) -> begin
+            match get q with
+            | [] -> loop fields
+            | l ->
+                List.fold_right
+                  (fun v acc -> (name, ty.construct v) :: acc)
+                  l
+                  (loop fields)
+          end in
+      loop fields
+
+  let forge_partial_request
+    : type pr p i q o e.
+      (_, pr, p, q, i, o, e) service -> ?base:Uri.t -> p -> q -> i request
+    = fun s ?base:(uri = Uri.empty) args query ->
+      let path = String.concat "/" (forge_request_args s.path args) in
+      let prefix = Uri.path uri in
+      let prefixed_path = if prefix = "" then path else prefix ^ "/" ^ path in
+      let uri = Uri.with_path uri prefixed_path in
+      let uri = Uri.with_query' uri (forge_request_query s.types.query query) in
+      { meth = s.meth ; uri ; input = s.types.input }
+
+  let forge_partial_request =
+    (forge_partial_request
+     : (meth, _, _, _, _, _, _) service -> _
+     :> ([< meth], _, _, _, _, _, _) service -> _ )
+
+  let forge_request =
+    (forge_partial_request
+     : (meth, _, _, _, _, _, _) service -> _
+     :> ([< meth], unit, _, _, _, _, _) service -> _ )
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.mli b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.mli
new file mode 100644
index 000000000..6efac8979
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/lib_resto/resto.mli
@@ -0,0 +1,421 @@
+(**************************************************************************)
+(*  ocplib-resto                                                          *)
+(*  Copyright (C) 2016, OCamlPro.                                         *)
+(*                                                                        *)
+(*    All rights reserved.  This file is distributed under the terms      *)
+(*    of the GNU Lesser General Public License version 2.1, with the      *)
+(*    special exception on linking described in the file LICENSE.         *)
+(*                                                                        *)
+(**************************************************************************)
+
+type meth = [ `GET | `POST | `DELETE | `PUT | `PATCH ]
+
+val string_of_meth: [< meth ] -> string
+val meth_of_string: string -> [> meth ] option
+
+module MethMap : Map.S with type key = meth
+module StringMap : Map.S with type 'a t = 'a Map.Make(String).t
+                          and type key = string
+
+type (_, _) eq = Eq : ('a, 'a) eq
+
+(** Typed path argument. *)
+module Arg : sig
+
+  type 'a t
+  type 'a arg = 'a t
+  val make:
+    ?descr:string ->
+    name:string ->
+    destruct:(string -> ('a, string) result) ->
+    construct:('a -> string) ->
+    unit -> 'a arg
+
+  type descr = {
+    name: string ;
+    descr: string option ;
+  }
+  val descr: 'a arg -> descr
+
+  val bool: bool arg
+  val int: int arg
+  val int32: int32 arg
+  val int64: int64 arg
+  val float: float arg
+  val string: string arg
+
+  val like: 'a arg -> ?descr:string -> string -> 'a arg
+
+  val eq: 'a arg -> 'b arg -> ('a, 'b) eq option
+
+end
+
+
+(** Parametrized path to services. *)
+module Path : sig
+
+  type ('prefix, 'params) t
+  type ('prefix, 'params) path = ('prefix, 'params) t
+  type 'prefix context = ('prefix, 'prefix) path
+
+  val root: unit context
+  val open_root: 'a context
+
+  val add_suffix:
+    ('prefix, 'params) path -> string -> ('prefix, 'params) path
+  val (/):
+    ('prefix, 'params) path -> string -> ('prefix, 'params) path
+
+  val add_arg:
+    ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a) path
+  val (/:):
+    ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a) path
+
+  val add_final_args:
+    ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a list) path
+  val (/:*):
+    ('prefix, 'params) path -> 'a Arg.t -> ('prefix, 'params * 'a list) path
+
+  val prefix:
+    ('prefix, 'a) path -> ('a, 'params) path -> ('prefix, 'params) path
+
+  val subst0:
+    ('p, 'p) path -> ('p2, 'p2) path
+  val subst1:
+    ('p, 'p * 'a) path -> ('p2, 'p2 * 'a) path
+  val subst2:
+    ('p, ('p * 'a) * 'b) path -> ('p2, ('p2 * 'a) * 'b) path
+  val subst3:
+    ('p, (('p * 'a) * 'b) * 'c) path -> ('p2, (('p2 * 'a) * 'b) * 'c) path
+
+end
+
+(** Service directory description *)
+module Description : sig
+
+  type request = {
+    recurse: bool ;
+  }
+
+  type 'schema service = {
+    description: string option ;
+    path: path_item list ;
+    meth: meth ;
+    query: query_item list ;
+    input: 'schema option ;
+    output: 'schema ;
+    error: 'schema ;
+  }
+
+  and path_item =
+    | PStatic of string
+    | PDynamic of Arg.descr
+    | PDynamicTail of Arg.descr
+
+  and query_item = {
+    name: string ;
+    description: string option ;
+    kind: query_kind ;
+  }
+
+  and query_kind =
+    | Single of Arg.descr
+    | Optional of Arg.descr
+    | Flag
+    | Multi of Arg.descr
+
+  type 'schema directory =
+    | Empty
+    | Static of 'schema static_directory
+    | Dynamic of string option
+
+  and 'schema static_directory = {
+    services: 'schema service MethMap.t ;
+    subdirs: 'schema static_subdirectories option ;
+  }
+
+  and 'schema static_subdirectories =
+    | Suffixes of 'schema directory StringMap.t
+    | Arg of Arg.descr * 'schema directory
+
+  val pp_print_directory:
+    (* ?pp_schema:(Format.formatter -> 'schema -> unit) -> *) (* TODO ?? *)
+    Format.formatter -> 'schema directory -> unit
+
+end
+
+module Query : sig
+
+  type 'a t
+  type 'a query = 'a t
+
+  val empty: unit query
+
+  type ('a, 'b) field
+  val field:
+    ?descr: string ->
+    string -> 'a Arg.t -> 'a -> ('b -> 'a) -> ('b, 'a) field
+  val opt_field:
+    ?descr: string ->
+    string -> 'a Arg.t -> ('b -> 'a option) -> ('b, 'a option) field
+  val flag:
+    ?descr: string ->
+    string -> ('b -> bool) -> ('b, bool) field
+  val multi_field:
+    ?descr: string ->
+    string -> 'a Arg.t -> ('b -> 'a list) -> ('b, 'a list) field
+
+  type ('a, 'b, 'c) open_query
+  val query: 'b -> ('a, 'b, 'b) open_query
+  val (|+):
+    ('a, 'b, 'c -> 'd) open_query ->
+    ('a, 'c) field -> ('a, 'b, 'd) open_query
+  val seal: ('a, 'b, 'a) open_query -> 'a t
+
+  type untyped = (string * string) list
+  exception Invalid of string
+  val parse: 'a query -> untyped -> 'a
+
+end
+
+(**/**)
+
+module Internal : sig
+
+  module Ty : sig
+
+    exception Not_equal
+    type 'a id
+    val eq : 'a id -> 'b id -> ('a, 'b) eq
+
+  end
+
+  type 'a arg = {
+    id: 'a Ty.id;
+    destruct: string -> ('a, string) result ;
+    construct: 'a -> string ;
+    descr: Arg.descr ;
+  }
+
+  val from_arg : 'a arg -> 'a Arg.t
+  val to_arg : 'a Arg.t -> 'a arg
+
+  type (_, _) path =
+    | Root : ('rkey, 'rkey) path
+    | Static : ('rkey, 'key) path * string -> ('rkey, 'key) path
+    | Dynamic : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a) path
+    | DynamicTail : ('rkey, 'key) path * 'a arg -> ('rkey, 'key * 'a list) path
+
+  val from_path : ('a, 'b) path -> ('a, 'b) Path.t
+  val to_path : ('a, 'b) Path.t -> ('a, 'b) path
+
+  type 'a query =
+    | Fields: ('a, 'b) query_fields * 'b -> 'a query
+
+  and ('a, 'b) query_fields =
+    | F0: ('a, 'a) query_fields
+    | F1: ('a, 'b) query_field * ('a, 'c) query_fields ->
+      ('a, 'b -> 'c) query_fields
+
+  and ('a, 'b) query_field =
+    | Single : {
+        name : string ; description : string option ;
+        ty : 'b arg ; default : 'b ; get : 'a -> 'b ;
+      } -> ('a, 'b) query_field
+    | Opt : {
+        name : string ; description : string option ;
+        ty : 'b arg ; get : 'a -> 'b option ;
+      } -> ('a, 'b option) query_field
+    | Flag : {
+        name : string ; description : string option ;
+        get : 'a -> bool ;
+      } -> ('a, bool) query_field
+    | Multi : {
+        name : string ; description : string option ;
+        ty : 'b arg ; get : 'a -> 'b list ;
+      } -> ('a, 'b list) query_field
+
+  val from_query : 'a query -> 'a Query.t
+  val to_query : 'a Query.t -> 'a query
+
+  val field_name : ('a, 'b) query_field -> string
+  val field_description : ('a, 'b) query_field -> string option
+  val field_kind : ('a, 'b) query_field -> Description.query_kind
+
+end
+
+(**/**)
+
+module type ENCODING = sig
+  type 'a t
+  type schema
+  val unit : unit t
+  val untyped : string t
+  val conv : ('a -> 'b) -> ('b -> 'a) -> 'b t -> 'a t
+  val schema : ?definitions_path:string -> 'a t -> schema
+  val description_request_encoding : Description.request t
+  val description_answer_encoding : schema Description.directory t
+end
+
+module MakeService(Encoding : ENCODING) : sig
+
+  (** Services. *)
+  type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t
+    constraint 'meth = [< meth ]
+  type (+'meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service =
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) t
+
+
+  val meth:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    'meth
+
+  val query:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    'query Query.t
+
+  type _ input =
+    | No_input : unit input
+    | Input : 'input Encoding.t -> 'input input
+
+  val input_encoding:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    'input input
+
+  val output_encoding:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    'output Encoding.t
+
+  val error_encoding:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    'error Encoding.t
+
+  val get_service:
+    ?description: string ->
+    query: 'query Query.t ->
+    output: 'output Encoding.t ->
+    error: 'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ([ `GET ], 'prefix, 'params, 'query, unit, 'output, 'error) service
+
+  val post_service:
+    ?description: string ->
+    query:'query Query.t ->
+    input: 'input Encoding.t ->
+    output: 'output Encoding.t ->
+    error: 'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ([ `POST ], 'prefix, 'params, 'query, 'input, 'output, 'error) service
+
+  val delete_service:
+    ?description: string ->
+    query:'query Query.t ->
+    output: 'output Encoding.t ->
+    error: 'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ([ `DELETE ], 'prefix, 'params, 'query, unit, 'output, 'error) service
+
+  val patch_service:
+    ?description: string ->
+    query:'query Query.t ->
+    input: 'input Encoding.t ->
+    output: 'output Encoding.t ->
+    error: 'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ([ `PATCH ], 'prefix, 'params, 'query, 'input, 'output, 'error) service
+
+  val put_service:
+    ?description: string ->
+    query:'query Query.t ->
+    input: 'input Encoding.t ->
+    output: 'output Encoding.t ->
+    error: 'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ([ `PUT ], 'prefix, 'params, 'query, 'input, 'output, 'error) service
+
+  val prefix:
+    ('prefix, 'inner_prefix) Path.t ->
+    ('meth, 'inner_prefix, 'params, 'query,
+     'input, 'output, 'error) service ->
+    ('meth, 'prefix, 'params,
+     'query, 'input, 'output, 'error) service
+
+  val subst0:
+    ([< meth ] as 'm, 'p, 'p, 'q, 'i, 'o, 'e) service ->
+    ('m, 'p2, 'p2, 'q, 'i, 'o, 'e) service
+
+  val subst1:
+    ([< meth ] as 'm, 'p, 'p * 'a, 'q, 'i, 'o, 'e) service ->
+    ('m, 'p2, 'p2 * 'a, 'q, 'i, 'o, 'e) service
+
+  val subst2:
+    ([< meth ] as 'm, 'p, ('p * 'a) * 'b, 'q, 'i, 'o, 'e) service ->
+    ('m, 'p2, ('p2 * 'a) * 'b, 'q, 'i, 'o, 'e) service
+
+  val subst3:
+    ([< meth ] as 'm, 'p, (('p * 'a) * 'b) * 'c, 'q, 'i, 'o, 'e) service ->
+    ('m, 'p2, (('p2 * 'a) * 'b) * 'c, 'q, 'i, 'o, 'e) service
+
+  type ('prefix, 'params, 'error) description_service =
+    ([ `GET ], 'prefix, 'params * string list, Description.request,
+     unit, Encoding.schema Description.directory, 'error) service
+
+  val description_service:
+    ?description:string ->
+    'error Encoding.t ->
+    ('prefix, 'params) Path.t ->
+    ('prefix, 'params, 'error) description_service
+
+  type 'input request = {
+    meth: meth ;
+    uri: Uri.t ;
+    input: 'input input ;
+  }
+
+  val forge_request:
+    ('meth, unit, 'params, 'query, 'input, 'output, 'error) service ->
+    ?base:Uri.t -> 'params -> 'query -> 'input request
+
+  val forge_partial_request:
+    ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+    ?base:Uri.t -> 'params -> 'query -> 'input request
+
+  module Internal : sig
+
+    include (module type of (struct include Internal end))
+
+    type ('query, 'input, 'output, 'error) types = {
+      query : 'query Query.t ;
+      input : 'input input ;
+      output : 'output Encoding.t ;
+      error : 'error Encoding.t ;
+    }
+
+    type (+'meth, 'prefix, 'params, 'query,
+          'input, 'output, 'error) iservice = {
+      description : string option ;
+      meth : 'meth ;
+      path : ('prefix, 'params) path ;
+      types : ('query, 'input, 'output, 'error) types ;
+    } constraint 'meth = [< meth ]
+
+    exception Not_equal
+    type (_, _) eq =
+      | Eq : (('query, 'input, 'output, 'error) types,
+              ('query, 'input, 'output, 'error) types) eq
+    val eq :
+      ('query1, 'input1, 'output1, 'error1) types ->
+      ('query2, 'input2, 'output2, 'error2) types ->
+      (('query1, 'input1, 'output1, 'error1) types,
+       ('query2, 'input2, 'output2, 'error2) types) eq
+
+    val from_service:
+      ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) iservice ->
+      ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service
+    val to_service:
+      ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) service ->
+      ('meth, 'prefix, 'params, 'query, 'input, 'output, 'error) iservice
+
+  end
+
+end
diff --git a/vendors/tezos-modded/vendors/ocplib-resto/ocplib-resto.version b/vendors/tezos-modded/vendors/ocplib-resto/ocplib-resto.version
new file mode 100644
index 000000000..3b04cfb60
--- /dev/null
+++ b/vendors/tezos-modded/vendors/ocplib-resto/ocplib-resto.version
@@ -0,0 +1 @@
+0.2